Sun Jul 13 13:10:48 UTC 2008 mantoniotti
* Some modification added. Exported symbols and reverted
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
diff -rN -u old-cl-unification-1/substitutions.lisp new-cl-unification-1/substitutions.lisp
--- old-cl-unification-1/substitutions.lisp 2013-07-21 20:02:44.000000000 +0000
+++ new-cl-unification-1/substitutions.lisp 2013-07-21 20:02:44.000000000 +0000
@@ -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 --
diff -rN -u old-cl-unification-1/templates-hierarchy.lisp new-cl-unification-1/templates-hierarchy.lisp
--- old-cl-unification-1/templates-hierarchy.lisp 2013-07-21 20:02:44.000000000 +0000
+++ new-cl-unification-1/templates-hierarchy.lisp 2013-07-21 20:02:44.000000000 +0000
@@ -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
diff -rN -u old-cl-unification-1/unification-package.lisp new-cl-unification-1/unification-package.lisp
--- old-cl-unification-1/unification-package.lisp 2013-07-21 20:02:44.000000000 +0000
+++ new-cl-unification-1/unification-package.lisp 2013-07-21 20:02:44.000000000 +0000
@@ -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"
diff -rN -u old-cl-unification-1/variables.lisp new-cl-unification-1/variables.lisp
--- old-cl-unification-1/variables.lisp 2013-07-21 20:02:44.000000000 +0000
+++ new-cl-unification-1/variables.lisp 2013-07-21 20:02:44.000000000 +0000
@@ -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) #\?)