From 123a8dd97ab99b5e205b6768f6389d7cc7c12656 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Mon, 3 Jun 2013 15:28:02 +0400 Subject: [PATCH] Fix NCONC type derivation. Properly check the types of arguments, instead of testing for subtypes or supertypes of LIST, check for arguments to be subtypes of NULL or CONS. Reported by Jerry James. --- NEWS | 1 + src/compiler/srctran.lisp | 5 +---- tests/compiler.pure.lisp | 2 ++ 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/NEWS b/NEWS index 45b6aec..0bcf148 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,7 @@ changes relative to sbcl-1.1.8: * enchancement: disassemble now annotates some previously missing static functions, like LENGTH. + * bug fix: problems with NCONC type derivation (reported by Jerry James). * optimization: calls to static functions on x86-64 use less instructions. * optimization: compute encode-universal-time at compile time when possible. * optimization: when referencing internal functions as #'x, don't go through diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index cc6b36d..82be1f2 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -177,10 +177,7 @@ while next do (let ((lvar-type (lvar-type arg))) - (unless (or (csubtypep list-type lvar-type) - (csubtypep lvar-type list-type) - ;; Check for NIL specifically, because - ;; SYMBOL or ATOM won't satisfie the above + (unless (or (csubtypep cons-type lvar-type) (csubtypep null-type lvar-type)) (assert-lvar-type arg list-type (lexenv-policy *lexenv*)) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index f30c809..b0c405a 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -4410,6 +4410,8 @@ (lambda (x y) (nconc x (the list y) x)) t (lambda (x y) (nconc (the atom x) y)) t (lambda (x y) (nconc (the (or null (eql 10)) x) y)) t + (lambda (x y) (nconc (the (or cons vector) x) y)) t + (lambda (x y) (nconc (the sequence x) y)) t (lambda (x y) (print (length y)) (append x y)) sequence))) (loop for (function result-type) on test-cases by #'cddr do (assert (equal (car (cdaddr (sb-kernel:%simple-fun-type -- 1.7.10.4