Changeset 11903


Ignore:
Timestamp:
05/20/09 20:50:27 (9 years ago)
Author:
ehuelsmann
Message:

Factor out common function definition replacement
from PRE::PRECOMPILE and JVM::%JVM-COMPILE.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11901 r11903  
    83518351            (terpri *error-output*))))))
    83528352
     8353(defun set-function-definition (name new old)
     8354  (let ((*warn-on-redefinition* nil))
     8355    (sys::%set-lambda-name new name)
     8356    (sys:set-call-count new (sys:call-count old))
     8357    (sys::%set-arglist new (sys::arglist old))
     8358    (when (macro-function name)
     8359      (setf new (make-macro name new)))
     8360    (if (typep old 'standard-generic-function)
     8361        (mop:set-funcallable-instance-function old new)
     8362        (setf (fdefinition name) new))))
     8363
    83538364(defun %jvm-compile (name definition expr env)
    83548365  (let* (compiled-function
     
    83628373        (delete-file tempfile)))
    83638374    (when (and name (functionp compiled-function))
    8364       (sys::%set-lambda-name compiled-function name)
    8365       (sys:set-call-count compiled-function (sys:call-count definition))
    8366       (sys::%set-arglist compiled-function (sys::arglist definition))
    8367       (let ((*warn-on-redefinition* nil))
    8368         (cond ((typep definition 'standard-generic-function)
    8369                (mop:set-funcallable-instance-function definition compiled-function))
    8370               (t
    8371                (setf (fdefinition name)
    8372                      (if (macro-function name)
    8373                          (make-macro name compiled-function)
    8374                          compiled-function))))))
     8375      (set-function-definition name compiled-function definition))
    83758376    (or name compiled-function)))
    83768377
  • trunk/abcl/src/org/armedbear/lisp/precompiler.lisp

    r11902 r11903  
    10441044    (setf result (coerce-to-function (precompile-form expr nil)))
    10451045    (when (and name (functionp result))
    1046       (%set-lambda-name result name)
    1047       (set-call-count result (call-count definition))
    1048       (let ((*warn-on-redefinition* nil))
    1049         (if (and (symbolp name) (macro-function name))
    1050             (let ((mac (make-macro name result)))
    1051               (%set-arglist mac (arglist (symbol-function name)))
    1052               (setf (fdefinition name) mac))
    1053             (progn
    1054               (setf (fdefinition name) result)
    1055               (%set-arglist result (arglist definition))))))
     1046      (sys::set-function-definition name result definition))
    10561047    (values (or name result) nil nil)))
    10571048
Note: See TracChangeset for help on using the changeset viewer.