diff options
Diffstat (limited to 'parser.fun')
| -rw-r--r-- | parser.fun | 147 |
1 files changed, 87 insertions, 60 deletions
@@ -121,6 +121,8 @@ functor Parser(structure Tree: TREE; structure P: PPC; (longlong_t, 8), (longlong_t, 8) ] + datatype under = UNone | USizeof | UAddr + val pointerSize = Word64.fromInt 8 val (ternaryOpPrio, ternaryOpLeftAssoc) = (2, false) @@ -194,7 +196,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; pos: P.tkPos, t: ctype, paramNum: int, - localVars: (nid * P.tkPos * ctype) vector, + localVars: { name: nid, pos: P.tkPos, onStack: bool, t: ctype } vector, stmt: stmt } @@ -238,11 +240,13 @@ functor Parser(structure Tree: TREE; structure P: PPC; GsEnumConst of int | GsTypedef of int + val localVars: { name: nid, pos: P.tkPos, onStack: bool, t: ctype } D.t + = D.create0 () + datatype ctx = Ctx of { aggrTypeNames: scope, localScopes: scope list, - localVars: (int * P.tkPos * ctype) list, funcRetType: ctype option, globalSyms: (int, globalSym) Tree.t, @@ -258,19 +262,18 @@ functor Parser(structure Tree: TREE; structure P: PPC; fun updateCtx (Ctx ctx) = fn z => let - fun from aggrTypeNames localScopes localVars - funcRetType globalSyms tokenBuf loopLevel + fun from aggrTypeNames localScopes funcRetType globalSyms + tokenBuf loopLevel = - { aggrTypeNames, localScopes, localVars, + { aggrTypeNames, localScopes, funcRetType, globalSyms, tokenBuf, loopLevel } - fun to f { aggrTypeNames, localScopes, localVars, + fun to f { aggrTypeNames, localScopes, funcRetType, globalSyms, tokenBuf, loopLevel } = - f aggrTypeNames localScopes localVars funcRetType - globalSyms tokenBuf loopLevel + f aggrTypeNames localScopes funcRetType globalSyms tokenBuf loopLevel in - FRU.makeUpdate7 (from, from, to) ctx (fn (a, f) => z (a, Ctx o f)) + FRU.makeUpdate6 (from, from, to) ctx (fn (a, f) => z (a, Ctx o f)) end datatype declParts = @@ -360,7 +363,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; Plist (pctype short) params (if short then "" else ", ", false) `"}" `(if short then "" else " -> ") A2 pctype short ret % | array_t (n, el) => - Printf out `"[" `(Word64.toString n) `"]" A2 pctype short el % + Printf out `"[" W n `"]" A2 pctype short el % | struct_t { name, ... } => Printf out A2 ptagged ("r", "struct") name % | union_t { name, ... } => Printf out A2 ptagged ("u", "union") name % | enum_t (name, _) => Printf out A2 ptagged ("e", "enum") name % @@ -697,7 +700,6 @@ functor Parser(structure Tree: TREE; structure P: PPC; aggrTypeNames = Tree.empty, localScopes = [], - localVars = [], funcRetType = NONE, globalSyms = Tree.empty, tokenBuf = (P.create { fname, incDirs, debugMode = false }, []), @@ -1305,21 +1307,29 @@ functor Parser(structure Tree: TREE; structure P: PPC; val (eof, parts, ctx) = collect ctx true [] val expr = constructExpr parts - val expr = checkExpr ctx false expr + val expr = checkExpr ctx UNone expr in ((eof, expr), ctx) end - and convAggr sizeofOrAddr t = - if sizeofOrAddr then - t - else - case t of - function_t _ => pointer_t (1, t) - | array_t (_, el_t) => pointer_t (1, el_t) - | _ => t + and convAggr under t = + case under of + UNone => ( + case t of + function_t _ => pointer_t (1, t) + | array_t (_, el_t) => pointer_t (1, el_t) + | _ => t + ) + | _ => t + + and reduceVarToStack id = + let + val ({ name, pos, onStack = _, t }) = D.get localVars id + in + D.set localVars id ({ name, pos, onStack = true, t }) + end - and findId (Ctx ctx) pos sizeofOrAddr id = + and findId (Ctx ctx) pos under id = let fun findLocal [] = NONE | findLocal (scope :: scopes) = @@ -1329,10 +1339,15 @@ functor Parser(structure Tree: TREE; structure P: PPC; case res of SOME lid => let - val locals = rev o #localVars $ ctx - val t = #3 $ List.nth (locals, lid) + val t = #t $ D.get localVars lid + + val () = + if under = UAddr then + reduceVarToStack lid + else + () in - SOME (Lid lid, true, convAggr sizeofOrAddr t, NONE) + SOME (Lid lid, true, convAggr under t, NONE) end | NONE => findLocal scopes end @@ -1345,7 +1360,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; in case res of SOME (GsDecl (_, _, t, _)) => - (Gid id, not $ isFunc t, convAggr sizeofOrAddr t, NONE) + (Gid id, not $ isFunc t, convAggr under t, NONE) | SOME (GsEnumConst v) => (Gid id, false, int_t, SOME v) | SOME (GsTypedef _) => P.error pos `"type in place of an identifier" % @@ -1420,9 +1435,14 @@ 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 sizeofOrAddr (EA (Eunop (unop, oper), pos, _, t)) = + and checkUnop check under (EA (Eunop (unop, oper), pos, _, t)) = let - val oper = check (unop = UnopSizeof orelse unop = UnopAddr) oper + val under' = + case unop of + UnopSizeof => USizeof + | UnopAddr => UAddr + | _ => UNone + val oper = check under' oper fun finish lvalue t = EA (Eunop (unop, oper), pos, lvalue, t) val ot = getT oper @@ -1469,7 +1489,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; | UnopDeref => ( case ot of pointer_t (1, T as function_t _) => - finish false (if sizeofOrAddr then T else ot) + finish false (case under of UNone => ot | _ => 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" % @@ -1811,7 +1831,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; end | checkMemberAccessByP _ _ = raise Unreachable - and checkExpr ctx sizeofOrAddr (E as EA (e, pos, _, _)) = + and checkExpr ctx (under: under) (E as EA (e, pos, _, _)) = let val check = checkExpr ctx @@ -1820,7 +1840,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; case e of Eid (id', _) => let - val (id, lvalue, t, const) = findId ctx pos sizeofOrAddr id' + val (id, lvalue, t, const) = findId ctx pos under id' in case const of SOME v => @@ -1828,12 +1848,12 @@ functor Parser(structure Tree: TREE; structure P: PPC; | _ => EA (Eid (id', SOME id), pos, lvalue, t) end | EsizeofType _ => checkSizeofType E - | EfuncCall _ => checkFuncCall (check false) E - | Ebinop (_, _, _) => checkBinop (check false) E - | Eternary _ => checkTernary (check false) E - | Eunop (_, _) => checkUnop check sizeofOrAddr E - | EmemberByV _ => checkMemberAccessByV (check false) E - | EmemberByP _ => checkMemberAccessByP (check false) E + | EfuncCall _ => checkFuncCall (check UNone) E + | Ebinop (_, _, _) => checkBinop (check UNone) E + | Eternary _ => checkTernary (check UNone) E + | Eunop (_, _) => checkUnop check under E + | EmemberByV _ => checkMemberAccessByV (check UNone) E + | EmemberByP _ => checkMemberAccessByP (check UNone) E | Econst _ | Estrlit _ => E end @@ -2996,14 +3016,17 @@ functor Parser(structure Tree: TREE; structure P: PPC; SOME _ => P.error pos `"local variable redefinition" % | NONE => let - val varId = length $ #localVars ctx - val localVars = (id, pos, t) :: #localVars ctx + val varId = D.length localVars + + val () = printfn `"vid: " I varId `": " P.? id `": len " % + + val () = D.push localVars + ({ name = id, pos, t, onStack = false }) val (_, scope) = Tree.insert intCompare scope id varId in (varId, id, updateCtx (Ctx ctx) - u#localScopes (fn scs => scope :: tl scs) - s#localVars localVars %) + u#localScopes (fn scs => scope :: tl scs) %) end end @@ -3332,13 +3355,13 @@ functor Parser(structure Tree: TREE; structure P: PPC; (StmtExpr ea, ctx) end - and handleInis (Ctx ctx) l = + and handleInis l = let fun handleIni (id, NONE) = (id, NONE) | handleIni (id, SOME ini) = let - val (pos, t) = (fn (_, pos, t) => (pos, t)) $ - List.nth (rev $ #localVars ctx, id) + val (pos, t) = (fn ({pos, t, ... }) => (pos, t)) $ + D.get localVars id val ini = canonIni pos t ini in @@ -3359,7 +3382,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; val (res, ctx) = parseDeclaration ctx val inits = case res of - LocalVarInits l => handleInis ctx l + LocalVarInits l => handleInis l | _ => raise Unreachable in collectDecls (List.revAppend (inits, acc)) ctx @@ -3474,38 +3497,41 @@ functor Parser(structure Tree: TREE; structure P: PPC; let val (rt, paramTypes) = funcParts t - fun createLocalVars (acc, scope) [] [] = (acc, scope) - | createLocalVars (acc, scope) (t :: ts) ((SOME id, pos) :: params) = + fun createLocalVars scope _ [] [] = scope + | createLocalVars scope curVarId (t :: ts) + ((SOME id, pos) :: params) + = let - val localVar = (id, pos, t) - val (_, scope) = Tree.insert intCompare scope id $ length acc + val localVar = { name = id, pos, t, onStack = false } + val (_, scope) = Tree.insert intCompare scope id curVarId in - createLocalVars (localVar :: acc, scope) ts params + D.push localVars localVar; + createLocalVars scope (curVarId + 1) ts params end - | createLocalVars _ _ _ = raise Unreachable - - val (localVars, scope) = - createLocalVars ([], Tree.empty) paramTypes params + | createLocalVars _ _ _ _ = raise Unreachable + val scope = createLocalVars Tree.empty 0 paramTypes params in - updateCtx ctx s#localVars localVars s#localScopes [scope] - s#funcRetType (SOME rt) % + updateCtx ctx s#localScopes [scope] s#funcRetType (SOME rt) % end - fun finishLocalVars (Ctx ctx) = Vector.fromList o rev o #localVars $ ctx + fun worldPrepareForFunc () = D.reset localVars + + fun finishLocalVars () = D.toVec localVars fun parseFuncDefinition (D as { id, pos, t, params, ... }: rawDecl) ctx = let val () = validateFuncHeader D val (id, params) = (valOf id, valOf params) + val () = worldPrepareForFunc () val ctx = ctxPrepareForFunc ctx t params val linkage = getLinkage ctx D val ctx = addDeclaration ctx (id, pos, t, linkage) DeclDefined val (stmt, ctx) = parseStmtCompound true ctx - val localVars = finishLocalVars ctx + val localVars = finishLocalVars () in (Definition { name = id, @@ -3524,7 +3550,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; rev acc else let - val param = #3 $ Vector.sub (localVars, idx) + val param = #t $ Vector.sub (localVars, idx) in getParams ((idx, param) :: acc) (idx + 1) end @@ -3551,8 +3577,9 @@ functor Parser(structure Tree: TREE; structure P: PPC; end | printDef (Definition (D as { stmt, localVars, ... })) = let - fun pLocalVar i (id, _, t) out = - Printf out `"%" I i `"(" P.?id `"): " Pctype t `"\n" % + fun pLocalVar i ({ name, t, onStack, ... }) out = + Printf out `"%" I i `"(" P.?name `"): " + `(if onStack then "& " else "") Pctype t `"\n" % in printFuncHeader D; printf Pstmt 0 stmt %; |