[cl-unification-cvs] CVS cl-unification

[mantoniotti]

Update of /project/cl-unification/cvsroot/cl-unification
In directory clnet:/tmp/cvs-serv27424

Modified Files:
	substitutions.lisp templates-hierarchy.lisp 
	unification-package.lisp variables.lisp 
Log Message:
Some modification added.  Exported symbols and reverted
reader macro #T to construct template instances at read time.
Added MAKE-LOAD-FORM method for templates which should fix problem with
SBCL.

Committing in .
 
 Modified Files:
 	substitutions.lisp templates-hierarchy.lisp 
 	unification-package.lisp variables.lisp 


--- /project/cl-unification/cvsroot/cl-unification/substitutions.lisp	2007/11/09 13:35:55	1.3
+++ /project/cl-unification/cvsroot/cl-unification/substitutions.lisp	2008/07/13 13:10:48	1.4
@@ -138,4 +138,12 @@
     env))
 
 
+(defun v? (s env &optional (plain-symbol-p nil))
+  (find-variable-value (if plain-symbol-p
+                           (make-var-name s)
+                           s)
+                       env))
+                           
+
+
 ;;;; end of file -- substitutions.lisp --
--- /project/cl-unification/cvsroot/cl-unification/templates-hierarchy.lisp	2006/07/19 21:52:34	1.3
+++ /project/cl-unification/cvsroot/cl-unification/templates-hierarchy.lisp	2008/07/13 13:10:48	1.4
@@ -219,9 +219,13 @@
 
 (defgeneric make-template (kind spec))
 
+
 ;;; Setting up the reader macro.
 
-#||
+;;; 20080711 MA:
+;;; Reverted to the old version with MAKE-LOAD-FORM added.  Template
+;;; objects are created at read-time.
+
 (defun |sharp-T-reader| (stream subchar arg)
   (declare (ignore subchar arg))
   (let ((spec (read stream t nil t)))
@@ -229,12 +233,19 @@
       (null (make-template nil spec))
       (cons (make-template (first spec) spec))
       (t    (make-template spec spec)))))
-||#
 
+(defmethod make-load-form ((x template) &optional env)
+  (make-load-form-saving-slots x :environment env))
 
-;;; New version with more 'macro-like' behavior. The previous version
+
+#||
+;;; Version with more 'macro-like' behavior. The previous version
 ;;; created an object at read-time, which may cause problems with
 ;;; MAKE-LOAD-FORMs, constant-ness etc etc.
+;;;
+;;; 20080713 MA
+;;; Removed because it was not working well with nested templates.
+;;; Reverted to the original one plus MAKE-LOAD-FORM.
 
 (defun |sharp-T-reader| (stream subchar arg)
   (declare (ignore subchar arg))
@@ -244,10 +255,34 @@
       (cons `(make-template ',(first spec) ',spec))
       (t    `(make-template ',spec ',spec)))
     ))
-
+||#
 
 (eval-when (:load-toplevel :execute)
-  (set-dispatch-macro-character #\# #\T #'|sharp-T-reader|))
+  (set-dispatch-macro-character #\# #\T '|sharp-T-reader|))
+
+
+#|| Useless with the read time templates and MAKE-LOAD-FORM.
+
+(defun rewrite-template-spec (spec)
+  "Rewrites a template specification.
+The rewriting simply makes sure that sub-templates are created as needed.
+The result is either the SPEC itself or an appropriate call to LIST."
+
+  (typecase spec
+    (atom `',spec)
+    (cons (destructuring-bind (head &rest tail)
+              spec
+            (case head
+              (quote spec)
+              (make-template `(make-template ,(first tail)
+                                             ,(rewrite-template-spec (second (second tail)))))
+              (t `(list ',head ,@(mapcar #'rewrite-template-spec tail)))
+              )))
+    (t `',spec)))
+
+||#
+  
+
 
 (defmethod make-template ((kind null) (spec symbol))
   (assert (null spec) (spec) "MAKE-TEMPLATE called erroneously with ~S and ~S." kind spec)
@@ -324,8 +359,8 @@
 
 
 
-
-;;; Implementation.
+;;;;===========================================================================
+;;;; Implementation.
 
 ;;; Symbol Templates.
 ;;; Specification is
--- /project/cl-unification/cvsroot/cl-unification/unification-package.lisp	2007/05/21 12:33:15	1.3
+++ /project/cl-unification/cvsroot/cl-unification/unification-package.lisp	2008/07/13 13:10:48	1.4
@@ -6,16 +6,29 @@
 This package contains all the definitions necessary for the general
 Common Lisp unifier to work.
 The package also has the \"UNIFY\" nickname.")
+
   (:export
    "MAKE-TEMPLATE"
    "TEMPLATEP"
    "TEMPLATE-SPEC")
+
   (:export
    "*UNIFY-STRING-CASE-INSENSITIVE-P*"
    "UNIFY"
    "FIND-VARIABLE-VALUE"
+   "V?"
+
    "MAKE-EMPTY-ENVIRONMENT"
-   "APPLY-SUBSTITUTION")
+   "APPLY-SUBSTITUTION"
+
+   "UNIFICATION-FAILURE"
+   "UNIFICATION-VARIABLE-UNBOUND"
+   )
+
+  (:export
+   "ENVIRONMENT"
+   "ENVIRONMENT-P")
+
   (:export
    "MATCH"
    "MATCHING"
--- /project/cl-unification/cvsroot/cl-unification/variables.lisp	2004/11/17 22:19:55	1.1.1.1
+++ /project/cl-unification/cvsroot/cl-unification/variables.lisp	2008/07/13 13:10:48	1.2
@@ -2,6 +2,11 @@
 
 (in-package "CL.EXT.DACF.UNIFICATION") ; DACF = Data And Control Flow.
 
+
+(defun make-var-name (&optional (s (gensym)) (package *package*))
+  (intern (concatenate 'string "?" (symbol-name s)) package))
+
+
 (defun variablep (x)
   (and (symbolp x)
        (or (char= (char (symbol-name x) 0) #\?)