Browse files

Obsolete match parameters.

  • Loading branch information...
1 parent aab07cc commit c6b43b7ff471e52421c8272938c4853e03f56669 Tomohiro Matsuyama committed Apr 21, 2011
Showing with 20 additions and 103 deletions.
  1. +6 −69 README.markdown
  2. +1 −0 src/case.lisp
  3. +3 −2 src/compile.lisp
  4. +4 −16 src/match.lisp
  5. +6 −6 src/pattern.lisp
  6. +0 −10 test/match.lisp
75 README.markdown
@@ -15,9 +15,6 @@ API
if no clauses matched. A clause have to be a form of `(pattern
form*)`, where `pattern` is a pattern (see "Patterns").
-`match` macro establishes new match parameters of that `test` function
-is `equal` and `unbound` is nil. See "Macro Parameters" for details.
#### Examples
(match '(1 2)
@@ -32,52 +29,6 @@ is `equal` and `unbound` is nil. See "Macro Parameters" for details.
((1 &optional a) a))
;;=> 2
-### Macro: `match*`
- match* value &body clauses
-Same as `match` macro except that `match*` accepts the current
-(lexical) match parameters. That is, you must be careful of the
-current lexical context if you use this macro. See "Match Parameters"
-for details.
-#### Examples
- (with-match-parameters (:unbound t)
- (match* ()
- ((&optional v) v)))
- ;;=> T
- (with-match-parameters (:test string-equal)
- (match* :foo
- ("foo" 'matched)))
- ;;=> MATCHED
-### Macro: `with-match-parameters`
- with-match-parameters (&key test unbound) &body body
-Establishes match parameters for lexical scope of `body`. This only
-affects on `match*` macro because `match` establishes another match
-parameters by itself.
-`test` keyword parameter will be used for comparing a constant patten
-(e.g. 1, "a", :x, etc) with a matching variable. For example,
- (with-match-parameters (test string-equal)
- ...)
-makes compare expressions within its body to use `string-equal` for
-comparing patterns and values. A value of this keyword parameter must
-be a function name or a lambda expression to achieve better
-performance. The default value is `equal`.
-`unbound` keyword parameter will be used for specifying a value of
-unbound variables. Optional variables in a pattern might be unbound
-even if the pattern is matched. In that case, such optional variables
-have a value specified by `unbound` keyword parameter. The default
-value is `nil`.
### Macro: `lambda-match`
lambda-match &body clauses
@@ -97,8 +48,10 @@ will be expaneded to
A pattern must be one of a symbol, a cons, and an atom. If the pattern
is symbol, the pattern is called a variable pattern, which can be
-matched with any value. The variable can be used in a body of a
-clause. Here is an example:
+matched with any value. A body of a clause will be evaluated with
+using a binding of the variable and the valueThe variable can be used
+in a body of a. If the variable is `_`, any binding will not be
+made. Here is an example:
(match 1
(x x))
@@ -116,9 +69,8 @@ cons. Here is an example:
Second case, if the `car` of the cons is `&optional`, the pattern is
called a optional variable pattern, which can be matched with any
value as same as usual variable patterns, but it can be not
-matched. If not matched, we say the pattern is unbound, meaning some
-undefined value will bound to the pattern. See "Match Parameters" for
-details. Here is an example:
+matched. If not matched, we say the pattern is unbound, meaning an
+undefined value (`nil` will bound to the pattern.
(match '(1)
((1 &optional x) x))
@@ -147,21 +99,6 @@ pattern. Here is an example:
(1 'matched))
-### Match Parameters
-Match parameters controls a meaning of pattern-matching in
-lexical. This will be used when you want to
-* change a default equal function for comparing patterns and values.
-* change a default value of optional variables.
-Note that `match` macro establishes a new match parameters by itself,
-meaning that doesn't accept the current lexical match parameters. In
-contrast, `match*` accept the current lexical match parameters. This
-is the main difference between `match` and `match*`.
-See `with-match-parameters` for details.
Micro Benchmark
1 src/case.lisp
@@ -1,5 +1,6 @@
(in-package :cl-pattern)
(use-syntax annot-syntax)
+(declaim (optimize (speed 3)))
(defun compile-case-clause (var clause else)
5 src/compile.lisp
@@ -1,5 +1,6 @@
(in-package :cl-pattern)
(use-syntax annot-syntax)
+(declaim (optimize (speed 3)))
(defun partition-match-clauses (clauses)
(loop with groups
@@ -75,7 +76,7 @@
(cons `(,@rest)
(if fv
- `((let ,(free-variables-bindings fv)
+ `((let ,fv
(declare (ignorable ,@fv))
@@ -98,7 +99,7 @@
(cons `(,par ,pdr ,@rest)
(if fv
- `((let ,(free-variables-bindings fv)
+ `((let ,fv
(declare (ignorable ,@fv))
20 src/match.lisp
@@ -1,11 +1,12 @@
(in-package :cl-pattern)
(use-syntax annot-syntax)
+(declaim (optimize (speed 3)))
(defmacro %match (vars clauses else)
(let ((groups (partition-match-clauses clauses)))
(compile-match-groups vars groups else)))
-(defmacro match-values (args &body clauses)
+(defmacro match* (args &body clauses)
(loop for arg in args
for var = (gensym "VAR")
if (atom arg)
@@ -19,26 +20,13 @@
(if bindings
`(let ,bindings ,then)
-(defmacro with-match-parameters ((&key (test 'equal) unbound) &body body)
- `(macrolet ((pattern-equal (pattern value)
- (list ',test pattern value)))
- (symbol-macrolet ((pattern-unbound ,unbound))
- ,@body)))
-(defmacro match* (arg &body clauses)
- `(match-values (,arg)
+(defmacro match (arg &body clauses)
+ `(match* (,arg)
,@(loop for (pattern . then) in clauses
collect `((,pattern) ,@then))))
-(defmacro match (arg &body clauses)
- `(with-match-parameters ()
- (match* ,arg ,@clauses)))
(defmacro lambda-match (&body clauses)
(with-gensyms (arg)
`(lambda (,arg)
12 src/pattern.lisp
@@ -1,10 +1,14 @@
(in-package :cl-pattern)
(use-syntax annot-syntax)
+(declaim (optimize (speed 3)))
(defmacro %equal (pattern value)
(typecase pattern
- (cons `(pattern-equal ',(cadr pattern) ,value))
- (t `(pattern-equal ,pattern ,value))))
+ (null `(null ,value))
+ (cons `(eq ',(cadr pattern) ,value))
+ ((or symbol character) `(eq ,pattern ,value))
+ (number `(eql ,pattern ,value))
+ (t `(equal ,pattern ,value))))
(defun pattern-type (pattern)
(etypecase pattern
@@ -23,10 +27,6 @@
(:cons (append (free-variables (car pattern))
(free-variables (cdr pattern))))))
-(defun free-variables-bindings (vars)
- (mapcar (lambda (var) (list var 'pattern-unbound))
- vars))
(defun optional-patterns (pattern)
(if (consp pattern)
(mapcar (lambda (sub-pattern)
10 test/match.lisp
@@ -73,20 +73,10 @@
((((&optional a))) a))
"match optional nest 3")
-(is (with-match-parameters (:unbound 1)
- (match* ()
- ((&optional a) a)))
- 1
- "match optional *unbound*")
(is (match '((1) "a")
(((1 &optional a) "a" &optional b) (list a b)))
'(nil nil)
"match complex")
-(is (with-match-parameters (:test string-equal)
- (match* :a
- ("a" 1)))
- 1
- "match with custom equal function")
(defun sum (list)
(match list

0 comments on commit c6b43b7

Please sign in to comment.