X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=af9ba1de30ae28cb35f7983fcc738835c8d817c5;hb=c1aeac123df223746249567a9c0d2f656d1222cb;hp=9d8e5826a012d50128337ad67037e4ee7bd4776c;hpb=0cfad881b88e03971a2b3ef0c0c0fc2e5f4f1bc8;p=sbcl.git

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 9d8e582..af9ba1d 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -179,7 +179,7 @@
 	      (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))
@@ -201,11 +201,11 @@
     (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*
@@ -828,15 +828,13 @@
 
 
 ;;; 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
@@ -867,10 +865,7 @@
 				    :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)))
@@ -895,16 +890,12 @@
 		  ;; 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
@@ -915,15 +906,9 @@
     ;; 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
@@ -934,7 +919,6 @@
 	(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)))
 
@@ -949,8 +933,7 @@
               (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)
@@ -1158,7 +1141,7 @@
 (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)