1.0.33.1: DEFTYPE-LAMBDA-LIST for builtin types.
authorTobias C. Rittweiler <trittweiler@users.sourceforge.net>
Sat, 28 Nov 2009 13:25:21 +0000 (13:25 +0000)
committerTobias C. Rittweiler <trittweiler@users.sourceforge.net>
Sat, 28 Nov 2009 13:25:21 +0000 (13:25 +0000)
Make SB-INTROSPECT:DEFTYPE-LAMBDA-LIST also work on most builtin
types.

NEWS
contrib/sb-introspect/introspect.lisp
contrib/sb-introspect/test-driver.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index 794dcf1..f2b2950 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,9 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
+
+changes relative to sbcl-1.0.33:
+  * enhancement: SB-INTROSPECT:DEFTYPE-LAMBDA-LIST now also works on most
+    builtin types.
+
 changes in sbcl-1.0.33 relative to sbcl-1.0.32:
   * new port: support added for x86-64 NetBSD.  (thanks to Aymeric Vincent)
   * improvement: support O_LARGEFILE access to files larger than 2GB on
index f031284..2bfcc68 100644 (file)
@@ -451,7 +451,19 @@ function designator."
   "Returns the lambda list of TYPESPEC-OPERATOR as first return
 value, and a flag whether the arglist could be found as second
 value."
-  (sb-int:info :type :lambda-list typespec-operator))
+  (check-type typespec-operator symbol)
+  (case (sb-int:info :type :kind typespec-operator)
+    (:defined
+     (sb-int:info :type :lambda-list typespec-operator))
+    (:primitive
+     (let ((translator-fun (sb-int:info :type :translator typespec-operator)))
+       (if translator-fun
+           (values (sb-kernel:%fun-lambda-list translator-fun) t)
+           ;; Some builtin types (e.g. STRING) do not have a
+           ;; translator, but they were actually defined via DEFTYPE
+           ;; in src/code/deftypes-for-target.lisp.
+           (sb-int:info :type :lambda-list typespec-operator))))
+    (t (values nil nil))))
 
 (defun struct-accessor-structure-class (function)
   (let ((self (sb-vm::%simple-fun-self function)))
index f379b26..f482b8d 100644 (file)
   nil)
 
 (deftest deftype-lambda-list.1
-    (multiple-value-bind (arglist found?) (deftype-lambda-list 'foobar-type)
-          (and found?
-               (equal arglist '(&whole w &environment e
-                                r1 r2 &optional o &rest rest &key k1 k2 k3))))
+    (deftype-lambda-list 'foobar-type)
+  (&whole w &environment e r1 r2 &optional o &rest rest &key k1 k2 k3)
   t)
 
 (deftest deftype-lambda-list.2
-    (equal (multiple-value-list (deftype-lambda-list (gensym)))
-           '(nil nil))
+    (deftype-lambda-list (gensym))
+  nil
+  nil)
+
+;; ARRAY is a primitive type with associated translator function.
+(deftest deftype-lambda-list.3
+    (deftype-lambda-list 'array)
+  (&optional (sb-kernel::element-type '*) (sb-kernel::dimensions '*))
+  t)
+
+;; VECTOR is a primitive type that is defined by means of DEFTYPE.
+(deftest deftype-lambda-list.4
+    (deftype-lambda-list 'vector)
+  (&optional sb-kernel::element-type sb-kernel::size)
   t)
 
 ;;; Test allocation-information
index 020b160..3fc8d74 100644 (file)
@@ -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.33"
+"1.0.33.1"