Clean up short-circuit combinators

db4
Slava Pestov 2008-11-21 04:36:18 -06:00
parent c678e6e362
commit 34b8bcf305
3 changed files with 19 additions and 25 deletions

View File

@ -52,17 +52,17 @@ HELP: 3||
{ "quot" quotation } } { "quot" quotation } }
{ $description "Returns true if any quotation in the sequence returns true. Each quotation takes the same three elements from the datastack and must return a boolean." } ; { $description "Returns true if any quotation in the sequence returns true. Each quotation takes the same three elements from the datastack and must return a boolean." } ;
HELP: n&&-rewrite HELP: n&&
{ $values { $values
{ "quots" "a sequence of quotations" } { "N" integer } { "quots" "a sequence of quotations" } { "N" integer }
{ "quot" quotation } } { "quot" quotation } }
{ $description "A macro that reqrites the code to pass " { $snippet "N" } " parameters from the stack to each AND quotation." } ; { $description "A macro that reqrites the code to pass " { $snippet "n" } " parameters from the stack to each AND quotation." } ;
HELP: n||-rewrite HELP: n||
{ $values { $values
{ "quots" "a sequence of quotations" } { "N" integer } { "quots" "a sequence of quotations" } { "n" integer }
{ "quot" quotation } } { "quot" quotation } }
{ $description "A macro that reqrites the code to pass " { $snippet "N" } " parameters from the stack to each OR quotation." } ; { $description "A macro that reqrites the code to pass " { $snippet "n" } " parameters from the stack to each OR quotation." } ;
ARTICLE: "combinators.short-circuit" "Short-circuit combinators" ARTICLE: "combinators.short-circuit" "Short-circuit combinators"
"The " { $vocab-link "combinators.short-circuit" } " vocabulary stops a computation early once a condition is met." $nl "The " { $vocab-link "combinators.short-circuit" } " vocabulary stops a computation early once a condition is met." $nl
@ -77,8 +77,8 @@ ARTICLE: "combinators.short-circuit" "Short-circuit combinators"
{ $subsection 2|| } { $subsection 2|| }
{ $subsection 3|| } { $subsection 3|| }
"Generalized combinators:" "Generalized combinators:"
{ $subsection n&&-rewrite } { $subsection n&& }
{ $subsection n||-rewrite } { $subsection n|| }
; ;
ABOUT: "combinators.short-circuit" ABOUT: "combinators.short-circuit"

View File

@ -3,12 +3,10 @@ locals generalizations macros fry ;
IN: combinators.short-circuit IN: combinators.short-circuit
MACRO:: n&& ( quots n -- quot ) MACRO:: n&& ( quots n -- quot )
[let | pairs [ [ f ]
quots [| q | { [ drop n ndup q dup not ] [ drop n ndrop f ] } ] map quots [| q | { [ drop n ndup q call dup not ] [ drop n ndrop f ] } ] map
{ [ t ] [ n nnip ] } suffix [ n nnip ] suffix 1array
] | [ cond ] 3append ;
[ f pairs cond ]
] ;
MACRO: 0&& ( quots -- quot ) '[ _ 0 n&& ] ; MACRO: 0&& ( quots -- quot ) '[ _ 0 n&& ] ;
MACRO: 1&& ( quots -- quot ) '[ _ 1 n&& ] ; MACRO: 1&& ( quots -- quot ) '[ _ 1 n&& ] ;
@ -16,13 +14,11 @@ MACRO: 2&& ( quots -- quot ) '[ _ 2 n&& ] ;
MACRO: 3&& ( quots -- quot ) '[ _ 3 n&& ] ; MACRO: 3&& ( quots -- quot ) '[ _ 3 n&& ] ;
MACRO:: n|| ( quots n -- quot ) MACRO:: n|| ( quots n -- quot )
[let | pairs [ [ f ]
quots quots
[| q | { [ drop n ndup q dup ] [ n nnip ] } ] map [| q | { [ drop n ndup q call dup ] [ n nnip ] } ] map
{ [ drop n ndrop t ] [ f ] } suffix { [ drop n ndrop t ] [ f ] } suffix 1array
] | [ cond ] 3append ;
[ f pairs cond ]
] ;
MACRO: 0|| ( quots -- quot ) '[ _ 0 n|| ] ; MACRO: 0|| ( quots -- quot ) '[ _ 0 n|| ] ;
MACRO: 1|| ( quots -- quot ) '[ _ 1 n|| ] ; MACRO: 1|| ( quots -- quot ) '[ _ 1 n|| ] ;

View File

@ -1,7 +1,5 @@
USING: kernel sequences math stack-checker effects accessors macros USING: kernel sequences math stack-checker effects accessors macros
combinators.short-circuit ; fry combinators.short-circuit ;
IN: combinators.short-circuit.smart IN: combinators.short-circuit.smart
<PRIVATE <PRIVATE
@ -13,6 +11,6 @@ IN: combinators.short-circuit.smart
PRIVATE> PRIVATE>
MACRO: && ( quots -- quot ) dup arity n&&-rewrite ; MACRO: && ( quots -- quot ) dup arity '[ _ _ n&& ] ;
MACRO: || ( quots -- quot ) dup arity n||-rewrite ; MACRO: || ( quots -- quot ) dup arity '[ _ _ n|| ] ;