generalizations: make napply work with non-literal quotations
							parent
							
								
									eeb601dade
								
							
						
					
					
						commit
						86118ce56a
					
				| 
						 | 
				
			
			@ -202,7 +202,7 @@ HELP: nwith
 | 
			
		|||
} ;
 | 
			
		||||
 | 
			
		||||
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."
 | 
			
		||||
} 
 | 
			
		||||
{ $examples
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
 | 
			
		||||
{ 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 1 2 3 ] [ nover-test ] unit-test
 | 
			
		||||
 | 
			
		||||
[ '[ number>string _ append ] 4 napply ] must-infer
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -87,8 +87,8 @@ MACRO: nspread ( quots n -- )
 | 
			
		|||
        '[ [ _ _ nspread ] _ ndip @ ]
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
MACRO: napply ( quot n -- )
 | 
			
		||||
    swap <repetition> spread>quot ;
 | 
			
		||||
MACRO: napply ( n -- )
 | 
			
		||||
    [ [ drop ] ] dip [ '[ tuck _ 2dip call ] ] times ;
 | 
			
		||||
 | 
			
		||||
MACRO: mnswap ( m n -- )
 | 
			
		||||
    1 + '[ _ -nrot ] swap '[ _ _ napply ] ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue