diff options
Diffstat (limited to 'parser.fun')
| -rw-r--r-- | parser.fun | 69 |
1 files changed, 41 insertions, 28 deletions
@@ -65,7 +65,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; and evalRes = ER of word * ctype - and id = Lid of int | Gid of int + and id = Lid of int | Gid of int * bool and expr = Eid of int * id option | @@ -143,8 +143,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; datatype ini = IniExpr of exprAug | IniCompound of ini list - datatype cini = CiniExpr of exprAug | CiniConst of word | - CiniLayout of int + datatype cini = CiniExpr of exprAug | CiniLayout of int datatype storageSpec = SpecTypedef | @@ -1382,8 +1381,8 @@ functor Parser(structure Tree: TREE; structure P: PPC; in case res of SOME (GsDecl (_, _, t, _)) => - (Gid id, not $ isFunc t, convAggr under t, NONE) - | SOME (GsEnumConst v) => (Gid id, false, int_t, SOME v) + (Gid (id, isFunc t), not $ isFunc t, convAggr under t, NONE) + | SOME (GsEnumConst v) => (Gid (id, false), false, int_t, SOME v) | SOME (GsTypedef _) => P.error pos `"type in place of an identifier" % | NONE => P.error pos `"unknown identifier" % @@ -1424,6 +1423,13 @@ functor Parser(structure Tree: TREE; structure P: PPC; else E + and commonType t1 t2 = + let + val common = if typeRank t1 > typeRank t2 then t1 else t2 + in + if typeRank common < typeRank int_t then int_t else common + end + and convArith (E1 as EA (_, pos1, _, t1)) (E2 as EA (_, pos2, _, t2)) = let val rank1 = typeRank t1 @@ -1479,7 +1485,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; case unop of UnopPostInc | UnopPostDec | UnopPreInc | UnopPreDec => if isScalar ot andalso isLvalue oper then - EA (Eunop (unop, oper), pos, true, ot) + EA (Eunop (unop, oper), pos, false, ot) else P.error (getPos oper) `"expected an arithmetic or a pointer lvalue expression" % @@ -1598,12 +1604,16 @@ functor Parser(structure Tree: TREE; structure P: PPC; val rightPos = getPos right val isSub = case binop of BR BrSub => true | _ => false + + fun swap (EA (Ebinop (binop, left, right), pos, lvalue, t)) = + EA (Ebinop (binop, right, left), pos, lvalue, t) + | swap _ = raise Unreachable in if isArith leftT then if isArith rightT then justConvArith E ResFromHigher else if isPointerToObj rightT then - setT E rightT + swap $ setT E rightT else P.error rightPos `"expeced pointer" % else if isPointerToObj leftT then @@ -1804,6 +1814,15 @@ functor Parser(structure Tree: TREE; structure P: PPC; end | checkTernary _ _ = raise Unreachable + and getFieldInfo t field = + let + val fields = tryGetFields t + in + case List.find (fn (f, _, _) => f = field) fields of + SOME (_, offset, fieldType) => SOME (offset, fieldType) + | NONE => NONE + end + and checkMemberAccessByV check (EA (EmemberByV (ea, field), pos, _, _)) = let val ea = check ea @@ -1814,13 +1833,10 @@ functor Parser(structure Tree: TREE; structure P: PPC; t else P.error (getPos ea) `"expected an aggregate" % - - val fields = tryGetFields t in - case List.find (fn (f, _, _) => f = field) fields of + case getFieldInfo t field of NONE => P.error pos `"unknown field" % - | SOME (_, _, field_type) => - EA (EmemberByV (ea, field), pos, true, field_type) + | SOME (_, ft) => EA (EmemberByV (ea, field), pos, true, ft) end | checkMemberAccessByV _ _ = raise Unreachable @@ -1842,14 +1858,10 @@ functor Parser(structure Tree: TREE; structure P: PPC; end else P.error (getPos ea) `"expected a pointer to an aggregate" % - - - val fields = tryGetFields t in - case List.find (fn (f, _, _) => f = field) fields of + case getFieldInfo t field of NONE => P.error pos `"unknown field" % - | SOME (_, _, field_type) => - EA (EmemberByP (ea, field), pos, true, field_type) + | SOME (_, ft) => EA (EmemberByP (ea, field), pos, true, ft) end | checkMemberAccessByP _ _ = raise Unreachable @@ -2828,7 +2840,6 @@ functor Parser(structure Tree: TREE; structure P: PPC; end fun printIni _ (CiniExpr ea) out = Printf out A1 pea ea % - | printIni _ (CiniConst w) out = Printf out W w % | printIni off (CiniLayout id) out = let val (_, _, layout) = D.get iniLayouts id @@ -3182,18 +3193,23 @@ functor Parser(structure Tree: TREE; structure P: PPC; ) end + fun registerLayout layout t toplev = + D.pushAndGetId iniLayouts (toplev, sizeOfType t, layout) + + fun getLayoutSize id = #2 $ D.get iniLayouts id + fun canonExprIni toplev t ea = if toplev then let val () = printf `"Here\n" % - val w = eval ea t + val value = eval ea t + val layout = [{ offset = 0w0, t, value }] in - CiniConst w + CiniLayout (registerLayout layout t toplev) end else CiniExpr $ convEA t ea - fun canonIni toplev pos t ini = let val ini = convStrlitIni pos t ini @@ -3210,10 +3226,9 @@ functor Parser(structure Tree: TREE; structure P: PPC; | _ => let val layout = calcOffsets 0w0 $ LcAux (0w0, computeTLayout t) - val seq = flattenIni pos layout ini + val layout = flattenIni pos layout ini - val id = D.length iniLayouts - val () = D.push iniLayouts (toplev, sizeOfType t, seq) + val id = registerLayout layout t toplev in CiniLayout id end @@ -3265,10 +3280,8 @@ functor Parser(structure Tree: TREE; structure P: PPC; let val varId = D.length localVars - val () = printfn `"vid: " I varId `": " P.? id `": len " % - val () = D.push localVars - ({ name = id, pos, t, onStack = false }) + ({ name = id, pos, t, onStack = not $ isScalar t }) val (_, scope) = Tree.insert intCompare scope id varId in |