cmp: cleanup: add ignore declarations, remove unused args etc

src/cmp/cmpc-inliner.lsp

@@ -51,14 +51,14 @@
   ;; the variable *INLINE-BLOCKS*.
   (and (inline-possible fname)
        (not (gethash fname *c2-dispatch-table*))
-       (let* ((dest-rep-type (loc-representation-type *destination*))
+       (let* (;; (dest-rep-type (loc-representation-type *destination*))
               (ii (get-inline-info fname arg-types return-type return-rep-type)))
          ii)))
 
 (defun apply-inline-info (ii inlined-locs)
   (let* ((arg-types (inline-info-arg-types ii))
          (out-rep-type (inline-info-return-rep-type ii))
-         (out-type (inline-info-return-type ii))
+         ;; (out-type (inline-info-return-type ii))
          (side-effects-p (function-may-have-side-effects (inline-info-name ii)))
          (fun (inline-info-expansion ii))
          (one-liner (inline-info-one-liner ii)))

src/cmp/cmpc-wt.lsp

@@ -64,14 +64,16 @@
   (mapc #'wt1 forms))
 
 ;;; Blocks beyond this value will not be indented
-(defvar +max-depth+ 10)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defvar +max-depth+ 10))
+
 (defvar +c-newline-indent-strings+
   #.(coerce (let ((basis (make-array (1+ +max-depth+)
                                      :initial-element #\Space
                                      :element-type 'base-char)))
               (setf (aref basis 0) #\Newline)
               (loop for i from 0 to +max-depth+
-                 collect (subseq basis 0 (1+ i))))
+                    collect (subseq basis 0 (1+ i))))
             'vector))
 
 (defun wt-nl-indent ()
@@ -136,7 +138,7 @@
           ((or (eq c #\Newline) (eq c #\Tab))
            (princ c stream))
           ((or (< code 32) (> code 127))
-           (format stream "\ux" code))
+           (format stream "\u~x" code))
           ((and (char= c #\*) (char= (schar text (1+ n)) #\/))
            (princ #\\ stream))
           (t
@@ -184,6 +186,7 @@
 
 (defun wt-filtered-data (string stream &key one-liner
                          (external-format #-unicode :default #+unicode :utf-8))
+  (declare (ignorable external-format))
   #+unicode
   (setf string (encode-string string external-format))
   (let ((N (length string))

src/cmp/cmpinline.lsp

@@ -110,7 +110,7 @@
           (c2expr* form)
           (list type temp))
         (list type
-              (list 'SYS:STRUCTURE-REF
+              (list 'si:STRUCTURE-REF
                     (first (coerce-locs
                             (inline-args (list (c1form-arg 0 form)))))
                     (c1form-arg 1 form)
@@ -125,7 +125,7 @@
           (c2expr* form)
           (list type temp))
         (list type
-              (list 'SYS:INSTANCE-REF
+              (list 'si:instance-ref
                     (first (coerce-locs
                             (inline-args (list (c1form-arg 0 form)))))
                     (c1form-arg 1 form)
@@ -140,10 +140,10 @@
        (emit-inlined-variable form forms))
       (CALL-GLOBAL
        (emit-inlined-call-global form (c1form-primary-type form)))
-      (SYS:STRUCTURE-REF
+      (si:STRUCTURE-REF
        (emit-inlined-structure-ref form forms))
       #+clos
-      (SYS:INSTANCE-REF
+      (si:INSTANCE-REF
        (emit-inlined-instance-ref form forms))
       (SETQ
        (emit-inlined-setq form forms))

src/cmp/cmppass1-call.lsp

@@ -24,7 +24,7 @@
 
 (defun unoptimized-funcall (fun arguments)
   (let ((l (length arguments)))
-    (if (<= l si::c-arguments-limit)
+    (if (<= l si:c-arguments-limit)
         (make-c1form* 'FUNCALL :sp-change t :side-effects t
                                :args (c1expr fun) (c1args* arguments))
         (unoptimized-long-call fun arguments))))
@@ -101,7 +101,7 @@
              form)))
     (let* ((fun (first args))
            (arguments (rest args)))
-      (cond ((eql (first (last arguments)) 'clos::.combined-method-args.)
+      (cond ((eql (first (last arguments)) 'clos:.combined-method-args.)
              ;; Uses frames instead of lists as last argumennt
              (default-apply fun arguments))
             ((and (consp fun)
@@ -257,7 +257,7 @@
 ;;; arguments) expression into an equivalent let* statement. Returns
 ;;; the bindings and body as two values.
 (defun transform-funcall/apply-into-let* (lambda-form arguments apply-p
-                                          &aux body apply-list apply-var
+                                          &aux apply-list apply-var
                                           let-vars extra-stmts all-keys)
   (multiple-value-bind (requireds optionals rest key-flag keywords
                                   allow-other-keys aux-vars)

src/cmp/cmppass1-data.lsp

@@ -121,7 +121,7 @@
                    ;; inconsistent.
                    ((and (not item) (not duplicate) (symbolp object)
                          (multiple-value-bind (foundp symbol)
-                             (si::mangle-name object)
+                             (si:mangle-name object)
                            (and foundp
                                 (return-from add-object symbol)))))
                    (t

src/cmp/cmppass1-fun.lsp

@@ -278,6 +278,7 @@
              (var (c1make-var name ss is ts))
              (init (third specs))
              (flag (fourth specs)))
+        (declare (ignore key))
         (setq init (if init
                        (and-form-type (var-type var) (c1expr init) init
                                       :safe "In (LAMBDA ~a...)" function-name)

src/cmp/cmppass1-special.lsp

@@ -61,7 +61,7 @@
   (setq args (progv symbols values (c1progn (cdr args))))
   (make-c1form 'ext:compiler-let args symbols values args))
 
-(defun c1function (args &aux fd)
+(defun c1function (args)
   (check-args-number 'FUNCTION args 1 1)
   (let ((fun (car args)))
     (cond ((si::valid-function-name-p fun)

src/cmp/cmppass1-stack.lsp

@@ -30,6 +30,7 @@
                   :args body)))
 
 (defun c1innermost-stack-frame (args)
+  (declare (ignore args))
   `(ffi:c-inline () () :object "_ecl_inner_frame"
                        :one-liner t :side-effects nil))
 

src/cmp/cmppass1-top.lsp

@@ -117,7 +117,7 @@
   (destructuring-bind (name lambda-list &rest body)
       args
     (multiple-value-bind (function pprint doc-string)
-        (sys::expand-defmacro name lambda-list body)
+        (si:expand-defmacro name lambda-list body)
       (declare (ignore pprint doc-string))
       (let ((fn (cmp-eval function *cmp-env*)))
         (cmp-env-register-global-macro name fn))

src/cmp/cmpprop.lsp

@@ -22,9 +22,11 @@
       `(format *standard-output* ,string ,@args))))
 
 (defun p1ordinary (c1form assumptions form)
+  (declare (ignore c1form))
   (p1propagate form assumptions))
 
 (defun p1fset (c1form assumptions fun fname macro pprint c1forms)
+  (declare (ignore c1form fun fname macro pprint c1forms))
   (values 'function assumptions))
 
 (defun p1propagate (form assumptions)
@@ -67,13 +69,14 @@
     (values type assumptions)))
 
 (defun p1values (form assumptions values)
+  (declare (ignore form))
   (loop for v in values
-     collect (multiple-value-bind (type new-assumptions)
-                 (p1propagate v assumptions)
-               (setf assumptions new-assumptions)
-               (values-type-primary-type type))
-     into all-values
-     finally (return (values `(values ,@all-values) assumptions))))
+        collect (multiple-value-bind (type new-assumptions)
+                    (p1propagate v assumptions)
+                  (setf assumptions new-assumptions)
+                  (values-type-primary-type type))
+          into all-values
+        finally (return (values `(values ,@all-values) assumptions))))
 
 (defun p1propagate-list (list assumptions)
   (loop with final-type = t
@@ -91,10 +94,12 @@ of the occurrences in those lists."
     (baboon :format-control "P1MERGE-BRANCHES got a non-empty list of assumptions")))
 
 (defun revise-var-type (variable assumptions where-to-stop)
+  (declare (ignore variable))
   (unless (and (null assumptions) (null where-to-stop))
     (baboon :format-control "REVISE-VAR-TYPE got a non-empty list of assumptions")))
 
 (defun p1block (c1form assumptions blk body)
+  (declare (ignore c1form))
   (setf (blk-type blk) nil)
   (multiple-value-bind (normal-type assumptions)
       (p1propagate body assumptions)
@@ -103,6 +108,7 @@ of the occurrences in those lists."
               assumptions))))
 
 (defun p1return-from (c1form assumptions blk return-type value)
+  (declare (ignore c1form return-type))
   (let* ((values-type (p1propagate value assumptions))
          (blk-type (blk-type blk)))
     (setf (blk-type blk) (if blk-type
@@ -111,39 +117,49 @@ of the occurrences in those lists."
     (values values-type assumptions)))
 
 (defun p1call-global (c1form assumptions fname args)
+  (declare (ignore c1form))
   (loop for v in args
-     do (multiple-value-bind (arg-type local-ass)
-            (p1propagate v assumptions)
-          (setf assumptions local-ass))
-     finally (let ((type (propagate-types fname args)))
-               (prop-message "~&;;; Computing output of function ~A with args~&;;;  ~{ ~A~}~&;;; gives ~A, while before ~A"
-                       fname (mapcar #'c1form-primary-type args)
-                       type (c1form-type c1form))
-               (return (values type assumptions)))))
+        do (multiple-value-bind (arg-type local-ass)
+               (p1propagate v assumptions)
+             (declare (ignore arg-type))
+             (setf assumptions local-ass))
+        finally (let ((type (propagate-types fname args)))
+                  (prop-message "~&;;; Computing output of function ~A with args~&;;;  ~{ ~A~}~&;;; gives ~A, while before ~A"
+                                fname (mapcar #'c1form-primary-type args)
+                                type (c1form-type c1form))
+                  (return (values type assumptions)))))
 
 (defun p1call-local (c1form assumptions fun args)
+  (declare (ignore c1form))
   (loop for v in args
-     do (multiple-value-bind (arg-type local-ass)
-            (p1propagate v assumptions)
-          (setf assumptions local-ass))
-     finally (return (values (fun-return-type fun)
-                             assumptions))))
+        do (multiple-value-bind (arg-type local-ass)
+               (p1propagate v assumptions)
+             (declare (ignore arg-type))
+             (setf assumptions local-ass))
+        finally (return (values (fun-return-type fun)
+                                assumptions))))
 
 (defun p1catch (c1form assumptions tag body)
+  (declare (ignore c1form))
   (multiple-value-bind (tag-type assumptions)
       (p1propagate tag assumptions)
+    (declare (ignore tag-type))
     (p1propagate body assumptions))
   (values t assumptions))
 
 (defun p1throw (c1form assumptions catch-value output-value)
+  (declare (ignore c1form))
   (multiple-value-bind (type new-assumptions)
       (p1propagate catch-value assumptions)
+    (declare (ignore type))
     (p1propagate output-value new-assumptions))
   (values t assumptions))
 
 (defun p1if (c1form assumptions fmla true-branch false-branch)
+  (declare (ignore c1form))
   (multiple-value-bind (fmla-type base-assumptions)
       (p1propagate fmla assumptions)
+    (declare (ignore fmla-type))
     (multiple-value-bind (t1 a1)
         (p1propagate true-branch base-assumptions)
       (multiple-value-bind (t2 a2)
@@ -152,40 +168,45 @@ of the occurrences in those lists."
                 (p1merge-branches base-assumptions (list a1 a2)))))))
 
 (defun p1fmla-not (c1form assumptions form)
+  (declare (ignore c1form))
   (multiple-value-bind (type assumptions)
       (p1propagate form assumptions)
+    (declare (ignore type))
     (values '(member t nil) assumptions)))
 
 (defun p1fmla-and (c1form orig-assumptions butlast last)
+  (declare (ignore c1form))
   (loop with type = t
-     with assumptions = orig-assumptions
-     for form in (append butlast (list last))
-     collect (progn
-               (multiple-value-setq (type assumptions)
-                 (p1propagate form assumptions))
-               assumptions)
-     into assumptions-list
-     finally (return (values (type-or 'null (values-type-primary-type type))
-                             (p1merge-branches orig-assumptions
-                                               assumptions-list)))))
+        with assumptions = orig-assumptions
+        for form in (append butlast (list last))
+        collect (progn
+                  (multiple-value-setq (type assumptions)
+                    (p1propagate form assumptions))
+                  assumptions)
+          into assumptions-list
+        finally (return (values (type-or 'null (values-type-primary-type type))
+                                (p1merge-branches orig-assumptions
+                                                  assumptions-list)))))
 
 (defun p1fmla-or (c1form orig-assumptions butlast last)
+  (declare (ignore c1form))
   (loop with type
-     with output-type = t
-     with assumptions = orig-assumptions
-     for form in (append butlast (list last))
-     collect (progn
-               (multiple-value-setq (type assumptions)
-                 (p1propagate form assumptions))
-               (setf output-type (type-or (values-type-primary-type type)
-                                          output-type))
-               assumptions)
-     into assumptions-list
-     finally (return (values output-type
-                             (p1merge-branches orig-assumptions
-                                               assumptions-list)))))
+        with output-type = t
+        with assumptions = orig-assumptions
+        for form in (append butlast (list last))
+        collect (progn
+                  (multiple-value-setq (type assumptions)
+                    (p1propagate form assumptions))
+                  (setf output-type (type-or (values-type-primary-type type)
+                                             output-type))
+                  assumptions)
+          into assumptions-list
+        finally (return (values output-type
+                                (p1merge-branches orig-assumptions
+                                                  assumptions-list)))))
 
 (defun p1lambda (c1form assumptions lambda-list doc body &rest not-used)
+  (declare (ignore c1form lambda-list doc not-used))
   (prop-message "~&;;;~&;;; Propagating function~&;;;")
   (let ((type (p1propagate body assumptions)))
     (values type assumptions)))
@@ -197,66 +218,75 @@ of the occurrences in those lists."
             assumptions)))
 
 (defun p1let* (c1form base-assumptions vars forms body)
+  (declare (ignore c1form))
   (let ((assumptions base-assumptions))
     (loop with type
-       for v in vars
-       for f in forms
-       unless (or (global-var-p v) (var-set-nodes v))
-       do (progn
-            (multiple-value-setq (type assumptions) (p1propagate f assumptions))
-            (setf (var-type v) (type-and (values-type-primary-type type)
-                                         (var-type v)))
-            (prop-message "~&;;; Variable ~A assigned type ~A"
-                          (var-name v) (var-type v))))
+          for v in vars
+          for f in forms
+          unless (or (global-var-p v) (var-set-nodes v))
+            do (progn
+                 (multiple-value-setq (type assumptions) (p1propagate f assumptions))
+                 (setf (var-type v) (type-and (values-type-primary-type type)
+                                              (var-type v)))
+                 (prop-message "~&;;; Variable ~A assigned type ~A"
+                               (var-name v) (var-type v))))
     (multiple-value-bind (type assumptions)
         (p1propagate body assumptions)
       (loop for v in vars
-         do (revise-var-type v assumptions base-assumptions))
+            do (revise-var-type v assumptions base-assumptions))
       (values type assumptions))))
 
 (defun p1locals (c1form assumptions funs body labels)
+  (declare (ignore c1form labels))
   (loop for f in funs
-     do (p1propagate-function f assumptions))
+        do (p1propagate-function f assumptions))
   (p1propagate body assumptions))
 
 (defun p1multiple-value-bind (c1form assumptions vars-list init-c1form body)
+  (declare (ignore c1form))
   (multiple-value-bind (init-form-type assumptions)
       (p1propagate init-c1form assumptions)
     (loop for v in vars-list
-       for type in (values-type-to-n-types init-form-type (length vars-list))
-       unless (or (global-var-p v)
-                  (var-set-nodes v))
-       do (setf (var-type v) (type-and (var-type v) type)) and
-       do (prop-message "~&;;; Variable ~A assigned type ~A"
-                          (var-name v) (var-type v)))
+          for type in (values-type-to-n-types init-form-type (length vars-list))
+          unless (or (global-var-p v)
+                     (var-set-nodes v))
+            do (setf (var-type v) (type-and (var-type v) type)) and
+          do (prop-message "~&;;; Variable ~A assigned type ~A"
+                           (var-name v) (var-type v)))
     (p1propagate body assumptions)))
 
 (defun p1multiple-value-setq (c1form assumptions vars-list value-c1form)
+  (declare (ignore c1form vars-list))
   (multiple-value-bind (init-form-type assumptions)
       (p1propagate value-c1form assumptions)
     (values init-form-type assumptions)))
 
 (defun p1progn (c1form assumptions forms)
+  (declare (ignore c1form))
   (p1propagate-list forms assumptions))
 
 (defun p1compiler-typecase (c1form assumptions variable expressions)
+  (declare (ignore c1form))
   (let ((var-type (var-type variable)))
     (loop with output-type = t
-       for (a-type c1form) in expressions
-       for c1form-type = (p1propagate c1form assumptions)
-       when (or (member a-type '(t otherwise))
-                (subtypep var-type a-type))
-       do (setf output-type c1form-type)
-       finally (return (values output-type assumptions)))))
+          for (a-type c1form) in expressions
+          for c1form-type = (p1propagate c1form assumptions)
+          when (or (member a-type '(t otherwise))
+                   (subtypep var-type a-type))
+            do (setf output-type c1form-type)
+          finally (return (values output-type assumptions)))))
 
 (defun p1checked-value (c1form assumptions type value let-form)
-  (let* ((value-type (p1propagate value assumptions))
-         (alt-type (p1propagate let-form assumptions)))
+  (declare (ignore c1form let-form))
+  (let ((value-type (p1propagate value assumptions))
+         ;;(alt-type (p1propagate let-form assumptions))
+        )
     (if (subtypep value-type type)
         value-type
         type)))
 
 (defun p1progv (c1form assumptions variables values body)
+  (declare (ignore c1form))
   (let (type)
     (multiple-value-setq (type assumptions)
       (p1propagate variables assumptions))
@@ -272,17 +302,20 @@ of the occurrences in those lists."
             assumptions)))
 
 (defun p1psetq (c1form assumptions vars c1forms)
+  (declare (ignore c1form vars))
   (loop for form in c1forms
-     do (multiple-value-bind (new-type assumptions)
-          (p1propagate form assumptions)))
+        do (p1propagate form assumptions))
   (values 'null assumptions))
 
 (defun p1with-stack (c1form assumptions body)
+  (declare (ignore c1form))
   (p1propagate body assumptions))
 
 (defun p1stack-push-values (c1form assumptions form inline)
+  (declare (ignore c1form inline))
   (multiple-value-bind (form-type assumptions)
       (p1propagate form assumptions)
+    (declare (ignore form-type))
     (values nil assumptions)))
 
 (defvar *tagbody-depth* -1
@@ -291,6 +324,7 @@ of the occurrences in those lists."
 as 2^*tagbody-limit* in the worst cases.")
 
 (defun p1go (c1form assumptions tag-var return-type)
+  (declare (ignore c1form tag-var return-type))
   (values t assumptions))
 
 (defun filter-only-declarations (assumptions)
@@ -305,7 +339,7 @@ as 2^*tagbody-limit* in the worst cases.")
     (values 'null (append (p1merge-branches nil ass-list) orig-assumptions))))
 
 (defun p1tagbody-one-pass (c1form assumptions tag-loc body)
-  (declare (ignore tag-loc))
+  (declare (ignore c1form tag-loc))
   (loop with local-ass = assumptions
      with ass-list = '()
      with aux

src/cmp/cmptype-assert.lsp

@@ -143,7 +143,7 @@
               value
               let-form)))
 
-(defmacro optional-type-assertion (&whole whole value type &environment env)
+(defmacro optional-type-assertion (value type &environment env)
   "If safety settings are high enough, generates a type check on an
 expression, ensuring that it is satisfied."
   (when (and (policy-type-assertions env)
@@ -151,7 +151,7 @@ expression, ensuring that it is satisfied."
     (cmpdebug "Checking type of ~A to be ~A" value type)
     `(ext:checked-value ,type ,value)))
 
-(defmacro type-assertion (&whole whole value type &environment env)
+(defmacro type-assertion (value type &environment env)
   "Generates a type check on an expression, ensuring that it is satisfied."
   (cmpdebug "Checking type of ~A to be ~A" value type)
   (unless (trivial-type-p type)

src/cmp/cmptype.lsp

@@ -182,7 +182,7 @@
        "if (ecl_unlikely(!(#0)))
          FEwrong_type_argument(#1,#2);" :one-liner nil))))
 
-(defmacro assert-type-if-known (&whole whole value type &environment env)
+(defmacro assert-type-if-known (value type &environment env)
   "Generates a type check on an expression, ensuring that it is satisfied."
   (multiple-value-bind (trivial valid)
       (subtypep 't type)
@@ -211,8 +211,7 @@
           (otherwise
            type)))))
 
-(defmacro optional-type-check (&whole whole value type &environment env)
-  (declare (ignore env))
+(defmacro optional-type-check (value type)
   (if (policy-assume-right-type)
       value
       `(assert-type-if-known ,value ,type)))