Changeset 13493


Ignore:
Timestamp:
08/14/11 11:27:54 (10 years ago)
Author:
ehuelsmann
Message:

More refactoring.

File:
1 edited

Legend:

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

    r13492 r13493  
    107107
    108108
     109(declaim (ftype (function (t t t) t) process-toplevel-quote))
     110(defun precompile-toplevel-form (form stream compile-time-too)
     111  (declare (ignore stream))
     112  (let ((form (precompiler:precompile-form form nil
     113                                           *compile-file-environment*)))
     114    (when compile-time-too
     115      (eval form))
     116    form))
     117
     118
     119
     120
     121
    109122(declaim (ftype (function (t t t) t) process-toplevel-defconstant))
    110123(defun process-toplevel-defconstant (form stream compile-time-too)
     
    120133  (eval form)
    121134  form)
     135
     136(declaim (ftype (function (t t t) t) process-toplevel-quote))
     137(defun process-toplevel-quote (form stream compile-time-too)
     138  (declare (ignore stream))
     139  (when compile-time-too
     140    (eval form))
     141  nil)
     142
     143
     144(declaim (ftype (function (t t t) t) process-toplevel-import))
     145(defun process-toplevel-import (form stream compile-time-too)
     146  (declare (ignore stream))
     147  (let ((form (precompiler:precompile-form form nil
     148                                           *compile-file-environment*)))
     149    (let ((*package* +keyword-package+))
     150      (output-form form))
     151    (when compile-time-too
     152      (eval form)))
     153  nil)
     154
     155(declaim (ftype (function (t t t) t) process-toplevel-mop.ensure-method))
     156(defun process-toplevel-mop.ensure-method (form stream compile-time-too)
     157  (declare (ignore stream))
     158  (let ((form (convert-ensure-method form)))
     159    (when compile-time-too
     160      (eval form))
     161    form))
    122162
    123163(declaim (ftype (function (t t t) t) process-toplevel-defvar/defparameter))
     
    320360  (setf (get symbol 'toplevel-handler) handler))
    321361
    322 (dolist (pair '(
     362(dolist (pair '((COMPILER-DEFSTRUCT precompile-toplevel-form)
    323363                (DECLARE process-toplevel-declare)
    324364                (DEFCONSTANT process-toplevel-defconstant)
     
    332372                (DEFVAR process-toplevel-defvar/defparameter)
    333373                (EVAL-WHEN process-toplevel-eval-when)
     374                (EXPORT precompile-toplevel-form)
     375;;                (IMPORT precompile-toplevel-form)
    334376                (IN-PACKAGE process-toplevel-defpackage/in-package)
    335377                (LOCALLY process-toplevel-locally)
    336378                (MACROLET process-toplevel-macrolet)
     379                (PROCLAIM precompile-toplevel-form)
    337380                (PROGN process-toplevel-progn)
     381                (PROVIDE precompile-toplevel-form)
     382                (PUT precompile-toplevel-form)
     383                (QUOTE process-toplevel-quote)
     384                (REQUIRE precompile-toplevel-form)
     385                (SHADOW precompile-toplevel-form)
     386                (%SET-FDEFINITION precompile-toplevel-form)
     387                (MOP::ENSURE-METHOD process-toplevel-mop.ensure-method)
    338388))
    339389  (install-toplevel-handler (car pair) (cadr pair)))
     
    364414
    365415        (cond
    366           ((eq operator 'QUOTE)
    367            (when compile-time-too
    368              (eval form))
    369            (return-from process-toplevel-form))
    370           ((eq operator 'PUT)
    371            (setf form (precompiler:precompile-form form nil
    372                                                    *compile-file-environment*)))
    373           ((eq operator 'COMPILER-DEFSTRUCT)
    374            (setf form (precompiler:precompile-form form nil
    375                                                    *compile-file-environment*)))
    376           ((eq operator 'PROCLAIM)
    377            (setf form (precompiler:precompile-form form nil
    378                                                    *compile-file-environment*)))
    379           ((and (memq operator '(EXPORT REQUIRE PROVIDE SHADOW))
    380                 (or (keywordp (second form))
    381                     (and (listp (second form))
    382                          (eq (first (second form)) 'QUOTE))))
    383            (setf form (precompiler:precompile-form form nil
    384                                                    *compile-file-environment*)))
    385           ((eq operator 'IMPORT)
    386            (setf form (precompiler:precompile-form form nil
    387                                                    *compile-file-environment*))
    388            ;; Make sure package prefix is printed when symbols are imported.
    389            (let ((*package* +keyword-package+))
    390              (output-form form))
    391            (when compile-time-too
    392              (eval form))
    393            (return-from process-toplevel-form))
    394           ((and (eq operator '%SET-FDEFINITION)
    395                 (eq (car (second form)) 'QUOTE)
    396                 (consp (third form))
    397                 (eq (%car (third form)) 'FUNCTION)
    398                 (symbolp (cadr (third form))))
    399            (setf form (precompiler:precompile-form form nil
    400                                                    *compile-file-environment*)))
    401           ((eq operator 'mop::ensure-method)
    402            (setf form (convert-ensure-method form)))
    403416          ((and (symbolp operator)
    404417                (not (special-operator-p operator))
     
    464477interpreted toplevel form, non-NIL if it is 'simple enough'."
    465478  (and (consp form)
    466              (every #'(lambda (arg)
    467                         (or (and (atom arg)
    468                                  (not (and (symbolp arg)
    469                                            (symbol-macro-p arg))))
    470                             (and (consp arg)
    471                                  (eq 'QUOTE (car arg)))))
     479       (every #'(lambda (arg)
     480                  (or (and (atom arg)
     481                           (not (and (symbolp arg)
     482                                     (symbol-macro-p arg))))
     483                      (and (consp arg)
     484                           (eq 'QUOTE (car arg)))))
    472485              (cdr form))))
    473486
Note: See TracChangeset for help on using the changeset viewer.