match: allow matching against empty sequences

chris.double 2006-11-27 03:18:21 +00:00
parent 0121068dd2
commit 1369f6f5b2
1 changed files with 3 additions and 1 deletions

View File

@ -24,6 +24,8 @@ USE: prettyprint
drop f drop f
] if ; ] if ;
: && ( obj seq -- ? ) [ call ] all-with? ;
: (match) ( seq1 seq2 -- matched? ) : (match) ( seq1 seq2 -- matched? )
{ {
{ [ 2dup = ] [ 2drop t ] } { [ 2dup = ] [ 2drop t ] }
@ -31,7 +33,7 @@ USE: prettyprint
{ [ dup _ = ] [ 2drop t ] } { [ dup _ = ] [ 2drop t ] }
{ [ dup match-var? ] [ set t ] } { [ dup match-var? ] [ set t ] }
{ [ over match-var? ] [ swap set t ] } { [ over match-var? ] [ swap set t ] }
{ [ over sequence? over sequence? and [ over first over first (match) ] [ f ] if ] [ >r 1 tail r> 1 tail (match) ] } { [ over { [ sequence? ] [ empty? not ] } && over { [ sequence? ] [ empty? not ] } && and [ over first over first (match) ] [ f ] if ] [ >r 1 tail r> 1 tail (match) ] }
{ [ over tuple? over tuple? and ] [ >r tuple>array r> tuple>array (match) ] } { [ over tuple? over tuple? and ] [ >r tuple>array r> tuple>array (match) ] }
{ [ t ] [ 2drop f ] } { [ t ] [ 2drop f ] }
} cond ; } cond ;