1.0.24.4: SB-INTROSPECT:DEFTYPE-LAMBDA-LIST

 * Patch by Tobias Rittweiler.

diff --git a/NEWS b/NEWS
index ef00da9..6e7338b 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,7 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 changes in sbcl-1.0.25 relative to 1.0.24:
+  * new feature: SB-INTROSPECT:DEFTYPE-LAMBDA-LIST allows retrieval of
+    DEFTYPE lambda lists. (thanks to Tobias Rittweiler)
   * improvement: reading from a TWO-WAY-STREAM does not touch the output
     stream anymore making it thread safe to have a concurrent reader and
     a writer, for instance, in a pipe.

diff --git a/contrib/sb-introspect/sb-introspect.lisp b/contrib/sb-introspect/sb-introspect.lisp
index b163ba6..76b6452 100644 (file)
--- a/contrib/sb-introspect/sb-introspect.lisp
+++ b/contrib/sb-introspect/sb-introspect.lisp
@@ -25,6 +25,7 @@
 (defpackage :sb-introspect
   (:use "CL")
   (:export "FUNCTION-ARGLIST"
+           "DEFTYPE-LAMBDA-LIST"
            "VALID-FUNCTION-NAME-P"
            "FIND-DEFINITION-SOURCE"
            "FIND-DEFINITION-SOURCES-BY-NAME"
@@ -430,6 +431,12 @@ not found"
          (sb-eval:interpreted-function-lambda-list function))
         (t (sb-kernel:%simple-fun-arglist (sb-kernel:%fun-fun function)))))
 
+(defun deftype-lambda-list (typespec-operator)
+  "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))
+
 (defun struct-accessor-structure-class (function)
   (let ((self (sb-vm::%simple-fun-self function)))
     (cond

diff --git a/contrib/sb-introspect/test-driver.lisp b/contrib/sb-introspect/test-driver.lisp
index 9ae4e63..8762f2b 100644 (file)
--- a/contrib/sb-introspect/test-driver.lisp
+++ b/contrib/sb-introspect/test-driver.lisp
@@ -122,6 +122,21 @@
 ;;;; Test finding a type that isn't one
 (assert (not (find-definition-sources-by-name 'fboundp :type)))
 
+;;;; Check correctness of DEFTYPE-LAMBDA-LIST.
+(deftype foobar-type
+    (&whole w &environment e r1 r2 &optional o &rest rest &key k1 k2 k3)
+  (declare (ignore w e r1 r2 o rest k1 k2 k3))
+  nil)
+
+(assert (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)))))
+
+(assert (equal (multiple-value-list (deftype-lambda-list (gensym)))
+               '(nil nil)))
+
+
 ;;;; Test the xref facility
 
 (load (merge-pathnames "xref-test.lisp" *load-pathname*))

diff --git a/version.lisp-expr b/version.lisp-expr
index 781f17b..907579b 100644 (file)
--- 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.24.3"
+"1.0.24.4"