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

combinators.lib: New short-circuit combinators

db4
Eduardo Cavazos 2008-06-09 23:23:09 -05:00
parent 102b9aab76
commit 95f5c78159
2 changed files with 55 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/combinators/lib/lib-docs.factor
View File

@ -51,6 +51,6 @@ HELP: &&
{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } } { $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } }
{ $description "Calls each quotation in turn; outputs " { $link f } " if one of the quotations output " { $link f } ", otherwise outputs " { $link t } ". As soon as a quotation outputs " { $link f } ", evaluation stops and subsequent quotations are not called." } ; { $description "Calls each quotation in turn; outputs " { $link f } " if one of the quotations output " { $link f } ", otherwise outputs " { $link t } ". As soon as a quotation outputs " { $link f } ", evaluation stops and subsequent quotations are not called." } ;
HELP: || ! HELP: ||
{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } } ! { $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } }
{ $description "Calls each quotation in turn; outputs " { $link t } " if one of the quotations output " { $link t } ", otherwise outputs " { $link f } ". As soon as a quotation outputs " { $link t } ", evaluation stops and subsequent quotations are not called." } ; ! { $description "Calls each quotation in turn; outputs " { $link t } " if one of the quotations output " { $link t } ", otherwise outputs " { $link f } ". As soon as a quotation outputs " { $link t } ", evaluation stops and subsequent quotations are not called." } ;

70
extra/combinators/lib/lib.factor
View File

@ -63,34 +63,68 @@ MACRO: napply ( n -- )
! short circuiting words ! short circuiting words
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: short-circuit ( quots quot default -- quot ) ! : short-circuit ( quots quot default -- quot )
1quotation -rot { } map>assoc <reversed> alist>quot ; ! 1quotation -rot { } map>assoc <reversed> alist>quot ;
MACRO: && ( quots -- ? ) ! MACRO: && ( quots -- ? )
[ [ not ] append [ f ] ] t short-circuit ; ! [ [ not ] append [ f ] ] t short-circuit ;
MACRO: <-&& ( quots -- ) ! MACRO: <-&& ( quots -- )
[ [ dup ] prepend [ not ] append [ f ] ] t short-circuit ! [ [ dup ] prepend [ not ] append [ f ] ] t short-circuit
[ nip ] append ; ! [ nip ] append ;
MACRO: <--&& ( quots -- ) ! MACRO: <--&& ( quots -- )
[ [ 2dup ] prepend [ not ] append [ f ] ] t short-circuit ! [ [ 2dup ] prepend [ not ] append [ f ] ] t short-circuit
[ 2nip ] append ; ! [ 2nip ] append ;
! or ! or
MACRO: || ( quots -- ? ) [ [ t ] ] f short-circuit ; ! MACRO: || ( quots -- ? ) [ [ t ] ] f short-circuit ;
MACRO: 0|| ( quots -- ? ) [ [ t ] ] f short-circuit ; ! MACRO: 0|| ( quots -- ? ) [ [ t ] ] f short-circuit ;
MACRO: 1|| ( quots -- ? ) ! MACRO: 1|| ( quots -- ? )
[ [ dup ] prepend [ t ] ] f short-circuit [ nip ] append ; ! [ [ dup ] prepend [ t ] ] f short-circuit [ nip ] append ;
MACRO: 2|| ( quots -- ? ) ! MACRO: 2|| ( quots -- ? )
[ [ 2dup ] prepend [ t ] ] f short-circuit [ 2nip ] append ; ! [ [ 2dup ] prepend [ t ] ] f short-circuit [ 2nip ] append ;
MACRO: 3|| ( quots -- ? ) ! MACRO: 3|| ( quots -- ? )
[ [ 3dup ] prepend [ t ] ] f short-circuit [ 3nip ] append ; ! [ [ 3dup ] prepend [ t ] ] f short-circuit [ 3nip ] append ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MACRO: 0&& ( quots -- quot )
[ '[ drop @ dup not ] [ drop f ] 2array ] map
{ [ t ] [ ] } suffix
'[ f , cond ] ;
MACRO: 1&& ( quots -- quot )
[ '[ drop dup @ dup not ] [ drop drop f ] 2array ] map
{ [ t ] [ nip ] } suffix
'[ f , cond ] ;
MACRO: 2&& ( quots -- quot )
[ '[ drop 2dup @ dup not ] [ drop 2drop f ] 2array ] map
{ [ t ] [ 2nip ] } suffix
'[ f , cond ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MACRO: 0|| ( quots -- quot )
[ '[ drop @ dup ] [ ] 2array ] map
{ [ drop t ] [ f ] } suffix
'[ f , cond ] ;
MACRO: 1|| ( quots -- quot )
[ '[ drop dup @ dup ] [ nip ] 2array ] map
{ [ drop drop t ] [ f ] } suffix
'[ f , cond ] ;
MACRO: 2|| ( quots -- quot )
[ '[ drop 2dup @ dup ] [ 2nip ] 2array ] map
{ [ drop 2drop t ] [ f ] } suffix
'[ f , cond ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! ifte ! ifte