Fri Nov 9 13:43:20 UTC 2007 mantoniotti
* Made several changes to improve MATCH-CASE (following a note from Ivan
Made several changes to improve MATCH-CASE (following a note from Ivan
Boldyrev from a long time ago), MATCHING and MATCH.
Else-clauses are now handled correctly (AFAICT).
Single variable templates in MATCH, MATCH-CASE and MATCHING clauses do
not need to be quoted.
MATCHING was generating one gensym'ed variable per clause without
creating an appropriate enclosing LET. This is now fixed.
hunk ./match-block.lisp 1
-;;; -*- Mode: Lisp -*-[_^M_][_$_]
+;;;; -*- Mode: Lisp -*-[_^M_][_$_]
+[_^M_][_$_]
+;;;; match-block.lisp --[_^M_][_$_]
+;;;; Various macros built on top of the unifier: MATCH, MATCHING and MATCH-CASE.[_^M_][_$_]
hunk ./match-block.lisp 20
- "Sets up a lexical environment to evaluate FORMS after a unification operation.[_^M_][_$_]
+ "Sets up a lexical environment to evaluate FORMS after an unification.[_^M_][_$_]
+[_^M_][_$_]
hunk ./match-block.lisp 38
+ (template (if (variablep template)[_^M_][_$_]
+ `',template ; Logical variables are special-cased.[_^M_][_$_]
+ template))[_^M_][_$_]
hunk ./match-block.lisp 44
- nconc (list `(,v (find-variable-value ',v ,env-var))[_^M_][_$_]
+ nconc (list `(,v (find-variable-value ',v[_^M_][_$_]
+ ,env-var))[_^M_][_$_]
hunk ./match-block.lisp 53
- (declare (ignorable ,@(mapcar #'first (generate-var-bindings))))[_^M_][_$_]
+ (declare (ignorable ,@(mapcar #'first[_^M_][_$_]
+ (generate-var-bindings))))[_^M_][_$_]
hunk ./match-block.lisp 72
- (default-substitution (make-empty-environment)))[_^M_][_$_]
+ (default-substitution[_^M_][_$_]
+ (make-empty-environment)))[_^M_][_$_]
hunk ./match-block.lisp 76
+[_^M_][_$_]
hunk ./match-block.lisp 104
- (let ((template-vars (collect-template-vars template)))[_^M_][_$_]
+ (let ((template-vars (collect-template-vars template))[_^M_][_$_]
+ (template (if (variablep template)[_^M_][_$_]
+ `',template ; Logical variables are[_^M_][_$_]
+ ; special-cased.[_^M_][_$_]
+ template)) [_^M_][_$_]
+ )[_^M_][_$_]
hunk ./match-block.lisp 118
- (ignore-errors (unify ',template[_^M_][_$_]
+ (ignore-errors (unify ,template[_^M_][_$_]
hunk ./match-block.lisp 139
- (let* ((default-clause (or (find t match-clauses :key #'first)[_^M_][_$_]
- (find 'otherwise match-clauses :key #'first)))[_^M_][_$_]
- (match-clauses (delete default-clause match-clauses)) ; EQL test suffices.[_^M_][_$_]
+ (let* ((default-clause (or (find t match-clauses[_^M_][_$_]
+ :key #'first)[_^M_][_$_]
+ (find 'otherwise match-clauses[_^M_][_$_]
+ :key #'first)))[_^M_][_$_]
+ (match-clauses (delete default-clause match-clauses)) ; EQL[_^M_][_$_]
+ ; test[_^M_][_$_]
+ ; suffices.[_^M_][_$_]
+ (match-clauses-env-vars (mapcar (lambda (mc)[_^M_][_$_]
+ (declare (ignore mc))[_^M_][_$_]
+ (gensym "UNIFICATION-ENV-")[_^M_][_$_]
+ )[_^M_][_$_]
+ match-clauses))[_^M_][_$_]
hunk ./match-block.lisp 152
- `(block matching[_^M_][_$_]
- (cond ,@(mapcar (lambda (match-clause match-clause-env-var)[_^M_][_$_]
- (build-match-clause match-clause match-clause-env-var))[_^M_][_$_]
- match-clauses[_^M_][_$_]
- (mapcar (lambda (mc)[_^M_][_$_]
- (declare (ignore mc))[_^M_][_$_]
- (gensym "UNIFICATION-ENV-")[_^M_][_$_]
- )[_^M_][_$_]
- match-clauses))[_^M_][_$_]
- (,errorp[_^M_][_$_]
- (error 'unification-non-exhaustive[_^M_][_$_]
- :format-control "Non exhaustive matching."))[_^M_][_$_]
- ,@(when default-clause (list default-clause)))))[_^M_][_$_]
- ))[_^M_][_$_]
hunk ./match-block.lisp 153
+ `(block matching[_^M_][_$_]
+ (let ,match-clauses-env-vars[_^M_][_$_]
+ (declare (dynamic-extent ,@match-clauses-env-vars))[_^M_][_$_]
+ (cond ,@(mapcar (lambda (match-clause match-clause-env-var)[_^M_][_$_]
+ (build-match-clause match-clause[_^M_][_$_]
+ match-clause-env-var))[_^M_][_$_]
+ match-clauses[_^M_][_$_]
+ match-clauses-env-vars)[_^M_][_$_]
+ (,errorp[_^M_][_$_]
+ (error 'unification-non-exhaustive[_^M_][_$_]
+ :format-control "Non exhaustive matching."))[_^M_][_$_]
+ ,@(when default-clause (list default-clause))))))[_^M_][_$_]
+ ))[_^M_][_$_]
hunk ./match-block.lisp 170
+;;;[_^M_][_$_]
+;;; Notes:[_^M_][_$_]
+;;;[_^M_][_$_]
+;;; [MA 20071109][_^M_][_$_]
+;;; When the construction of the inner MATCH clauses could be done[_^M_][_$_]
+;;; more intelligently by supplying :ERRORP NIL, thus avoiding the[_^M_][_$_]
+;;; HANDLER-CASEs, which are quite expensive. Any takers?[_^M_][_$_]
hunk ./match-block.lisp 178
-(defmacro match-case ((object &key errorp default-substitution) &rest clauses)[_^M_][_$_]
+(defmacro match-case ((object &key errorp default-substitution)[_^M_][_$_]
+ &rest clauses)[_^M_][_$_]
hunk ./match-block.lisp 181
+[_^M_][_$_]
hunk ./match-block.lisp 219
- `(error 'unification-non-exhaustive[_^M_][_$_]
- :format-control "Non exhaustive matching."))))[_^M_][_$_]
+ `(t (error 'unification-non-exhaustive[_^M_][_$_]
+ :format-control "Non exhaustive matching.")))))[_^M_][_$_]
hunk ./match-block.lisp 234
+;;;;---------------------------------------------------------------------------[_^M_][_$_]
+;;;; Testing.[_^M_][_$_]
+[_^M_][_$_]
+#| Tests[_^M_][_$_]
+[_^M_][_$_]
+(let ((n 42))[_^M_][_$_]
+ (matching ()[_^M_][_$_]
+ ((0 n) 1)[_^M_][_$_]
+ ((?x n) (* x (1- x)))))[_^M_][_$_]
+[_^M_][_$_]
+[_^M_][_$_]
+(let ((n 42))[_^M_][_$_]
+ (match-case (n)[_^M_][_$_]
+ (0 1)[_^M_][_$_]
+ (?x (* x (1- x)))))[_^M_][_$_]
+[_^M_][_$_]
+[_^M_][_$_]
+(let ((n 42))[_^M_][_$_]
+ (match-case (n)[_^M_][_$_]
+ (0 1)[_^M_][_$_]
+ (otherwise (* n (1- n)))))[_^M_][_$_]
+[_^M_][_$_]
+(defun fatt (x)[_^M_][_$_]
+ (match-case (x :errorp t)[_^M_][_$_]
+ (0 1)[_^M_][_$_]
+ (#T(number ?n) (* ?n (fatt (1- n))))[_^M_][_$_]
+ ))[_^M_][_$_]
+[_^M_][_$_]
+|#[_^M_][_$_]
hunk ./match-block.lisp 264
-;;; end of file -- math-blocks.lisp --[_^M_][_$_]
+;;;; end of file -- math-blocks.lisp --[_^M_][_$_]