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