/[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.2 by camm, Sun Sep 14 02:43:01 2003 UTC revision 1.3 by camm, Thu Sep 16 21:08:18 2004 UTC
# Line 132  Line 132 
132  (defun type-and (type1 type2)  (defun type-and (type1 type2)
133        
134    (cond ((equal type1 type2) type1)    (cond ((equal type1 type2) type1)
135            ((and (consp type2) (eq (car type2) 'values))
136             (if (and (consp type1) (eq (car type1) 'values))
137                 (let ((r (list 'values)))
138                   (do ((t1 (cdr type1) (cdr t1))
139                        (t2 (cdr type2) (cdr t2)))
140                       ((not (and (consp t1) (consp t2))) (nreverse r))
141                     (push (type-and (car t1) (car t2)) r)))
142               (type-and type1 (second type2))))
143            ((and (consp type1) (eq (car type1) 'values))
144               (type-and (second type1) type2))
145          ((eq type1 t) type2)          ((eq type1 t) type2)
146          ((eq type1 '*) type2)          ((eq type1 '*) type2)
147          ((eq type1 'object) type2)          ((eq type1 'object) type2)
148          ((eq type2 'object) type1)          ((eq type2 'object) type1)
149          ((eq type2 t) type1)          ((eq type2 t) type1)
150          ((eq type2 '*) type1)          ((eq type2 '*) type1)
         ((and (consp type2) (eq (car type2) 'values))  
          (type-and type1 (second type2)))  
151          ((consp type1)          ((consp type1)
152           (case (car type1)           (case (car type1)
153                 (array                 (array
# Line 154  Line 162 
162                  (if (and (consp type2) (eq (car type2) 'array)                  (if (and (consp type2) (eq (car type2) 'array)
163                           (eq (cadr type1) (cadr type2)))                           (eq (cadr type1) (cadr type2)))
164                      type1 nil))                      type1 nil))
                (values (type-and (second type1) type2))  
165                 (t nil)))                 (t nil)))
166          (t (case type1          (t (case type1
167                   (string                   (string

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

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