steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fry: make-free deep-fry

db4
Eduardo Cavazos 2008-07-03 11:25:27 -05:00
parent d0cddcfc41
commit 9b3d124157
1 changed files with 11 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
extra/fry/fry.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos. ! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences combinators parser splitting USING: kernel sequences combinators parser splitting math
quotations arrays namespaces qualified ; quotations arrays namespaces qualified sequences.deep sequences.lib ;
QUALIFIED: namespaces QUALIFIED: namespaces
IN: fry IN: fry
@ -35,26 +35,22 @@ DEFER: shallow-fry
: shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ; : shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
: deep-fry ( quot -- quot' ) : deep-fry ( quot -- quot )
{ _ } last-split1 [ { _ } last-split1 dup [
[ shallow-fry [ >r ] rot
shallow-fry % deep-fry [ [ dip ] curry r> compose ] 4array concat
[ >r ] %
deep-fry %
[ [ dip ] curry r> compose ] %
] [ ] make
] [ ] [
shallow-fry drop shallow-fry
] if* ; ] if ;
: fry-specifier? ( obj -- ? ) { , namespaces:, @ } member? ; : fry-specifier? ( obj -- ? ) { , namespaces:, @ } member? ;
: count-inputs ( quot -- n ) : count-inputs ( quot -- n )
[ [
{ {
{ [ dup callable? ] [ count-inputs ] } { [ dup callable? ] [ count-inputs ] }
{ [ dup fry-specifier? ] [ drop 1 ] } { [ dup fry-specifier? ] [ drop 1 ] }
[ drop 0 ] [ drop 0 ]
} cond } cond
] map sum ; ] map sum ;