unmaintained/bake/fry/fry.factor

   1
   2 USING: kernel combinators arrays vectors quotations sequences splitting
   3        parser macros sequences.deep
   4        combinators.short-circuit combinators.conditional bake newfx ;
   5
   6 IN: bake.fry
   7
   8 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   9
  10 SYMBOL: _
  11
  12 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  13
  14 DEFER: (shallow-fry)
  15 DEFER: shallow-fry
  16
  17 : ((shallow-fry)) ( accum quot adder -- result )
  18   >r shallow-fry r>
  19   append swap dup empty?
  20     [ drop ]
  21     [ [ prepose ] curry append ]
  22   if ; inline
  23
  24 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  25
  26 : (shallow-fry) ( accum quot -- result )
  27   dup empty?
  28     [ drop 1quotation ]
  29     [
  30       unclip
  31         {
  32           { \ , [ [ curry   ] ((shallow-fry)) ] }
  33           { \ @ [ [ compose ] ((shallow-fry)) ] }
  34           [ swap >r suffix r> (shallow-fry) ]
  35         }
  36       case
  37     ]
  38   if ;
  39
  40 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  41
  42 : shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
  43
  44 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  45
  46 : deep-fry ( quot -- quot )
  47   { _ } split1-last dup
  48     [
  49       shallow-fry [ >r ] rot
  50       deep-fry    [ [ dip ] curry r> compose ] 4array concat
  51     ]
  52     [ drop shallow-fry ]
  53   if ;
  54
  55 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  56
  57 : bakeable? ( obj -- ? ) { [ array? ] [ vector? ] } 1|| ;
  58
  59 : fry-specifier? ( obj -- ? ) { , @ } member-of? ;
  60
  61 : count-inputs ( quot -- n ) flatten [ fry-specifier? ] count ;
  62
  63 : commas ( n -- seq ) , <repetition> ;
  64
  65 : [fry] ( quot -- quot' )
  66     [
  67         {
  68           { [ callable? ] [ [ count-inputs commas ] [ [fry]  ] bi append ] }
  69           { [ bakeable? ] [ [ count-inputs commas ] [ [bake] ] bi append ] }
  70           { [ drop t    ] [ 1quotation                                   ] }
  71         }
  72       1cond
  73     ]
  74   map concat deep-fry ;
  75
  76 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  77
  78 MACRO: fry ( seq -- quot ) [fry] ;
  79
  80 : '[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing