From mantoniotti at common-lisp.net  Tue Oct 25 19:08:16 2005
From: mantoniotti at common-lisp.net (Marco Antoniotti)
Date: Tue, 25 Oct 2005 21:08:16 +0200 (CEST)
Subject: [cl-unification-cvs] CVS update: cl-unification/match-block.lisp 
Message-ID: <20051025190816.EF98D8855B@common-lisp.net>

Update of /project/cl-unification/cvsroot/cl-unification
In directory common-lisp.net:/tmp/cvs-serv4395

Modified Files:
	match-block.lisp 
Log Message:
Fixed problem with checking the presence of T and OTHERWISE clauses in
MATCHING.

Date: Tue Oct 25 21:08:15 2005
Author: mantoniotti

Index: cl-unification/match-block.lisp
diff -u cl-unification/match-block.lisp:1.5 cl-unification/match-block.lisp:1.6
--- cl-unification/match-block.lisp:1.5	Wed Apr 27 23:04:36 2005
+++ cl-unification/match-block.lisp	Tue Oct 25 21:08:15 2005
@@ -93,11 +93,15 @@
              (let ((template-vars (collect-template-vars template)))
                (flet ((generate-var-bindings ()
                         (loop for v in template-vars
-                              nconc (list `(,v (find-variable-value ',v ,clause-var))
+                              nconc (list `(,v (find-variable-value
+						',v
+						,clause-var))
                                           `(,(clean-unify-var-name v) ,v))))
                       )
                  `((setf ,clause-var
-                         (ignore-errors (unify ',template ,object ,substitution)))
+                         (ignore-errors (unify ',template
+					       ,object
+					       ,substitution)))
                    (let* (,@(generate-var-bindings))
                      , at forms))
                  )))
@@ -105,10 +109,16 @@
            (build-match-clause (match-clause match-env-var)
              (destructuring-bind ((template object) &body forms)
                  match-clause
-               (%%match%% match-env-var template object forms '(make-empty-environment))))
+               (%%match%% match-env-var
+			  template
+			  object
+			  forms
+			  '(make-empty-environment))))
            )
-    (when (or (> 1 (count t match-clauses :key #'first))
-              (> 1 (count 'otherwise match-clauses :key #'first)))
+    (when (or (and (find t match-clauses :key #'first)
+		   (find 'otherwise match-clauses :key #'first))
+	      (> (count t match-clauses :key #'first) 1)
+              (> (count 'otherwise match-clauses :key #'first) 1))
       (error 'program-error))
     (let* ((default-clause (or (find t match-clauses :key #'first)
                                (find 'otherwise match-clauses :key #'first)))



From mantoniotti at common-lisp.net  Tue Oct 25 19:17:34 2005
From: mantoniotti at common-lisp.net (Marco Antoniotti)
Date: Tue, 25 Oct 2005 21:17:34 +0200 (CEST)
Subject: [cl-unification-cvs] CVS update: cl-unification/unifier.lisp 
Message-ID: <20051025191734.A3F888855B@common-lisp.net>

Update of /project/cl-unification/cvsroot/cl-unification
In directory common-lisp.net:/tmp/cvs-serv5468

Modified Files:
	unifier.lisp 
Log Message:
Fixed problem with the unification of a list with a
SEQUENCE-TEMPLATE.  The implementation was not checking that the
length of the list was compatible with the length of the required
elements in the template.

Apart from that, keyword matching is still unimplemented.

Date: Tue Oct 25 21:17:33 2005
Author: mantoniotti

Index: cl-unification/unifier.lisp
diff -u cl-unification/unifier.lisp:1.3 cl-unification/unifier.lisp:1.4
--- cl-unification/unifier.lisp:1.3	Fri May 20 17:19:53 2005
+++ cl-unification/unifier.lisp	Tue Oct 25 21:17:33 2005
@@ -331,7 +331,9 @@
       
       (let* ((n-vars (list-length vars))
              (n-optionals (list-length optionals))
-             (env (unify (subseq a 0 (list-length vars)) vars env))
+             (env (unify (subseq a 0 (min ll (list-length vars)))
+			 vars
+			 env))
              )
         (when (and optionals (>= ll (+ n-vars n-optionals)))
           (setf env (unify (subseq a n-vars (+ n-vars n-optionals)) optionals env)))