Removal of unused labels, basic live intervals

5 files changed, 733 insertions, 437 deletions

diff --git a/dynarray.sig b/dynarray.sig
index 7b148c1..a588c0e 100644
--- a/dynarray.sig
+++ b/dynarray.sig
@@ -10,8 +10,13 @@ signature DYNARRAY = sig
   val pushAndGetId: 'a t -> 'a -> int
   val get: 'a t -> int -> 'a
   val set: 'a t -> int -> 'a -> unit
+  val update: 'a t -> ('a -> 'a) -> int -> unit
+  val copy: 'a t -> ('a -> 'b) -> 'b t
 
   val reset: 'a t -> unit
   val toVec: 'a t -> 'a vector
   val appi: (int * 'a -> unit) -> 'a t -> unit
+
+  val pop: 'a t -> 'a
+  val last: 'a t -> 'a
 end
diff --git a/dynarray.sml b/dynarray.sml
index d52f148..4e64461 100644
--- a/dynarray.sml
+++ b/dynarray.sml
@@ -89,9 +89,49 @@ structure Dynarray: DYNARRAY = struct
     fun loop idx =
       if idx = len then
         ()
-      else
-        f (idx, valOf $ Array.sub (arr, idx))
+      else (
+        f (idx, valOf $ Array.sub (arr, idx));
+        loop (idx + 1)
+      )
   in
     loop 0
   end
+
+  fun last dynarr =
+  let
+    val len = length dynarr
+  in
+    get dynarr (len - 1)
+  end
+
+  fun pop dynarr =
+  let
+    val v = last dynarr
+    val (len, arr) = !dynarr
+  in
+    dynarr := (len - 1, arr);
+    v
+  end
+
+  fun update dynarr f id =
+  let
+    val v = get dynarr id
+    val v = f v
+  in
+    set dynarr id v
+  end
+
+  fun copy (dynarr: 'a t) (f: 'a -> 'b): 'b t =
+  let
+    val dynarr2 = create (length dynarr)
+
+    fun loop idx =
+      if idx = length dynarr then
+        ()
+      else
+        (push dynarr2 (f $ get dynarr idx); loop (idx + 1))
+  in
+    loop 0;
+    dynarr2
+  end
 end
diff --git a/emit.fun b/emit.fun
index 05e84f0..6e21556 100644
--- a/emit.fun
+++ b/emit.fun
@@ -120,10 +120,122 @@ functor Emit(I: IL) = struct
     D.appi f P.iniLayouts
   end
 
+  fun getVarsForAlloc vregs =
+  let
+    fun loop idx acc =
+      if idx = D.length vregs then
+        rev acc
+      else
+        let
+          val { t, ... } = D.get vregs idx
+        in
+          if t = I.RtReg then
+            loop (idx + 1) (idx :: acc)
+          else
+            loop (idx + 1) acc
+        end
+  in
+    loop 0 []
+  end
+
+  fun extendEnd (iStart, iEnd) ops labels =
+  let
+    fun loop idx iEnd =
+      if idx = D.length ops then
+        iEnd
+      else
+        let
+          val ins = D.get ops idx
+        in
+          case ins of
+            SOME (I.IrJmp lid) | SOME (I.IrJz (_, lid)) |
+            SOME (I.IrJnz (_, lid)) =>
+            let
+              val ldest = valOf $ D.get labels lid
+
+              val iEnd =
+                if ldest > iStart andalso ldest < iEnd then
+                  idx
+                else
+                  iEnd
+            in
+              loop (idx + 1) iEnd
+            end
+          | _ => loop (idx + 1) iEnd
+        end
+  in
+    loop iEnd iEnd
+  end
+
+  fun computeIntLocal (s, e) ops labels =
+  let
+    val e = extendEnd (s, e) ops labels
+  in
+    (s, e)
+  end
+
+  fun getBasicInt [] _ = raise Unreachable
+    | getBasicInt defs [] = (List.last defs, hd defs + 1)
+    | getBasicInt defs use =
+    let
+      val (firstDef, lastDef) = (List.last defs, hd defs)
+      val (firstUse, lastUse) = (List.last use, hd use)
+
+      val first = if firstDef < firstUse then firstDef else firstUse - 1
+      val last = if lastDef < lastUse then lastUse else lastDef + 1
+    in
+      (first, last)
+    end
+
+  fun computeInt (I.Fi { vregs, ops, localBound, labels, ... }) var =
+  let
+    val { defs, use, ... } = D.get vregs var
+    val (iStart, iEnd) = getBasicInt defs use
+
+    val (iStart, iEnd) =
+      if var < localBound then
+        computeIntLocal (iStart, iEnd) ops labels
+      else
+        (iStart, iEnd)
+  in
+    (var, iStart, iEnd)
+  end
+
+  fun computeInts (F as I.Fi { vregs, ... }) vars =
+    List.map (computeInt F) vars
+
+  fun printInts ints =
+  let
+    val () = printfn `"\nintervals:\n" %
+    fun p (id, s, e) = printfn `"id: %" I id `" {" I s `", " I e `"}" %
+  in
+    List.app p ints
+  end
+
+
+  fun regAlloc (F as I.Fi { vregs, labels, ... }) =
+  let
+    val varsForAlloc = getVarsForAlloc vregs
+    val () = printfn `"for alloc: " Plist i varsForAlloc (", ", true, 0) %
+
+    val intervals = computeInts F varsForAlloc
+
+    val () = printInts intervals
+  in
+    raise Unimplemented
+  end
+
+  fun emitFunc (F as I.Fi { vregs, ... }) =
+  let
+    val () = regAlloc F vregs
+  in
+    raise Unimplemented
+  end
+
   fun openFile fname = file := SOME (TextIO.openOut fname)
 
   fun emit fname
-    (I.Ctx { globSyms, extSyms, objsZI, objs, strlits, ... }) =
+    (I.Ctx { globSyms, extSyms, objsZI, objs, strlits, funcInfos, ... }) =
   let
     val () = openFile fname
 
@@ -134,6 +246,8 @@ functor Emit(I: IL) = struct
     val () = handleData objs
     val () = handleStrlits strlits
     val () = handleLocalIniLayouts ()
+
+    val () = List.app emitFunc funcInfos
   in
     ()
   end
diff --git a/il.fun b/il.fun
index 069f476..13855ba 100644
--- a/il.fun
+++ b/il.fun
@@ -4,15 +4,6 @@ functor IL(P: PARSER) = struct
   structure PP = P.P
   structure D = P.D
 
-  datatype ctx = Ctx of {
-    objs: P.objDef list,
-    objsZI: P.objDef list,
-    extSyms: P.nid list,
-    globSyms: P.nid list,
-    funcs: P.funcInfo list,
-    strlits: int list
-  }
-
   datatype vregClass = VR4 | VR8
 
   type vreg = int
@@ -72,7 +63,8 @@ functor IL(P: PARSER) = struct
   datatype ev = Reg of vreg | Addr of vreg
 
   datatype regType =
-    RtUnk |
+    RtReg |
+    RtRem |
     RtConst of word |
     RtAddrConst of int * word
 
@@ -85,38 +77,40 @@ functor IL(P: PARSER) = struct
 
   datatype localCtx = Lctx of {
     localVars: { onStack: bool, t: P.ctype } vector,
+    paramNum: int,
+
     vregs: regInfo D.t,
-    newLabelNum: int,
-    ops: irIns list,
-    opTable: (irIns option) array option,
-    curPos: int, (* length ops + 1 *)
-    loopLabels: { break: label, continue: label } list,
-    paramNum: int
+    ops: (irIns option) D.t,
+
+    loopLabels: { break: label, continue: label } D.t,
+    labels: (int option * int) D.t
   }
 
-  (*
-  fun updateCtx (Ctx ctx) = fn z =>
-  let
-    fun from objs objsZI extSyms globSyms funcs strlits =
-      { objs, objsZI, extSyms, globSyms, funcs, strlits }
-    fun to f { objs, objsZI, extSyms, globSyms, funcs, strlits } =
-      f objs objsZI extSyms globSyms funcs strlits
-  in
-    FRU.makeUpdate6 (from, from, to) ctx (fn (a, f) => z (a, Ctx o f))
-  end
-  *)
+  datatype funcInfo = Fi of {
+    name: int,
+    localBound: int,
+    vregs: regInfo D.t,
+    ops: (irIns option) D.t,
+    labels: int option D.t
+  }
+
+  datatype ctx = Ctx of {
+    objs: P.objDef list,
+    objsZI: P.objDef list,
+    extSyms: P.nid list,
+    globSyms: P.nid list,
+    funcInfos: funcInfo list,
+    strlits: int list
+  }
 
   fun updateLctx (Lctx ctx) = fn z =>
   let
-    fun from localVars vregs ops opTable curPos newLabelNum loopLabels
-      paramNum =
-      { localVars, vregs, ops, opTable, curPos, newLabelNum, loopLabels,
-      paramNum }
-    fun to f { localVars, vregs, ops, opTable, curPos, newLabelNum,
-      loopLabels, paramNum } =
-      f localVars vregs ops opTable curPos newLabelNum loopLabels paramNum
+    fun from localVars paramNum vregs ops loopLabels labels =
+      { localVars, paramNum, vregs, ops, loopLabels, labels }
+    fun to f { localVars, paramNum, vregs, ops, loopLabels, labels } =
+      f localVars paramNum vregs ops loopLabels labels
   in
-    FRU.makeUpdate8 (from, from, to) ctx (fn (a, f) => z (a, Lctx o f))
+    FRU.makeUpdate6 (from, from, to) ctx (fn (a, f) => z (a, Lctx o f))
   end
 
   fun isLocal (Lctx { localVars, ... }) id = id < Vector.length localVars
@@ -178,16 +172,16 @@ functor IL(P: PARSER) = struct
           let
             val { t, onStack, ... } = Vector.sub (localVars, idx)
             val class = if onStack then VR8 else getClassForType t
-            val defs = if idx < paramNum then [0] else []
+            val defs = if idx < paramNum then [~1] else []
           in
-            D.push vregs ({ class, defs, use = [], t = RtUnk });
+            D.push vregs ({ class, defs, use = [], t = RtReg });
             loop (idx + 1)
           end
         else
           let
             val { class, ... } = D.get vregs (idx - lvlen)
           in
-            D.push vregs ({ class, defs = [], use = [], t = RtUnk });
+            D.push vregs ({ class, defs = [], use = [], t = RtReg });
             loop (idx + 1)
           end
     val () = loop 0
@@ -266,53 +260,63 @@ functor IL(P: PARSER) = struct
     List.app updateUse use
   end
 
-  fun ctxPutOp (C as Lctx { curPos, ... }) op' =
+  fun ctxPutOp (C as Lctx { ops, labels, ... }) op' =
   let
     val { defs, use } = getInsInfo op'
-    val insPos = curPos + 1
+    val insPos = D.length ops
     val () = updateDefsUse C defs use insPos
+    val () = D.push ops (SOME op')
+
+    fun setPos (NONE, use) = (SOME insPos, use)
+      | setPos (SOME _, _) = raise Unreachable
+
+    fun inc (v, use) = (v, use + 1)
   in
-    updateLctx C u#ops (fn l => op' ::  l) u#curPos (fn pos => pos + 1) %
+    case op' of
+      IrNopLabel lid => D.update labels setPos lid
+    | IrJmp lid | IrJnz (_, lid) | IrJz (_, lid) => D.update labels inc lid
+    | _ => ()
   end
 
   fun copyArgs (C as Lctx { localVars, paramNum, ... }) =
   let
     val lvlen = Vector.length localVars
 
-    fun loop ctx idx =
+    fun loop idx =
       if idx = paramNum then
-        ctx
+        ()
       else
-        loop (ctxPutOp ctx (IrSet (idx + lvlen, SaVReg idx))) (idx + 1)
-    val ctx = loop C 0
+        let
+          val () = ctxPutOp C (IrSet (idx + lvlen, SaVReg idx))
+        in
+          loop (idx + 1)
+        end
   in
-    ctx
+    loop 0
   end
 
+  fun getLabel (Lctx { labels, ... }) = D.pushAndGetId labels (NONE, 0)
+
   fun createLocalCtx localVars paramNum =
   let
     val localVars = setupLocalVars localVars
     val vregs = setupVregs localVars paramNum
-    val ctx = Lctx { localVars, vregs, ops = [], opTable = NONE, curPos = 0,
-        newLabelNum = 0, loopLabels = [], paramNum }
+    val labels = D.create0 ()
+
+    val ctx = Lctx {
+      localVars, paramNum,
+      vregs, ops = D.create0 (),
+      loopLabels = D.create0 (), labels
+    }
+    val _ = getLabel ctx (* label before ret *)
+    val () = copyArgs ctx
   in
-    copyArgs ctx
+    ctx
   end
 
-    (*
-  type funcInfo = {
-    name: int,
-    pos: P.tkPos,
-    t: ctype,
-    paramNum: int,
-    localVars: { name: nid, pos: P.tkPos, onStack: bool, t: ctype } vector,
-    stmt: stmt
-  }
-  *)
-
   fun getNewVReg class (Lctx { vregs, ... }) =
   let
-    val id = D.pushAndGetId vregs ({ class, defs = [], use = [], t = RtUnk })
+    val id = D.pushAndGetId vregs ({ class, defs = [], use = [], t = RtReg })
   in
     id
   end
@@ -323,8 +327,9 @@ functor IL(P: PARSER) = struct
   fun newConst ctx class w =
   let
     val v = getNewVReg class ctx
+    val () = ctxPutOp ctx (IrSet (v, SaConst w))
   in
-    (v, ctxPutOp ctx (IrSet (v, SaConst w)))
+    v
   end
 
   fun getClass (Lctx { vregs, ... }) id = #class $ D.get vregs id
@@ -341,46 +346,44 @@ functor IL(P: PARSER) = struct
       | LESS => VR4
 
     val v = getNewVReg class ctx
+    val () = ctxPutOp ctx (IrSet (v, SaConst w))
   in
-    (Reg v, ctxPutOp ctx (IrSet (v, SaConst w)))
+    Reg v
   end
 
   fun convGLconst ctx (id, isFunc) =
   let
     val v = getNew8 ctx
-    val ctx = ctxPutOp ctx (IrSet (v, SaAddr (id, 0w0)))
   in
-    if isFunc then
-      (Reg v, ctx)
-    else
-      (Addr v, ctx)
+    ctxPutOp ctx (IrSet (v, SaAddr (id, 0w0)));
+    if isFunc then Reg v else Addr v
   end
 
   fun convId ctx (P.Gid p) = convGLconst ctx p
-    | convId (C as Lctx { localVars, paramNum, ... }) (P.Lid id) =
+    | convId (Lctx { localVars, paramNum, ... }) (P.Lid id) =
       if id < paramNum then (* function parameter *)
-        (Reg $ id + Vector.length (localVars), C)
+        (Reg (id + Vector.length localVars))
       else
         let
           val onStack = #onStack $ Vector.sub (localVars, id)
         in
-          ((if onStack then Addr else Reg) id, C)
+          (if onStack then Addr else Reg) id
         end
 
   fun getOffset ea field = #1 $ valOf $ P.getFieldInfo (P.getT ea) field
 
   fun computeFieldFromVReg ctx v offset =
   let
-    val (vOff, ctx) = newConst ctx VR8 offset
+    val vOff = newConst ctx VR8 offset
     val vRes = getNew8 ctx
-    val ctx = ctxPutOp ctx (IrAdd (vRes, v, vOff))
+    val () = ctxPutOp ctx (IrAdd (vRes, v, vOff))
   in
-    (Addr vRes, ctx)
+    Addr vRes
   end
 
-  fun convFieldAccessByV ctx ea field =
+  fun convFieldAccessByV ctx ea field: ev =
   let
-    val (v, ctx) = convExpr ctx ea
+    val v: ev = convExpr ctx ea
     val offset = getOffset ea field
   in
     case v of
@@ -390,27 +393,27 @@ functor IL(P: PARSER) = struct
 
   and convFieldAccesByP ctx ea field =
   let
-    val (v, ctx) = convExpr ctx ea
+    val v = convExpr ctx ea
 
     val offset = getOffset ea field
   in
     case v of
       Reg v => computeFieldFromVReg ctx v offset
     | Addr v =>
-        let
-          val vl = getNew8 ctx
-          val ctx = ctxPutOp ctx (IrLoad (vl, v, AC8))
-        in
-          computeFieldFromVReg ctx vl offset
-        end
+      let
+        val vl = getNew8 ctx
+        val () = ctxPutOp ctx (IrLoad (vl, v, AC8))
+      in
+        computeFieldFromVReg ctx vl offset
+      end
   end
 
-  and convSizeOfType ctx t: ev * localCtx =
+  and convSizeOfType ctx t: ev =
   let
     val w = P.sizeOfType t
-    val (v, ctx) = newConst ctx VR8 w
+    val v = newConst ctx VR8 w
   in
-    (Reg v, ctx)
+    Reg v
   end
 
   and getSingleOffset t =
@@ -424,23 +427,22 @@ functor IL(P: PARSER) = struct
       Reg v =>
       let
         val class = getClass ctx v
-        val (v1, ctx) = newConst ctx class (getSingleOffset t)
-
-        val ctx = ctxPutOp ctx (op' (v, v, v1))
+        val v1 = newConst ctx class (getSingleOffset t)
       in
-        (Reg v, ctx)
+        ctxPutOp ctx (op' (v, v, v1));
+        Reg v
       end
     | Addr v =>
       let
         val class = getClassForType t
         val aClass = typeAccessClass t
         val vl = getNewVReg class ctx
-        val ctx = ctxPutOp ctx (IrLoad (vl, v, aClass))
-        val (v1, ctx) = newConst ctx class (getSingleOffset t)
-        val ctx = ctxPutOp ctx (op' (vl, vl, v1))
-        val ctx = ctxPutOp ctx (IrStore (v, vl, aClass))
+        val v1 = newConst ctx class (getSingleOffset t)
       in
-        (Reg vl, ctx)
+        ctxPutOp ctx (IrLoad (vl, v, aClass));
+        ctxPutOp ctx (op' (vl, vl, v1));
+        ctxPutOp ctx (IrStore (v, vl, aClass));
+        Reg vl
       end
 
   and convPost op' ctx (v, t) =
@@ -449,62 +451,62 @@ functor IL(P: PARSER) = struct
         let
           val class = getClass ctx v
           val vOld = getNewVReg class ctx
-          val ctx = ctxPutOp ctx (IrSet (vOld, SaVReg v))
-          val (v1, ctx) = newConst ctx class (getSingleOffset t)
-          val ctx = ctxPutOp ctx (op' (v, v, v1))
+          val v1 = newConst ctx class (getSingleOffset t)
         in
-          (Reg vOld, ctx)
+          ctxPutOp ctx (IrSet (vOld, SaVReg v));
+          ctxPutOp ctx (op' (v, v, v1));
+          Reg vOld
         end
     | Addr v =>
       let
         val class = getClassForType t
         val aClass = typeAccessClass t
         val vl = getNewVReg class ctx
-        val ctx = ctxPutOp ctx (IrLoad (vl, v, aClass))
         val vOld = getNewVReg class ctx
-        val ctx = ctxPutOp ctx (IrSet (vOld, SaVReg vl))
-        val (v1, ctx) = newConst ctx class (getSingleOffset t)
-        val ctx = ctxPutOp ctx (op' (vl, vl, v1))
-        val ctx = ctxPutOp ctx (IrStore (v, vl, aClass))
+        val v1 = newConst ctx class (getSingleOffset t)
       in
-        (Reg vOld, ctx)
+        ctxPutOp ctx (IrLoad (vl, v, aClass));
+        ctxPutOp ctx (IrSet (vOld, SaVReg vl));
+        ctxPutOp ctx (op' (vl, vl, v1));
+        ctxPutOp ctx (IrStore (v, vl, aClass));
+        Reg vOld
       end
 
-  and convAddr ctx v =
+  and convAddr v =
     case v of
       Reg _ => raise Unreachable
-    | Addr v => (Reg v, ctx)
+    | Addr v => Reg v
 
   and convDeref ctx v =
     case v of
-      Reg v => (Addr v, ctx)
+      Reg v => Addr v
     | Addr v =>
       let
         val vD = getNew8 ctx
-        val ctx = ctxPutOp ctx (IrLoad (vD, v, AC8))
+        val () = ctxPutOp ctx (IrLoad (vD, v, AC8))
       in
-        (Addr vD, ctx)
+        Addr vD
       end
 
-  and convPos ctx v = (v, ctx)
+  and convPos v = v
 
   and prepIsZero ctx vDest vSrc =
   let
-    val (vc, ctx) = newConst ctx (getClass ctx vSrc) 0w0
+    val vc = newConst ctx (getClass ctx vSrc) 0w0
   in
     ctxPutOp ctx (IrEq (vDest, vSrc, vc))
   end
 
   and prepNeg ctx vDest vSrc =
   let
-    val (vc, ctx) = newConst ctx (getClass ctx vSrc) 0w0
+    val vc = newConst ctx (getClass ctx vSrc) 0w0
   in
     ctxPutOp ctx (IrSub (vDest, vc, vSrc))
   end
 
   and prepComp ctx vDest vSrc =
   let
-    val (vc, ctx) = newConst ctx (getClass ctx vSrc) (Word.~ 0w1)
+    val vc = newConst ctx (getClass ctx vSrc) (Word.~ 0w1)
   in
     ctxPutOp ctx (IrXor (vDest, vSrc, vc))
   end
@@ -514,36 +516,36 @@ functor IL(P: PARSER) = struct
       Reg v =>
       let
         val vNew = getNewVReg (getClass ctx v) ctx
-        val ctx = fop ctx vNew v
       in
-        (Reg vNew, ctx)
+        fop ctx vNew v;
+        Reg vNew
       end
     | Addr v =>
       let
         val aClass = typeAccessClass t
         val class = getClassForType t
         val vl = getNewVReg class ctx
-        val ctx = ctxPutOp ctx (IrLoad (vl, v, aClass))
-        val ctx = fop ctx vl vl
-        val ctx = ctxPutOp ctx (IrStore (v, vl, aClass))
       in
-        (Reg vl, ctx)
+        ctxPutOp ctx (IrLoad (vl, v, aClass));
+        fop ctx vl vl;
+        ctxPutOp ctx (IrStore (v, vl, aClass));
+        Reg vl
       end
 
-  and convCast ctx (v, _, P.void_t) = (v, ctx)
+  and convCast _ (v, _, P.void_t) = v
     | convCast ctx (v, fromT, toT) =
     case Word.compare (P.sizeOfType toT, P.sizeOfType fromT) of
-      EQUAL => (v, ctx)
+      EQUAL => v
     | LESS => (
         case v of
           Reg v =>
             let
               val vNew = getNew4 ctx
-              val ctx = ctxPutOp ctx (IrSet (vNew, SaVReg v))
             in
-              (Reg vNew, ctx)
+              ctxPutOp ctx (IrSet (vNew, SaVReg v));
+              Reg vNew
             end
-        | Addr v => (Addr v, ctx)
+        | Addr v => Addr v
     )
     | GREATER =>
       let
@@ -551,25 +553,25 @@ functor IL(P: PARSER) = struct
         val aClass = typeAccessClass fromT
         val toTClass = getClassForType toT
 
-        val (v, ctx) =
+        val v =
             case v of
               Addr v =>
               let
                 val vl = getNew4 ctx
-                val ctx = ctxPutOp ctx (IrLoad (vl, v, aClass))
               in
-                (vl, ctx)
+                ctxPutOp ctx (IrLoad (vl, v, aClass));
+                vl
               end
-            | Reg v => (v, ctx)
-       val vNew = getNewVReg toTClass ctx
-       val ctx = ctxPutOp ctx (op' (vNew, v, aClass))
+            | Reg v => v
+        val vNew = getNewVReg toTClass ctx
       in
-        (Reg vNew, ctx)
+        ctxPutOp ctx (op' (vNew, v, aClass));
+        Reg vNew
       end
 
-  and convUnop ctx unop ea t =
+  and convUnop ctx unop ea t: ev =
   let
-    val (v, ctx) = convExpr ctx ea
+    val v: ev = convExpr ctx ea
     val subT = P.getT ea
   in
     case unop of
@@ -578,9 +580,9 @@ functor IL(P: PARSER) = struct
     | P.UnopPostInc => convPost IrAdd ctx (v, subT)
     | P.UnopPostDec => convPost IrSub ctx (v, subT)
     | P.UnopSizeof => convSizeOfType ctx subT
-    | P.UnopAddr => convAddr ctx v
+    | P.UnopAddr => convAddr v
     | P.UnopDeref => convDeref ctx v
-    | P.UnopPos => convPos ctx v
+    | P.UnopPos => convPos v
     | P.UnopNeg => convSimpleUnop prepNeg ctx (v, subT)
     | P.UnopComp => convSimpleUnop prepComp ctx (v, subT)
     | P.UnopLogNeg => convSimpleUnop prepIsZero ctx (v, subT)
@@ -589,130 +591,123 @@ functor IL(P: PARSER) = struct
 
   and loadIfNeeded ctx t vLeft =
     case vLeft of
-      Reg v => (v, ctx)
+      Reg v => v
     | Addr v =>
       let
         val aClass = typeAccessClass t
         val class = getClassForType t
         val vl = getNewVReg class ctx
-        val ctx = ctxPutOp ctx (IrLoad (vl, v, aClass))
       in
-        (vl, ctx)
+        ctxPutOp ctx (IrLoad (vl, v, aClass));
+        vl
       end
 
   and binopPrepOpers ctx t vLeft vRight =
   let
-    val (vLeft, ctx) = loadIfNeeded ctx t vLeft
-    val (vRight, ctx) = loadIfNeeded ctx t vRight
+    val vLeft = loadIfNeeded ctx t vLeft
+    val vRight = loadIfNeeded ctx t vRight
     val vNew = getNewVReg (getClass ctx vLeft) ctx
   in
-    (vNew, vLeft, vRight, ctx)
+    (vNew, vLeft, vRight)
   end
 
   and convSimple op' ctx t vLeft vRight =
   let
-    val (vNew, vLeft, vRight, ctx) = binopPrepOpers ctx t vLeft vRight
-    val ctx = ctxPutOp ctx (op' (vNew, vLeft, vRight))
+    val (vNew, vLeft, vRight) = binopPrepOpers ctx t vLeft vRight
   in
-    (Reg vNew, ctx)
+    ctxPutOp ctx (op' (vNew, vLeft, vRight));
+    Reg vNew
   end
 
   and shiftPointer ctx op' (leftT, vLeft) (rightT, vRight) =
     let
-      val (v, ctx) =
+      val v =
         case convCast ctx (Reg vRight, rightT, P.ulong_t) of
-          (Reg v, ctx) => (v, ctx)
-        | (Addr _, _) => raise Unreachable
-      val (multiplier, ctx) =
-        newConst ctx VR8 (P.sizeOfType (P.pointsTo leftT))
+          Reg v => v
+        | Addr _ => raise Unreachable
+      val multiplier = newConst ctx VR8 (P.sizeOfType (P.pointsTo leftT))
       val vm = getNew8 ctx
-      val ctx = ctxPutOp ctx (IrMul (vm, v, multiplier))
       val vRes = getNew8 ctx
-      val ctx = ctxPutOp ctx (op' (vRes, vLeft, vm))
     in
-      (Reg vRes, ctx)
+      ctxPutOp ctx (IrMul (vm, v, multiplier));
+      ctxPutOp ctx (op' (vRes, vLeft, vm));
+      Reg vRes
     end
 
   and convSum ctx (leftT, vLeft) (rightT, vRight) =
   let
-    val (vLeft, ctx) = loadIfNeeded ctx leftT vLeft
-    val (vRight, ctx) = loadIfNeeded ctx rightT vRight
+    val vLeft = loadIfNeeded ctx leftT vLeft
+    val vRight = loadIfNeeded ctx rightT vRight
   in
     if P.isPointer leftT then
       shiftPointer ctx IrAdd (leftT, vLeft) (rightT, vRight)
     else
       let
         val vNew = getNewVReg (getClass ctx vLeft) ctx
-        val ctx = ctxPutOp ctx (IrAdd (vNew, vLeft, vRight))
       in
-        (Reg vNew, ctx)
+        ctxPutOp ctx (IrAdd (vNew, vLeft, vRight));
+        Reg vNew
       end
   end
 
   and convSub ctx (leftT, vLeft) (rightT, vRight) =
   let
-    val (vLeft, ctx) = loadIfNeeded ctx leftT vLeft
-    val (vRight, ctx) = loadIfNeeded ctx rightT vRight
+    val vLeft = loadIfNeeded ctx leftT vLeft
+    val vRight = loadIfNeeded ctx rightT vRight
   in
     if P.isPointer leftT then
       if P.isPointer rightT then
         let
           val vDiff = getNew8 ctx
-          val ctx = ctxPutOp ctx (IrSub (vDiff, vLeft, vRight))
-          val (divider, ctx) =
-            newConst ctx VR8 (P.sizeOfType (P.pointsTo leftT))
           val vRes = getNew8 ctx
-          val ctx = ctxPutOp ctx (IrDiv (vRes, vDiff, divider))
+          val divider = newConst ctx VR8 (P.sizeOfType (P.pointsTo leftT))
         in
-          (Reg vRes, ctx)
+          ctxPutOp ctx (IrSub (vDiff, vLeft, vRight));
+          ctxPutOp ctx (IrDiv (vRes, vDiff, divider));
+          Reg vRes
         end
       else
         shiftPointer ctx IrSub (leftT, vLeft) (rightT, vRight)
     else
       let
         val vNew = getNewVReg (getClass ctx vLeft) ctx
-        val ctx = ctxPutOp ctx (IrSub (vNew, vLeft, vRight))
       in
-        (Reg vNew, ctx)
+        ctxPutOp ctx (IrSub (vNew, vLeft, vRight));
+        Reg vNew
       end
   end
 
   and convSimpleAssignment ctx leftT vLeft vRight =
   let
-    val (vRight, ctx) = loadIfNeeded ctx leftT vRight
+    val vRight = loadIfNeeded ctx leftT vRight
   in
     case vLeft of
-      Reg v =>
-        let
-          val ctx = ctxPutOp ctx (IrSet (v, SaVReg vRight))
-        in
-          (Reg v, ctx)
-        end
-    | Addr v =>
-        let
-          val ctx =
-            ctxPutOp ctx (IrStore (v, vRight, typeAccessClass leftT))
-        in
-          (Reg vRight, ctx)
-        end
+      Reg v => (
+          ctxPutOp ctx (IrSet (v, SaVReg vRight));
+          Reg v
+      )
+    | Addr v => (
+      ctxPutOp ctx (IrStore (v, vRight, typeAccessClass leftT));
+      Reg vRight
+    )
   end
 
   and convSubscript ctx (leftT, vLeft) (rightT, vRight) =
   let
-    val (vLeft, ctx) = loadIfNeeded ctx leftT vLeft
-    val (vRight, ctx) = loadIfNeeded ctx rightT vRight
+    val vLeft = loadIfNeeded ctx leftT vLeft
+    val vRight = loadIfNeeded ctx rightT vRight
 
-    val (res, ctx) =
+    val res =
       case shiftPointer ctx IrAdd (leftT, vLeft) (rightT, vRight) of
-        (Reg v, ctx) => (v, ctx)
-      | (Addr _, _) => raise Unreachable
+        Reg v => v
+      | Addr _ => raise Unreachable
   in
-    (Addr res, ctx)
+    Addr res
   end
 
   and convCompAssign (op', op2) ctx (leftT, vLeft) (rightT, vRight) =
   let
-    val (vRight, ctx) = loadIfNeeded ctx rightT vRight
+    val vRight = loadIfNeeded ctx rightT vRight
     val leftT = P.resolveType leftT
     val rightT = P.resolveType rightT
 
@@ -721,123 +716,117 @@ functor IL(P: PARSER) = struct
     fun convIfNeeded ctx t v =
       if t <> commonType then
         case convCast ctx (Reg v, t, commonType) of
-          (Reg v, ctx) => (v, ctx)
-        | (Addr _, _) => raise Unreachable
+          Reg v => v
+        | Addr _ => raise Unreachable
       else
-        (v, ctx)
+        v
 
     fun apply ctx leftV =
     let
-      val (vLeft, ctx) = convIfNeeded ctx leftT leftV
-      val (vRight, ctx) = convIfNeeded ctx rightT vRight
+      val vLeft = convIfNeeded ctx leftT leftV
+      val vRight = convIfNeeded ctx rightT vRight
 
       val op' = if P.isSigned commonType then op2 else op'
-      val (vRight, ctx) =
+      val vRight =
         if P.isPointer leftT then
           let
-            val (mul, ctx) =
-              newConst ctx VR8 (P.sizeOfType (P.pointsTo leftT))
+            val mul = newConst ctx VR8 (P.sizeOfType (P.pointsTo leftT))
             val vm = getNew8 ctx
-            val ctx = ctxPutOp ctx (IrMul (vm, vRight, mul))
           in
-            (vm, ctx)
+            ctxPutOp ctx (IrMul (vm, vRight, mul));
+            vm
           end
         else
-          (vRight, ctx)
-      val ctx = ctxPutOp ctx (op' (vLeft, vLeft, vRight))
+          vRight
     in
-      (vLeft, ctx)
+      ctxPutOp ctx (op' (vLeft, vLeft, vRight));
+      vLeft
     end
   in
     case vLeft of
       Reg v =>
       let
-        val (vLeft, ctx) = apply ctx v
-
-        val ctx =
-          if leftT <> commonType then
-            ctxPutOp ctx (IrSet (v, SaVReg vLeft))
-          else
-            ctx
+        val vLeft = apply ctx v
       in
-        (Reg v, ctx)
+        if leftT <> commonType then
+          ctxPutOp ctx (IrSet (v, SaVReg vLeft))
+        else
+          ();
+        Reg v
       end
     | Addr v =>
       let
         val class = getClassForType leftT
         val aClass = typeAccessClass leftT
         val vl = getNewVReg class ctx
-        val ctx = ctxPutOp ctx (IrLoad (vl, v, aClass))
+        val () = ctxPutOp ctx (IrLoad (vl, v, aClass))
 
-        val (vLeft, ctx) = apply ctx vl
-        val ctx = ctxPutOp ctx (IrStore (v, vLeft, aClass))
+        val vLeft = apply ctx vl
       in
-        (Reg vLeft, ctx)
+        ctxPutOp ctx (IrStore (v, vLeft, aClass));
+        Reg vLeft
       end
   end
 
-  and convComma ctx _ (_, vRight) = (vRight, ctx)
-
-  and getLabel (C as Lctx { newLabelNum, ... }) =
-    (newLabelNum, updateLctx C u#newLabelNum (fn l => l + 1) %)
+  and convComma _ _ (_, vRight) = vRight
 
   and getLabelPair ctx =
   let
-    val (l1, ctx) = getLabel ctx
-    val (l2, ctx) = getLabel ctx
+    val l1 = getLabel ctx
+    val l2 = getLabel ctx
   in
-    (l1, l2, ctx)
+    (l1, l2)
   end
 
   and genLogPart ctx ea =
   let
     val t = P.getT ea
-    val (v, ctx) = convExpr ctx ea
-    val (v, ctx) = loadIfNeeded ctx t v
-    val (v, ctx) =
+    val v = convExpr ctx ea
+    val v = loadIfNeeded ctx t v
+    val v =
       if P.typeRank t < P.typeRank P.int_t then
         case convCast ctx (Reg v, t, P.int_t) of
-          (Reg v, ctx) => (v, ctx)
-        | (Addr _, _) => raise Unreachable
+          Reg v => v
+        | Addr _ => raise Unreachable
       else
-        (v, ctx)
+        v
   in
-    (v, ctx)
+    v
   end
 
   and convLogOr ctx left right =
   let
-    val (vLeft, ctx) = genLogPart ctx left
+    val vLeft = genLogPart ctx left
 
-    val (elseLabel, endLabel, ctx) = getLabelPair ctx
-    val ctx = ctxPutOp ctx (IrJz (vLeft, elseLabel))
+    val (elseLabel, endLabel) = getLabelPair ctx
     val vRes = getNew4 ctx
-    val ctx = ctxPutOp ctx (IrSet (vRes, SaConst 0w1))
-    val ctx = ctxPutOp ctx (IrJmp endLabel)
-    val ctx = ctxPutOp ctx (IrNopLabel elseLabel)
+    val () = ctxPutOp ctx (IrJz (vLeft, elseLabel))
+    val () = ctxPutOp ctx (IrSet (vRes, SaConst 0w1))
+    val () = ctxPutOp ctx (IrJmp endLabel)
+    val () = ctxPutOp ctx (IrNopLabel elseLabel)
 
-    val (vRight, ctx) = genLogPart ctx right
-    val (vC, ctx) = newConst ctx (getClass ctx vRight) 0w0
-    val ctx = ctxPutOp ctx (IrNeq (vRes, vRight, vC))
+    val vRight = genLogPart ctx right
+    val vC = newConst ctx (getClass ctx vRight) 0w0
+    val () = ctxPutOp ctx (IrNeq (vRes, vRight, vC))
   in
-    (Reg vRes, ctx)
+    Reg vRes
   end
 
   and convLogAnd ctx left right =
   let
-    val (vLeft, ctx) = genLogPart ctx left
-    val (falseLabel, endLabel, ctx) = getLabelPair ctx
-    val ctx = ctxPutOp ctx (IrJz (vLeft, falseLabel))
-    val (vRight, ctx) = genLogPart ctx right
+    val vLeft = genLogPart ctx left
+    val (falseLabel, endLabel) = getLabelPair ctx
+    val () = ctxPutOp ctx (IrJz (vLeft, falseLabel))
+    val vRight = genLogPart ctx right
     val vRes = getNew4 ctx
-    val (vC, ctx) = newConst ctx (getClass ctx vRight) 0w0
-    val ctx = ctxPutOp ctx (IrNeq (vRes, vRight, vC))
-    val ctx = ctxPutOp ctx (IrJmp endLabel)
-    val ctx = ctxPutOp ctx (IrNopLabel (falseLabel))
-    val ctx = ctxPutOp ctx (IrSet (vRes, SaConst 0w0))
-    val ctx = ctxPutOp ctx (IrNopLabel endLabel)
+    val vC = newConst ctx (getClass ctx vRight) 0w0
   in
-    (Reg vRes, ctx)
+    ctxPutOp ctx (IrNeq (vRes, vRight, vC));
+    ctxPutOp ctx (IrJmp endLabel);
+    ctxPutOp ctx (IrNopLabel (falseLabel));
+    ctxPutOp ctx (IrSet (vRes, SaConst 0w0));
+    ctxPutOp ctx (IrNopLabel endLabel);
+    Reg vRes
   end
 
   and convBinop ctx binop left right =
@@ -849,8 +838,8 @@ functor IL(P: PARSER) = struct
 
     fun apply f =
     let
-      val (vLeft, ctx) = convExpr ctx left
-      val (vRight, ctx) = convExpr ctx right
+      val vLeft = convExpr ctx left
+      val vRight = convExpr ctx right
     in
       f ctx (leftT, vLeft) (rightT, vRight)
     end
@@ -905,71 +894,64 @@ functor IL(P: PARSER) = struct
   let
     val leftT = P.getT left
 
-    val (cond, ctx) = genLogPart ctx cond
-    val (elseLabel, endLabel, ctx) = getLabelPair ctx
-    val ctx = ctxPutOp ctx (IrJz (cond, elseLabel))
+    val cond = genLogPart ctx cond
+    val (elseLabel, endLabel) = getLabelPair ctx
+    val () = ctxPutOp ctx (IrJz (cond, elseLabel))
     val vRes = getNewVReg (getClassForType leftT) ctx
-    val (vLeft, ctx) = convExpr ctx left
-    val (vLeft, ctx) = loadIfNeeded ctx leftT vLeft
-    val ctx = ctxPutOp ctx (IrSet (vRes, SaVReg vLeft))
-    val ctx = ctxPutOp ctx (IrJmp endLabel)
-    val ctx = ctxPutOp ctx (IrNopLabel elseLabel)
-    val (vRight, ctx) = convExpr ctx right
-    val (vRight, ctx) = loadIfNeeded ctx leftT vRight
-    val ctx = ctxPutOp ctx (IrSet (vRes, SaVReg vRight))
-    val ctx = ctxPutOp ctx (IrNopLabel endLabel)
+    val vLeft = convExpr ctx left
+    val vLeft = loadIfNeeded ctx leftT vLeft
+    val () = ctxPutOp ctx (IrSet (vRes, SaVReg vLeft))
+    val () = ctxPutOp ctx (IrJmp endLabel)
+    val () = ctxPutOp ctx (IrNopLabel elseLabel)
+    val vRight = convExpr ctx right
+    val vRight = loadIfNeeded ctx leftT vRight
+    val () = ctxPutOp ctx (IrSet (vRes, SaVReg vRight))
+    val () = ctxPutOp ctx (IrNopLabel endLabel)
   in
-    (Reg vRes, ctx)
+    Reg vRes
   end
 
   and convFuncCall ctx func args =
   let
     val t = P.getT func
-    val (vFunc, ctx) = convExpr ctx func
-    val (vFunc, ctx) = loadIfNeeded ctx t vFunc
-    val (vFunc, ctx) =
+    val vFunc = convExpr ctx func
+    val vFunc = loadIfNeeded ctx t vFunc
+    val vFunc =
       case (getClass ctx vFunc) of
         VR4 =>
         let
           val v = getNew8 ctx
         in
-          (v, ctxPutOp ctx (IrSet (v, SaVReg vFunc)))
+          ctxPutOp ctx (IrSet (v, SaVReg vFunc));
+          v
         end
-      | VR8 => (vFunc, ctx)
+      | VR8 => vFunc
 
-    fun genArgs ctx [] acc =
+    fun genArgs [] acc =
       let
-        fun loop ctx _ [] acc2 = (rev acc2, ctx)
-          | loop ctx idx (vArg :: acc) acc2 =
+
+        fun loop _ [] acc2 = rev acc2
+          | loop idx (vArg :: acc) acc2 =
           let
             val arg = getNewVReg (getClass ctx vArg) ctx
-            val ctx = ctxPutOp ctx (IrSet (arg, SaVReg vArg))
           in
-            loop ctx (idx + 1) acc (arg :: acc2)
+            ctxPutOp ctx (IrSet (arg, SaVReg vArg));
+            loop (idx + 1) acc (arg :: acc2)
           end
+
+        val () = ctxPutOp ctx (IrNop "here")
       in
-        loop ctx 0 acc []
+        loop 0 acc []
       end
-      | genArgs ctx (arg :: args) acc =
+      | genArgs (arg :: args) acc =
       let
-        val (vArg, ctx) = convExpr ctx arg
-        val (vArg, ctx) = loadIfNeeded ctx (P.getT arg) vArg
-        val (vArg, ctx) =
-          if isLocal ctx vArg then
-            let
-              val vA = getNewVReg (getClassForType t) ctx
-              val ctx = ctxPutOp ctx (IrSet (vA, SaVReg vArg))
-            in
-              (vA, ctx)
-            end
-          else
-            (vArg, ctx)
-
+        val vArg = convExpr ctx arg
+        val vArg = loadIfNeeded ctx (P.getT arg) vArg
       in
-        genArgs ctx args (vArg :: acc)
+        genArgs args (vArg :: acc)
       end
 
-    val (args, ctx) = genArgs ctx args []
+    val args = genArgs args []
 
     val rt = #1 $ P.funcParts (P.pointsTo t)
     val vRes =
@@ -983,10 +965,11 @@ functor IL(P: PARSER) = struct
             vRes
           end
   in
-    (Reg vRes, ctxPutOp ctx (IrFcall (vRes, vFunc, args)))
+    ctxPutOp ctx (IrFcall (vRes, vFunc, args));
+    Reg vRes
   end
 
-  and convExpr ctx ea: ev * localCtx =
+  and convExpr ctx ea: ev =
   let
     val P.EA (e, _, _, t) = ea
   in
@@ -1013,13 +996,13 @@ functor IL(P: PARSER) = struct
     | convIni (C as Lctx { localVars, ... }) (id, SOME (P.CiniExpr ea)) =
     let
       val t = P.getT ea
-      val (v, ctx) = convExpr C ea
-      val (v, ctx) = loadIfNeeded ctx t v
+      val v = convExpr C ea
+      val v = loadIfNeeded C t v
     in
       if #onStack $ Vector.sub (localVars, id) then
-        ctxPutOp ctx (IrLoad (id, v, typeAccessClass t))
+        ctxPutOp C (IrLoad (id, v, typeAccessClass t))
       else
-        ctxPutOp ctx (IrSet (id, SaVReg v))
+        ctxPutOp C (IrSet (id, SaVReg v))
     end
     | convIni ctx (id, SOME (P.CiniLayout lid)) =
     let
@@ -1032,8 +1015,8 @@ functor IL(P: PARSER) = struct
     case ea of
       SOME ea =>
       let
-        val (v, ctx) = convExpr ctx ea
-        val (v, ctx) = loadIfNeeded ctx (P.getT ea) v
+        val v = convExpr ctx ea
+        val v = loadIfNeeded ctx (P.getT ea) v
       in
         ctxPutOp ctx (IrRet $ SOME v)
       end
@@ -1041,73 +1024,63 @@ functor IL(P: PARSER) = struct
 
   fun convIf ctx (cond, thenPart, elsePart) =
   let
-    val (v, ctx) = genLogPart ctx cond
-    val (elseL, endL, ctx) = getLabelPair ctx
-    val ctx = ctxPutOp ctx (IrJz (v, elseL))
-    val ctx = convStmt ctx thenPart
-
-    val ctx = if isSome elsePart then ctxPutOp ctx (IrJmp endL) else ctx
-    val ctx = ctxPutOp ctx (IrNopLabel elseL)
-
-    val ctx =
-      case elsePart of
-        SOME elsePart =>
-        let
-          val ctx = convStmt ctx elsePart
-          val ctx = ctxPutOp ctx (IrNopLabel endL)
-        in
-          ctx
-        end
-      | NONE => ctx
+    val v = genLogPart ctx cond
+    val (elseL, endL) = getLabelPair ctx
   in
-    ctx
+    ctxPutOp ctx (IrJz (v, elseL));
+    convStmt ctx thenPart;
+
+    if isSome elsePart then ctxPutOp ctx (IrJmp endL) else ();
+    ctxPutOp ctx (IrNopLabel elseL);
+    case elsePart of
+      SOME elsePart => (
+        convStmt ctx elsePart;
+        ctxPutOp ctx (IrNopLabel endL)
+      )
+    | NONE => ()
   end
 
-  and ctxGetLoopLabels ctx =
+  and ctxGetLoopLabels (C as Lctx { loopLabels, ... }) =
   let
-    val (l1, l2, ctx) = getLabelPair ctx
-    val ctx = updateLctx ctx u#loopLabels
-        (fn l => { break = l1, continue = l2 } :: l) %
+    val (l1, l2) = getLabelPair C
+
+    val () = D.push loopLabels { break = l1, continue = l2 }
   in
-    (l1, l2, ctx)
+    (l1, l2)
   end
 
-  and ctxLoopExit ctx = updateLctx ctx u#loopLabels tl %
+  and ctxLoopExit (Lctx { loopLabels, ... }) = ignore $ D.pop loopLabels
 
   and convWhile ctx (cond, body) =
   let
-    val (breakL, contL, ctx) = ctxGetLoopLabels ctx
-    val ctx = ctxPutOp ctx (IrNopLabel contL)
-    val (cond, ctx) = genLogPart ctx cond
-    val ctx = ctxPutOp ctx (IrJz (cond, breakL))
-    val ctx = convStmt ctx body
-    val ctx = ctxPutOp ctx (IrJmp contL)
-    val ctx = ctxPutOp ctx (IrNopLabel breakL)
-
-    val ctx = ctxLoopExit ctx
+    val (breakL, contL) = ctxGetLoopLabels ctx
+    val () = ctxPutOp ctx (IrNopLabel contL)
+    val cond = genLogPart ctx cond
   in
-    ctx
+    ctxPutOp ctx (IrJz (cond, breakL));
+    convStmt ctx body;
+    ctxPutOp ctx (IrJmp contL);
+    ctxPutOp ctx (IrNopLabel breakL);
+    ctxLoopExit ctx
   end
 
   and convDoWhile ctx (body, cond) =
   let
-    val (breakL, contL, ctx) = ctxGetLoopLabels ctx
-    val (startL, ctx) = getLabel ctx
-    val ctx = ctxPutOp ctx (IrNopLabel startL)
-    val ctx = convStmt ctx body
-    val ctx = ctxPutOp ctx (IrNopLabel contL)
-    val (cond, ctx) = genLogPart ctx cond
-    val ctx = ctxPutOp ctx (IrJnz (cond, startL))
-    val ctx = ctxPutOp ctx (IrNopLabel breakL)
-
-    val ctx = ctxLoopExit ctx
+    val (breakL, contL) = ctxGetLoopLabels ctx
+    val startL = getLabel ctx
+    val () = ctxPutOp ctx (IrNopLabel startL)
+    val () = convStmt ctx body
+    val () = ctxPutOp ctx (IrNopLabel contL)
+    val cond = genLogPart ctx cond
   in
-    ctx
+    ctxPutOp ctx (IrJnz (cond, startL));
+    ctxPutOp ctx (IrNopLabel breakL);
+    ctxLoopExit ctx
   end
 
   and convBreakOrCont isBreak (C as Lctx { loopLabels, ... }) =
   let
-    val { break, continue } = hd loopLabels
+    val { break, continue } = D.last loopLabels
     val label = if isBreak then break else continue
   in
     ctxPutOp C (IrJmp label)
@@ -1115,46 +1088,42 @@ functor IL(P: PARSER) = struct
 
   and convFor ctx (pre, cond, post, stmt) =
   let
-    val ctx =
+    val () =
       case pre of
-        NONE => ctx
-      | SOME ea => #2 $ convExpr ctx ea
-    val (startL, ctx) = getLabel ctx
-    val (breakL, contL, ctx) = ctxGetLoopLabels ctx
+        NONE => ()
+      | SOME ea => ignore $ convExpr ctx ea
+    val startL = getLabel ctx
+    val (breakL, contL) = ctxGetLoopLabels ctx
 
-    val ctx = ctxPutOp ctx (IrNopLabel startL)
-    val ctx =
+    val () = ctxPutOp ctx (IrNopLabel startL)
+    val () =
       case cond of
-        NONE => ctx
+        NONE => ()
       | SOME cond =>
         let
-          val (cond, ctx) = genLogPart ctx cond
+          val cond = genLogPart ctx cond
         in
           ctxPutOp ctx (IrJz (cond, breakL))
         end
-    val ctx = convStmt ctx stmt
-    val ctx = ctxPutOp ctx (IrNopLabel contL)
-    val ctx =
+    val () = convStmt ctx stmt
+    val () = ctxPutOp ctx (IrNopLabel contL)
+    val () =
       case post of
-        NONE => ctx
-      | SOME post => #2 $ convExpr ctx post
-    val ctx = ctxPutOp ctx (IrJmp startL)
-    val ctx = ctxPutOp ctx (IrNopLabel breakL)
+        NONE => ()
+      | SOME post => ignore $ convExpr ctx post
+    val () = ctxPutOp ctx (IrJmp startL)
+    val () = ctxPutOp ctx (IrNopLabel breakL)
   in
-    ctx
+    ()
   end
 
-  and convStmt ctx stmt =
+  and convStmt ctx stmt: unit =
     case stmt of
-      P.StmtExpr ea => #2 $ convExpr ctx ea
-    | P.StmtCompound (inis, stmts) =>
-        let
-          open List
-          val ctx = foldl (fn (ini, ctx) => convIni ctx ini) ctx inis
-          val ctx = foldl (fn (stmt, ctx) => convStmt ctx stmt) ctx stmts
-        in
-          ctx
-        end
+      P.StmtExpr ea => ignore $ convExpr ctx ea
+    | P.StmtCompound (inis, stmts) => (
+      List.app (fn ini => convIni ctx ini) inis;
+      List.app (fn stmt => convStmt ctx stmt) stmts
+    )
     | P.StmtIf t => convIf ctx t
     | P.StmtReturn ea => convReturn ctx ea
     | P.StmtFor quad => convFor ctx quad
@@ -1216,9 +1185,16 @@ functor IL(P: PARSER) = struct
   fun preg (C as Lctx { vregs, ... }) id out =
   let
     val rt = getRegType vregs id
+
+    val () =
+      if id = 10 then
+        printfn `"printing 10" %
+      else
+        ()
   in
     case rt of
-      RtUnk => Printf out `"%" I id %
+      RtReg => Printf out `"%" I id %
+    | RtRem => raise Unreachable
     | RtConst w => printConst (getClass C id) w
     | RtAddrConst (id, w) => (printf `"$" PP.? id %; printConst VR8 w)
   end
@@ -1268,6 +1244,13 @@ functor IL(P: PARSER) = struct
     in
       printf `"fcall " Preg ctx f `"" Plist (preg ctx) args (", ", true, 0) %
     end
+    fun printLabel (Lctx { labels, ... }) lid =
+    let
+      val (labelPos, use) = D.get labels lid
+      val () = if valOf labelPos <> idx then raise Unreachable else ()
+    in
+        printf `"@" Pl lid `"(" I use `"):" %
+    end
   in
     case op' of
       IrSet (reg, arg) => printOpSet ctx reg arg
@@ -1306,7 +1289,7 @@ functor IL(P: PARSER) = struct
     | IrJmp l => printf `"\tjmp " Pl l %
     | IrJz p => pj p "jz"
     | IrJnz p => pj p "jnz"
-    | IrNopLabel l => printf `"@" Pl l `":" %
+    | IrNopLabel l => printLabel ctx l
     | IrNop s => printf `"\t; " `s %
     | IrRet v => printRet v
     | IrAlloc p => printAlloc p
@@ -1317,16 +1300,26 @@ functor IL(P: PARSER) = struct
   end
    | printOp _ (_, NONE) = ()
 
-  fun printIns (C as Lctx { opTable, ... }) =
-    Array.appi (printOp C) (valOf opTable)
+  fun printIns (C as Lctx { ops, ... }) =
+    D.appi (printOp C) ops
 
-  fun printVar idx { class, defs, use, t = _ } =
-    if length defs = 0 andalso length use = 0 then
-      ()
-    else
-      printfn `"%" I idx `" " `(if class = VR4 then "w4" else "w8")
+  fun printVar idx { class, defs, use, t } =
+  let
+    val c = if class = VR4 then "w4" else "w8"
+
+    val () = printf `"%" I idx `" " `c
           `": defs = " Plist i defs (", ", true, 0)
           `", uses = " Plist i use (", ", true, 0) %
+  in
+    case t of
+     RtReg => printf `" regular" %
+   | RtRem => printf `" removed" %
+   | RtConst w => (printf `" const "; printConst class w)
+   | RtAddrConst (id, w) =>
+       (printf `" addr const " PP.? id; printConst class w)
+   ;
+   printf `"\n" %
+  end
 
   fun printVars (Lctx { vregs, ... }) =
   let
@@ -1341,19 +1334,11 @@ functor IL(P: PARSER) = struct
     loop 0
   end
 
-  fun createInsTable (C as Lctx { ops, ... }) =
-  let
-    val l = NONE :: map (fn v => SOME v) (rev ops)
-    val arr = Array.fromList l
-  in
-    updateLctx C s#opTable (SOME arr) %
-  end
-
-  fun constAdd vregs opTable vid v insId =
+  fun constAdd vregs ops vid v insId =
   let
     val () = printfn `"new constant: %" I vid %
 
-    val { class, ... } = D.get vregs vid
+    val { class, defs, use, ... } = D.get vregs vid
 
     val v =
       case v of
@@ -1364,17 +1349,15 @@ functor IL(P: PARSER) = struct
           RtConst w
         end
       | RtAddrConst (id, w) => RtAddrConst (id, w)
-      | RtUnk => raise Unreachable
-    val () = D.set vregs vid { class, defs = [], use = [], t = v }
+      | RtReg | RtRem => raise Unreachable
+    val () = D.set vregs vid { class, defs, use, t = v }
   in
-    Array.update (opTable, insId, NONE)
+    D.set ops insId NONE
   end
 
   fun getFirstConstants
-    (Lctx { vregs, opTable, localVars, paramNum, ... }) =
+    (Lctx { vregs, ops, localVars, paramNum, ... }) =
   let
-    val opTable = valOf opTable
-
     fun loop vid acc =
       if vid = D.length vregs then
         rev acc
@@ -1390,13 +1373,13 @@ functor IL(P: PARSER) = struct
               | SaAddr p => RtAddrConst p
               | _ => raise Unreachable
           in
-            constAdd vregs opTable vid v def
+            constAdd vregs ops vid v def
           end
         in
           case defs of
             [def] =>
             let
-              val ins = valOf $ Array.sub (opTable, def)
+              val ins = valOf $ D.get ops def
             in
               case ins of
                 IrSet(_, arg as SaConst _ | arg as SaAddr _) =>
@@ -1452,7 +1435,7 @@ functor IL(P: PARSER) = struct
   fun evalSimple supThird vregs ext triple op' =
     case evalPrep supThird vregs triple ext of
       SOME wp => RtConst (op' wp)
-    | NONE => RtUnk
+    | NONE => RtReg
 
   fun evalSet vregs (rd, SaVReg rs) =
   let
@@ -1466,7 +1449,7 @@ functor IL(P: PARSER) = struct
         if toSize = 0w8 then
           RtAddrConst p
         else
-          RtUnk
+          RtReg
     | _ => raise Unreachable
   end
     | evalSet _ _ = raise Unreachable
@@ -1475,6 +1458,8 @@ functor IL(P: PARSER) = struct
   let
     val rt = getRegType vregs rs
     val ext = if ext = ExtZero then P.extz else P.exts
+
+    val () = printfn `"eval EXT" %
   in
     case rt of
       RtConst w => RtConst $ ext w (ac2word aClass)
@@ -1482,7 +1467,7 @@ functor IL(P: PARSER) = struct
         if aClass = AC8 then
           RtAddrConst p
         else
-          RtUnk
+          RtReg
     | _ => raise Unreachable
   end
 
@@ -1502,7 +1487,8 @@ functor IL(P: PARSER) = struct
     case (rt1, rt2) of
       (RtConst w1, RtConst w2) => RtConst $ P.extz (op' (w1, w2)) size
     | (RtAddrConst (id, w1), RtConst w2) => RtAddrConst (id, op' (w1, w2))
-    | _ => RtUnk
+    | (RtRem, _) | (_, RtRem) => raise Unreachable
+    | _ => RtReg
   end
 
   fun eval' ins vregs =
@@ -1567,7 +1553,7 @@ functor IL(P: PARSER) = struct
     | IrExtSign p => evalExt vregs ExtSign p
 
     | IrAlloc _ | IrLoad _ | IrStore _ | IrRet _ | IrFcall _
-    | IrCopy _ | IrJz _ | IrJnz _  => RtUnk
+    | IrCopy _ | IrJz _ | IrJnz _  => RtReg
     | IrJmp _ | IrNop _ | IrNopLabel _ => raise Unreachable
   end
 
@@ -1584,9 +1570,10 @@ functor IL(P: PARSER) = struct
       in
         RtConst w
       end
+    | RtRem => raise Unreachable
     | _ => res
   end
-   | eval NONE _ = RtUnk
+   | eval NONE _ = RtReg
 
   fun defines (SOME ins) =
   let
@@ -1597,24 +1584,33 @@ functor IL(P: PARSER) = struct
     | defines NONE = raise Unreachable
 
   fun propagate [] _ _ = ()
-    | propagate (v :: vs) vregs opTable =
+    | propagate (v :: vs) vregs ops =
     let
-      open Array
       val { use, ... } = D.get vregs v
 
+      (*
+      val () = printfn `"Took from worklist: " I v  %
+      val () = printfn `"usage: " Plist i use (", ", true, 0) %
+      *)
+
       fun loop (insId :: tail) acc =
       let
-        val ins = sub (opTable, insId)
+        val ins = D.get ops insId
+
+        (*
+        val () = printfn `"v: " I v `", Ins: " I insId %
+        *)
       in
         case eval ins vregs of
-          RtUnk => loop tail acc
+          RtReg => loop tail acc
+        | RtRem => raise Unreachable
         | v =>
         let
           val vd = defines ins
           val { defs, ... } = D.get vregs vd
           val newConst =
             case defs of
-              [_] => (constAdd vregs opTable vd v insId; SOME vd)
+              [_] => (constAdd vregs ops vd v insId; SOME vd)
             | _ =>
               let
                 val vl =
@@ -1624,7 +1620,7 @@ functor IL(P: PARSER) = struct
                   | _ => raise Unreachable
                 val ins = IrSet (vd, vl)
               in
-                update (opTable, insId, SOME ins);
+                D.set ops insId (SOME ins);
                 NONE
               end
         in
@@ -1635,15 +1631,14 @@ functor IL(P: PARSER) = struct
 
       val newConst = loop use []
     in
-      propagate (List.revAppend (newConst, vs)) vregs opTable
+      propagate (List.revAppend (newConst, vs)) vregs ops
     end
 
-  fun constPropagate (C as Lctx { vregs, opTable, ... }) =
+  fun constPropagate (C as Lctx { vregs, ops, ... }) =
   let
-    val opTable = valOf opTable
     val worklist = getFirstConstants C
   in
-    propagate worklist vregs opTable
+    propagate worklist vregs ops
   end
 
   fun changeDest rd ins =
@@ -1686,16 +1681,16 @@ functor IL(P: PARSER) = struct
     | IrJnz _ | IrStore _ => raise Unreachable
   end
 
-  fun mergeIns (Lctx { vregs, opTable, ... }) idx rd rs =
+  fun mergeIns (Lctx { vregs, ops, ... }) idx rd rs =
   let
-    val opTable = valOf opTable
+    val () = printfn `"removing %" I rs %
 
-    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 { class, ... } = D.get vregs rs
+    val () = D.set vregs rs { defs = [], use = [], class, t = RtRem }
+    val ins = valOf $ D.get ops (idx - 1)
     val ir = changeDest rd ins
-    val () = Array.update (opTable, idx - 1, SOME ir)
-    val () = Array.update (opTable, idx, NONE)
+    val () = D.set ops (idx - 1) (SOME ir)
+    val () = D.set ops idx NONE
 
     val { defs, use, class, t } = D.get vregs rd
 
@@ -1707,7 +1702,7 @@ functor IL(P: PARSER) = struct
     ()
   end
 
-  fun optSet (C as Lctx { vregs, opTable, localVars, ... })
+  fun optSet (C as Lctx { vregs, localVars, paramNum, ... })
     (idx, SOME (IrSet (rd, SaVReg rs)))
   =
     if getCS vregs rd <> getCS vregs rs then
@@ -1718,7 +1713,8 @@ functor IL(P: PARSER) = struct
       in
         case (defs, use) of
           ([d], [_]) =>
-            if d = idx - 1 andalso rs >= Vector.length localVars then
+            if d = idx - 1 andalso rs >= Vector.length localVars + paramNum
+            then
               mergeIns C idx rd rs
             else
               ()
@@ -1726,51 +1722,111 @@ functor IL(P: PARSER) = struct
       end
     | optSet _ _ = ()
 
-  fun peephole (C as Lctx { opTable, ... }) =
+  fun peephole (C as Lctx { ops, ... }) =
   let
-    val () = Array.appi (optSet C) (valOf opTable)
+    val () = D.appi (optSet C) ops
   in
     ()
   end
 
-  fun translateFn (F as { localVars, stmt, paramNum, ... }) =
+  fun removeUnusedLabels (Lctx { ops, labels, ... }) =
+  let
+    fun f (insId, op') =
+      case op' of
+        SOME (IrNopLabel lid) =>
+        let
+          val (_, usage) = D.get labels lid
+        in
+          if usage = 0 then
+            (printfn `"removing label: " I lid %; D.set ops insId NONE)
+          else
+            ()
+        end
+      | _ => ()
+
+    fun loop idx =
+      if idx = D.length ops then
+        ()
+      else (
+        f (idx, D.get ops idx);
+        loop (idx + 1)
+      )
+  in
+    loop 0
+  end
+
+  fun removeUnusedVars (Lctx { vregs, ... }) =
+  let
+    fun loop idx =
+      if idx = D.length vregs then
+        ()
+      else
+        let
+          val { defs, use, t, class } = D.get vregs idx
+          val t =
+            if t = RtReg andalso defs = [] andalso use = [] then
+              RtRem
+            else
+              t
+        in
+          D.set vregs idx { defs, use, t, class };
+          loop (idx + 1)
+        end
+  in
+    loop 0
+  end
+
+  fun translateFn (F as { localVars, stmt, paramNum, name, ... }) =
   let
     val () = P.printDef (P.Definition F)
     val ctx = createLocalCtx localVars paramNum
-    val ctx = convStmt ctx stmt
+    val () = convStmt ctx stmt
+
+    val () = ctxPutOp ctx (IrNopLabel 0)
 
-    val ctx = createInsTable ctx
     val () = printVars ctx
     val () = printIns ctx
 
     val () = printf `"\nconstant propagation\n\n" %
     val () = constPropagate ctx
+    val () = printVars ctx
     val () = printIns ctx
 
-    val () = printf `"\npeephole il optimizations\n\n" %
+    val () = printf `"\nmisc il optimizations\n\n" %
+
+    val () = removeUnusedLabels ctx
+    val () = removeUnusedVars ctx
     val () = peephole ctx
+
+    val () = printVars ctx
     val () = printIns ctx
 
     val () = printf `"\nvariables\n\n" %
     val () = printVars ctx
+
+    val Lctx { vregs, ops, labels, ... } = ctx
   in
-    ctx
+    Fi { name, localBound = Vector.length localVars + paramNum,
+        vregs, ops, labels = D.copy labels (fn (v, _) => v) }
   end
 
   fun createCtx ({ ext, glob, objsZI, objs, funcs, strlits }) =
   let
-    val _ = List.map (fn func => translateFn func) funcs
+    val fis = List.map (fn func => translateFn func) funcs
   in
-    Ctx { objs, objsZI, extSyms = ext, globSyms = glob, funcs, strlits }
+    Ctx { objs, objsZI, extSyms = ext, globSyms = glob,
+      funcInfos = fis, strlits }
   end
 
+  (*
   fun updateCtx (Ctx ctx) = fn z =>
   let
-    fun from objs objsZI extSyms globSyms funcs strlits =
+    fun from objs objsZI extSyms globSyms funcInfos strlits =
       { objs, objsZI, extSyms, globSyms, funcs, strlits }
     fun to f { objs, objsZI, extSyms, globSyms, funcs, strlits } =
       f objs objsZI extSyms globSyms funcs strlits
   in
     FRU.makeUpdate6 (from, from, to) ctx (fn (a, f) => z (a, Ctx o f))
   end
+  *)
 end
diff --git a/il.sig b/il.sig
index 767c9b5..745f72f 100644
--- a/il.sig
+++ b/il.sig
@@ -1,13 +1,94 @@
 signature IL = sig
 
   structure P: PARSER
+  structure PP: PPC
+  structure D: DYNARRAY
+
+  datatype vregClass = VR4 | VR8
+
+  type vreg = int
+  type label = int
+
+  datatype setArg = SaVReg of vreg | SaConst of word |
+    SaAddr of P.nid * word
+
+  datatype accessClass = AC1 | AC2 | AC4 | AC8
+
+  datatype irIns =
+      IrSet of vreg * setArg
+    | IrAdd of vreg * vreg * vreg
+    | IrSub of vreg * vreg * vreg
+    | IrMul of vreg * vreg * vreg
+    | IrIMul of vreg * vreg * vreg
+    | IrDiv of vreg * vreg * vreg
+    | IrIDiv of vreg * vreg * vreg
+    | IrMod of vreg * vreg * vreg
+    | IrIMod of vreg * vreg * vreg
+    | IrShr of vreg * vreg * vreg
+    | IrShl of vreg * vreg * vreg
+    | IrSar of vreg * vreg * vreg
+    | IrAnd of vreg * vreg * vreg
+    | IrOr of vreg * vreg * vreg
+    | IrXor of vreg * vreg * vreg
+    | IrEq of vreg * vreg * vreg
+    | IrNeq of vreg * vreg * vreg
+
+    | IrCmpul of vreg * vreg * vreg
+    | IrCmpug of vreg * vreg * vreg
+    | IrCmpule of vreg * vreg * vreg
+    | IrCmpuge of vreg * vreg * vreg
+
+    | IrCmpsl of vreg * vreg * vreg
+    | IrCmpsg of vreg * vreg * vreg
+    | IrCmpsle of vreg * vreg * vreg
+    | IrCmpsge of vreg * vreg * vreg
+
+    | IrExtZero of vreg * vreg * accessClass
+    | IrExtSign of vreg * vreg * accessClass
+    | IrLoad of vreg * vreg * accessClass (* %1 <- [%2] *)
+    | IrStore of vreg * vreg * accessClass (* [%1] <- %2 *)
+
+    | IrJz of vreg * label
+    | IrJnz of vreg * label
+    | IrJmp of label
+
+    | IrRet of vreg option
+    | IrAlloc of vreg * word
+    | IrCopy of vreg * label * word
+    | IrFcall of vreg * vreg * vreg list
+
+    | IrNopLabel of label
+    | IrNop of string
+
+  datatype ev = Reg of vreg | Addr of vreg
+
+  datatype regType =
+    RtReg |
+    RtRem |
+    RtConst of word |
+    RtAddrConst of int * word
+
+  type regInfo = {
+    class: vregClass,
+    use: int list,
+    defs: int list,
+    t: regType
+  }
+
+  datatype funcInfo = Fi of {
+    name: int,
+    localBound: int,
+    vregs: regInfo D.t,
+    ops: (irIns option) D.t,
+    labels: int option D.t
+  }
 
   datatype ctx = Ctx of {
     objs: P.objDef list,
     objsZI: P.objDef list,
     extSyms: P.nid list,
     globSyms: P.nid list,
-    funcs: P.funcInfo list,
+    funcInfos: funcInfo list,
     strlits: int list
   }