sbcl-1.4.10: Add backport patch to fix regression.
See: https://groups.google.com/forum/#!topic/sbcl-devel/bCc5-izybyo
This commit is contained in:
Kyle Nusbaum
Leah Neukirchen
parent
ac1816bc4d
commit
12db0f15e8
|
|
@ -0,0 +1,108 @@
|
|||
From 77e4b86a0393fa408f9ca0a337e63617ff9e5c73 Mon Sep 17 00:00:00 2001
|
||||
From: Stas Boukarev <stassats@gmail.com>
|
||||
Date: Thu, 2 Aug 2018 17:47:45 +0300
|
||||
Subject: [PATCH] Fix PRIMITIVE-TYPE on type intersections.
|
||||
|
||||
FUNCTION can intersect with many type intersections, don't use
|
||||
TYPES-EQUAL-OR-INTERSECT but check individual types for being subtypes
|
||||
of FUNCTION.
|
||||
|
||||
## (Void Linux Notes from knusbaum)
|
||||
sbcl-1.4.10 has a fairly bad regression, breaking pretty much all
|
||||
clim-based gui applications on sbcl (every one I've tried anyway).
|
||||
There's already a fix on master, which is where this patch came from,
|
||||
so this patch can be discarded whenever sbcl does their next release.
|
||||
|
||||
diff --git src/compiler/generic/primtype.lisp src/compiler/generic/primtype.lisp
|
||||
index 6ab742dee..d56b37157 100644
|
||||
--- src/compiler/generic/primtype.lisp
|
||||
+++ src/compiler/generic/primtype.lisp
|
||||
@@ -320,37 +320,37 @@
|
||||
(setq res new-ptype)
|
||||
(return (any)))))))))))
|
||||
(intersection-type
|
||||
- (if (types-equal-or-intersect (specifier-type 'function) type)
|
||||
- ;; Things like (AND STANDARD-OBJECT FUNCTION) are callable as functions.
|
||||
- (part-of function)
|
||||
- (let ((types (intersection-type-types type))
|
||||
- (res (any)))
|
||||
- ;; why NIL for the exact? Well, we assume that the
|
||||
- ;; intersection type is in fact doing something for us:
|
||||
- ;; that is, that each of the types in the intersection is
|
||||
- ;; in fact cutting off some of the type lattice. Since no
|
||||
- ;; intersection type is represented by a primitive type and
|
||||
- ;; primitive types are mutually exclusive, it follows that
|
||||
- ;; no intersection type can represent the entirety of the
|
||||
- ;; primitive type. (And NIL is the conservative answer,
|
||||
- ;; anyway). -- CSR, 2006-09-14
|
||||
- (dolist (type types (values res nil))
|
||||
- (multiple-value-bind (ptype)
|
||||
- (primitive-type type)
|
||||
- (cond
|
||||
- ;; if the result so far is (any), any improvement on
|
||||
- ;; the specificity of the primitive type is valid.
|
||||
- ((eq res (any))
|
||||
- (setq res ptype))
|
||||
- ;; if the primitive type returned is (any), the
|
||||
- ;; result so far is valid. Likewise, if the
|
||||
- ;; primitive type is the same as the result so far,
|
||||
- ;; everything is fine.
|
||||
- ((or (eq ptype (any)) (eq ptype res)))
|
||||
- ;; otherwise, we have something hairy and confusing,
|
||||
- ;; such as (and condition funcallable-instance).
|
||||
- ;; Punt.
|
||||
- (t (return (any)))))))))
|
||||
+ (let ((types (intersection-type-types type))
|
||||
+ (res (any)))
|
||||
+ ;; why NIL for the exact? Well, we assume that the
|
||||
+ ;; intersection type is in fact doing something for us:
|
||||
+ ;; that is, that each of the types in the intersection is
|
||||
+ ;; in fact cutting off some of the type lattice. Since no
|
||||
+ ;; intersection type is represented by a primitive type and
|
||||
+ ;; primitive types are mutually exclusive, it follows that
|
||||
+ ;; no intersection type can represent the entirety of the
|
||||
+ ;; primitive type. (And NIL is the conservative answer,
|
||||
+ ;; anyway). -- CSR, 2006-09-14
|
||||
+ (dolist (type types (values res nil))
|
||||
+ (when (csubtypep type (specifier-type 'function))
|
||||
+ ;; Things like (AND STANDARD-OBJECT FUNCTION) are callable as functions.
|
||||
+ (part-of function))
|
||||
+ (multiple-value-bind (ptype)
|
||||
+ (primitive-type type)
|
||||
+ (cond
|
||||
+ ;; if the result so far is (any), any improvement on
|
||||
+ ;; the specificity of the primitive type is valid.
|
||||
+ ((eq res (any))
|
||||
+ (setq res ptype))
|
||||
+ ;; if the primitive type returned is (any), the
|
||||
+ ;; result so far is valid. Likewise, if the
|
||||
+ ;; primitive type is the same as the result so far,
|
||||
+ ;; everything is fine.
|
||||
+ ((or (eq ptype (any)) (eq ptype res)))
|
||||
+ ;; otherwise, we have something hairy and confusing,
|
||||
+ ;; such as (and condition funcallable-instance).
|
||||
+ ;; Punt.
|
||||
+ (t (return (any))))))))
|
||||
(member-type
|
||||
(let (res)
|
||||
(block nil
|
||||
diff --git tests/compiler-2.pure.lisp tests/compiler-2.pure.lisp
|
||||
index a89e07d4b..4ba87d65e 100644
|
||||
--- tests/compiler-2.pure.lisp
|
||||
+++ tests/compiler-2.pure.lisp
|
||||
@@ -1524,3 +1524,12 @@
|
||||
(declare (type (string 1) s))
|
||||
(the (or simple-array (member 1/2 "ba" 0 #\3)) s))
|
||||
((#1="a") #1#)))
|
||||
+
|
||||
+(with-test (:name :primitive-type-function)
|
||||
+ (checked-compile-and-assert
|
||||
+ ()
|
||||
+ `(lambda (x)
|
||||
+ (funcall (the (and atom (not null)) x))
|
||||
+ )
|
||||
+ ((#'list) nil)
|
||||
+ (('list) nil)))
|
||||
--
|
||||
2.18.0
|
||||
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
# Template file for 'sbcl'
|
||||
pkgname=sbcl
|
||||
version=1.4.10
|
||||
revision=1
|
||||
revision=2
|
||||
only_for_archs="i686 x86_64 x86_64-musl armv7l aarch64"
|
||||
|
||||
hostmakedepends="iana-etc"
|
||||
|
|
|
|||
Loading…
Reference in New Issue