[EMAIL PROTECTED] (Gerd Moellmann) writes:
> But there's another problem revealed by CLOCC that I don't seem to be
> able to track down. CMUCL enters an infinite loop or something while
> compiling CLOCC's rng.lisp, which uses #+NEGATIVE-ZERO-IS-NOT-ZERO,
> which I think we deleted, RANDOM and a lot of other float stuff, of
> course. Maybe someone with better knowledge of that area can help
> out?
I saw SBCL falling into an infinite recursion this morning on
(compile nil '(lambda (x) (typep x '(not (member 0d0))))). Maybe this
patch would help.
Index: typetran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/typetran.lisp,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -d -r1.37 -r1.38
--- typetran.lisp 16 Jun 2003 14:18:17 -0000 1.37
+++ typetran.lisp 3 Jul 2003 07:38:52 -0000 1.38
@@ -245,17 +245,20 @@
;;; trying to optimize it.
(defun source-transform-union-typep (object type)
(let* ((types (union-type-types type))
- (ltype (specifier-type 'list))
- (mtype (find-if #'member-type-p types)))
- (if (and mtype (csubtypep ltype type))
- (let ((members (member-type-members mtype)))
- (once-only ((n-obj object))
- `(or (listp ,n-obj)
- (typep ,n-obj
- '(or ,@(mapcar #'type-specifier
- (remove (specifier-type 'cons)
- (remove mtype types)))
- (member ,@(remove nil members)))))))
+ (type-list (specifier-type 'list))
+ (type-cons (specifier-type 'cons))
+ (mtype (find-if #'member-type-p types))
+ (members (when mtype (member-type-members mtype))))
+ (if (and mtype
+ (memq nil members)
+ (memq type-cons types))
+ (once-only ((n-obj object))
+ `(or (listp ,n-obj)
+ (typep ,n-obj
+ '(or ,@(mapcar #'type-specifier
+ (remove type-cons
+ (remove mtype types)))
+ (member ,@(remove nil members))))))
(once-only ((n-obj object))
`(or ,@(mapcar (lambda (x)
`(typep ,n-obj ',(type-specifier x)))
--
Regards,
Alexey Dejneka
"Alas, the spheres of truth are less transparent than those of
illusion." -- L.E.J. Brouwer
