From 8258b3ef68a2ce4529c4c62e54ad2035193c1a53 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Fri, 26 Mar 2010 12:59:25 +0000 Subject: [PATCH] 1.0.36.40: fix PPC build * Resent unknown-type reparsing changes could result in LVAR-TYPE being # but _behaving_ as if it actually was # -- make PRIMITIVE-TYPE reparse the type if appropriate so that the right template can be found. * This problem was masked on x86oids as they have %INSTANCE-REF arg type *, whereas PPC had INSTANCE. Fixes launchpad bug #542894. --- src/code/early-type.lisp | 20 +++++++++++++++++++ src/code/late-type.lisp | 38 +++++------------------------------- src/compiler/generic/primtype.lisp | 1 + version.lisp-expr | 2 +- 4 files changed, 27 insertions(+), 34 deletions(-) diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp index 7e419f0..a4160a2 100644 --- a/src/code/early-type.lisp +++ b/src/code/early-type.lisp @@ -34,6 +34,26 @@ (defstruct (unknown-type (:include hairy-type) (:copier nil))) +(defun maybe-reparse-specifier (type) + (when (unknown-type-p type) + (let* ((spec (unknown-type-specifier type)) + (name (if (consp spec) + (car spec) + spec))) + (when (info :type :kind name) + (let ((new-type (specifier-type spec))) + (unless (unknown-type-p new-type) + new-type)))))) + +;;; Evil macro. +(defmacro maybe-reparse-specifier! (type) + (assert (symbolp type)) + (with-unique-names (new-type) + `(let ((,new-type (maybe-reparse-specifier ,type))) + (when ,new-type + (setf ,type ,new-type) + t)))) + (defstruct (negation-type (:include ctype (class-info (type-class-or-lose 'negation)) ;; FIXME: is this right? It's diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 609d33c..3953c54 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -1373,45 +1373,21 @@ (!define-type-method (hairy :unparse) (x) (hairy-type-specifier x)) -(defun maybe-specifier-for-reparse (type) - (when (unknown-type-p type) - (let* ((spec (unknown-type-specifier type)) - (name (if (consp spec) - (car spec) - spec))) - (when (info :type :kind name) - spec)))) - -;;; Evil macro. -(defmacro maybe-reparse-specifier! (type) - (assert (symbolp type)) - (with-unique-names (spec) - `(let ((,spec (maybe-specifier-for-reparse ,type))) - (when ,spec - (setf ,type (specifier-type ,spec)) - t)))) - (!define-type-method (hairy :simple-subtypep) (type1 type2) (let ((hairy-spec1 (hairy-type-specifier type1)) (hairy-spec2 (hairy-type-specifier type2))) (cond ((equal-but-no-car-recursion hairy-spec1 hairy-spec2) (values t t)) ((maybe-reparse-specifier! type1) - (if (unknown-type-p type1) - (values nil nil) - (csubtypep type1 type2))) + (csubtypep type1 type2)) ((maybe-reparse-specifier! type2) - (if (unknown-type-p type2) - (values nil nil) - (csubtypep type1 type2))) + (csubtypep type1 type2)) (t (values nil nil))))) (!define-type-method (hairy :complex-subtypep-arg2) (type1 type2) (if (maybe-reparse-specifier! type2) - (if (unknown-type-p type2) - (values nil nil) - (csubtypep type1 type2)) + (csubtypep type1 type2) (let ((specifier (hairy-type-specifier type2))) (cond ((and (consp specifier) (eql (car specifier) 'satisfies)) (case (cadr specifier) @@ -1424,16 +1400,12 @@ (!define-type-method (hairy :complex-subtypep-arg1) (type1 type2) (if (maybe-reparse-specifier! type1) - (if (unknown-type-p type1) - (values nil nil) - (csubtypep type1 type2)) + (csubtypep type1 type2) (values nil nil))) (!define-type-method (hairy :complex-=) (type1 type2) (if (maybe-reparse-specifier! type2) - (if (unknown-type-p type2) - (values nil nil) - (type= type1 type2)) + (type= type1 type2) (values nil nil))) (!define-type-method (hairy :simple-intersection2 :complex-intersection2) diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp index 2b5e2c6..43c5e26 100644 --- a/src/compiler/generic/primtype.lisp +++ b/src/compiler/generic/primtype.lisp @@ -143,6 +143,7 @@ ;;; !DEF-VM-SUPPORT-ROUTINE and DEFUN-CACHED. (/show0 "primtype.lisp 188") (!def-vm-support-routine primitive-type (type) + (sb!kernel::maybe-reparse-specifier! type) (primitive-type-aux type)) (/show0 "primtype.lisp 191") (defun-cached (primitive-type-aux diff --git a/version.lisp-expr b/version.lisp-expr index ec8196d..913dbd2 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.36.39" +"1.0.36.40" -- 1.7.10.4