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

generalizations: make napply work with non-literal quotations

db4
Slava Pestov 2009-09-29 23:28:43 -05:00
parent eeb601dade
commit 86118ce56a
3 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/generalizations/generalizations-docs.factor
View File

@ -202,7 +202,7 @@ HELP: nwith
} ; } ;
HELP: napply HELP: napply
{ $values { "quot" quotation } { "n" integer } } { $values { "n" integer } }
{ $description "A generalization of " { $link bi@ } " and " { $link tri@ } " that can work for any stack depth." { $description "A generalization of " { $link bi@ } " and " { $link tri@ } " that can work for any stack depth."
} }
{ $examples { $examples

5
basis/generalizations/generalizations-tests.factor
View File

@ -1,4 +1,5 @@
USING: tools.test generalizations kernel math arrays sequences ascii ; USING: tools.test generalizations kernel math arrays sequences
ascii fry math.parser ;
IN: generalizations.tests IN: generalizations.tests
{ 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test { 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test
@ -72,3 +73,5 @@ IN: generalizations.tests
1 2 3 4 3 nover ; 1 2 3 4 3 nover ;
[ 1 2 3 4 1 2 3 ] [ nover-test ] unit-test [ 1 2 3 4 1 2 3 ] [ nover-test ] unit-test
[ '[ number>string _ append ] 4 napply ] must-infer

4
basis/generalizations/generalizations.factor
View File

@ -87,8 +87,8 @@ MACRO: nspread ( quots n -- )
'[ [ _ _ nspread ] _ ndip @ ] '[ [ _ _ nspread ] _ ndip @ ]
] if ; ] if ;
MACRO: napply ( quot n -- ) MACRO: napply ( n -- )
swap <repetition> spread>quot ; [ [ drop ] ] dip [ '[ tuck _ 2dip call ] ] times ;
MACRO: mnswap ( m n -- ) MACRO: mnswap ( m n -- )
1 + '[ _ -nrot ] swap '[ _ _ napply ] ; 1 + '[ _ -nrot ] swap '[ _ _ napply ] ;