Add more optimization passes to a test snippet

It replaces the IR-FETCHVAR's result with the variable being
fetched. This only works when the only use is in an operation that
does not require a separate fetch be performed, such as those
implemented as CPU instructions.

wip-duuqnd/user-side-compiler/middle/data.lisp

@@ -1,7 +1,8 @@
 (in-package #:user-side-compiler)
 
 (defclass ir-data ()
-  ((%definition :accessor definition :initarg :definition)))
+  ((%definition :accessor definition :initarg :definition)
+   (%last-use :accessor last-use)))
 
 (defclass ir-result (ir-data)
   ((%user :accessor user :initarg :user :initform nil)))

wip-duuqnd/user-side-compiler/middle/jigs.lisp

@@ -80,6 +80,8 @@ end")
                 (compile-node (match-syntax program) builder)
                 root-block)))
       (do-iblocks (ib rb)
+        (optim-reorder-arguments ib)
+        (optim-direct-variable-use ib)
         (optim-call-duplicate-args ib)
         (optim-remove-unused ib))
       (print-iblocks rb)

wip-duuqnd/user-side-compiler/middle/optimizations.lisp

@@ -168,3 +168,35 @@ though I'm pretty sure it can't anyway.")
                   (push input arguments))))
           (loop :for (new . old) :in replacements
                 :do (setf (inputs call) (substitute new old (inputs call)))))))))
+
+(defun optim-direct-variable-use (iblock)
+  "Removes unnecessary uses of IR-FETCHVAR.
+Some operations do not require their operands to be copied before use. CPU
+instructions, for example. This optimization pass goes through and removes
+IR-FETCHVAR instructions that would serve no purpose in compiled code."
+  ;; TODO: Add more instructions to the candidates
+  (let ((candidates-type '(or ir-test-equal ir-plus ir-minus))
+        (to-remove '()))
+    (do-instructions (inst iblock)
+      #+(or)
+      (when (equalp (name iblock) "else")
+        (break "~A ~A" inst
+               (if (typep inst 'ir-fetchvar)
+                   (format nil "~A ~A ~A" (input inst) (output inst) (users (output inst)))
+                   "")))
+      (when (typep inst 'ir-fetchvar)
+        (let ((result (output inst))
+              (src (input inst)))
+          (when (and (not (typep (output inst) 'ir-reusable))
+                     (typep (user result) candidates-type))
+            (let ((user (user (output inst))))
+              (setf (inputs user) (substitute src result (inputs user)))
+              (push inst to-remove))))))
+    (mapc #'delete-instruction to-remove)))
+
+(defun compute-lifetime-knowledge (start-iblock)
+  (do-iblocks (iblock start-iblock)
+    (do-instructions (inst iblock)
+      (loop :for data :in (inputs inst)
+            :when (typep data 'ir-data)
+              :do (setf (last-use data) inst)))))