BIR: Define function for removing unused constants etc from modules

This allows the generator to be more flexible and put in constants
that aren't actually used, as long as it does the cleanup. I'm
doing that for the generation from Maclina bytecode.

Author: Bike

BIR/graph-modifications.lisp

@@ -69,6 +69,27 @@
 (defmethod add-definition ((datum variable) (definition instruction))
   (set:nadjoinf (writers datum) definition))
 
+(defgeneric remove-if-unused (value module))
+(defmethod remove-if-unused ((value constant) module)
+  (when (set:empty-set-p (readers value))
+    (set:nremovef (constants module) value)
+    (remhash (constant-value value) (constant-table module))))
+(defmethod remove-if-unused ((value function-cell) module)
+  (when (set:empty-set-p (readers value))
+    (set:nremovef (constants module) value)
+    (remhash (function-name value) (function-cell-table module))))
+(defmethod remove-if-unused ((value variable-cell) module)
+  (when (set:empty-set-p (readers value))
+    (set:nremovef (constants module) value)
+    (remhash (variable-name value) (variable-cell-table module))))
+(defmethod remove-if-unused ((ltv load-time-value) module)
+  (when (set:empty-set-p (readers ltv))
+    (set:nremovef (constants module) ltv)))
+(defmethod remove-if-unused ((value function) module)
+  (when (and (null (enclose value))
+          (set:empty-set-p (local-calls value)))
+    (clean-up-function value)))
+
 (defmethod (setf outputs) :before (new-outputs (inst instruction))
   (dolist (output (outputs inst))
     (remove-definition output inst))
@@ -144,6 +165,15 @@
   (unlink-instruction movant)
   (insert-instruction-after movant existing))
 
+;;; Remove any constants etc. that are unused. This is important to do if
+;;; the process of generating the module can create constants that are never
+;;; given a constant-reference instruction (analogously ltv-reference, etc.),
+;;; the deletion of which would usually clean up unused constants.
+;;; Verification requires unused constants to be deleted.
+(defun remove-unused-values (module)
+  (set:doset (constant (constants module))
+    (remove-if-unused constant module)))
+
 ;;; Remove backpointers to an instruction, etc.
 (defgeneric clean-up-instruction (instruction)
   (:method-combination progn)
@@ -201,38 +231,23 @@
 (defmethod clean-up-instruction progn ((inst constant-reference))
   (let ((constant (first (inputs inst))))
     (set:nremovef (readers constant) inst)
-    (when (set:empty-set-p (readers constant))
-      (let ((module (module (function inst))))
-        (set:nremovef (constants module) constant)
-        (remhash (constant-value constant) (constant-table module))))))
+    (remove-if-unused constant (module (function inst)))))
 (defmethod clean-up-instruction progn ((inst constant-fdefinition))
   (let ((constant (first (inputs inst))))
     (set:nremovef (readers constant) inst)
-    (when (set:empty-set-p (readers constant))
-      (let ((module (module (function inst))))
-        (set:nremovef (constants module) constant)
-        (remhash (function-name constant) (function-cell-table module))))))
+    (remove-if-unused constant (module (function inst)))))
 (defmethod clean-up-instruction progn ((inst constant-symbol-value))
   (let ((constant (first (inputs inst))))
     (set:nremovef (readers constant) inst)
-    (when (set:empty-set-p (readers constant))
-      (let ((module (module (function inst))))
-        (set:nremovef (constants module) constant)
-        (remhash (variable-name constant) (variable-cell-table module))))))
+    (remove-if-unused constant (module (function inst)))))
 (defmethod clean-up-instruction progn ((inst set-constant-symbol-value))
   (let ((constant (first (inputs inst))))
     (set:nremovef (readers constant) inst)
-    (when (set:empty-set-p (readers constant))
-      (let ((module (module (function inst))))
-        (set:nremovef (constants module) constant)
-        (remhash (variable-name constant) (variable-cell-table module))))))
+    (remove-if-unused constant (module (function inst)))))
 (defmethod clean-up-instruction progn ((inst constant-bind))
   (let ((constant (first (inputs inst))))
     (set:nremovef (readers constant) inst)
-    (when (set:empty-set-p (readers constant))
-      (let ((module (module (function inst))))
-        (set:nremovef (constants module) constant)
-        (remhash (variable-name constant) (variable-cell-table module))))))
+    (remove-if-unused constant (module (function inst)))))
 (defmethod clean-up-instruction progn ((inst load-time-value-reference))
   (let ((ltv (first (inputs inst))))
     (set:nremovef (readers ltv) inst)
@@ -241,15 +256,12 @@
 (defmethod clean-up-instruction progn ((inst enclose))
   (let ((code (code inst)))
     (setf (enclose code) nil)
-    (when (set:empty-set-p (local-calls code))
-      (clean-up-function code))))
+    (remove-if-unused code (module code))))
 (defmethod clean-up-instruction progn ((inst abstract-local-call))
   (let* ((code (callee inst))
          (local-calls (local-calls code)))
     (set:nremovef local-calls inst)
-    (when (and (null (enclose code))
-               (set:empty-set-p local-calls))
-      (clean-up-function code))))
+    (remove-if-unused code (module code))))
 (defmethod clean-up-instruction progn ((inst unwind))
   (set:nremovef (entrances (destination inst)) (iblock inst))
   (set:nremovef (unwinds (come-from inst)) inst))

BIR/packages.lisp

@@ -66,7 +66,8 @@
            #:delete-instruction
            #:replace-uses #:replace-terminator
            #:split-block-after #:delete-iblock #:maybe-delete-iblock
-           #:clean-up-iblock #:merge-successor-if-possible #:delete-iblock-if-empty)
+           #:clean-up-iblock #:merge-successor-if-possible #:delete-iblock-if-empty
+           #:remove-unused-values)
   (:export #:map-lambda-list)
   (:export #:verify)
   (:export #:unused-variable #:type-conflict)