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

Fix bug in match

release
Slava Pestov 2007-10-28 00:28:46 -04:00
parent 55ecc4b2bc
commit 748cb2c318
2 changed files with 8 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/match/match-tests.factor Normal file → Executable file
View File

@ -5,6 +5,8 @@ IN: temporary
MATCH-VARS: ?a ?b ; MATCH-VARS: ?a ?b ;
[ f ] [ { ?a ?a } { 1 2 } match ] unit-test
[ H{ { ?a 1 } { ?b 2 } } ] [ [ H{ { ?a 1 } { ?b 2 } } ] [
{ ?a ?b } { 1 2 } match { ?a ?b } { 1 2 } match
] unit-test ] unit-test

9
extra/match/match.factor Normal file → Executable file
View File

@ -3,7 +3,7 @@
! !
! Based on pattern matching code from Paul Graham's book 'On Lisp'. ! Based on pattern matching code from Paul Graham's book 'On Lisp'.
USING: parser kernel words namespaces sequences tuples USING: parser kernel words namespaces sequences tuples
combinators macros ; combinators macros assocs ;
IN: match IN: match
SYMBOL: _ SYMBOL: _
@ -22,10 +22,13 @@ SYMBOL: _
: match-var? ( symbol -- bool ) : match-var? ( symbol -- bool )
dup word? [ "match-var" word-prop ] [ drop f ] if ; 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? ) : (match) ( value1 value2 -- matched? )
{ {
{ [ dup match-var? ] [ set t ] } { [ dup match-var? ] [ set-match-var ] }
{ [ over match-var? ] [ swap set t ] } { [ over match-var? ] [ swap set-match-var ] }
{ [ 2dup = ] [ 2drop t ] } { [ 2dup = ] [ 2drop t ] }
{ [ 2dup [ _ eq? ] either? ] [ 2drop t ] } { [ 2dup [ _ eq? ] either? ] [ 2drop t ] }
{ [ 2dup [ sequence? ] both? ] [ { [ 2dup [ sequence? ] both? ] [