From 287475f107626c6c8993b955daa9b19b292e69fd Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 7 Apr 2004 14:22:35 +0000 Subject: [PATCH] 0.8.9.27: Make special operators know about their user-visible arglists ... change motivated by all-new all-singing all-dancing automagic documentation facility; ... add a hacky test for it in sb-introspect --- contrib/sb-introspect/sb-introspect.lisp | 4 ++-- contrib/sb-introspect/test-driver.lisp | 2 ++ src/compiler/macros.lisp | 21 +++++++++++---------- version.lisp-expr | 2 +- 4 files changed, 16 insertions(+), 13 deletions(-) diff --git a/contrib/sb-introspect/sb-introspect.lisp b/contrib/sb-introspect/sb-introspect.lisp index a00e254..7b73c56 100644 --- a/contrib/sb-introspect/sb-introspect.lisp +++ b/contrib/sb-introspect/sb-introspect.lisp @@ -46,8 +46,8 @@ (defun function-arglist (function) "Describe the lambda list for the function designator FUNCTION. -Works for macros, simple functions and generic functions. Signals error -if not found" +Works for special-operators, macros, simple functions and generic +functions. Signals error if not found" (cond ((valid-function-name-p function) (function-arglist (or (macro-function function) (fdefinition function)))) diff --git a/contrib/sb-introspect/test-driver.lisp b/contrib/sb-introspect/test-driver.lisp index fa4372d..5068d8c 100644 --- a/contrib/sb-introspect/test-driver.lisp +++ b/contrib/sb-introspect/test-driver.lisp @@ -4,6 +4,8 @@ (assert (equal (function-arglist 'cl-user::one) '(cl-user::a cl-user::b cl-user::c))) +(assert (equal (function-arglist 'the) + '(type sb-c::value))) (defun matchp (object form-number) (let ((ds (sb-introspect:find-definition-source object))) diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp index c92c88a..dbb41f9 100644 --- a/src/compiler/macros.lisp +++ b/src/compiler/macros.lisp @@ -45,9 +45,8 @@ ;;; list. START-VAR, NEXT-VAR and RESULT-VAR are bound to the start and ;;; result continuations for the resulting IR1. KIND is the function ;;; kind to associate with NAME. -(defmacro def-ir1-translator (name (lambda-list start-var next-var result-var - &key (kind :special-form)) - &body body) +(defmacro def-ir1-translator (name (lambda-list start-var next-var result-var) + &body body) (let ((fn-name (symbolicate "IR1-CONVERT-" name)) (n-form (gensym)) (n-env (gensym))) @@ -69,18 +68,20 @@ ;; FIXME: Evidently "there can only be one!" -- we overwrite any ;; other :IR1-CONVERT value. This deserves a warning, I think. (setf (info :function :ir1-convert ',name) #',fn-name) - (setf (info :function :kind ',name) ,kind) + ;; FIXME: rename this to SPECIAL-OPERATOR, to update it to + ;; the 1990s? + (setf (info :function :kind ',name) :special-form) ;; It's nice to do this for error checking in the target ;; SBCL, but it's not nice to do this when we're running in ;; the cross-compilation host Lisp, which owns the ;; SYMBOL-FUNCTION of its COMMON-LISP symbols. #-sb-xc-host - ,@(when (eq kind :special-form) - `((setf (symbol-function ',name) - (lambda (&rest rest) - (declare (ignore rest)) - (error 'special-form-function - :name ',name))))))))) + (let ((fun (lambda (&rest rest) + (declare (ignore rest)) + (error 'special-form-function :name ',name)))) + (setf (%simple-fun-arglist fun) ',lambda-list) + (setf (symbol-function ',name) fun)) + ',name)))) ;;; (This is similar to DEF-IR1-TRANSLATOR, except that we pass if the ;;; syntax is invalid.) diff --git a/version.lisp-expr b/version.lisp-expr index 79848cd..c59abcd 100644 --- 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".) -"0.8.9.26" +"0.8.9.27" -- 1.7.10.4