diff options
| author | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-16 07:52:07 +0200 |
|---|---|---|
| committer | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-16 07:56:50 +0200 |
| commit | 25913996c924ebe7a40ce10c83a98ba817151abe (patch) | |
| tree | e809546679db182674dda5ccc558fbde54f19626 | |
| parent | e46cbe4750338333088c4b67c0f7e83c41eb6a9b (diff) | |
PREPARE-GLOBAL-CALL: Deal with redefinition by using FDEFINITION-OBJECTs.
Conflicts:
sb-eval2.lisp
| -rw-r--r-- | sb-eval2.lisp | 33 |
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) |