Changeset 11843


Ignore:
Timestamp:
05/08/09 21:09:09 (12 years ago)
Author:
ehuelsmann
Message:

Reflow PROCESS-TOPLEVEL-FORM in order to make
more lines meet our 80-character length limit.

File:
1 edited

Legend:

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

    r11841 r11843  
    100100(declaim (ftype (function (t stream t) t) process-toplevel-form))
    101101(defun process-toplevel-form (form stream compile-time-too)
    102   (cond ((atom form)
    103          (when compile-time-too
    104            (eval form)))
    105         (t
    106          (let ((operator (%car form)))
    107            (case operator
    108              (MACROLET
    109               (process-toplevel-macrolet form stream compile-time-too)
    110               (return-from process-toplevel-form))
    111              ((IN-PACKAGE DEFPACKAGE)
    112               (note-toplevel-form form)
    113               (setf form (precompile-form form nil))
    114               (eval form)
    115               ;; Force package prefix to be used when dumping form.
    116               (let ((*package* +keyword-package+))
    117                 (dump-form form stream))
    118               (%stream-terpri stream)
    119               (return-from process-toplevel-form))
    120              ((DEFVAR DEFPARAMETER)
    121               (note-toplevel-form form)
    122               (if compile-time-too
    123                   (eval form)
    124                   ;; "If a DEFVAR or DEFPARAMETER form appears as a top level form,
    125                   ;; the compiler must recognize that the name has been proclaimed
    126                   ;; special. However, it must neither evaluate the initial-value
    127                   ;; form nor assign the dynamic variable named NAME at compile
    128                   ;; time."
    129                   (let ((name (second form)))
    130                     (%defvar name))))
    131              (DEFCONSTANT
    132               (note-toplevel-form form)
    133               (process-defconstant form stream)
    134               (return-from process-toplevel-form))
    135              (DEFUN
    136               (note-toplevel-form form)
    137               (let* ((name (second form))
    138                      (block-name (fdefinition-block-name name))
    139                      (lambda-list (third form))
    140                      (body (nthcdr 3 form))
    141                      (*speed* *speed*)
    142                      (*space* *space*)
    143                      (*safety* *safety*)
    144                      (*debug* *debug*))
    145                 (multiple-value-bind (body decls doc)
    146                     (parse-body body)
    147                   (let* ((expr `(lambda ,lambda-list ,@decls (block ,block-name ,@body)))
    148                          (classfile-name (next-classfile-name))
    149                          (classfile (report-error
    150                                      (jvm:compile-defun name expr nil classfile-name)))
    151                          (compiled-function (verify-load classfile)))
    152                     (cond (compiled-function
    153                            (setf form
    154                                  `(fset ',name
    155                                         (load-compiled-function ,(file-namestring classfile))
    156                                         ,*source-position*
    157                                         ',lambda-list
    158                                         ,doc))
    159                            (when compile-time-too
    160                              (fset name compiled-function)))
    161                           (t
    162                            ;; FIXME This should be a warning or error of some sort...
    163                            (format *error-output* "; Unable to compile function ~A~%" name)
    164                            (let ((precompiled-function (precompile-form expr nil)))
    165                              (setf form
    166                                    `(fset ',name
    167                                           ,precompiled-function
    168                                           ,*source-position*
    169                                           ',lambda-list
    170                                           ,doc)))
    171                            (when compile-time-too
    172                              (eval form)))))
    173                   (when (and (symbolp name) (eq (get name '%inline) 'INLINE))
    174                     ;; FIXME Need to support SETF functions too!
    175                     (setf (inline-expansion name)
    176                           (jvm::generate-inline-expansion block-name lambda-list body))
    177                     (dump-form `(setf (inline-expansion ',name) ',(inline-expansion name))
    178                                stream)
    179                     (%stream-terpri stream)))
    180                 (push name jvm::*functions-defined-in-current-file*)
    181                 (note-name-defined name)
    182                 ;; If NAME is not fbound, provide a dummy definition so that
    183                 ;; getSymbolFunctionOrDie() will succeed when we try to verify that
    184                 ;; functions defined later in the same file can be loaded correctly.
    185                 (unless (fboundp name)
    186                   (setf (fdefinition name) #'dummy)
    187                   (push name *fbound-names*))))
    188              ((DEFGENERIC DEFMETHOD)
    189               (note-toplevel-form form)
    190               (note-name-defined (second form))
    191               (let ((*compile-print* nil))
    192                 (process-toplevel-form (macroexpand-1 form *compile-file-environment*)
    193                                        stream compile-time-too))
    194               (return-from process-toplevel-form))
    195              (DEFMACRO
    196               (note-toplevel-form form)
    197               (let ((name (second form)))
    198                 (eval form)
    199                 (let* ((expr (function-lambda-expression (macro-function name)))
    200                        (classfile-name (next-classfile-name))
    201                        (classfile
    202                         (ignore-errors
    203                          (jvm:compile-defun nil expr nil classfile-name))))
    204                   (if (verify-load classfile)
    205                       (progn
    206                         (setf form
    207                               (if (special-operator-p name)
    208                                   `(put ',name 'macroexpand-macro
    209                                         (make-macro ',name
    210                                                     (load-compiled-function
    211                                                      ,(file-namestring classfile))))
    212                                   `(fset ',name
    213                                          (make-macro ',name
    214                                                      (load-compiled-function
    215                                                       ,(file-namestring classfile)))
    216                                          ,*source-position*
    217                                          ',(third form)))))
    218                       ;; FIXME error or warning
    219                       (format *error-output* "; Unable to compile macro ~A~%" name)))))
    220              (DEFTYPE
    221               (note-toplevel-form form)
    222               (eval form))
    223              (EVAL-WHEN
    224               (multiple-value-bind (ct lt e)
    225                   (parse-eval-when-situations (cadr form))
    226                 (let ((new-compile-time-too (or ct
    227                                                 (and compile-time-too e)))
    228                       (body (cddr form)))
    229                   (cond (lt
    230                          (process-toplevel-progn body stream new-compile-time-too))
    231                         (new-compile-time-too
    232                          (eval `(progn ,@body)))))
    233                 (return-from process-toplevel-form)))
    234              (LOCALLY
    235               ;; FIXME Need to handle special declarations too!
    236               (let ((*speed* *speed*)
    237                     (*safety* *safety*)
    238                     (*debug* *debug*)
    239                     (*space* *space*)
    240                     (*inline-declarations* *inline-declarations*))
    241                 (multiple-value-bind (forms decls)
    242                     (parse-body (cdr form) nil)
    243                   (process-optimization-declarations decls)
    244                   (process-toplevel-progn forms stream compile-time-too)
    245                   (return-from process-toplevel-form))))
    246              (PROGN
    247               (process-toplevel-progn (cdr form) stream compile-time-too)
    248               (return-from process-toplevel-form))
    249              (DECLARE
    250               (compiler-style-warn "Misplaced declaration: ~S" form))
    251              (t
    252               (when (and (symbolp operator)
    253                          (macro-function operator *compile-file-environment*))
    254                 (note-toplevel-form form)
    255                 ;; Note that we want MACROEXPAND-1 and not MACROEXPAND here, in
    256                 ;; case the form being expanded expands into something that needs
    257                 ;; special handling by PROCESS-TOPLEVEL-FORM (e.g. DEFMACRO).
    258                 (let ((*compile-print* nil))
    259                   (process-toplevel-form (macroexpand-1 form *compile-file-environment*)
    260                                          stream compile-time-too))
    261                 (return-from process-toplevel-form))
    262 
    263               (cond ((eq operator 'QUOTE)
    264 ;;                      (setf form (precompile-form form nil))
    265                      (when compile-time-too
    266                        (eval form))
    267                      (return-from process-toplevel-form)
    268                      )
    269                     ((eq operator 'PUT)
    270                      (setf form (precompile-form form nil)))
    271                     ((eq operator 'COMPILER-DEFSTRUCT)
    272                      (setf form (precompile-form form nil)))
    273                     ((eq operator 'PROCLAIM)
    274                      (setf form (precompile-form form nil)))
    275                     ((and (memq operator '(EXPORT REQUIRE PROVIDE SHADOW))
    276                           (or (keywordp (second form))
    277                               (and (listp (second form))
    278                                    (eq (first (second form)) 'QUOTE))))
    279                      (setf form (precompile-form form nil)))
    280                     ((eq operator 'IMPORT)
    281                      (setf form (precompile-form form nil))
    282                      ;; Make sure package prefix is printed when symbols are imported.
    283                      (let ((*package* +keyword-package+))
    284                        (dump-form form stream))
    285                      (%stream-terpri stream)
    286                      (when compile-time-too
    287                        (eval form))
    288                      (return-from process-toplevel-form))
    289                     ((and (eq operator '%SET-FDEFINITION)
    290                           (eq (car (second form)) 'QUOTE)
    291                           (consp (third form))
    292                           (eq (%car (third form)) 'FUNCTION)
    293                           (symbolp (cadr (third form))))
    294                      (setf form (precompile-form form nil)))
    295 ;;                     ((memq operator '(LET LET*))
    296 ;;                      (let ((body (cddr form)))
    297 ;;                        (if (dolist (subform body nil)
    298 ;;                              (when (and (consp subform) (eq (%car subform) 'DEFUN))
    299 ;;                                (return t)))
    300 ;;                            (setf form (convert-toplevel-form form))
    301 ;;                            (setf form (precompile-form form nil)))))
    302                     ((eq operator 'mop::ensure-method)
    303                      (setf form (convert-ensure-method form)))
    304                     ((and (symbolp operator)
    305                           (not (special-operator-p operator))
    306                           (null (cdr form)))
    307                      (setf form (precompile-form form nil)))
    308                     (t
    309 ;;                      (setf form (precompile-form form nil))
    310                      (note-toplevel-form form)
    311                      (setf form (convert-toplevel-form form))
    312                      )))))))
     102  (if (atom form)
     103      (when compile-time-too
     104        (eval form))
     105    (progn
     106      (let ((operator (%car form)))
     107        (case operator
     108          (MACROLET
     109           (process-toplevel-macrolet form stream compile-time-too)
     110           (return-from process-toplevel-form))
     111          ((IN-PACKAGE DEFPACKAGE)
     112           (note-toplevel-form form)
     113           (setf form (precompile-form form nil))
     114           (eval form)
     115           ;; Force package prefix to be used when dumping form.
     116           (let ((*package* +keyword-package+))
     117             (dump-form form stream))
     118           (%stream-terpri stream)
     119           (return-from process-toplevel-form))
     120          ((DEFVAR DEFPARAMETER)
     121           (note-toplevel-form form)
     122           (if compile-time-too
     123               (eval form)
     124               ;; "If a DEFVAR or DEFPARAMETER form appears as a top level form,
     125               ;; the compiler must recognize that the name has been proclaimed
     126               ;; special. However, it must neither evaluate the initial-value
     127               ;; form nor assign the dynamic variable named NAME at compile
     128               ;; time."
     129               (let ((name (second form)))
     130                 (%defvar name))))
     131          (DEFCONSTANT
     132           (note-toplevel-form form)
     133           (process-defconstant form stream)
     134           (return-from process-toplevel-form))
     135          (DEFUN
     136           (note-toplevel-form form)
     137           (let* ((name (second form))
     138                  (block-name (fdefinition-block-name name))
     139                  (lambda-list (third form))
     140                  (body (nthcdr 3 form))
     141                  (*speed* *speed*)
     142                  (*space* *space*)
     143                  (*safety* *safety*)
     144                  (*debug* *debug*))
     145             (multiple-value-bind (body decls doc)
     146                 (parse-body body)
     147               (let* ((expr `(lambda ,lambda-list
     148                               ,@decls (block ,block-name ,@body)))
     149                      (classfile-name (next-classfile-name))
     150                      (classfile (report-error
     151                                  (jvm:compile-defun name expr nil
     152                                                     classfile-name)))
     153                      (compiled-function (verify-load classfile)))
     154                 (cond
     155                   (compiled-function
     156                    (setf form
     157                          `(fset ',name
     158                                 (load-compiled-function ,(file-namestring classfile))
     159                                 ,*source-position*
     160                                 ',lambda-list
     161                                 ,doc))
     162                    (when compile-time-too
     163                      (fset name compiled-function)))
     164                   (t
     165                    ;; FIXME Should be a warning or error of some sort...
     166                    (format *error-output*
     167                            "; Unable to compile function ~A~%" name)
     168                    (let ((precompiled-function (precompile-form expr nil)))
     169                      (setf form
     170                            `(fset ',name
     171                                   ,precompiled-function
     172                                   ,*source-position*
     173                                   ',lambda-list
     174                                   ,doc)))
     175                    (when compile-time-too
     176                      (eval form)))))
     177               (when (and (symbolp name) (eq (get name '%inline) 'INLINE))
     178                 ;; FIXME Need to support SETF functions too!
     179                 (setf (inline-expansion name)
     180                       (jvm::generate-inline-expansion block-name
     181                                                       lambda-list body))
     182                 (dump-form `(setf (inline-expansion ',name)
     183                                   ',(inline-expansion name))
     184                            stream)
     185                 (%stream-terpri stream)))
     186             (push name jvm::*functions-defined-in-current-file*)
     187             (note-name-defined name)
     188             ;; If NAME is not fbound, provide a dummy definition so that
     189             ;; getSymbolFunctionOrDie() will succeed when we try to verify that
     190             ;; functions defined later in the same file can be loaded correctly.
     191             (unless (fboundp name)
     192               (setf (fdefinition name) #'dummy)
     193               (push name *fbound-names*))))
     194          ((DEFGENERIC DEFMETHOD)
     195           (note-toplevel-form form)
     196           (note-name-defined (second form))
     197           (let ((*compile-print* nil))
     198             (process-toplevel-form (macroexpand-1 form *compile-file-environment*)
     199                                    stream compile-time-too))
     200             (return-from process-toplevel-form))
     201          (DEFMACRO
     202           (note-toplevel-form form)
     203           (let ((name (second form)))
     204             (eval form)
     205             (let* ((expr (function-lambda-expression (macro-function name)))
     206                    (classfile-name (next-classfile-name))
     207                    (classfile
     208                     (ignore-errors
     209                       (jvm:compile-defun nil expr nil classfile-name))))
     210               (if (null (verify-load classfile))
     211                   ;; FIXME error or warning
     212                   (format *error-output* "; Unable to compile macro ~A~%" name)
     213                 (progn
     214                   (setf form
     215                         (if (special-operator-p name)
     216                             `(put ',name 'macroexpand-macro
     217                                   (make-macro ',name
     218                                               (load-compiled-function
     219                                                ,(file-namestring classfile))))
     220                             `(fset ',name
     221                                    (make-macro ',name
     222                                                (load-compiled-function
     223                                                 ,(file-namestring classfile)))
     224                                    ,*source-position*
     225                                    ',(third form)))))))))
     226          (DEFTYPE
     227           (note-toplevel-form form)
     228           (eval form))
     229          (EVAL-WHEN
     230           (multiple-value-bind (ct lt e)
     231               (parse-eval-when-situations (cadr form))
     232             (let ((new-compile-time-too (or ct (and compile-time-too e)))
     233                   (body (cddr form)))
     234               (if lt
     235                   (process-toplevel-progn body stream new-compile-time-too)
     236                 (when new-compile-time-too
     237                   (eval `(progn ,@body)))))
     238           (return-from process-toplevel-form)))
     239          (LOCALLY
     240           ;; FIXME Need to handle special declarations too!
     241           (let ((*speed* *speed*)
     242                 (*safety* *safety*)
     243                 (*debug* *debug*)
     244                 (*space* *space*)
     245                 (*inline-declarations* *inline-declarations*))
     246             (multiple-value-bind (forms decls)
     247                 (parse-body (cdr form) nil)
     248               (process-optimization-declarations decls)
     249               (process-toplevel-progn forms stream compile-time-too)
     250               (return-from process-toplevel-form))))
     251          (PROGN
     252           (process-toplevel-progn (cdr form) stream compile-time-too)
     253           (return-from process-toplevel-form))
     254          (DECLARE
     255           (compiler-style-warn "Misplaced declaration: ~S" form))
     256          (t
     257           (when (and (symbolp operator)
     258                        (macro-function operator *compile-file-environment*))
     259             (note-toplevel-form form)
     260             ;; Note that we want MACROEXPAND-1 and not MACROEXPAND here, in
     261             ;; case the form being expanded expands into something that needs
     262             ;; special handling by PROCESS-TOPLEVEL-FORM (e.g. DEFMACRO).
     263             (let ((*compile-print* nil))
     264               (process-toplevel-form (macroexpand-1 form *compile-file-environment*)
     265                                      stream compile-time-too))
     266             (return-from process-toplevel-form))
     267
     268           (cond ((eq operator 'QUOTE)
     269;;;                      (setf form (precompile-form form nil))
     270                  (when compile-time-too
     271                    (eval form))
     272                  (return-from process-toplevel-form))
     273                 ((eq operator 'PUT)
     274                  (setf form (precompile-form form nil)))
     275                 ((eq operator 'COMPILER-DEFSTRUCT)
     276                  (setf form (precompile-form form nil)))
     277                 ((eq operator 'PROCLAIM)
     278                  (setf form (precompile-form form nil)))
     279                 ((and (memq operator '(EXPORT REQUIRE PROVIDE SHADOW))
     280                       (or (keywordp (second form))
     281                           (and (listp (second form))
     282                                (eq (first (second form)) 'QUOTE))))
     283                  (setf form (precompile-form form nil)))
     284                 ((eq operator 'IMPORT)
     285                  (setf form (precompile-form form nil))
     286                  ;; Make sure package prefix is printed when symbols are imported.
     287                  (let ((*package* +keyword-package+))
     288                    (dump-form form stream))
     289                  (%stream-terpri stream)
     290                  (when compile-time-too
     291                    (eval form))
     292                  (return-from process-toplevel-form))
     293                 ((and (eq operator '%SET-FDEFINITION)
     294                       (eq (car (second form)) 'QUOTE)
     295                       (consp (third form))
     296                       (eq (%car (third form)) 'FUNCTION)
     297                       (symbolp (cadr (third form))))
     298                  (setf form (precompile-form form nil)))
     299;;;                     ((memq operator '(LET LET*))
     300;;;                      (let ((body (cddr form)))
     301;;;                        (if (dolist (subform body nil)
     302;;;                              (when (and (consp subform) (eq (%car subform) 'DEFUN))
     303;;;                                (return t)))
     304;;;                            (setf form (convert-toplevel-form form))
     305;;;                            (setf form (precompile-form form nil)))))
     306                 ((eq operator 'mop::ensure-method)
     307                  (setf form (convert-ensure-method form)))
     308                 ((and (symbolp operator)
     309                       (not (special-operator-p operator))
     310                       (null (cdr form)))
     311                  (setf form (precompile-form form nil)))
     312                 (t
     313;;;                      (setf form (precompile-form form nil))
     314                  (note-toplevel-form form)
     315                  (setf form (convert-toplevel-form form)))))))))
    313316  (when (consp form)
    314317    (dump-form form stream)
Note: See TracChangeset for help on using the changeset viewer.