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

Another recursive fry fi

db4
Slava Pestov 2008-05-26 00:48:18 -05:00
parent 1c10cb0ff1
commit b91a314f0e
2 changed files with 22 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
extra/fry/fry-tests.factor
View File

@ -52,3 +52,13 @@ sequences ;
[ { 1 { 2 { 3 } } } ] [ [ { 1 { 2 { 3 } } } ] [
1 2 3 '[ , [ , [ , 1array ] call 2array ] call 2array ] call 1 2 3 '[ , [ , [ , 1array ] call 2array ] call 2array ] call
] unit-test ] unit-test
{ 1 1 } [ '[ [ [ , ] ] ] ] must-infer-as
[ { { { 3 } } } ] [
3 '[ [ [ , 1array ] call 1array ] call 1array ] call
] unit-test
[ { { { 3 } } } ] [
3 '[ [ [ , 1array ] call 1array ] call 1array ] call
] unit-test

17
extra/fry/fry.factor
View File

@ -46,15 +46,22 @@ DEFER: (shallow-fry)
shallow-fry shallow-fry
] if* ; ] 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' ) : fry ( quot -- quot' )
[ [
[ [
dup callable? [ dup callable? [
[ [ count-inputs \ , <repetition> % ] [ fry % ] bi
[ { , namespaces:, @ } member? ] filter length
\ , <repetition> %
]
[ fry % ] bi
] [ namespaces:, ] if ] [ namespaces:, ] if
] each ] each
] [ ] make deep-fry ; ] [ ] make deep-fry ;