cmp: cleanup to avoid some forward-references

src/cmp/cmpenv-api.lsp

@@ -156,7 +156,15 @@ that are susceptible to be changed by PROCLAIM."
 
 (defun cmp-env-search-macro (name &optional (env *cmp-env*))
   (let ((f (cmp-env-search-function name env)))
-    (if (functionp f) f nil)))
+    (if (functionp f)
+        f
+        nil)))
+
+;;; Like macro-function except it searches the lexical environment,
+;;; to determine if the macro is shadowed by a function or a macro.
+(defun cmp-macro-function (name)
+  (or (cmp-env-search-macro name)
+      (macro-function name)))
 
 (defun cmp-env-search-ftype (name &optional (env *cmp-env*))
   (dolist (i env nil)

src/cmp/cmpform.lsp

@@ -204,7 +204,8 @@
     (baboon :format-control "Attempted to move a form with side-effects"))
   ;; The following protocol is only valid for VAR references.
   (unless (eq (c1form-name dest) 'VAR)
-    (baboon :format-control "Cannot replace forms other than VARs:~%~4I~A" dest))
+    (baboon :format-control "Cannot replace forms other than VARs:~%~4I~A"
+            :format-arguments (list dest)))
   ;; We have to relocate the children nodes of NEW-FIELDS in
   ;; the new branch. This implies rewriting the parents chain,
   ;; but only for non-location nodes (these are reused). The only

src/cmp/cmpopt-type.lsp

@@ -32,7 +32,8 @@
                          ,@declarations)
                 (si::while (< ,variable ,%limit)
                   ,@body
-                  (reckless (setq ,variable (1+ ,variable))))
+                  (locally (declare (optimize (safety 0)))
+                    (setq ,variable (1+ ,variable))))
                 ,@output))
              (t
               (let ((,variable 0))

src/cmp/cmppass2-top.lsp

@@ -304,7 +304,9 @@
   (declare (type fun fun))
 
   ;; Compiler note about compiling this function
-  (print-emitting fun)
+  (when *compile-print*
+    (ext:when-let ((name (or (fun-name fun) (fun-description fun))))
+      (format t "~&;;; Emitting code for ~s.~%" name)))
 
   (let* ((lambda-expr (fun-lambda fun))
          (*cmp-env* (c1form-env lambda-expr))

src/cmp/cmputil.lsp

@@ -121,12 +121,6 @@
               (innermost-non-expanded-form *current-toplevel-form*))))
   nil)
 
-(defun print-emitting (f)
-  (when *compile-print*
-    (let* ((name (or (fun-name f) (fun-description f))))
-      (when name
-        (format t "~&;;; Emitting code for ~s.~%" name)))))
-
 (defun cmpprogress (&rest args)
   (when *compile-verbose*
     (apply #'format t args)))
@@ -140,12 +134,6 @@
               form c)
       nil)))
 
-;;; Like macro-function except it searches the lexical environment,
-;;; to determine if the macro is shadowed by a function or a macro.
-(defun cmp-macro-function (name)
-  (or (cmp-env-search-macro name)
-      (macro-function name)))
-
 (defun cmp-expand-macro (fd form &optional (env *cmp-env*))
   (handler-case
       (let ((new-form (funcall *macroexpand-hook* fd form env)))
@@ -518,10 +506,6 @@ comparing circular objects."
       *exit*
       (next-label)))
 
-(defun maybe-wt-label (label)
-  (unless (eq label *exit*)
-    (wt-label label)))
-
 (defmacro with-exit-label ((label) &body body)
   `(let* ((,label (next-label))
           (*unwind-exit* (cons ,label *unwind-exit*)))
@@ -532,7 +516,8 @@ comparing circular objects."
   `(let* ((,label (maybe-next-label))
           (*unwind-exit* (adjoin ,label *unwind-exit*)))
      ,@body
-     (maybe-wt-label ,label)))
+     (unless (eq ,label *exit*)
+       (wt-label ,label))))
 
 (defun next-lcl (&optional name)
   (list 'LCL (incf *lcl*) T
@@ -559,6 +544,13 @@ comparing circular objects."
     (incf *env*)
     (setq *max-env* (max *env* *max-env*))))
 
-(defmacro reckless (&rest body)
-  `(locally (declare (optimize (safety 0)))
-     ,@body))
+(defun env-grows (possibily)
+  ;; if additional closure variables are introduced and this is not
+  ;; last form, we must use a new env.
+  (and possibily
+       (plusp *env*)
+       (dolist (exit *unwind-exit*)
+         (case exit
+           (RETURN (return NIL))
+           (BDS-BIND)
+           (t (return T))))))

src/cmp/cmpvar.lsp

@@ -14,17 +14,6 @@
 
 (in-package #:compiler)
 
-(defun env-grows (possibily)
-  ;; if additional closure variables are introduced and this is not
-  ;; last form, we must use a new env.
-  (and possibily
-       (plusp *env*)
-       (dolist (exit *unwind-exit*)
-         (case exit
-           (RETURN (return NIL))
-           (BDS-BIND)
-           (t (return T))))))
-
 ;; should check whether a form before var causes a side-effect
 ;; exactly one occurrence of var is present in forms
 (defun replaceable (var form)