Ignore:
Timestamp:
Oct 2, 2008, 4:33:34 PM (11 years ago)
Author:
gz
Message:

Fix to r10938: add any defconstants and defmacros to compile time eval env

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lib/nfcomp.lisp

    r10938 r10939  
    162162                            :report (lambda (stream) (format stream "Skip compiling ~s" src))
    163163                            (return))))))
     164
     165(defvar *fasl-compile-time-env* nil)
    164166
    165167(defun %compile-file (src output-file verbose print load features
     
    219221             (defenv (new-definition-environment))
    220222             (lexenv (new-lexical-environment defenv))
     223             (*fasl-compile-time-env* (new-lexical-environment (new-definition-environment)))
    221224             (*fcomp-external-format* external-format))
    222225        (let ((forms nil))
     
    293296      (funcall (compile-named-function
    294297                `(lambda () ,form)
    295                 ;; Do not depend on, or extend, the compile-time environment!
    296                 ;;  :env env
     298                :env *fasl-compile-time-env*
    297299                :policy *compile-time-evaluation-policy*)))))
    298300
     
    707709(defun define-compile-time-constant (symbol initform env)
    708710  (note-variable-info symbol t env)
    709   (let ((definition-env (definition-environment env)))
    710     (when definition-env
     711  (let ((compile-time-defenv (definition-environment *fasl-compile-time-env*))
     712        (definition-env (definition-environment env)))
     713    (when (or compile-time-defenv definition-env)
    711714      (multiple-value-bind (value error)
    712715                           (ignore-errors (values (%compile-time-eval initform env) nil))
     
    714717          (warn "Compile-time evaluation of DEFCONSTANT initial value form for ~S while ~
    715718                 compiling ~S signalled the error: ~&~A" symbol *fasl-source-file* error))
    716         (push (cons symbol (if error (%unbound-marker-8) value)) (defenv.constants definition-env))))
     719        (let ((cell (cons symbol (if error (%unbound-marker-8) value))))
     720          (when definition-env
     721            (push cell (defenv.constants definition-env)))
     722          (when compile-time-defenv
     723            (push cell (defenv.constants compile-time-defenv))))))
    717724    symbol))
    718725
     
    759766     
    760767(defun define-compile-time-macro (name lambda-expression env)
    761   (let ((definition-env (definition-environment env)))
    762     (when definition-env
    763       (push (list* name
    764                    'macro
    765                    (compile-named-function lambda-expression :name name :env env))
    766             (defenv.functions definition-env))
     768  (let ((compile-time-defenv (definition-environment *fasl-compile-time-env*))
     769        (definition-env (definition-environment env)))
     770    (when (or definition-env compile-time-defenv)
     771      (let ((cell (list* name
     772                         'macro
     773                         (compile-named-function lambda-expression :name name :env env))))
     774        (when compile-time-defenv
     775          (push cell (defenv.functions compile-time-defenv)))
     776        (when definition-env
     777          (push cell (defenv.functions definition-env))))
    767778      (record-function-info name (%cons-def-info 'defmacro) env))
    768779    name))
    769780
    770781(defun define-compile-time-symbol-macro (name expansion env)
    771   (let* ((definition-env (definition-environment env)))
    772     (if definition-env
    773       (push (cons name expansion) (defenv.symbol-macros definition-env)))
     782  (let ((compile-time-defenv (definition-environment *fasl-compile-time-env*))
     783        (definition-env (definition-environment env)))
     784    (when (or definition-env compile-time-defenv)
     785      (let ((cell (cons name expansion)))
     786        (when compile-time-defenv
     787          (push cell (defenv.functions compile-time-defenv)))
     788        (when definition-env
     789          (push cell (defenv.functions definition-env)))))
    774790    name))
    775791
Note: See TracChangeset for help on using the changeset viewer.