X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=a39204fd2d5f80152e9e107f62b973674f8285d5;hb=986ce2596822cc0871b609346aaf592348aca596;hp=cf88b9968bc45f58ecc752d48518ab4f10f073c5;hpb=7fd2eb4b1bc68e8aaec233c4a39bdfc40225bda2;p=sbcl.git diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index cf88b99..a39204f 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -351,7 +351,6 @@ (values)) (defun %compile-component (component) - (/show "entering %COMPILE-COMPONENT") (let ((*code-segment* nil) (*elsewhere* nil)) (maybe-mumble "GTN ") @@ -443,7 +442,6 @@ ;; We're done, so don't bother keeping anything around. (setf (component-info component) nil) - (/show "leaving %COMPILE-COMPONENT") (values)) ;;; Delete components with no external entry points before we try to @@ -619,7 +617,7 @@ (defstruct (file-info (:copier nil)) ;; If a file, the truename of the corresponding source file. If from ;; a Lisp form, :LISP. If from a stream, :STREAM. - (name (required-argument) :type (or pathname (member :lisp :stream))) + (name (missing-arg) :type (or pathname (member :lisp :stream))) ;; the defaulted, but not necessarily absolute file name (i.e. prior ;; to TRUENAME call.) Null if not a file. This is used to set ;; *COMPILE-FILE-PATHNAME*, and if absolute, is dumped in the @@ -768,10 +766,14 @@ ;;; Macroexpand FORM in the current environment with an error handler. ;;; We only expand one level, so that we retain all the intervening ;;; forms in the source path. -(defun preprocessor-macroexpand (form) +(defun preprocessor-macroexpand-1 (form) (handler-case (sb!xc:macroexpand-1 form *lexenv*) (error (condition) - (compiler-error "(during macroexpansion)~%~A" condition)))) + (compiler-error "(during macroexpansion of ~A)~%~A" + (let ((*print-level* 1) + (*print-length* 2)) + (format nil "~S" form)) + condition)))) ;;; Process a PROGN-like portion of a top-level form. FORMS is a list of ;;; the forms, and PATH is the source path of the FORM they came out of. @@ -850,7 +852,7 @@ ;; I'd thought NIL should ;; work, but it doesn't. ;; -- WHN 2001-09-20 - (required-argument))) + (missing-arg))) (let* ((*current-path* path) (component (make-empty-component)) (*current-component* component)) @@ -885,16 +887,13 @@ ;; nice default for things where we don't have a ;; real source path (as in e.g. inside CL:COMPILE). '(original-source-start 0 0))) - (/show "entering %COMPILE" name) - (unless (or (null name) (legal-function-name-p name)) + (unless (or (null name) (legal-fun-name-p name)) (error "not a legal function name: ~S" name)) (let* ((*lexenv* (make-lexenv :policy *policy*)) (fun (make-functional-from-top-level-lambda lambda-expression :name name :path path))) - (/noshow fun) - ;; FIXME: The compile-it code from here on is sort of a ;; twisted version of the code in COMPILE-TOP-LEVEL. It'd be ;; better to find a way to share the code there; or @@ -903,23 +902,18 @@ ;; the :LOCALL-ONLY option to IR1-FOR-LAMBDA. Then maybe the ;; whole FUNCTIONAL-KIND=:TOP-LEVEL case could go away..) - (/show "about to LOCAL-CALL-ANALYZE-UNTIL-DONE") (local-call-analyze-until-done (list fun)) (multiple-value-bind (components-from-dfo top-components hairy-top) (find-initial-dfo (list fun)) (let ((*all-components* (append components-from-dfo top-components))) - (/noshow components-from-dfo top-components *all-components*) (mapc #'preallocate-physenvs-for-top-levelish-lambdas (append hairy-top top-components)) (dolist (component-from-dfo components-from-dfo) - (/show "compiling a COMPONENT-FROM-DFO") (compile-component component-from-dfo) - (/show "about to REPLACE-TOP-LEVEL-XEPS") (replace-top-level-xeps component-from-dfo))) - (/show "about to go into PROG1") (prog1 (let ((entry-table (etypecase *compile-object* (fasl-output (fasl-output-entry-table @@ -931,14 +925,12 @@ (aver found-p) result)) (mapc #'clear-ir1-info components-from-dfo) - (clear-stuff) - (/show "returning from %COMPILE"))))) + (clear-stuff))))) (defun process-top-level-cold-fset (name lambda-expression path) - (/show "entering PROCESS-TOP-LEVEL-COLD-FSET" name) (unless (producing-fasl-file) (error "can't COLD-FSET except in a fasl file")) - (unless (legal-function-name-p name) + (unless (legal-fun-name-p name) (error "not a legal function name: ~S" name)) (fasl-dump-cold-fset name (%compile lambda-expression @@ -946,7 +938,6 @@ :name name :path path) *compile-object*) - (/show "finished with PROCESS-TOP-LEVEL-COLD-FSET" name) (values)) ;;; Process a top-level FORM with the specified source PATH. @@ -1061,7 +1052,7 @@ ;; cross-compilation host.) (slightly-uncrossed (cons (uncross (first form)) (rest form))) - (expanded (preprocessor-macroexpand slightly-uncrossed))) + (expanded (preprocessor-macroexpand-1 slightly-uncrossed))) (if (eq expanded slightly-uncrossed) ;; (Now that we're no longer processing toplevel ;; forms, and hence no longer need to worry about @@ -1079,7 +1070,7 @@ ;; Top Level Forms". #-sb-xc-host (t - (let ((expanded (preprocessor-macroexpand form))) + (let ((expanded (preprocessor-macroexpand-1 form))) (cond ((eq expanded form) (when compile-time-too (eval form)) @@ -1114,8 +1105,8 @@ (values (fasl-dump-load-time-value-lambda lambda *compile-object*) (let ((type (leaf-type lambda))) - (if (function-type-p type) - (single-value-type (function-type-returns type)) + (if (fun-type-p type) + (single-value-type (fun-type-returns type)) *wild-type*))))) ;;; Compile the FORMS and arrange for them to be called (for effect,