From 8ecbaf49113acb9e56a3af65117c15773b0f66ac Mon Sep 17 00:00:00 2001
From: Vladimir Azarov <avm@intermediate-node.net>
Date: Thu, 7 Aug 2025 02:45:01 +0200
Subject: IL assignment merge optimization

---
 il.fun | 119 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 107 insertions(+), 12 deletions(-)

diff --git a/il.fun b/il.fun
index 4c12d51..069f476 100644
--- a/il.fun
+++ b/il.fun
@@ -530,7 +530,8 @@ functor IL(P: PARSER) = struct
         (Reg vl, ctx)
       end
 
-  and convCast ctx (v, fromT, toT) =
+  and convCast ctx (v, _, P.void_t) = (v, ctx)
+    | convCast ctx (v, fromT, toT) =
     case Word.compare (P.sizeOfType toT, P.sizeOfType fromT) of
       EQUAL => (v, ctx)
     | LESS => (
@@ -1320,12 +1321,12 @@ functor IL(P: PARSER) = struct
     Array.appi (printOp C) (valOf opTable)
 
   fun printVar idx { class, defs, use, t = _ } =
-  let
-  in
-    printfn `"%" I idx `" " `(if class = VR4 then "w4" else "w8")
-        `": defs = " Plist i defs (", ", true, 0)
-        `", uses = " Plist i use (", ", true, 0) %
-  end
+    if length defs = 0 andalso length use = 0 then
+      ()
+    else
+      printfn `"%" I idx `" " `(if class = VR4 then "w4" else "w8")
+          `": defs = " Plist i defs (", ", true, 0)
+          `", uses = " Plist i use (", ", true, 0) %
 
   fun printVars (Lctx { vregs, ... }) =
   let
@@ -1352,7 +1353,7 @@ functor IL(P: PARSER) = struct
   let
     val () = printfn `"new constant: %" I vid %
 
-    val { class, defs, use, t = _ } = D.get vregs vid
+    val { class, ... } = D.get vregs vid
 
     val v =
       case v of
@@ -1362,9 +1363,9 @@ functor IL(P: PARSER) = struct
         in
           RtConst w
         end
-      | RtAddrConst (id, 0w0) => RtAddrConst (id, 0w0)
-      | RtAddrConst _ | RtUnk => raise Unreachable
-    val () = D.set vregs vid { class, defs, use, t = v }
+      | RtAddrConst (id, w) => RtAddrConst (id, w)
+      | RtUnk => raise Unreachable
+    val () = D.set vregs vid { class, defs = [], use = [], t = v }
   in
     Array.update (opTable, insId, NONE)
   end
@@ -1645,6 +1646,93 @@ functor IL(P: PARSER) = struct
     propagate worklist vregs opTable
   end
 
+  fun changeDest rd ins =
+  let
+    fun tr (_, rs1, rs2) = (rd, rs1, rs2)
+  in
+    case ins of
+      IrAdd t => IrAdd (tr t)
+    | IrSub t => IrSub (tr t)
+    | IrMul t => IrMul (tr t)
+    | IrIMul t => IrIMul (tr t)
+    | IrDiv t => IrDiv (tr t)
+    | IrIDiv t => IrIDiv (tr t)
+    | IrMod t => IrMod (tr t)
+    | IrIMod t => IrIMod (tr t)
+    | IrCmpul t => IrCmpul (tr t)
+    | IrCmpug t => IrCmpug (tr t)
+    | IrCmpule t => IrCmpule (tr t)
+    | IrCmpuge t => IrCmpuge (tr t)
+    | IrCmpsl t => IrCmpsl (tr t)
+    | IrCmpsg t => IrCmpsg (tr t)
+    | IrCmpsle t => IrCmpsle (tr t)
+    | IrCmpsge t => IrCmpsge (tr t)
+    | IrAnd t => IrAnd (tr t)
+    | IrOr t => IrOr (tr t)
+    | IrXor t => IrXor (tr t)
+    | IrEq t => IrEq (tr t)
+    | IrNeq t => IrNeq (tr t)
+    | IrExtSign t => IrExtSign (tr t)
+    | IrExtZero t => IrExtZero (tr t)
+    | IrLoad (_, rs, am) => IrLoad (rd, rs, am)
+    | IrShl t => IrShl (tr t)
+    | IrShr t => IrShr (tr t)
+    | IrSar t => IrSar (tr t)
+    | IrFcall (_, f, args) => IrFcall (rd, f, args)
+    | IrRet (SOME _) => IrRet (SOME rd)
+    | IrRet NONE => raise Unreachable
+    | IrSet (_, arg) => IrSet (rd, arg)
+    | IrNop _ | IrNopLabel _ | IrAlloc _ | IrCopy _ | IrJmp _ | IrJz _
+    | IrJnz _ | IrStore _ => raise Unreachable
+  end
+
+  fun mergeIns (Lctx { vregs, opTable, ... }) idx rd rs =
+  let
+    val opTable = valOf opTable
+
+    val { class, t, ... } = D.get vregs rs
+    val () = D.set vregs rs { defs = [], use = [], class, t }
+    val ins = valOf $ Array.sub (opTable, idx - 1)
+    val ir = changeDest rd ins
+    val () = Array.update (opTable, idx - 1, SOME ir)
+    val () = Array.update (opTable, idx, NONE)
+
+    val { defs, use, class, t } = D.get vregs rd
+
+    fun loop (d :: ds) acc =
+      loop ds $ (if d = idx then idx - 1 else d) :: acc
+      | loop [] acc = rev acc
+    val () = D.set vregs rd { defs = loop defs [], use, class, t }
+  in
+    ()
+  end
+
+  fun optSet (C as Lctx { vregs, opTable, localVars, ... })
+    (idx, SOME (IrSet (rd, SaVReg rs)))
+  =
+    if getCS vregs rd <> getCS vregs rs then
+      ()
+    else
+      let
+        val { defs, use, ... } = D.get vregs rs
+      in
+        case (defs, use) of
+          ([d], [_]) =>
+            if d = idx - 1 andalso rs >= Vector.length localVars then
+              mergeIns C idx rd rs
+            else
+              ()
+        | _ => ()
+      end
+    | optSet _ _ = ()
+
+  fun peephole (C as Lctx { opTable, ... }) =
+  let
+    val () = Array.appi (optSet C) (valOf opTable)
+  in
+    ()
+  end
+
   fun translateFn (F as { localVars, stmt, paramNum, ... }) =
   let
     val () = P.printDef (P.Definition F)
@@ -1655,9 +1743,16 @@ functor IL(P: PARSER) = struct
     val () = printVars ctx
     val () = printIns ctx
 
-    val () = printf `"\nconstant propagation\n" %
+    val () = printf `"\nconstant propagation\n\n" %
     val () = constPropagate ctx
     val () = printIns ctx
+
+    val () = printf `"\npeephole il optimizations\n\n" %
+    val () = peephole ctx
+    val () = printIns ctx
+
+    val () = printf `"\nvariables\n\n" %
+    val () = printVars ctx
   in
     ctx
   end
-- 
cgit v1.2.3