/[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.9 by camm, Fri Jan 7 17:58:33 2005 UTC revision 1.10 by camm, Wed Jun 22 01:37:25 2005 UTC
# Line 214  Line 214 
214      (let ((t1 (si::normalize-type t1)))      (let ((t1 (si::normalize-type t1)))
215        (if (integer-typep t1) t1))))        (if (integer-typep t1) t1))))
216    
217    (defvar *two-stars* '(* *))
218    
219    (defun integer-norm-form (form &optional (st *two-stars* stp))
220      (cond ((and (not stp) (atom form)) (integer-norm-form (list form)))
221            ((and form (or (not st) (atom form))) (error "Bad integer type"))
222            (form (cons (car form) (integer-norm-form (cdr form) (if stp (cdr st) st))))
223            (st)))
224    
225  (defun integer-type-and (type1 type2)  (defun integer-type-and (type1 type2)
226    (let ((ct1 (coerce-to-integer-type type1))    (let ((ct1 (integer-norm-form (coerce-to-integer-type type1)))
227          (ct2 (coerce-to-integer-type type2)))          (ct2 (integer-norm-form (coerce-to-integer-type type2))))
228      (and ct1 ct2      (and ct1 ct2
229           (eq (car ct1) (car ct2))           (eq (car ct1) (car ct2))
230           (let ((b1 (cadr ct1))           (let ((b1 (cadr ct1))

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

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