sbcl: update to 1.4.11.

This commit is contained in:
Leah Neukirchen 2018-08-29 13:46:05 +02:00
parent 50434f4a66
commit c4a2434623
2 changed files with 9 additions and 117 deletions

View file

@ -1,108 +0,0 @@
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

View file

@ -1,7 +1,7 @@
# Template file for 'sbcl'
pkgname=sbcl
version=1.4.10
revision=2
version=1.4.11
revision=1
only_for_archs="i686 x86_64 x86_64-musl armv7l aarch64"
hostmakedepends="iana-etc"
@ -11,27 +11,27 @@ short_desc="Steel Bank Common Lisp"
maintainer="Leah Neukirchen <leah@vuxu.org>"
license="custom"
homepage="http://www.sbcl.org/"
distfiles="${SOURCEFORGE_SITE}/${pkgname}/${version}/${pkgname}-${version}-source.tar.bz2"
checksum=904ee7e90fd6d66dfb4da578ec9e3dab1a2a49b61b13fa1fbf30ce8b80593cc9
distfiles="${SOURCEFORGE_SITE}/${pkgname}/${pkgname}-${version}-source.tar.bz2"
checksum=f4b82e95ed1b1d973901442fb9e609c1446bc50a4e554ca8b94b8e8c281c4eb5
nocross=yes
nopie=yes
_bootstrap_lisp="bash ../sbcl-*-linux/run-sbcl.sh --no-sysinit --no-userinit --disable-debugger"
case "$XBPS_TARGET_MACHINE" in
x86_64)
distfiles+=" ${SOURCEFORGE_SITE}/${pkgname}/${version}/${pkgname}-${version}-x86-64-linux-binary.tar.bz2"
checksum+=" b773c40a1fa49d3c31fb9b520112674733409871422ec1d694bc37797b6dddb2"
distfiles+=" ${SOURCEFORGE_SITE}/${pkgname}/${pkgname}-${version}-x86-64-linux-binary.tar.bz2"
checksum+=" b40ba286bf24647dd6241927ec0679080a1a3dd4c2895a3ff398f93b1ca0e464"
;;
i686)
distfiles+=" ${SOURCEFORGE_SITE}/${pkgname}/${version}/${pkgname}-1.4.3-x86-linux-binary.tar.bz2"
distfiles+=" ${SOURCEFORGE_SITE}/${pkgname}/${pkgname}-1.4.3-x86-linux-binary.tar.bz2"
checksum+=" 6bed7e31bb28e841da7bfc48c75adb8bef19e5e07d1d6f0fc7487f022c32f92c"
;;
arm*)
distfiles+=" ${SOURCEFORGE_SITE}/${pkgname}/${version}/${pkgname}-1.2.14-armhf-linux-binary.tar.bz2"
distfiles+=" ${SOURCEFORGE_SITE}/${pkgname}/${pkgname}-1.2.14-armhf-linux-binary.tar.bz2"
checksum+=" a5fbf1d596a909a7719bc4a958f00e8537bf399fa051f83736baee950b21e56a"
;;
aarch64)
distfiles+=" ${SOURCEFORGE_SITE}/${pkgname}/${version}/${pkgname}-1.3.9-arm64-linux-binary.tar.bz2"
distfiles+=" ${SOURCEFORGE_SITE}/${pkgname}/${pkgname}-1.3.9-arm64-linux-binary.tar.bz2"
checksum+=" 494829f8e3ea7eb1c308b343cc390daf94a6215030a5f2b9ee0cded67511e918"
;;
*-musl)