[cl-unification-cvs] CVS cl-unification

[mantoniotti]

Update of /project/cl-unification/cvsroot/cl-unification
In directory cl-net:/tmp/cvs-serv18677

Modified Files:
	templates-hierarchy.lisp 
Log Message:
Fixed a couple of problems with some accessors in the NUMBER,
STRUCTURE-OBJECT and STANDARD-OBJECT templates.


--- /project/cl-unification/cvsroot/cl-unification/templates-hierarchy.lisp	2009/04/15 10:18:59	1.5
+++ /project/cl-unification/cvsroot/cl-unification/templates-hierarchy.lisp	2009/12/17 16:43:12	1.6
@@ -407,6 +407,23 @@
       (cons (second spec)))))
 
 
+(defun number-template-numeric-type (x)
+  (declare (type number-template x))
+  (let ((n (number-template-number x)))
+    (if (numberp n)
+        (type-of n)
+        (first (template-spec x)))))
+
+(defun number-template-numeric-class (x)
+  (declare (type number-template x))
+  (let ((n (number-template-number x)))
+    (if (numberp n)
+        (class-of n)
+        (find-class (first (template-spec x))))))
+
+
+
+
 ;;; Sequence Templates.
 ;;; Specification is
 ;;;
@@ -493,11 +510,19 @@
 
 ;;; Structure and Standard Object Templates.
 
+(defun structure-object-template-class (x)
+  (and (structure-object-template-p x)
+       (first (template-spec x))))
+
 (defun structure-object-template-slots (x)
   (and (structure-object-template-p x)
        (rest (template-spec x))))
 
 
+(defun standard-object-template-class (x)
+  (and (standard-object-template-p x)
+       (first (template-spec x))))
+
 (defun standard-object-template-slots (x)
   (and (standard-object-template-p x)
        (rest (template-spec x))))