Changeset 11919


Ignore:
Timestamp:
05/21/09 20:25:17 (12 years ago)
Author:
ehuelsmann
Message:

Separate the precompiler and the file compiler
by giving each its own 'current environment' variable:
introduce *PRECOMPILE-ENV* in precompiler.lisp.

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

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

    r11848 r11919  
    111111          ((IN-PACKAGE DEFPACKAGE)
    112112           (note-toplevel-form form)
    113            (setf form (precompile-form form nil))
     113           (setf form (precompiler:precompile-form form nil *compile-file-environment*))
    114114           (eval form)
    115115           ;; Force package prefix to be used when dumping form.
     
    163163                      (format *error-output*
    164164                              "; Unable to compile function ~A~%" name)
    165                       (let ((precompiled-function (precompile-form expr nil)))
     165                      (let ((precompiled-function
     166                             (precompiler:precompile-form expr nil
     167                                              *compile-file-environment*)))
    166168                        (setf form
    167169                              `(fset ',name
     
    265267
    266268           (cond ((eq operator 'QUOTE)
    267 ;;;                      (setf form (precompile-form form nil))
     269;;;                      (setf form (precompiler:precompile-form form nil
     270;;;                                                  *compile-file-environment*))
    268271                  (when compile-time-too
    269272                    (eval form))
    270273                  (return-from process-toplevel-form))
    271274                 ((eq operator 'PUT)
    272                   (setf form (precompile-form form nil)))
     275                  (setf form (precompiler:precompile-form form nil *compile-file-environment*)))
    273276                 ((eq operator 'COMPILER-DEFSTRUCT)
    274                   (setf form (precompile-form form nil)))
     277                  (setf form (precompiler:precompile-form form nil *compile-file-environment*)))
    275278                 ((eq operator 'PROCLAIM)
    276                   (setf form (precompile-form form nil)))
     279                  (setf form (precompiler:precompile-form form nil *compile-file-environment*)))
    277280                 ((and (memq operator '(EXPORT REQUIRE PROVIDE SHADOW))
    278281                       (or (keywordp (second form))
    279282                           (and (listp (second form))
    280283                                (eq (first (second form)) 'QUOTE))))
    281                   (setf form (precompile-form form nil)))
     284                  (setf form (precompiler:precompile-form form nil *compile-file-environment*)))
    282285                 ((eq operator 'IMPORT)
    283                   (setf form (precompile-form form nil))
     286                  (setf form (precompiler:precompile-form form nil *compile-file-environment*))
    284287                  ;; Make sure package prefix is printed when symbols are imported.
    285288                  (let ((*package* +keyword-package+))
     
    294297                       (eq (%car (third form)) 'FUNCTION)
    295298                       (symbolp (cadr (third form))))
    296                   (setf form (precompile-form form nil)))
     299                  (setf form (precompiler:precompile-form form nil *compile-file-environment*)))
    297300;;;                     ((memq operator '(LET LET*))
    298301;;;                      (let ((body (cddr form)))
     
    301304;;;                                (return t)))
    302305;;;                            (setf form (convert-toplevel-form form))
    303 ;;;                            (setf form (precompile-form form nil)))))
     306;;;                            (setf form (precompiler:precompile-form form nil)))))
    304307                 ((eq operator 'mop::ensure-method)
    305308                  (setf form (convert-ensure-method form)))
     
    307310                       (not (special-operator-p operator))
    308311                       (null (cdr form)))
    309                   (setf form (precompile-form form nil)))
     312                  (setf form (precompiler:precompile-form form nil *compile-file-environment*)))
    310313                 (t
    311 ;;;                      (setf form (precompile-form form nil))
     314;;;                      (setf form (precompiler:precompile-form form nil))
    312315                  (note-toplevel-form form)
    313316                  (setf form (convert-toplevel-form form)))))))))
     
    327330  (c-e-m-1 form :function)
    328331  (c-e-m-1 form :fast-function)
    329   (precompile-form form nil))
     332  (precompiler:precompile-form form nil *compile-file-environment*))
    330333
    331334(declaim (ftype (function (t t) t) c-e-m-1))
     
    357360          (if compiled-function
    358361              `(funcall (load-compiled-function ,(file-namestring classfile)))
    359               (precompile-form form nil)))))
     362              (precompiler:precompile-form form nil *compile-file-environment*)))))
    360363
    361364
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

    r11879 r11919  
    5454           (setf body (copy-tree body))
    5555           (list 'LAMBDA lambda-list
    56                  (precompile-form (list* 'BLOCK block-name body) t)))))
     56                 (precompiler:precompile-form (list* 'BLOCK block-name body) t *compile-file-environment*)))))
    5757  ) ; EVAL-WHEN
    5858
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11911 r11919  
    73297329(defun p2-setq (form target representation)
    73307330  (unless (= (length form) 3)
    7331     (return-from p2-setq (compile-form (precompiler::precompile-setq form)
     7331    (return-from p2-setq (compile-form (precompiler:precompile-form form t
     7332                                                        *compile-file-environment*)
    73327333                                       target representation)))
    73337334  (let ((expansion (macroexpand (%cadr form) *compile-file-environment*)))
     
    82608261                                                           :lambda-list (cadr ',form)))))))
    82618262        (compile-1 (make-compiland :name name
    8262                                    :lambda-expression (precompile-form form t)
     8263                                   :lambda-expression
     8264                                   (precompiler:precompile-form form t
     8265                                                         *compile-file-environment*)
    82638266                                   :class-file class-file)))))
    82648267
     
    84018404                              (or name "top-level form"))
    84028405                (return-from jvm-compile
    8403                   (precompiler::precompile name definition)))))
     8406                  (sys:precompile name definition)))))
    84048407         (style-warning
    84058408          #'(lambda (c) (declare (ignore c))
  • trunk/abcl/src/org/armedbear/lisp/precompiler.lisp

    r11917 r11919  
    334334(in-package "EXTENSIONS")
    335335
    336 (export '(precompile-form precompile))
    337 
    338336(unless (find-package "PRECOMPILER")
    339337  (make-package "PRECOMPILER"
     
    356354
    357355(defvar *in-jvm-compile* nil)
     356(defvar *precompile-env* nil)
     357
    358358
    359359(declaim (ftype (function (t) t) precompile1))
     
    374374             (cond ((setf handler (get op 'precompile-handler))
    375375                    (return-from precompile1 (funcall handler form)))
    376                    ((macro-function op *compile-file-environment*)
     376                   ((macro-function op *precompile-env*)
    377377                    (return-from precompile1 (precompile1 (expand-macro form))))
    378378                   ((special-operator-p op)
     
    423423(defun precompile-dolist (form)
    424424  (if *in-jvm-compile*
    425       (precompile1 (macroexpand form *compile-file-environment*))
     425      (precompile1 (macroexpand form *precompile-env*))
    426426      (cons 'DOLIST (cons (mapcar #'precompile1 (cadr form))
    427427                          (mapcar #'precompile1 (cddr form))))))
     
    429429(defun precompile-dotimes (form)
    430430  (if *in-jvm-compile*
    431       (precompile1 (macroexpand form *compile-file-environment*))
     431      (precompile1 (macroexpand form *precompile-env*))
    432432      (cons 'DOTIMES (cons (mapcar #'precompile1 (cadr form))
    433433                           (mapcar #'precompile1 (cddr form))))))
     
    465465(defun precompile-do/do* (form)
    466466  (if *in-jvm-compile*
    467       (precompile1 (macroexpand form *compile-file-environment*))
     467      (precompile1 (macroexpand form *precompile-env*))
    468468      (list* (car form)
    469469             (precompile-do/do*-vars (cadr form))
     
    607607
    608608(defun precompile-macrolet (form)
    609   (let ((*compile-file-environment*
    610          (make-environment *compile-file-environment*)))
     609  (let ((*precompile-env* (make-environment *precompile-env*)))
    611610    (dolist (definition (cadr form))
    612611      (environment-add-macro-definition
    613        *compile-file-environment*
     612       *precompile-env*
    614613       (car definition)
    615614       (make-macro (car definition)
     
    622621
    623622(defun precompile-symbol-macrolet (form)
    624   (let ((*compile-file-environment*
    625          (make-environment *compile-file-environment*))
     623  (let ((*precompile-env* (make-environment *precompile-env*))
    626624        (defs (cadr form)))
    627625    (dolist (def defs)
     
    633631                 "Attempt to bind the special variable ~S with SYMBOL-MACROLET."
    634632                 :format-arguments (list sym)))
    635         (environment-add-symbol-binding *compile-file-environment*
     633        (environment-add-symbol-binding *precompile-env*
    636634                                        sym
    637635                                        (sys::make-symbol-macro expansion))))
     
    681679                        :format-arguments (list v)))
    682680               (push (list v (precompile1 expr)) result)
    683                (environment-add-symbol-binding *compile-file-environment*
    684                                                v nil))) ;; any value will do
     681               (environment-add-symbol-binding *precompile-env* v nil)))
     682               ;; any value will do: we just need to shadow any symbol macros
    685683            (t
    686684             (push var result)
    687              (environment-add-symbol-binding *compile-file-environment*
    688                                              var nil))))
     685             (environment-add-symbol-binding *precompile-env* var nil))))
    689686    (nreverse result)))
    690687
    691688(defun precompile-let (form)
    692   (let ((*compile-file-environment*
    693          (make-environment *compile-file-environment*)))
     689  (let ((*precompile-env* (make-environment *precompile-env*)))
    694690    (list* 'LET
    695691           (precompile-let/let*-vars (cadr form))
     
    708704(defun precompile-let* (form)
    709705  (setf form (maybe-fold-let* form))
    710   (let ((*compile-file-environment*
    711          (make-environment *compile-file-environment*)))
     706  (let ((*precompile-env* (make-environment *precompile-env*)))
    712707    (list* 'LET*
    713708           (precompile-let/let*-vars (cadr form))
     
    716711(defun precompile-case (form)
    717712  (if *in-jvm-compile*
    718       (precompile1 (macroexpand form *compile-file-environment*))
     713      (precompile1 (macroexpand form *precompile-env*))
    719714      (let* ((keyform (cadr form))
    720715             (clauses (cddr form))
     
    731726(defun precompile-cond (form)
    732727  (if *in-jvm-compile*
    733       (precompile1 (macroexpand form *compile-file-environment*))
     728      (precompile1 (macroexpand form *precompile-env*))
    734729      (let ((clauses (cdr form))
    735730            (result nil))
     
    747742        (body (cddr def)))
    748743    ;; Macro names are shadowed by local functions.
    749     (environment-add-function-definition *compile-file-environment* name body)
     744    (environment-add-function-definition *precompile-env* name body)
    750745    (cdr (precompile-named-lambda (list* 'NAMED-LAMBDA def)))))
    751746
     
    767762
    768763(defun precompile-flet/labels (form)
    769   (let ((*compile-file-environment*
    770          (make-environment *compile-file-environment*))
     764  (let ((*precompile-env* (make-environment *precompile-env*))
    771765        (operator (car form))
    772766        (locals (cadr form))
     
    841835(defun precompile-when (form)
    842836  (if *in-jvm-compile*
    843       (precompile1 (macroexpand form *compile-file-environment*))
     837      (precompile1 (macroexpand form *precompile-env*))
    844838      (precompile-cons form)))
    845839
    846840(defun precompile-unless (form)
    847841  (if *in-jvm-compile*
    848       (precompile1 (macroexpand form *compile-file-environment*))
     842      (precompile1 (macroexpand form *precompile-env*))
    849843      (precompile-cons form)))
    850844
     
    854848        (values-form (caddr form))
    855849        (body (cdddr form))
    856         (*compile-file-environment*
    857          (make-environment *compile-file-environment*)))
     850        (*precompile-env* (make-environment *precompile-env*)))
    858851    (dolist (var vars)
    859       (environment-add-symbol-binding *compile-file-environment* var nil))
     852      (environment-add-symbol-binding *precompile-env* var nil))
    860853    (list* 'MULTIPLE-VALUE-BIND
    861854           vars
     
    869862(defun precompile-nth-value (form)
    870863  (if *in-jvm-compile*
    871       (precompile1 (macroexpand form *compile-file-environment*))
     864      (precompile1 (macroexpand form *precompile-env*))
    872865      form))
    873866
    874867(defun precompile-return (form)
    875868  (if *in-jvm-compile*
    876       (precompile1 (macroexpand form *compile-file-environment*))
     869      (precompile1 (macroexpand form *precompile-env*))
    877870      (list 'RETURN (precompile1 (cadr form)))))
    878871
     
    921914           (return-from expand-macro form)))
    922915       (multiple-value-bind (result expanded)
    923            (macroexpand-1 form *compile-file-environment*)
     916           (macroexpand-1 form *precompile-env*)
    924917         (unless expanded
    925918           (return-from expand-macro (values result exp)))
     
    928921
    929922(declaim (ftype (function (t t) t) precompile-form))
    930 (defun precompile-form (form in-jvm-compile)
     923(defun precompile-form (form in-jvm-compile
     924                        &optional precompile-env)
    931925  (let ((*in-jvm-compile* in-jvm-compile)
    932         (*inline-declarations* *inline-declarations*))
     926        (*inline-declarations* *inline-declarations*)
     927        (pre::*precompile-env* precompile-env))
    933928    (precompile1 form)))
    934929
     
    10051000(install-handlers)
    10061001
     1002(export '(precompile-form))
     1003
    10071004(in-package #:system)
    10081005
    10091006(defun macroexpand-all (form &optional env)
    1010   (let ((*compile-file-environment* env))
    1011     (precompile-form form nil)))
     1007  (precompiler:precompile-form form nil env))
    10121008
    10131009(defmacro compiler-let (bindings &body forms &environment env)
     
    10351031    (setq definition (or (and (symbolp name) (macro-function name))
    10361032                         (fdefinition name))))
    1037   (let (expr result)
     1033  (let (expr result
     1034        (pre::*precompile-env* nil))
    10381035    (cond ((functionp definition)
    10391036           (multiple-value-bind (form closure-p)
     
    10531050           (format t "Unable to precompile ~S.~%" name)
    10541051           (return-from precompile (values nil t t))))
    1055     (setf result (coerce-to-function (precompile-form expr nil)))
     1052    (setf result (coerce-to-function (precompiler:precompile-form expr nil)))
    10561053    (when (and name (functionp result))
    10571054      (sys::set-function-definition name result definition))
     
    11321129               (setf env nil))
    11331130             (when (null env)
    1134                (setf lambda-expression (precompile-form lambda-expression nil)))
     1131               (setf lambda-expression (precompiler:precompile-form lambda-expression nil)))
    11351132             `(progn
    11361133                (%defun ',name ,lambda-expression)
    11371134                ,@(when doc
    11381135                   `((%set-documentation ',name 'function ,doc)))))))))
     1136
     1137(export '(precompile))
     1138
     1139;;(provide "PRECOMPILER")
Note: See TracChangeset for help on using the changeset viewer.