Wed Apr 15 10:16:24 UTC 2009 mantoniotti
* Added MATCHF (whose name may change) to simplify the
Added MATCHF (whose name may change) to simplify the
'destructuring-bind'-like syntax and behavior of the matching
facilities.
hunk ./match-block.lisp 16
+ (match-named nil)[_^M_][_$_]
hunk ./match-block.lisp 36
+[_^M_][_$_]
+If MATCH-NAMED is not NIL, then a surrounding BLOCK named MATCH-NAMED[_^M_][_$_]
+is set up around the matching code.[_^M_][_$_]
hunk ./match-block.lisp 52
- `(block nil[_^M_][_$_]
+ `(block ,match-named[_^M_][_$_]
+ (handler-case[_^M_][_$_]
+ (let* ((,env-var (unify ,template ,object ,substitution))[_^M_][_$_]
+ ,@(generate-var-bindings)[_^M_][_$_]
+ )[_^M_][_$_]
+ (declare (ignorable ,@(mapcar #'first[_^M_][_$_]
+ (generate-var-bindings))))[_^M_][_$_]
+ ,@forms)[_^M_][_$_]
+ [_^M_][_$_]
+ ;; Yes. The above is sligthly wasteful.[_^M_][_$_]
+[_^M_][_$_]
+ (unification-failure (uf)[_^M_][_$_]
+ (if ,errorp[_^M_][_$_]
+ (error uf)[_^M_][_$_]
+ ,error-value))[_^M_][_$_]
+ )))))[_^M_][_$_]
+[_^M_][_$_]
+[_^M_][_$_]
+(defmacro matchf ((template object[_^M_][_$_]
+ &key[_^M_][_$_]
+ (match-named nil)[_^M_][_$_]
+ (substitution '(make-empty-environment))[_^M_][_$_]
+ (errorp t)[_^M_][_$_]
+ (error-value nil))[_^M_][_$_]
+ &body forms)[_^M_][_$_]
+ "Sets up a lexical environment to evaluate FORMS after an unification.[_^M_][_$_]
+[_^M_][_$_]
+MATCHF unifies a TEMPLATE and an OBJECT and then sets up a lexical[_^M_][_$_]
+environment where the variables present in the template are bound[_^M_][_$_]
+lexically. Note that both variable names '?FOO' and 'FOO' are bound[_^M_][_$_]
+for convenience.[_^M_][_$_]
+[_^M_][_$_]
+MATCHF does not 'evaluate' TEMPLATE (note that using the #T syntax will[_^M_][_$_]
+generate a template at read-time).[_^M_][_$_]
+[_^M_][_$_]
+The MATCHF form returns the values returned by the evaluation of the[_^M_][_$_]
+last of the FORMS.[_^M_][_$_]
+[_^M_][_$_]
+If ERRORP is non-NIL (the default) then the form raises a[_^M_][_$_]
+UNIFICATION-FAILURE, otherwise the result of evaluating ERROR-VALUE,[_^M_][_$_]
+whose default is NIL is returned. (Note that UNIFICATION-FAILUREs[_^M_][_$_]
+raising from the evaluation of FORMS will also be caught and handled[_^M_][_$_]
+according to ERRORP settings.)[_^M_][_$_]
+[_^M_][_$_]
+If MATCH-NAMED is not NIL, then a surrounding BLOCK named MATCH-NAMED[_^M_][_$_]
+is set up around the matching code.[_^M_][_$_]
+"[_^M_][_$_]
+ (let ((template-vars (collect-template-vars template))[_^M_][_$_]
+ (env-var (gensym "UNIFICATION-ENV-"))[_^M_][_$_]
+ (template (cond ((variablep template)[_^M_][_$_]
+ `',template) ; Logical variables are special-cased.[_^M_][_$_]
+ ((listp template) ; Same for lists.[_^M_][_$_]
+ (make-instance 'list-template[_^M_][_$_]
+ :spec (cons 'list template)))[_^M_][_$_]
+ ;`',template)[_^M_][_$_]
+ (t[_^M_][_$_]
+ template)))[_^M_][_$_]
+ )[_^M_][_$_]
+ ;; Logical variables and lists are special cased for convenience.[_^M_][_$_]
+ ;; Lists are especially inteded as abbreviation for destructuring.[_^M_][_$_]
+ (flet ((generate-var-bindings ()[_^M_][_$_]
+ (loop for v in template-vars[_^M_][_$_]
+ nconc (list `(,v (find-variable-value ',v[_^M_][_$_]
+ ,env-var))[_^M_][_$_]
+ `(,(clean-unify-var-name v) ,v))))[_^M_][_$_]
+ )[_^M_][_$_]
+ `(block ,match-named[_^M_][_$_]
hunk ./match-block.lisp 143
- (make-empty-environment)))[_^M_][_$_]
+ (make-empty-environment))[_^M_][_$_]
+ (matching-named nil))[_^M_][_$_]
hunk ./match-block.lisp 224
- `(block matching[_^M_][_$_]
+ `(block ,matching-named[_^M_][_$_]
hunk ./match-block.lisp 245
-;;; When the construction of the inner MATCH clauses could be done[_^M_][_$_]
+;;; The construction of the inner MATCH clauses could be done[_^M_][_$_]
hunk ./match-block.lisp 249
-(defmacro match-case ((object &key errorp default-substitution)[_^M_][_$_]
+(defmacro match-case ((object &key errorp default-substitution match-case-named)[_^M_][_$_]
hunk ./match-block.lisp 301
- ,(generate-matchers (cdr clauses))))))))[_^M_][_$_]
- `(let ((,object-var ,object))[_^M_][_$_]
- ,(generate-matchers non-otherwise-clauses)))))[_^M_][_$_]
+ ,(generate-matchers (cdr clauses))))))))[_^M_][_$_]
+ `(block ,match-case-named[_^M_][_$_]
+ (let ((,object-var ,object))[_^M_][_$_]
+ ,(generate-matchers non-otherwise-clauses))))))[_^M_][_$_]