factor/extra/fry/fry.factor

70 lines
1.7 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
quotations arrays namespaces qualified ;
QUALIFIED: namespaces
IN: fry
: , "Only valid inside a fry" throw ;
: @ "Only valid inside a fry" throw ;
: _ "Only valid inside a fry" throw ;
DEFER: (shallow-fry)
: ((shallow-fry)) ( accum quot adder -- result )
>r [ ] swap (shallow-fry) r>
append swap dup empty? [ drop ] [
[ prepose ] curry append
] if ; inline
: (shallow-fry) ( accum quot -- result )
dup empty? [
drop 1quotation
] [
unclip {
{ \ , [ [ curry ] ((shallow-fry)) ] }
{ \ @ [ [ compose ] ((shallow-fry)) ] }
! to avoid confusion, remove if fry goes core
{ \ namespaces:, [ [ curry ] ((shallow-fry)) ] }
[ swap >r suffix r> (shallow-fry) ]
} case
] if ;
: shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
: deep-fry ( quot -- quot' )
{ _ } last-split1 [
[
shallow-fry %
[ >r ] %
deep-fry %
[ [ dip ] curry r> compose ] %
] [ ] make
] [
shallow-fry
] if* ;
: fry-specifier? ( obj -- ? ) { , namespaces:, @ } member? ;
: count-inputs ( quot -- n )
[
{
{ [ dup callable? ] [ count-inputs ] }
{ [ dup fry-specifier? ] [ drop 1 ] }
[ drop 0 ]
} cond
] map sum ;
: fry ( quot -- quot' )
[
[
dup callable? [
[ count-inputs \ , <repetition> % ] [ fry % ] bi
] [ namespaces:, ] if
] each
] [ ] make deep-fry ;
: '[ \ ] parse-until fry over push-all ; parsing