Constant propagation

1 files changed, 62 insertions, 44 deletions

diff --git a/parser.fun b/parser.fun
index 40d254f..9e36f2c 100644
--- a/parser.fun
+++ b/parser.fun
@@ -263,6 +263,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
     tokenBuf: P.t * (token * P.tkPos) list list,
 
     loopLevel: int,
+    paramNum: int option,
 
     defs: def list,
     strlits: int list
@@ -275,18 +276,18 @@ functor Parser(structure Tree: TREE; structure P: PPC;
   fun updateCtx (Ctx ctx) = fn z =>
   let
     fun from aggrTypeNames localScopes funcRetType globalSyms
-      tokenBuf loopLevel defs strlits
+      tokenBuf loopLevel paramNum defs strlits
     =
       { aggrTypeNames, localScopes, funcRetType, globalSyms,
-        tokenBuf, loopLevel, defs, strlits }
+        tokenBuf, loopLevel, paramNum, defs, strlits }
 
     fun to f { aggrTypeNames, localScopes, funcRetType, globalSyms,
-        tokenBuf, loopLevel, defs, strlits }
+        tokenBuf, loopLevel, paramNum, defs, strlits }
     =
       f aggrTypeNames localScopes funcRetType globalSyms tokenBuf
-        loopLevel defs strlits
+        loopLevel paramNum defs strlits
   in
-    FRU.makeUpdate8 (from, from, to) ctx (fn (a, f) => z (a, Ctx o f))
+    FRU.makeUpdate9 (from, from, to) ctx (fn (a, f) => z (a, Ctx o f))
   end
 
   datatype declParts =
@@ -718,6 +719,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
     globalSyms = Tree.empty,
     tokenBuf = (P.create { fname, incDirs, debugMode = false }, []),
     loopLevel = 0,
+    paramNum = NONE,
     defs = [],
     strlits = []
   }
@@ -1364,7 +1366,10 @@ functor Parser(structure Tree: TREE; structure P: PPC;
 
             val () =
               if under = UAddr then
-                reduceVarToStack lid
+                if lid < valOf (#paramNum ctx) then
+                  P.error pos `"cannot take address of function argument" %
+                else
+                  reduceVarToStack lid
               else
                 ()
           in
@@ -1957,40 +1962,42 @@ functor Parser(structure Tree: TREE; structure P: PPC;
 
   and sizeofWrapper t = Word64.toInt $ sizeOfType t
 
-  and zeroExtend (ER (w, t)): word =
+  and zeroExtend (ER (w, t)): word = extz w (sizeOfType t)
+
+  and extz w fromSize =
   let
-    val size = Word.fromLarge $ sizeOfType t
     val minus1 = Word64.notb (Word64.fromInt 0)
-    val mask = Word64.>> (minus1, 0w64 - size * 0w8)
+    val mask = Word64.>> (minus1, 0w64 - fromSize * 0w8)
 
-    val () = printf `"ZH0: " W w `"\n" %
     val res = Word64.andb (mask, w)
-    val () = printf `"ZH1: " W res `"\n" %
   in
     res
   end
 
-  and getSignBit w sizeInBits =
+  and getSignBit w sizeInBits: int =
   let
-    val shift = Word64.>> (w, Word.fromInt $ sizeInBits -1)
-    val bit = Word64.andb (shift, Word64.fromInt 1)
+    open Word
+
+    val shift = >> (w, sizeInBits - 0w1)
+    val bit = andb (shift, 0w1)
   in
-    Word64.toInt bit
+    toInt bit
   end
 
-  and signExtend (R as (ER (w, t))) =
+  and signExtend (ER (w, t)) = exts w (sizeOfType t)
+
+  and exts w fromSize =
   let
-    val sizeInBits = 8 * sizeofWrapper t
+    open Word
 
+    val sizeInBits = fromSize * 0w8
     val signBit = getSignBit w sizeInBits
-
-    val signExtMask =
-      Word64.<< (Word64.notb $ Word64.fromInt 0, Word.fromInt sizeInBits)
+    val signExtMask = << (notb 0w0, sizeInBits)
   in
     if Int.compare (signBit, 0) = EQUAL then
-      zeroExtend R
+      extz w fromSize
     else
-      Word64.orb (signExtMask, w)
+      orb (signExtMask, w)
   end
 
   and evalUnop UnopPos _ arg = arg
@@ -2055,7 +2062,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
 
   and ebIsNegative (ER (w, t)) =
     if isSigned t then
-      if getSignBit w (8 * sizeofWrapper t) = 1 then
+      if getSignBit w (0w8 * sizeOfType t) = 1 then
         true
       else
         false
@@ -3248,7 +3255,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
   in
     if class = DeclDefined then
       let
-        val ini = canonIni (isGlobalScope ctx) pos t (valOf ini)
+        val ini = canonIni true pos t (valOf ini)
       in
         (SOME $ ToplevId (id, pos, t, ini, linkage), ctx)
       end
@@ -3301,10 +3308,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
     printf R offset
         `"local var " P.?nid `"(" I varId `"): " Pctype t `"\n" %;
 
-    if isSome ini orelse not $ isScalar t then
-      (SOME $ LocalId (varId, ini), ctx)
-    else
-      (NONE, ctx)
+    (SOME $ LocalId (varId, ini), ctx)
   end
 
   fun handleTypedef (C as Ctx ctx) ({ pos, t, id, ini, ... }: rawDecl) =
@@ -3611,20 +3615,30 @@ functor Parser(structure Tree: TREE; structure P: PPC;
       (StmtExpr ea, ctx)
   end
 
-  and handleInis ctx l =
-  let
-    fun handleIni (id, NONE) = (id, NONE)
-      | handleIni (id, SOME ini) =
-      let
-        val (pos, t) = (fn ({pos, t, ... }) => (pos, t)) $
-            D.get localVars id
+  and handleLocalIni (id, NONE) =
+    if #onStack $ D.get localVars id then
+      SOME (id, NONE)
+    else
+      NONE
+    | handleLocalIni (id, SOME ini) =
+    let
+      val (pos, t) = (fn ({pos, t, ... }) => (pos, t)) $
+          D.get localVars id
 
-        val ini = canonIni (isGlobalScope ctx) pos t ini
-      in
-        (id, SOME ini)
-      end
+      val ini = canonIni false pos t ini
+    in
+      SOME (id, SOME ini)
+    end
+
+  and processLocalInis inis =
+  let
+    fun loop [] acc = rev acc
+      | loop (ini :: inis) acc =
+        case handleLocalIni ini of
+          NONE => loop inis acc
+        | SOME v => loop inis (v :: acc)
   in
-    List.map handleIni l
+    loop inis []
   end
 
   and parseStmtCompound isFuncBody ctx =
@@ -3636,12 +3650,12 @@ functor Parser(structure Tree: TREE; structure P: PPC;
       if isTypeNameStart ctx tk then
         let
           val (res, ctx) = parseDeclaration ctx
-          val inits =
+          val varInits =
             case res of
-              LocalVarInits l => handleInis ctx l
+              LocalVarInits l => l (* handleInis ctx l *)
             | _ => raise Unreachable
         in
-          collectDecls (List.revAppend (inits, acc)) ctx
+          collectDecls (List.revAppend (varInits, acc)) ctx
         end
       else
         (rev acc, ctx)
@@ -3669,6 +3683,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
 
     val (inits, ctx) = collectDecls [] ctx
     val (stmts, ctx) = collectStmts [] ctx
+    val inits = processLocalInis inits
 
     val ctx = updateCtx ctx u#localScopes tl %
   in
@@ -3768,7 +3783,8 @@ functor Parser(structure Tree: TREE; structure P: PPC;
 
     val scope = createLocalVars Tree.empty 0 paramTypes params
   in
-    updateCtx ctx s#localScopes [scope] s#funcRetType (SOME rt) %
+    updateCtx ctx s#localScopes [scope] s#funcRetType (SOME rt)
+        s#paramNum (SOME $ length params) %
   end
 
   fun worldPrepareForFunc () = D.reset localVars
@@ -3788,6 +3804,8 @@ functor Parser(structure Tree: TREE; structure P: PPC;
 
     val (stmt, ctx) = parseStmtCompound true ctx
     val localVars = finishLocalVars ()
+
+    val ctx = updateCtx ctx s#paramNum NONE %
   in
     (Definition {
         name = id,