Removing slip 2slip 3slip nslip
Slava Pestov
parent
a366909c25
commit
f6ff74596e
|
|
@ -57,7 +57,6 @@ $nl
|
|||
"Here are some built-in combinators rewritten in terms of fried quotations:"
|
||||
{ $table
|
||||
{ { $link literalize } { $snippet ": literalize '[ _ ] ;" } }
|
||||
{ { $link slip } { $snippet ": slip '[ @ _ ] call ;" } }
|
||||
{ { $link curry } { $snippet ": curry '[ _ @ ] ;" } }
|
||||
{ { $link compose } { $snippet ": compose '[ @ @ ] ;" } }
|
||||
{ { $link bi@ } { $snippet ": bi@ tuck '[ _ @ _ @ ] call ;" } }
|
||||
|
|
|
|||
|
|
@ -161,22 +161,6 @@ HELP: ndip
|
|||
}
|
||||
} ;
|
||||
|
||||
HELP: nslip
|
||||
{ $values { "n" integer } }
|
||||
{ $description "A generalization of " { $link slip } " that can work "
|
||||
"for any stack depth. The first " { $snippet "n" } " items after the quotation will be "
|
||||
"removed from the stack, the quotation called, and the items restored."
|
||||
}
|
||||
{ $examples
|
||||
{ $example "USING: generalizations kernel prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip 6 narray ." "{ 99 1 2 3 4 5 }" }
|
||||
"Some core words expressed in terms of " { $link nslip } ":"
|
||||
{ $table
|
||||
{ { $link slip } { $snippet "1 nslip" } }
|
||||
{ { $link 2slip } { $snippet "2 nslip" } }
|
||||
{ { $link 3slip } { $snippet "3 nslip" } }
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: nkeep
|
||||
{ $values { "quot" quotation } { "n" integer } }
|
||||
{ $description "A generalization of " { $link keep } " that can work "
|
||||
|
|
@ -339,7 +323,6 @@ ARTICLE: "shuffle-generalizations" "Generalized shuffle words"
|
|||
|
||||
ARTICLE: "combinator-generalizations" "Generalized combinators"
|
||||
{ $subsection ndip }
|
||||
{ $subsection nslip }
|
||||
{ $subsection nkeep }
|
||||
{ $subsection napply }
|
||||
{ $subsection ncleave }
|
||||
|
|
|
|||
|
|
@ -26,8 +26,6 @@ IN: generalizations.tests
|
|||
[ [ 1 ] 5 ndip ] must-infer
|
||||
[ 1 2 3 4 ] [ 2 3 4 [ 1 ] 3 ndip ] unit-test
|
||||
|
||||
[ [ 99 ] 1 2 3 4 5 5 nslip ] must-infer
|
||||
{ 99 1 2 3 4 5 } [ [ 99 ] 1 2 3 4 5 5 nslip ] unit-test
|
||||
[ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer
|
||||
{ 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test
|
||||
[ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test
|
||||
|
|
|
|||
|
|
@ -60,9 +60,6 @@ MACRO: ntuck ( n -- )
|
|||
MACRO: ndip ( quot n -- )
|
||||
[ '[ _ dip ] ] times ;
|
||||
|
||||
MACRO: nslip ( n -- )
|
||||
'[ [ call ] _ ndip ] ;
|
||||
|
||||
MACRO: nkeep ( quot n -- )
|
||||
tuck '[ _ ndup _ _ ndip ] ;
|
||||
|
||||
|
|
|
|||
|
|
@ -62,9 +62,6 @@ $nl
|
|||
": dip [ ] bi* ;"
|
||||
": 2dip [ ] [ ] tri* ;"
|
||||
""
|
||||
": slip [ call ] [ ] bi* ;"
|
||||
": 2slip [ call ] [ ] [ ] tri* ;"
|
||||
""
|
||||
": nip [ drop ] [ ] bi* ;"
|
||||
": 2nip [ drop ] [ drop ] [ ] tri* ;"
|
||||
""
|
||||
|
|
@ -121,7 +118,7 @@ $nl
|
|||
{ $subsection both? }
|
||||
{ $subsection either? } ;
|
||||
|
||||
ARTICLE: "slip-keep-combinators" "Retain stack combinators"
|
||||
ARTICLE: "retainstack-combinators" "Retain stack combinators"
|
||||
"Sometimes an additional storage area is needed to hold objects. The " { $emphasis "retain stack" } " is an auxilliary stack for this purpose. Objects can be moved between the data and retain stacks using a set of combinators."
|
||||
$nl
|
||||
"The dip combinators invoke the quotation at the top of the stack, hiding the values underneath:"
|
||||
|
|
@ -129,10 +126,6 @@ $nl
|
|||
{ $subsection 2dip }
|
||||
{ $subsection 3dip }
|
||||
{ $subsection 4dip }
|
||||
"The slip combinators invoke a quotation further down on the stack. They are most useful for implementing other combinators:"
|
||||
{ $subsection slip }
|
||||
{ $subsection 2slip }
|
||||
{ $subsection 3slip }
|
||||
"The keep combinators invoke a quotation which takes a number of values off the stack, and then they restore those values:"
|
||||
{ $subsection keep }
|
||||
{ $subsection 2keep }
|
||||
|
|
@ -259,7 +252,7 @@ ARTICLE: "conditionals" "Conditional combinators"
|
|||
|
||||
ARTICLE: "dataflow-combinators" "Data flow combinators"
|
||||
"Data flow combinators pass values between quotations:"
|
||||
{ $subsection "slip-keep-combinators" }
|
||||
{ $subsection "retainstack-combinators" }
|
||||
{ $subsection "cleave-combinators" }
|
||||
{ $subsection "spread-combinators" }
|
||||
{ $subsection "apply-combinators" }
|
||||
|
|
|
|||
|
|
@ -212,18 +212,6 @@ HELP: call-clear ( quot -- )
|
|||
{ $description "Calls a quotation with an empty call stack. If the quotation returns, Factor will exit.." }
|
||||
{ $notes "Used to implement " { $link "threads" } "." } ;
|
||||
|
||||
HELP: slip
|
||||
{ $values { "quot" quotation } { "x" object } }
|
||||
{ $description "Calls a quotation while hiding the top of the stack." } ;
|
||||
|
||||
HELP: 2slip
|
||||
{ $values { "quot" quotation } { "x" object } { "y" object } }
|
||||
{ $description "Calls a quotation while hiding the top two stack elements." } ;
|
||||
|
||||
HELP: 3slip
|
||||
{ $values { "quot" quotation } { "x" object } { "y" object } { "z" object } }
|
||||
{ $description "Calls a quotation while hiding the top three stack elements." } ;
|
||||
|
||||
HELP: keep
|
||||
{ $values { "quot" { $quotation "( x -- ... )" } } { "x" object } }
|
||||
{ $description "Call a quotation with a value on the stack, restoring the value when the quotation returns." }
|
||||
|
|
|
|||
|
|
@ -58,37 +58,19 @@ DEFER: if
|
|||
: ?if ( default cond true false -- )
|
||||
pick [ drop [ drop ] 2dip call ] [ 2nip call ] if ; inline
|
||||
|
||||
! Slippers and dippers.
|
||||
! Dippers.
|
||||
! Not declared inline because the compiler special-cases them
|
||||
|
||||
: slip ( quot x -- x )
|
||||
#! 'slip' and 'dip' can be defined in terms of each other
|
||||
#! because the JIT special-cases a 'dip' preceeded by
|
||||
#! a literal quotation.
|
||||
[ call ] dip ;
|
||||
: dip ( x quot -- x ) swap [ call ] dip ;
|
||||
|
||||
: 2slip ( quot x y -- x y )
|
||||
#! '2slip' and '2dip' can be defined in terms of each other
|
||||
#! because the JIT special-cases a '2dip' preceeded by
|
||||
#! a literal quotation.
|
||||
[ call ] 2dip ;
|
||||
: 2dip ( x y quot -- x y ) -rot [ call ] 2dip ;
|
||||
|
||||
: 3slip ( quot x y z -- x y z )
|
||||
#! '3slip' and '3dip' can be defined in terms of each other
|
||||
#! because the JIT special-cases a '3dip' preceeded by
|
||||
#! a literal quotation.
|
||||
[ call ] 3dip ;
|
||||
|
||||
: dip ( x quot -- x ) swap slip ;
|
||||
|
||||
: 2dip ( x y quot -- x y ) -rot 2slip ;
|
||||
|
||||
: 3dip ( x y z quot -- x y z ) -roll 3slip ;
|
||||
: 3dip ( x y z quot -- x y z ) -roll [ call ] 3dip ;
|
||||
|
||||
: 4dip ( w x y z quot -- w x y z ) swap [ 3dip ] dip ; inline
|
||||
|
||||
! Keepers
|
||||
: keep ( x quot -- x ) over slip ; inline
|
||||
: keep ( x quot -- x ) over [ call ] dip ; inline
|
||||
|
||||
: 2keep ( x y quot -- x y ) [ 2dup ] dip 2dip ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ M: quotation call (call) ;
|
|||
|
||||
M: curry call uncurry call ;
|
||||
|
||||
M: compose call uncompose slip call ;
|
||||
M: compose call uncompose [ call ] dip call ;
|
||||
|
||||
M: wrapper equal?
|
||||
over wrapper? [ [ wrapped>> ] bi@ = ] [ 2drop f ] if ;
|
||||
|
|
|
|||
|
|
@ -52,7 +52,6 @@ IN: reports.noise
|
|||
{ nkeep 5 }
|
||||
{ npick 6 }
|
||||
{ nrot 5 }
|
||||
{ nslip 5 }
|
||||
{ ntuck 6 }
|
||||
{ nwith 4 }
|
||||
{ over 2 }
|
||||
|
|
|
|||
Loading…
Reference in New Issue