Driver

1 files changed, 31 insertions, 29 deletions

diff --git a/parser.fun b/parser.fun
index 85ff551..f95739f 100644
--- a/parser.fun
+++ b/parser.fun
@@ -330,7 +330,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
     (BrLogOr, T.DoubleVerticalBar, 4, true),
 
     (BrAssign, T.EqualSign, 2, false),
-    (BrMulAssign, T.AmpersandEqualSign, 2, false),
+    (BrMulAssign, T.AsteriskEqualSign, 2, false),
     (BrDivAssign, T.SlashEqualSign, 2, false),
     (BrModAssign, T.PercentEqualSign, 2, false),
     (BrSumAssign, T.PlusEqualSign, 2, false),
@@ -746,13 +746,12 @@ functor Parser(structure Tree: TREE; structure P: PPC;
     fun dprintf g = Fold.fold ctx g
   end
 
-  fun createCtx fname incDirs debug =
+  fun createCtx fname incDirs dFile =
   let
     val () =
-      if debug then
-        debugFile := SOME (TextIO.openOut (fname ^ ".p"))
-      else
-        ()
+      case dFile of
+        NONE => ()
+      | SOME fname => debugFile := SOME (TextIO.openOut fname)
   in
     Ctx {
       aggrTypeNames = Tree.empty,
@@ -1401,7 +1400,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
     D.set localVars id ({ name, pos, onStack = true, t })
   end
 
-  and findId (Ctx ctx) pos under id =
+  and findId (Ctx ctx) pos id =
   let
     fun findLocal [] = NONE
       | findLocal (scope :: scopes) =
@@ -1412,17 +1411,8 @@ functor Parser(structure Tree: TREE; structure P: PPC;
           SOME lid =>
           let
             val t = #t $ D.get localVars lid
-
-            val () =
-              if under = UAddr then
-                if lid < valOf (#paramNum ctx) then
-                  P.error pos `"cannot take address of function argument" %
-                else
-                  reduceVarToStack lid
-              else
-                ()
           in
-            SOME $ convAggr under (EA (Eid (id, SOME $ Lid lid), pos, true, t))
+            SOME (EA (Eid (id, SOME $ Lid lid), pos, true, t))
           end
         | NONE => findLocal scopes
       end
@@ -1434,8 +1424,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
         val res = lookup (#globalSyms ctx) id
       in
         case res of
-          SOME (GsDecl (_, _, t, _)) =>
-            convAggr under (EA (Eid (id, SOME (Gid id)), pos, true, t))
+          SOME (GsDecl (_, _, t, _)) => EA (Eid (id, SOME (Gid id)), pos, true, t)
         | SOME (GsEnumConst v) =>
             EA (Econst (id, Ninteger (Word.fromInt v)), pos, false, int_t)
         | SOME (GsTypedef _) =>
@@ -1518,7 +1507,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
   and getPos (EA (_, pos, _, _)) = pos
   and setT (EA (binop, pos, lvalue, _)) t = EA (binop, pos, lvalue, t)
 
-  and checkUnop check under (EA (Eunop (unop, oper), pos, _, t)) =
+  and checkUnop check (EA (Eunop (unop, oper), pos, _, t)) =
   let
     val under' =
       case unop of
@@ -1571,9 +1560,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
           P.error pos `"expected function designator or lvalue operand" %
     | UnopDeref => (
         case ot of
-          pointer_t (1, T as function_t _) =>
-            finish false (case under of UNone => ot | _ => T)
-        | pointer_t (1, t) => finish true t
+          pointer_t (1, t) => finish true t
         | pointer_t (n, t) => finish true (pointer_t (n-1, t))
         | _ => P.error pos `"operand of not pointer type" %
     )
@@ -1585,7 +1572,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
         else
           finish false t
   end
-   | checkUnop _ _ _ = raise Unreachable
+   | checkUnop _ _ = raise Unreachable
 
   and checkSizeofType (EA (E as EsizeofType t, pos, _, _)) =
     if isFunc t then
@@ -1924,23 +1911,38 @@ functor Parser(structure Tree: TREE; structure P: PPC;
   end
    | checkMemberAccessByP _ _ = raise Unreachable
 
-  and checkExpr ctx under (E as EA (e, pos, _, _)) =
+  and checkExpr' ctx (E as EA (e, pos, _, _)) =
   let
     val check = checkExpr ctx
 
     (* val () = printf `"Checking " A1 pea E `"\n" % *)
   in
     case e of
-      Eid (id', _) => findId ctx pos under id'
+      Eid (id', _) => findId ctx pos id'
     | EsizeofType _ => checkSizeofType E
     | EfuncCall _ => checkFuncCall (check UNone) E
     | Ebinop (_, _, _) => checkBinop (check UNone) E
     | Eternary _ => checkTernary (check UNone) E
-    | Eunop (_, _) => checkUnop check under E
+    | Eunop (_, _) => checkUnop check E
     | EmemberByV _ => checkMemberAccessByV (check UNone) E
     | EmemberByP _ => checkMemberAccessByP (check UNone) E
-    | Econst _ => E
-    | Estrlit _ => convAggr under E
+    | Econst _ | Estrlit _ => E
+  end
+
+  and checkExpr (C as Ctx ctx) under ea =
+  let
+    val ea = checkExpr' C ea
+
+    val () =
+      case (under, ea) of
+        (UAddr, EA (Eid (_, SOME (Lid lid)), pos, _, _)) =>
+            if lid < valOf (#paramNum ctx) then
+              P.error pos `"cannot take address of function argument" %
+            else
+              reduceVarToStack lid
+      | _ => ()
+  in
+    convAggr under ea
   end
 
   and tryGetTypedefName (Ctx ctx) id =