/[gcl]/gcl/cmpnew/gcl_cmptype.lsp
ViewVC logotype

Diff of /gcl/cmpnew/gcl_cmptype.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.19 by camm, Wed Oct 12 01:48:29 2005 UTC revision 1.20 by camm, Fri Dec 9 01:00:14 2005 UTC
# Line 49  Line 49 
49  ;;; Check if THING is an object of the type TYPE.  ;;; Check if THING is an object of the type TYPE.
50  ;;; Depends on the implementation of TYPE-OF.  ;;; Depends on the implementation of TYPE-OF.
51  (defun object-type (thing)  (defun object-type (thing)
52    (let ((type (type-of thing)))    (let* ((type (type-of thing)))
53      (case type      (cond ((type>= 'integer type) `(integer ,thing ,thing))
54        ((fixnum bignum) `(integer ,thing ,thing))            ((eq type 'cons) `(cons ,(object-type (car thing)) ,(if (cdr thing) (object-type (cdr thing)) 'null)))
55        ((short-float long-float symbol null boolean) type)            ((eq type 'keyword) 'symbol)
56        (cons `(cons ,(object-type (car thing)) ,(if (cdr thing) (object-type (cdr thing)) 'null)))            ((type>= 'character type) 'character)
57        (keyword 'symbol)            (type))))
       ((standard-char character) 'character)  
       ((string bit-vector) type)  
       (vector (list 'vector (array-element-type thing)))  
       (array (list 'array (array-element-type thing)))  
       (t t))))   ;   'unknown ;; I can't see any use of this  
58    
59  (defvar *norm-tp-hash* (make-hash-table :test 'equal))  (defvar *norm-tp-hash* (make-hash-table :test 'equal))
60  (defvar *and-tp-hash* (make-hash-table :test 'equal))  (defvar *and-tp-hash* (make-hash-table :test 'equal))

Legend:
Removed from v.1.19  
changed lines
  Added in v.1.20

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26