basis/fry/fry.factor

   1 ! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel sequences combinators parser splitting math
   4 quotations arrays make qualified words ;
   5 IN: fry
   6
   7 : _ ( -- * ) "Only valid inside a fry" throw ;
   8 : @ ( -- * ) "Only valid inside a fry" throw ;
   9
  10 <PRIVATE
  11
  12 DEFER: (shallow-fry)
  13 DEFER: shallow-fry
  14
  15 : ((shallow-fry)) ( accum quot adder -- result )
  16     >r shallow-fry r>
  17     append swap [
  18         [ prepose ] curry append
  19     ] unless-empty ; inline
  20
  21 : (shallow-fry) ( accum quot -- result )
  22     [ 1quotation ] [
  23         unclip {
  24             { \ _ [ [ curry ] ((shallow-fry)) ] }
  25             { \ @ [ [ compose ] ((shallow-fry)) ] }
  26             [ swap >r suffix r> (shallow-fry) ]
  27         } case
  28     ] if-empty ;
  29
  30 : shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
  31
  32 PREDICATE: fry-specifier < word { _ @ } memq? ;
  33
  34 GENERIC: count-inputs ( quot -- n )
  35
  36 M: callable count-inputs [ count-inputs ] sigma ;
  37 M: fry-specifier count-inputs drop 1 ;
  38 M: object count-inputs drop 0 ;
  39
  40 PRIVATE>
  41
  42 : fry ( quot -- quot' )
  43     [
  44         [
  45             dup callable? [
  46                 [ count-inputs \ _ <repetition> % ] [ fry % ] bi
  47             ] [ , ] if
  48         ] each
  49     ] [ ] make shallow-fry ;
  50
  51 : '[ \ ] parse-until fry over push-all ; parsing