Eval

1 files changed, 585 insertions, 12 deletions

diff --git a/parser.fun b/parser.fun
index 97b091d..ecaab22 100644
--- a/parser.fun
+++ b/parser.fun
@@ -59,6 +59,8 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     | Nfloat of Real32.real
     | Ndouble of Real64.real
 
+  and evalRes = ER of Word64.word * ctype
+
   and id = Lid of int | Gid of int
 
   and expr =
@@ -98,8 +100,20 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     function_t of ctype * ctype list |
     array_t of Word64.word * ctype
 
+  val typeSizes = [
+    (char_t, 1), (uchar_t, 1),
+    (short_t, 2), (ushort_t, 2),
+    (int_t, 4), (uint_t, 4),
+    (long_t, 8), (ulong_t, 8),
+    (longlong_t, 8), (longlong_t, 8)
+  ]
+
+  val pointerSize = Word64.fromInt 8
+
   val (ternaryOpPrio, ternaryOpLeftAssoc) = (2, false)
 
+  val voidp = pointer_t (1, void_t)
+
   datatype exprPart =
     EPexpr of exprAug |
     (* last two are prio and leftAssoc *)
@@ -249,6 +263,8 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     (BrComma, T.Comma, 1, true)
   ]
 
+  datatype justConvArithResType = ResFromHigher | ResFromLeft | ResIsInt
+
   fun pctype short t out =
   let
     fun &(f, s) = Printf out `(if short then s else f) %
@@ -330,7 +346,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
         [T.kwLong, T.kwLong, T.kwInt],
         [T.kwSigned, T.kwLong, T.kwLong, T.kwInt]]),
     (ulonglong_t, [[T.kwUnsigned, T.kwLong, T.kwLong],
-        [T.kwUnsigned, T.kwLong, T.kwLong, T.kwInt]]),
+        [T.kwUnsigned, T.kwLong, T.kwLong, T.kwInt]])
     (*
     (float_t, [[T.kwFloat]]),
     (double_t, [[T.kwDouble]])
@@ -536,6 +552,10 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
       (* float_t | double_t => true | *)
       _ => isIntegral t
 
+  val isSigned = fn
+    char_t | short_t | int_t | long_t | longlong_t => true
+  | _ => false
+
   fun isScalar t =
     case t of
       pointer_t _ => true
@@ -549,6 +569,12 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
       pointer_t _ => true
     | _ => false
 
+  val pointsTo = fn
+      pointer_t (1, t) => t
+    | pointer_t (n, t) =>
+        if n < 2 then raise Unreachable else pointer_t (n - 1, t)
+    | _ => raise Unreachable
+
   fun createCtx fname incDirs = Ctx {
     localScopes = [],
     localVars = [],
@@ -692,7 +718,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     | EfuncCall (func, args) =>
         Printf out `"fcall " A1 pea func `", " Plist pea args (", ", false) %
     | Eternary (cond, ifB, elseB) =>
-        Printf out A1 pea cond `"?" A1 pea ifB `":" A1 pea elseB %
+        Printf out A1 pea cond `" ? " A1 pea ifB `" : " A1 pea elseB %
     | Ebinop(BinopTernaryIncomplete _, _, _) => raise Unreachable
     | Ebinop(BR binop, left, right) =>
     let
@@ -1166,6 +1192,8 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
 
   and findId (Ctx ctx) pos sizeofOrAddr id =
   let
+    val () = printf `"findId: " B sizeofOrAddr `"\n" %
+
     fun findLocal [] = NONE
       | findLocal (scope :: scopes) =
       let
@@ -1177,7 +1205,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
             val locals = rev o #localVars $ ctx
             val t = #3 $ List.nth (locals, lid)
           in
-            SOME (Lid lid, true, t)
+            SOME (Lid lid, true, convAggr sizeofOrAddr t)
           end
         | NONE => findLocal scopes
       end
@@ -1212,8 +1240,11 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     | function_t _ => 15
     | unknown_t => raise Unreachable
 
-  and convEA t (E as EA (_, pos, _, _)) =
-    EA (Eunop (UnopCast, E), pos, false, t)
+  and convEA t (E as EA (_, pos, _, t')) =
+    if t = t' then
+      E
+    else
+      EA (Eunop (UnopCast, E), pos, false, t)
 
   and promoteToInt (E as EA (_, _, _, t)) =
     if typeRank t < typeRank int_t then
@@ -1221,9 +1252,38 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     else
       E
 
-  and isLvalue (EA (_, _, lvalue, _)) = lvalue
+  and convArith (E1 as EA (_, pos1, _, t1)) (E2 as EA (_, pos2, _, t2)) =
+  let
+    val rank1 = typeRank t1
+    val rank2 = typeRank t2
 
-  and getT ea = case ea of EA (_, _, _, t) => t
+    val (higherType, pos, emax, emin, swapNeeded) =
+      if rank1 > rank2 then
+        (t1, pos1, E1, E2, false)
+      else
+        (t2, pos2, E2, E1, true)
+
+    val () =
+      if typeRank higherType > typeRank ulonglong_t then
+        P.error pos `"expected arithmetic type" %
+      else
+        ()
+
+    fun swap e1 e2 = if swapNeeded then (e2, e1) else (e1, e2)
+  in
+    if rank1 = rank2 then
+      if rank1 >= typeRank int_t then
+        (t1, (E1, E2))
+      else
+        (int_t, (promoteToInt E1, promoteToInt E2))
+    else
+      (higherType, swap emax (convEA higherType emin))
+  end
+
+  and isLvalue (EA (_, _, lvalue, _)) = lvalue
+  and getT (EA (_, _, _, t)) = t
+  and getPos (EA (_, pos, _, _)) = pos
+  and setT (EA (binop, pos, lvalue, _)) t = EA (binop, pos, lvalue, t)
 
   and checkUnop check sizeofOrAddr (EA (Eunop (unop, oper), pos, _, t)) =
   let
@@ -1241,7 +1301,11 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
   in
     case unop of
       UnopPostInc | UnopPostDec | UnopPreInc | UnopPreDec =>
-        raise Unimplemented
+      if isArith ot orelse isPointer ot then
+        EA (Eunop (unop, oper), pos, true, ot)
+      else
+        P.error (getPos oper)
+          `"expected an arithmetic or a pointer expression" %
     | UnopPos | UnopNeg =>
         if isArith ot then
           toInt ()
@@ -1292,8 +1356,199 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
       EA (E, pos, false, ulong_t)
     | checkSizeofType _ = raise Unreachable
 
-  and checkBinop check (EA (Ebinop (binop, left, right), pos, _, t)) =
-    EA (Ebinop (binop, check left, check right), pos, false, t)
+  and justConvArith (EA (Ebinop (binop, left, right), pos, _, _))
+      resultMode =
+  let
+    val (resT, (left, right)) = convArith left right
+    val resT =
+      case resultMode of
+        ResIsInt => int_t
+      | ResFromLeft => getT left
+      | ResFromHigher => resT
+  in
+    EA (Ebinop (binop, left, right), pos, false, resT)
+  end
+   | justConvArith _ _ = raise Unreachable
+
+  and checkRel (E as (EA (Ebinop (binop, left, right), _, _, _))) =
+  let
+    val isEqCheck =
+      case binop of BR BrEqual | BR BrNotEqual => true | _ => false
+
+    val leftT = getT left
+    val rightT = getT right
+    val rightPos = getPos right
+  in
+    if isArith leftT andalso isArith rightT then
+      justConvArith E ResIsInt
+    else if isPointer leftT then
+      if isPointer rightT then
+        if pointsTo leftT = pointsTo rightT then
+          setT E int_t
+        else if isEqCheck andalso (rightT = voidp orelse leftT = voidp)
+        then
+          setT E int_t
+        else
+          P.error rightPos `"pointer type does not match left sibling" %
+      else
+        P.error rightPos `"expected pointer" %
+    else
+      P.error (getPos left) `"expected arithmetic type or pointer" %
+  end
+    | checkRel _ = raise Unreachable
+
+  and checkLogOp (E as EA (Ebinop (_, left, right), _, _, _)) =
+  let
+    fun error ea = P.error (getPos ea)`"expected value of scalar type" %
+  in
+      if isScalar (getT left) then
+        if isScalar (getT right) then
+          setT E int_t
+        else
+          error right
+      else
+        error left
+  end
+    | checkLogOp _ = raise Unreachable
+
+  and checkSimpleArith (E as (EA (Ebinop (binop, left, right), _, _, _))) =
+  let
+    val leftT = getT left
+    val rightT = getT right
+
+    val leftPos = getPos left
+    val rightPos = getPos right
+
+    val isSub = case binop of BR BrSub => true | _ => false
+  in
+    if isArith leftT then
+      if isArith rightT then
+        justConvArith E ResFromHigher
+      else if isPointer rightT then
+        setT E rightT
+      else
+        P.error rightPos `"expeced pointer" %
+    else if isPointer leftT then
+      if isIntegral rightT then
+        setT E leftT
+      else if isSub andalso isPointer rightT then
+        if leftT = rightT then
+          setT E long_t
+        else
+          P.error rightPos `"value type does not match its left sibling" %
+      else
+        P.error rightPos `"expected value of an integral type" %
+    else
+      P.error leftPos `"expected value of an integral type or a pointer" %
+  end
+    | checkSimpleArith _ = raise Unreachable
+
+  and checkSimpleAssignment
+    (E as EA (Ebinop (binop, left, right), pos, lvalue, _))
+  =
+    if not $ isLvalue left then
+      P.error (getPos left) `"expected lvalue" %
+    else
+    let
+      val leftT = getT left
+      val rightT = getT right
+    in
+      if isArith leftT andalso isArith rightT then
+        EA (Ebinop (binop, left, convEA leftT right), pos, lvalue, leftT)
+      else if isPointer leftT then
+        if leftT = rightT then
+          setT E leftT
+        else if leftT = voidp orelse rightT = voidp then
+          setT E leftT
+        else
+          P.error (getPos right)
+            `"expression has a type incompatible with its sibling: "
+             `"(" Pctype leftT `", >" Pctype rightT `")" %
+      else
+        P.error (getPos left)
+          `"expected value of an arithmetic type or a pointer" %
+    end
+   | checkSimpleAssignment _ = raise Unreachable
+
+  and checkCompoundAssignment maybePointer
+    (E as EA (Ebinop (binop, left, right), pos, _, _))
+  =
+    if not $ isLvalue left then
+      P.error (getPos left) `"expected lvalue" %
+    else
+    let
+      val leftT = getT left
+      val rightT = getT right
+    in
+      if isArith leftT andalso isArith rightT then
+        if typeRank rightT < typeRank leftT then
+          EA (Ebinop (binop, left, convEA leftT right), pos, false, leftT)
+        else
+          setT E leftT
+      else if maybePointer andalso
+        isPointer leftT andalso isIntegral rightT
+      then
+        setT E leftT
+      else
+        P.error pos `"unvalid operands of a compound assignment" %
+    end
+   | checkCompoundAssignment _ _ = raise Unreachable
+
+  and checkComma (EA (Ebinop (binop, left, right), pos, _, _)) =
+  let
+    val left = convEA void_t left
+  in
+    EA (Ebinop (binop, left, right), pos, false, getT right)
+  end
+    | checkComma _ = raise Unreachable
+
+  and checkSubscript (EA (Ebinop (_, left, right), pos, _, _)) =
+  let
+    val leftT = getT left
+    val rightT = getT right
+
+    val (left, right) =
+      if isPointer leftT andalso isIntegral rightT then
+        (left, convEA long_t right)
+      else if isIntegral leftT andalso isPointer rightT then
+        (right, convEA long_t left)
+      else
+        P.error pos `"expected pointer and integral pair" Pctype leftT %
+
+    val resT = pointsTo $ getT left
+  in
+      EA (Ebinop(BR BrSubscript, left, right), pos, true, resT)
+  end
+   | checkSubscript _ = raise Unreachable
+
+  and checkBinop check (EA (Ebinop (binop, left, right), pos, lvalue, t)) =
+  let
+    val E = EA (Ebinop (binop, check left, check right), pos, lvalue, t)
+  in
+    case binop of
+      BR BrMul | BR BrDiv | BR BrMod => justConvArith E ResFromHigher
+    | BR BrShiftLeft | BR BrShiftRight => justConvArith E ResFromLeft
+    | BR BrLess | BR BrGreater | BR BrLessEqual | BR BrGreaterEqual =>
+        checkRel E
+    | BR BrEqual | BR BrNotEqual => checkRel E
+    | BR BrBitAnd | BR BrBitOr | BR BrBitXor =>
+        justConvArith E ResFromHigher
+    | BR BrLogAnd | BR BrLogOr => checkLogOp E
+    | BR BrSum | BR BrSub => checkSimpleArith E
+    | BR BrAssign => checkSimpleAssignment E
+
+    | BR BrSumAssign | BR BrSubAssign => checkCompoundAssignment true E
+
+    | BR BrMulAssign | BR BrDivAssign | BR BrModAssign
+    | BR BrLeftShiftAssign | BR BrRightShiftAssign
+    | BR BrBitAndAssign | BR BrBitXorAssign | BR BrBitOrAssign =>
+        checkCompoundAssignment false E
+
+    | BR BrComma => checkComma E
+    | BR BrSubscript => checkSubscript E
+
+    | BinopTernaryIncomplete _ => raise Unreachable
+  end
     | checkBinop _ _ = raise Unreachable
 
   and checkFuncCall check (EA (EfuncCall (func, args), pos, _, _)) =
@@ -1308,9 +1563,49 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
   end
     | checkFuncCall _ _ = raise Unreachable
 
+  and checkTernary check
+    (E as (EA (Eternary (cond, thenPart, elsePart), pos, _, _)))
+  =
+  let
+    val cond = check cond
+    val thenPart = check thenPart
+    val elsePart = check elsePart
+  in
+    if not $ isScalar $ getT cond then
+      P.error (getPos cond) `"expected expression of scalar type" %
+    else
+    let
+      val thenT = getT thenPart
+      val elseT = getT elsePart
+    in
+      if isArith thenT andalso isArith elseT then
+        let
+          val (resT, (thenPart, elsePart)) = convArith thenPart elsePart
+        in
+          EA (Eternary (cond, thenPart, elsePart), pos, false, resT)
+        end
+      else if thenT = void_t andalso elseT = void_t then
+        setT E void_t
+      else if isPointer thenT then
+        if thenT = elseT then
+          setT E thenT
+        else if elseT = voidp orelse thenT = voidp then
+          setT E voidp
+        else
+          P.error (getPos elsePart)
+            `"expression type is incompatible with its left sibling" %
+      else
+        P.error (getPos thenPart)
+          `"expected expression of pointer or arithmetic type" %
+    end
+  end
+    | checkTernary _ _ = raise Unreachable
+
   and checkExpr ctx sizeofOrAddr (E as EA (e, pos, _, _)) =
   let
     val check = checkExpr ctx
+
+    (* val () = printf `"Checking " A1 pea E `"\n" % *)
   in
     case e of
       Eid (id', _) =>
@@ -1322,6 +1617,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     | EsizeofType _ => checkSizeofType E
     | EfuncCall _ => checkFuncCall (check false) E
     | Ebinop (_, _, _) => checkBinop (check false) E
+    | Eternary _ => checkTernary (check false) E
     | Eunop (_, _) => checkUnop check sizeofOrAddr E
     | _ => E
   end
@@ -1349,6 +1645,278 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     )
   end
 
+  and sizeOfType (pointer_t _) = pointerSize
+    | sizeOfType (array_t (n, t)) = Word64.* (n, sizeOfType t)
+    | sizeOfType t =
+    case List.find (fn (t', _) => t' = t) typeSizes of
+      SOME (_, size) => Word64.fromInt size
+    | _ => raise Unreachable
+
+  and sizeofWrapper t = Word64.toInt $ sizeOfType t
+
+  and zeroExtend (ER (w, t)) =
+  let
+    val size = Word.fromLarge $ sizeOfType t
+    val minus1 = Word64.notb (Word64.fromInt 0)
+    val mask = Word64.>> (minus1, 0w64 - size * 0w8)
+
+    val () = printf `"ZH0: " W64 w `"\n" %
+    val res = Word64.andb (mask, w)
+    val () = printf `"ZH1: " W64 res `"\n" %
+  in
+    res
+  end
+
+  and getSignBit w sizeInBits =
+  let
+    val shift = Word64.>> (w, Word.fromInt $ sizeInBits -1)
+    val bit = Word64.andb (shift, Word64.fromInt 1)
+  in
+    Word64.toInt bit
+  end
+
+  and signExtend (R as (ER (w, t))) =
+  let
+    val sizeInBits = 8 * sizeofWrapper t
+
+    val signBit = getSignBit w sizeInBits
+
+    val signExtMask =
+      Word64.<< (Word64.notb $ Word64.fromInt 0, Word.fromInt sizeInBits)
+  in
+    if Int.compare (signBit, 0) = EQUAL then
+      zeroExtend R
+    else
+      Word64.orb (signExtMask, w)
+  end
+
+  and evalUnop UnopPos _ arg = arg
+    | evalUnop UnopNeg _ (R as (ER (_, t))) =
+    let
+      val w = zeroExtend R
+    in
+      ER (Word64.~ w, t)
+    end
+    | evalUnop UnopComp _ (ER (w, t)) =
+    let
+      val minus1 = Word64.notb $ Word64.fromInt 0
+      val res as ER (w, _) = ER (Word64.xorb (minus1, w), t)
+      val () = printf `"~ after: " W64 w `"\n" %
+    in
+      res
+    end
+    | evalUnop UnopCast (t', pos) (R as (ER (w, t))) =
+    let
+      val () =
+        if not $ isArith t' then
+          P.error pos `"not an arithmetic expression" %
+        else
+          ()
+    in
+      case Int.compare (sizeofWrapper t', sizeofWrapper t) of
+        GREATER =>
+          if isSigned t then
+            ER (signExtend R, t')
+          else
+            ER (zeroExtend R, t')
+      | EQUAL => ER (w, t')
+      | LESS => ER (w, t')
+    end
+    | evalUnop _ (_, pos) _ =
+      P.error pos `"invalid unop in constant expression" %
+
+  and evalEqCheck eq left right =
+  let
+    val w1 = zeroExtend left
+    val w2 = zeroExtend right
+
+    val ` = Word64.fromInt
+  in
+    case (Word64.compare (w1, w2), eq) of
+      (EQUAL, true) => `1
+    | (EQUAL, false) => `0
+    | (_, true) => `0
+    | (_, false) => `1
+  end
+
+  and ebGetT (ER (_, t)) = t
+
+  and ebIsNonzero arg =
+  let
+    val cleaned = zeroExtend arg
+  in
+    case Word64.compare (cleaned, Word64.fromInt 0) of
+      EQUAL => false
+    | _ => true
+  end
+
+  and ebIsNegative (ER (w, t)) =
+    if isSigned t then
+      if getSignBit w (8 * sizeofWrapper t) = 1 then
+        true
+      else
+        false
+    else
+      false
+
+  and w64FromBool true = Word64.fromInt 1
+    | w64FromBool false = Word64.fromInt 0
+
+  and ebDirect w64op (ER (w1, t)) (ER (w2, _)) = ER (w64op (w1, w2), t)
+
+  and ebCompare left right convResult =
+  let
+    val (conv, comp) =
+      if isSigned (ebGetT left) then
+        (signExtend,
+          fn (w1, w2) =>
+            Int64.compare (word64Toint64 w1, word64Toint64 w2))
+      else
+        (zeroExtend, Word64.compare)
+    val left' = conv left
+    val right' = conv right
+
+    val () = printf `"eval compare: " W64 left' `", " W64 right' `"\n" %
+    val res = convResult $ comp (left', right')
+  in
+    ER (w64FromBool res, int_t)
+  end
+
+  and ebShiftLeft pos (ER (w1, t)) (right as ER (w2, _)) =
+  let
+    val count =
+      if ebIsNegative right then
+        P.error pos `"left shift count is negative" %
+      else
+        Word.fromLarge w2
+  in
+    ER (Word64.<< (w1, count), t)
+  end
+
+  and ebShiftRight pos left (right as ER (w, _)) =
+  let
+    val count =
+      if ebIsNegative right then
+        P.error pos `"right shift count is negative" %
+      else
+        Word.fromLarge w
+
+    val (conv, w64op) =
+      if isSigned (ebGetT left) then
+        (signExtend, Word64.~>>)
+      else
+        (zeroExtend, Word64.>>)
+  in
+    ER (w64op (conv left, count), ebGetT left)
+  end
+
+  and ebHardArith (int32op, int64op, word64op) (left as ER (w1, t))
+    (right as ER (w2, _))
+  =
+    if isSigned t then
+      let
+        val w = case sizeofWrapper t of
+          4 => int32Toword64 $ int32op (word64Toint32 w1, word64Toint32 w2)
+        | 8 => int64Toword64 $ int64op (word64Toint64 w1, word64Toint64 w2)
+        | _ => raise Unreachable
+      in
+        ER (w, t)
+      end
+    else
+      ebDirect word64op left right
+
+  and evalBinop (BR BrSum) _ left right = ebDirect Word64.+ left right
+    |  evalBinop (BR BrSub) _ left right = ebDirect Word64.- left right
+    | evalBinop (BR BrBitAnd) _ left right =
+        ebDirect Word64.andb left right
+    | evalBinop (BR BrBitOr) _ left right = ebDirect Word64.orb left right
+    | evalBinop (BR BrBitXor) _ left right =
+        ebDirect Word64.xorb left right
+
+    | evalBinop (BR BrMul) _ left right =
+      ebHardArith (Int32.*, Int64.*, Word64.*) left right
+    | evalBinop (BR BrDiv) _ left right =
+      ebHardArith (Int32.div, Int64.div, Word64.div) left right
+    | evalBinop (BR BrMod) _ left right =
+      ebHardArith (Int32.mod, Int64.mod, Word64.mod) left right
+
+    | evalBinop (BR BrEqual) _ left right =
+        ER (evalEqCheck true left right, ebGetT left)
+    | evalBinop (BR BrNotEqual) _ left right =
+        ER (evalEqCheck false left right, ebGetT left)
+
+    | evalBinop (BR BrLogAnd) _ left right =
+      if ebIsNonzero left then
+        ER (w64FromBool $ ebIsNonzero right, int_t)
+      else
+        ER (Word64.fromInt 0, int_t)
+    | evalBinop (BR BrLogOr) _ left right =
+      if ebIsNonzero left then
+        ER (Word64.fromInt 1, int_t)
+      else
+        ER (w64FromBool $ ebIsNonzero right, int_t)
+
+    | evalBinop (BR BrShiftLeft) pos left right =
+        ebShiftLeft pos left right
+    | evalBinop (BR BrShiftRight) pos left right =
+        ebShiftRight pos left right
+
+    | evalBinop (BR BrGreater) _ left right =
+        ebCompare left right (fn GREATER => true | _ => false)
+    | evalBinop (BR BrGreaterEqual) _ left right =
+        ebCompare left right (fn GREATER | EQUAL => true | _ => false)
+    | evalBinop (BR BrLess) _ left right =
+        ebCompare left right (fn LESS => true | _ => false)
+    | evalBinop (BR BrLessEqual) _ left right =
+        ebCompare left right (fn LESS | EQUAL => true | _ => false)
+
+    | evalBinop _ pos _ _ = P.error pos
+      `"unsupported operator in constant expression" %
+
+  and sizeofValue (EA (_, _, _, t)) = ER (sizeOfType t, ulong_t)
+
+  and evalTernary cond left right =
+    eval' (if ebIsNonzero $ eval' cond then left else right)
+
+  and eval' (EA (e, pos, _, t)) =
+    case e of
+      Eid _ => P.error pos `"variable in constant expression" %
+    | Econst (_, Ninteger w) =>
+        (printf `"eval num: " W64 w `": " Pctype t `"\n" %;
+            ER (w, t))
+    | Econst _ => raise Unimplemented
+    | Estrlit _ => P.error pos `"string literal in constant expression" %
+    | EmemberByV _ | EmemberByP _ =>
+        P.error pos `"field access in constant expresssion" %
+    | EfuncCall _ => P.error pos `"function call in constant expression" %
+    | EsizeofType t' => ER (sizeOfType t', ulong_t)
+    | Eunop (UnopSizeof, sub) => sizeofValue sub
+    | Eunop (unop, sub) =>
+        if isArith $ getT sub then
+          evalUnop unop (t, pos) (eval' sub)
+        else
+          P.error pos `"not an arithmetic expression" %
+    | Ebinop (binop, left, right) =>
+        if isArith $ getT left then
+          if isArith $ getT right then
+            evalBinop binop pos (eval' left) (eval' right)
+          else
+            P.error pos `"not an arithmetic expression" %
+        else
+          P.error pos `"not an arithmetic expression" %
+    | Eternary (cond, left, right) => evalTernary cond left right
+
+  and eval (E as EA (_, pos, _, _)) t' =
+  let
+    val e = Eunop (UnopCast, E)
+    val res = eval' $ EA (e, pos, false, t')
+
+    val ER (w, _) = res
+    val () = printf `"eval: " W64 w `"\n" %
+  in
+    zeroExtend res
+  end
+
   and parseDeclPrefix ctx =
   let
     fun collect ctx (storSpec, typeReprId) =
@@ -1454,8 +2022,13 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
   in
     case tk of
       TkParens list => % ctx' list parseFuncParams parts
-    | TkBrackets _ =>
-      collectDDeclaratorTail (ArrayApplication 0w0 :: parts) untilEnd ctx'
+    | TkBrackets list =>
+      let
+        val ((_, ea), ctx) = ctxWithLayer ctx' list $ parseExpr []
+        val w = eval ea ulong_t
+      in
+        collectDDeclaratorTail (ArrayApplication w :: parts) untilEnd ctx
+      end
     | Tk T.EOS => (parts, ctx)
     | _ =>
       if untilEnd then