52 lines
1.3 KiB
Factor
Executable File
52 lines
1.3 KiB
Factor
Executable File
! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: kernel sequences combinators parser splitting math
|
|
quotations arrays make qualified words ;
|
|
IN: fry
|
|
|
|
: _ ( -- * ) "Only valid inside a fry" throw ;
|
|
: @ ( -- * ) "Only valid inside a fry" throw ;
|
|
|
|
<PRIVATE
|
|
|
|
DEFER: (shallow-fry)
|
|
DEFER: shallow-fry
|
|
|
|
: ((shallow-fry)) ( accum quot adder -- result )
|
|
>r shallow-fry r>
|
|
append swap [
|
|
[ prepose ] curry append
|
|
] unless-empty ; inline
|
|
|
|
: (shallow-fry) ( accum quot -- result )
|
|
[ 1quotation ] [
|
|
unclip {
|
|
{ \ _ [ [ curry ] ((shallow-fry)) ] }
|
|
{ \ @ [ [ compose ] ((shallow-fry)) ] }
|
|
[ swap >r suffix r> (shallow-fry) ]
|
|
} case
|
|
] if-empty ;
|
|
|
|
: shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
|
|
|
|
PREDICATE: fry-specifier < word { _ @ } memq? ;
|
|
|
|
GENERIC: count-inputs ( quot -- n )
|
|
|
|
M: callable count-inputs [ count-inputs ] sigma ;
|
|
M: fry-specifier count-inputs drop 1 ;
|
|
M: object count-inputs drop 0 ;
|
|
|
|
PRIVATE>
|
|
|
|
: fry ( quot -- quot' )
|
|
[
|
|
[
|
|
dup callable? [
|
|
[ count-inputs \ _ <repetition> % ] [ fry % ] bi
|
|
] [ , ] if
|
|
] each
|
|
] [ ] make shallow-fry ;
|
|
|
|
: '[ \ ] parse-until fry over push-all ; parsing
|