summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/internal-reader-syntax.lisp40
1 files changed, 30 insertions, 10 deletions
diff --git a/Lisp/internal-reader-syntax.lisp b/Lisp/internal-reader-syntax.lisp
index 2586b10..b637f85 100644
--- a/Lisp/internal-reader-syntax.lisp
+++ b/Lisp/internal-reader-syntax.lisp
@@ -95,14 +95,34 @@
(symbol-name x)
(symbol-name y))))
:count 2))
- (function-name (cadr defun-form))
(arg-types (first typedecl-parts))
- (return-types (second typedecl-parts)))
- `(progn
- (declaim (ftype (function (,@arg-types)
- (values ,@return-types
- ,@(unless
- (member '&rest return-types)
- '(&rest nil))))
- ,function-name))
- ,defun-form))))
+ (return-types (second typedecl-parts))
+ (return-type `(values ,@return-types
+ ,@(unless
+ (member '&rest return-types)
+ '(&rest nil)))))
+ (destructuring-bind (head function-name lambda-list . body) defun-form
+ (let* ((decls-end (position-if #'(lambda (form)
+ (not (or (stringp form)
+ (and (listp form)
+ (eq (first form)
+ 'declare)))))
+ body))
+ (declarations-and-docs (subseq body 0 decls-end))
+ (real-body (subseq body decls-end)))
+ `(progn
+ (declaim (ftype (function (,@arg-types) ,return-type)
+ ,function-name))
+ (,head ,function-name ,lambda-list
+ ,@declarations-and-docs
+ (declare
+ ,@(loop for arg in lambda-list
+ for type in arg-types
+ for arg-name = (cond ((atom arg) arg)
+ (t (car arg)))
+ unless (or (member arg lambda-list-keywords)
+ (and (symbolp type)
+ (string= (symbol-name type) "*")))
+ collect `(type ,type ,arg-name)))
+ (the ,return-type
+ ,@real-body))))))))