(when (and warnings (> undefined-warning-count warn-count))
(let ((more (- undefined-warning-count warn-count)))
(compiler-style-warning
- "~D more use~:P of undefined ~(~A~) ~S"
+ "~W more use~:P of undefined ~(~A~) ~S"
more kind name))))))
(dolist (kind '(:variable :function :type))
(format *error-output* "~&")
(pprint-logical-block (*error-output* nil :per-line-prefix "; ")
(compiler-mumble "compilation unit ~:[finished~;aborted~]~
- ~[~:;~:*~& caught ~D fatal ERROR condition~:P~]~
- ~[~:;~:*~& caught ~D ERROR condition~:P~]~
- ~[~:;~:*~& caught ~D WARNING condition~:P~]~
- ~[~:;~:*~& caught ~D STYLE-WARNING condition~:P~]~
- ~[~:;~:*~& printed ~D note~:P~]"
+ ~[~:;~:*~& caught ~W fatal ERROR condition~:P~]~
+ ~[~:;~:*~& caught ~W ERROR condition~:P~]~
+ ~[~:;~:*~& caught ~W WARNING condition~:P~]~
+ ~[~:;~:*~& caught ~W STYLE-WARNING condition~:P~]~
+ ~[~:;~:*~& printed ~W note~:P~]"
abort-p
*aborted-compilation-unit-count*
*compiler-error-count*
;;; utilities for extracting COMPONENTs of FUNCTIONALs
-(defun clambda-component (clambda)
- (block-component (node-block (lambda-bind clambda))))
(defun functional-components (f)
(declare (type functional f))
(etypecase f
- (clambda (list (clambda-component f)))
+ (clambda (list (lambda-component f)))
(optional-dispatch (let ((result nil))
(labels ((frob (clambda)
- (pushnew (clambda-component clambda)
+ (pushnew (lambda-component clambda)
result))
(maybe-frob (maybe-clambda)
(when maybe-clambda
:source-name (or name '.anonymous.)
:debug-name (unless name
"top level form"))))
- (/show "in MAKE-FUNCTIONAL-FROM-TOP-LEVEL-LAMBDA" locall-fun fun component)
- (/show (component-lambdas component))
- (/show (lambda-calls fun))
- (setf (functional-entry-function fun) locall-fun
+ (setf (functional-entry-fun fun) locall-fun
(functional-kind fun) :external
(functional-has-external-references-p fun) t)
fun)))
;; 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" lambda-expression 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-toplevel-lambda lambda-expression
:name name
:path path)))
- (/show "back in %COMPILE from M-F-FROM-TL-LAMBDA" fun)
- (/show (block-component (node-block (lambda-bind fun))))
- (/show (component-lambdas (block-component (node-block (lambda-bind fun)))))
;; FIXME: The compile-it code from here on is sort of a
;; twisted version of the code in COMPILE-TOPLEVEL. It'd be
;; whole FUNCTIONAL-KIND=:TOPLEVEL case could go away..)
(locall-analyze-clambdas-until-done (list fun))
- (/show (lambda-calls fun))
- #+nil (break "back from LOCALL-ANALYZE-CLAMBDAS-UNTIL-DONE" fun)
(multiple-value-bind (components-from-dfo top-components hairy-top)
(find-initial-dfo (list fun))
- (/show components-from-dfo top-components hairy-top)
- (/show (mapcar #'component-lambdas components-from-dfo))
- (/show (mapcar #'component-lambdas top-components))
- (/show (mapcar #'component-lambdas hairy-top))
(let ((*all-components* (append components-from-dfo top-components)))
;; FIXME: This is more monkey see monkey do based on CMU CL
(mapc #'preallocate-physenvs-for-toplevelish-lambdas hairy-top)
(mapc #'preallocate-physenvs-for-toplevelish-lambdas top-components)
(dolist (component-from-dfo components-from-dfo)
- (/show component-from-dfo (component-lambdas component-from-dfo))
(compile-component component-from-dfo)
(replace-toplevel-xeps component-from-dfo)))
(aver found-p)
result))
(mapc #'clear-ir1-info components-from-dfo)
- (clear-stuff)
- (/show "returning from %COMPILE")))))
+ (clear-stuff)))))
(defun process-toplevel-cold-fset (name lambda-expression path)
(unless (producing-fasl-file)
(defun compile-load-time-value-lambda (lambdas)
(aver (null (cdr lambdas)))
(let* ((lambda (car lambdas))
- (component (block-component (node-block (lambda-bind lambda)))))
+ (component (lambda-component lambda)))
(when (eql (component-kind component) :toplevel)
(setf (component-name component) (leaf-debug-name lambda))
(compile-component component)