summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <code@mail.matthias.benkard.de>2013-07-16 07:52:07 +0200
committerMatthias Andreas Benkard <code@mail.matthias.benkard.de>2013-07-16 07:56:50 +0200
commit25913996c924ebe7a40ce10c83a98ba817151abe (patch)
treee809546679db182674dda5ccc558fbde54f19626
parente46cbe4750338333088c4b67c0f7e83c41eb6a9b (diff)
PREPARE-GLOBAL-CALL: Deal with redefinition by using FDEFINITION-OBJECTs.
Conflicts: sb-eval2.lisp
-rw-r--r--sb-eval2.lisp33
1 files changed, 12 insertions, 21 deletions
diff --git a/sb-eval2.lisp b/sb-eval2.lisp
index 1b99129..830901a 100644
--- a/sb-eval2.lisp
+++ b/sb-eval2.lisp
@@ -402,7 +402,8 @@
(declaim (ftype (function ((or symbol list) list context) eval-closure) prepare-global-call))
(defun prepare-global-call (f args context)
- (let ((args* (mapcar (lambda (form) (prepare-form form context)) args)))
+ (let ((args* (mapcar (lambda (form) (prepare-form form context)) args))
+ (f* (sb-c::fdefinition-object f t)))
(if (< (length args) 20)
(specialize m% (length args) (loop for i from 0 below 20 collect i)
(let ((argvars (loop for i from 0 below m%
@@ -410,26 +411,16 @@
`(let ,(loop for var in argvars
for i from 0 below m%
collect `(,var (nth ,i args*)))
- (if (fboundp f)
- (let ((f* (fdefinition f)))
- (lambda (env)
- (declare (ignorable env))
- (funcall f*
- ,@(loop for var in argvars
- collect `(funcall (the eval-closure ,var) env)))))
- (lambda (env)
- (declare (ignorable env))
- (funcall (fdefinition f)
- ,@(loop for var in argvars
- collect `(funcall (the eval-closure ,var) env))))))))
- (if (fboundp f)
- (let ((f* (fdefinition f)))
- (lambda (env)
- (apply f*
- (mapcar (lambda (x) (funcall (the eval-closure x) env)) args*))))
- (lambda (env)
- (apply (fdefinition f)
- (mapcar (lambda (x) (funcall (the eval-closure x) env)) args*)))))))
+ (lambda (env)
+ (declare (ignorable env))
+ (funcall (or (sb-c::fdefn-fun f*)
+ (error 'undefined-function :name f))
+ ,@(loop for var in argvars
+ collect `(funcall (the eval-closure ,var) env)))))))
+ (lambda (env)
+ (apply (or (sb-c::fdefn-fun f*)
+ (error 'undefined-function :name f))
+ (mapcar (lambda (x) (funcall (the eval-closure x) env)) args*))))))
(declaim (ftype (function (eval-closure list context) eval-closure) prepare-direct-call))
(defun prepare-direct-call (f args context)