implement MATCH-VARS: in contrib/match
parent
296e8ba0b3
commit
f7e38fa8d4
|
@ -3,9 +3,19 @@
|
||||||
!
|
!
|
||||||
! Based on pattern matching code from Paul Graham's book 'On Lisp'.
|
! Based on pattern matching code from Paul Graham's book 'On Lisp'.
|
||||||
IN: match
|
IN: match
|
||||||
USING: kernel words sequences namespaces hashtables ;
|
USING: kernel words sequences namespaces hashtables parser ;
|
||||||
|
|
||||||
SYMBOL: _
|
SYMBOL: _
|
||||||
|
USE: prettyprint
|
||||||
|
|
||||||
|
: define-match-var ( name -- )
|
||||||
|
create-in [ dup <wrapper> , \ get , ] [ ] make define-compound ;
|
||||||
|
|
||||||
|
: define-match-vars ( seq -- )
|
||||||
|
[ define-match-var ] each ;
|
||||||
|
|
||||||
|
: MATCH-VARS: ! vars ...
|
||||||
|
string-mode on [ string-mode off define-match-vars ] f ; parsing
|
||||||
|
|
||||||
: match-var? ( symbol -- bool )
|
: match-var? ( symbol -- bool )
|
||||||
dup word? [
|
dup word? [
|
||||||
|
@ -34,5 +44,3 @@ SYMBOL: result
|
||||||
[
|
[
|
||||||
[ first over match dup result set ] find 2nip dup [ result get [ second call ] bind ] [ no-cond ] if
|
[ first over match dup result set ] find 2nip dup [ result get [ second call ] bind ] [ no-cond ] if
|
||||||
] with-scope ;
|
] with-scope ;
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -7,16 +7,26 @@ HELP: match
|
||||||
}
|
}
|
||||||
{ $description "Pattern match seq1 against seq2. The sequences can contain pattern variables, which are symbols that begin with '?'. The result is a hashtable of the bindings, mapping the pattern variables from one sequence to the equivalent value in the other sequence. The '_' symbol can be used to ignore the value at that point in the pattern for the match. " }
|
{ $description "Pattern match seq1 against seq2. The sequences can contain pattern variables, which are symbols that begin with '?'. The result is a hashtable of the bindings, mapping the pattern variables from one sequence to the equivalent value in the other sequence. The '_' symbol can be used to ignore the value at that point in the pattern for the match. " }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "SYMBOL: ?a\nSYMBOL: ?b\n{ ?a { 2 ?b } 5 } { 1 { 2 3 } _ } match\n => H{ { ?a 1 } { ?b 3 } }" }
|
{ $example "MATCH-VARS: ?a ?b ;\n{ ?a { 2 ?b } 5 } { 1 { 2 3 } _ } match\n => H{ { ?a 1 } { ?b 3 } }" }
|
||||||
}
|
}
|
||||||
{ $see-also match-cond } ;
|
{ $see-also match-cond } ;
|
||||||
|
|
||||||
HELP: match-cond
|
HELP: match-cond
|
||||||
{ $values { "seq" "A sequence" } { "assoc" "A sequence of quotation pairs" }
|
{ $values { "seq" "A sequence" } { "assoc" "A sequence of quotation pairs" } }
|
||||||
}
|
|
||||||
{ $description "Calls the second quotation in the first pair whose first sequence yields a successful " { $link match } " against seq. The second quotation, when called, has the hashtable returned from the " { $link match } " call bound as the top namespace so " { $link get } " can be used to retrieve the values. To have a fallthrough match clause use the '_' match variable." }
|
{ $description "Calls the second quotation in the first pair whose first sequence yields a successful " { $link match } " against seq. The second quotation, when called, has the hashtable returned from the " { $link match } " call bound as the top namespace so " { $link get } " can be used to retrieve the values. To have a fallthrough match clause use the '_' match variable." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "SYMBOL: ?value\n{ increment ?value } {\n { { increment ?value } [ ?value get do-something ] }\n { { decrement ?value } [ ?value get do-something-else ] }\n { _ [ no-match-found ] }\n} match-cond" }
|
{ $example "MATCH-VARS: ?value ;\n{ increment ?value } {\n { { increment ?value } [ ?value do-something ] }\n { { decrement ?value } [ ?value do-something-else ] }\n { _ [ no-match-found ] }\n} match-cond" }
|
||||||
}
|
}
|
||||||
{ $see-also match } ;
|
{ $see-also match } ;
|
||||||
|
|
||||||
|
|
||||||
|
HELP: MATCH-VARS:
|
||||||
|
{ $syntax "MATCH-VARS: var ... ;" }
|
||||||
|
{ $values { "var" "a match variable name beginning with '?'" } }
|
||||||
|
{ $description "Creates a symbol that can be used in " { $link match } " and " { $link match-cond } " for binding values in the matched sequence. The symbol name is created as a word that is defined to get the value of the symbol out of the current namespace. This can be used in " { $link match-cond } " to retrive the values in the quotation body." }
|
||||||
|
{ $examples
|
||||||
|
{ $example "MATCH-VARS: ?value ;\n{ increment ?value } {\n { { increment ?value } [ ?value do-something ] }\n { { decrement ?value } [ ?value do-something-else ] }\n { _ [ no-match-found ] }\n} match-cond" }
|
||||||
|
}
|
||||||
|
{ $see-also match match-cond } ;
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue