/[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.14 by camm, Mon Aug 8 23:03:22 2005 UTC revision 1.15 by camm, Wed Sep 7 02:41:57 2005 UTC
# Line 263  Line 263 
263    
264  ;;FIXME -- centralize subtypep, normalzie-type, type>=, type-and.  ;;FIXME -- centralize subtypep, normalzie-type, type>=, type-and.
265  ;;Consider traversing a static tree.  CM 20050106  ;;Consider traversing a static tree.  CM 20050106
266  (defun type-and (type1 type2)  (defun type-and (type1 type2 &aux tem)
267    
268    (let ((nt1 (si::normalize-type type1)))    (let ((nt1 (si::normalize-type type1)))
269      (unless (and (not (array-wd type1)) (equal nt1 (if (symbolp type1) (list type1) type1)))      (unless (and (not (array-wd type1)) (equal nt1 (if (symbolp type1) (list type1) type1)))
# Line 289  Line 289 
289          ((eq type2 '*) type1)          ((eq type2 '*) type1)
290          ((si::memq type1 '(t object)) type2)          ((si::memq type1 '(t object)) type2)
291          ((si::memq type2 '(t object)) type1)          ((si::memq type2 '(t object)) type1)
292            ((setq tem (car (si::resolve-type `(and ,type1 ,type2))));FIXME
293             (let ((ntem (si::normalize-type tem)))
294               (cond ((equal ntem type1) type1)
295                     ((equal ntem type2) type2)
296                     (tem))))
297          ((or (integer-typep type1) (integer-typep type2))          ((or (integer-typep type1) (integer-typep type2))
298  ;        (integer-type-and type1 type2))FIXME           (integer-type-and type1 type2));FIXME
          (si::resolve-type `(and ,type1 ,type2)))  
299          ((and (array-tp type1) (array-tp type2))          ((and (array-tp type1) (array-tp type2))
300           (cond           (cond
301            ((eq (car type1) (car type2))            ((eq (car type1) (car type2))
# Line 355  Line 359 
359               ))))               ))))
360                                    
361  (defun type>= (type1 type2)  (defun type>= (type1 type2)
362    (equal (type-and type1 type2) type2))    (eq (type-and type1 type2) type2))
363    
364  (defun reset-info-type (info)  (defun reset-info-type (info)
365    (if (info-type info)    (if (info-type info)

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15

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