cl-unification-cvs October 2005

cl-unification-cvs@common-lisp.net

1 participants
2 discussions

[cl-unification-cvs] CVS update: cl-unification/unifier.lisp
by mantoniotti＠common-lisp.net 25 Oct '05

25 Oct '05

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)))

1 0

[cl-unification-cvs] CVS update: cl-unification/match-block.lisp
by mantoniotti＠common-lisp.net 25 Oct '05

25 Oct '05

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)) ,@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)))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

cl-unification-cvs October 2005