diff options
| -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 771922c..1af91ff 100644 --- a/sb-eval2.lisp +++ b/sb-eval2.lisp @@ -195,7 +195,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% @@ -203,26 +204,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) |