Fix bug in match
parent
55ecc4b2bc
commit
748cb2c318
extra/match
|
@ -5,6 +5,8 @@ IN: temporary
|
|||
|
||||
MATCH-VARS: ?a ?b ;
|
||||
|
||||
[ f ] [ { ?a ?a } { 1 2 } match ] unit-test
|
||||
|
||||
[ H{ { ?a 1 } { ?b 2 } } ] [
|
||||
{ ?a ?b } { 1 2 } match
|
||||
] unit-test
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
!
|
||||
! Based on pattern matching code from Paul Graham's book 'On Lisp'.
|
||||
USING: parser kernel words namespaces sequences tuples
|
||||
combinators macros ;
|
||||
combinators macros assocs ;
|
||||
IN: match
|
||||
|
||||
SYMBOL: _
|
||||
|
@ -22,10 +22,13 @@ SYMBOL: _
|
|||
: match-var? ( symbol -- bool )
|
||||
dup word? [ "match-var" word-prop ] [ drop f ] if ;
|
||||
|
||||
: set-match-var ( value var -- ? )
|
||||
dup namespace key? [ get = ] [ set t ] if ;
|
||||
|
||||
: (match) ( value1 value2 -- matched? )
|
||||
{
|
||||
{ [ dup match-var? ] [ set t ] }
|
||||
{ [ over match-var? ] [ swap set t ] }
|
||||
{ [ dup match-var? ] [ set-match-var ] }
|
||||
{ [ over match-var? ] [ swap set-match-var ] }
|
||||
{ [ 2dup = ] [ 2drop t ] }
|
||||
{ [ 2dup [ _ eq? ] either? ] [ 2drop t ] }
|
||||
{ [ 2dup [ sequence? ] both? ] [
|
||||
|
|
Loading…
Reference in New Issue