diff options
| -rw-r--r-- | parser.fun | 174 |
1 files changed, 139 insertions, 35 deletions
@@ -157,7 +157,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct StmtFor of exprAug option * exprAug option * exprAug option * stmt | StmtWhile of exprAug * stmt | StmtDoWhile of stmt * exprAug | - StmtReturn of exprAug | + StmtReturn of exprAug option | StmtBreak | StmtContinue @@ -192,8 +192,9 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct datatype ctx = Ctx of { localScopes: scope list, - localVars: (int * P.tkPos * ctype) list, + funcRetType: ctype option, + globalDecls: (int, P.tkPos * declClass * ctype * linkage) Tree.t, tokenBuf: P.t * (token * P.tkPos) list list, @@ -207,12 +208,16 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct fun updateCtx (Ctx ctx) = fn z => let - fun from localScopes localVars globalDecls tokenBuf loopLevel = - { localScopes, localVars, globalDecls, tokenBuf, loopLevel } - fun to f { localScopes, localVars, globalDecls, tokenBuf, loopLevel } = - f localScopes localVars globalDecls tokenBuf loopLevel + fun from localScopes localVars funcRetType globalDecls + tokenBuf loopLevel = + { localScopes, localVars, funcRetType, globalDecls, + tokenBuf, loopLevel } + + fun to f { localScopes, localVars, funcRetType, globalDecls, + tokenBuf, loopLevel } = + f localScopes localVars funcRetType globalDecls tokenBuf loopLevel in - FRU.makeUpdate5 (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 = @@ -565,10 +570,24 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct function_t _ => true | _ => false + val isPointer = fn pointer_t _ => true | _ => false + fun isObj (void_t | function_t _) = false + | isObj _ = true + + fun isPointerToObj (pointer_t (n, t)) = + if n > 1 then + true + else + isObj t + | isPointerToObj _ = false + + fun funcParts (function_t pair) = pair + | funcParts _ = raise Unreachable + val pointsTo = fn pointer_t (1, t) => t | pointer_t (n, t) => @@ -578,6 +597,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct fun createCtx fname incDirs = Ctx { localScopes = [], localVars = [], + funcRetType = NONE, globalDecls = Tree.empty, tokenBuf = (P.create { fname, incDirs, debugMode = false }, []), loopLevel = 0 @@ -678,8 +698,10 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct fun ~s = Printf out `s % in case unop of - UnopPreInc | UnopPostInc => ~"++" - | UnopPreDec | UnopPostDec => ~"--" + UnopPreInc => ~"++@" + | UnopPostInc => ~"@++" + | UnopPreDec => ~"--@" + | UnopPostDec => ~"@--" | UnopSizeof => ~"sizeof" | UnopPos => ~"+" | UnopNeg => ~"-" @@ -836,6 +858,11 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct and parseFuncCall funcEa pos ctx = let + fun isEmpty ctx = + case #1 $ getTokenCtx ctx of + Tk T.EOS => true + | _ => false + fun collectArgs acc ctx = let val ((status, ea), ctx) = parseExpr [T.Comma] ctx @@ -845,7 +872,8 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct else collectArgs (ea :: acc) ctx end - val (args, ctx) = collectArgs [] ctx + + val (args, ctx) = if isEmpty ctx then ([], ctx) else collectArgs [] ctx in (SOME $ makeEA (EfuncCall (funcEa, args)) pos, ctx) end @@ -1243,6 +1271,8 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct and convEA t (E as EA (_, pos, _, t')) = if t = t' then E + else if t' = void_t then + P.error pos `"unable to convert void" % else EA (Eunop (UnopCast, E), pos, false, t) @@ -1301,11 +1331,11 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct in case unop of UnopPostInc | UnopPostDec | UnopPreInc | UnopPreDec => - if isArith ot orelse isPointer ot then + if isScalar ot andalso isLvalue oper then EA (Eunop (unop, oper), pos, true, ot) else P.error (getPos oper) - `"expected an arithmetic or a pointer expression" % + `"expected an arithmetic or a pointer lvalue expression" % | UnopPos | UnopNeg => if isArith ot then toInt () @@ -1370,7 +1400,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct end | justConvArith _ _ = raise Unreachable - and checkRel (E as (EA (Ebinop (binop, left, right), _, _, _))) = + and checkRel (E as (EA (Ebinop (binop, left, right), pos, _, _))) = let val isEqCheck = case binop of BR BrEqual | BR BrNotEqual => true | _ => false @@ -1385,9 +1415,10 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct 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 if isEqCheck andalso rightT = voidp then + EA (Ebinop (binop, convEA voidp left, right), pos, false, int_t) + else if isEqCheck andalso leftT = voidp then + EA (Ebinop (binop, left, convEA voidp right), pos, false, int_t) else P.error rightPos `"pointer type does not match left sibling" % else @@ -1424,11 +1455,11 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct if isArith leftT then if isArith rightT then justConvArith E ResFromHigher - else if isPointer rightT then + else if isPointerToObj rightT then setT E rightT else P.error rightPos `"expeced pointer" % - else if isPointer leftT then + else if isPointerToObj leftT then if isIntegral rightT then setT E leftT else if isSub andalso isPointer rightT then @@ -1508,9 +1539,9 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct val rightT = getT right val (left, right) = - if isPointer leftT andalso isIntegral rightT then + if isPointerToObj leftT andalso isIntegral rightT then (left, convEA long_t right) - else if isIntegral leftT andalso isPointer rightT then + else if isIntegral leftT andalso isPointerToObj rightT then (right, convEA long_t left) else P.error pos `"expected pointer and integral pair" Pctype leftT % @@ -1553,12 +1584,32 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct and checkFuncCall check (EA (EfuncCall (func, args), pos, _, _)) = let - (* TODO: check arguments *) + fun checkArg arg = + let + val arg = check arg + in + if isObj $ getT arg then + arg + else + P.error pos `"function argument is not of object type" % + end + val func = check func + val args = List.map checkArg args + + fun convertArgs (t :: ts) (arg :: args) = + convEA t arg :: convertArgs ts args + | convertArgs [] [] = [] + | convertArgs _ _ = + P.error pos `"function called with invalid number of arguments" % in case getT func of - pointer_t (1, function_t (rt, _)) => + pointer_t (1, function_t (rt, argTypes)) => + let + val args = convertArgs argTypes args + in EA (EfuncCall (func, args), pos, false, rt) + end | _ => P.error pos `"expected pointer to function" % end | checkFuncCall _ _ = raise Unreachable @@ -1584,16 +1635,21 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct 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 + else if elseT = voidp then + setT E voidp + else if isPointer elseT andalso 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" % @@ -1884,7 +1940,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct | Econst (_, Ninteger w) => (printf `"eval num: " W64 w `": " Pctype t `"\n" %; ER (w, t)) - | Econst _ => raise Unimplemented + | Econst _ => raise Unreachable | Estrlit _ => P.error pos `"string literal in constant expression" % | EmemberByV _ | EmemberByP _ => P.error pos `"field access in constant expresssion" % @@ -2477,7 +2533,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct | Tk T.kwDo => loopWrapper parseDoWhile | Tk T.kwBreak => parseJmp StmtBreak | Tk T.kwContinue => parseJmp StmtContinue - | Tk T.kwReturn => parseReturn ctx' + | Tk T.kwReturn => parseReturn ctx | _ => parseStmtExpr ctx end @@ -2490,14 +2546,45 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct | _ => P.clerror pos [P.Ctk T.LParen] end + and getReturnExpr ctx = + let + val (tk, _, ctx') = getTokenCtx ctx + in + case tk of + Tk T.Semicolon => (NONE, ctx') + | _ => + let + val ((status, ea), ctx) = parseExpr [T.Semicolon] ctx + in + if status = 0 then + P.clerror (#2 $ getTokenCtx ctx) [P.Ctk T.Semicolon] + else + (SOME ea, ctx) + end + end + and parseReturn ctx = let - val ((status, ea), ctx) = parseExpr [T.Semicolon] ctx + val (_, pos, ctx) = getTokenCtx ctx + + val (ea, ctx) = getReturnExpr ctx + + val Ctx ctx' = ctx + val rt = valOf $ #funcRetType ctx' + + fun ret () = (StmtReturn $ Option.map (convEA rt) ea, ctx) in - if status = 0 then - P.clerror (#2 $ getTokenCtx ctx) [P.Ctk T.Semicolon] - else - (StmtReturn ea, ctx) + case ea of + NONE => + if rt = void_t then + ret () + else + P.error pos `"empty return in non-void function" % + | SOME _ => + if rt = void_t then + P.error pos `"attempt to return value in void function" % + else + ret () end and parseExprFor last ctx = @@ -2673,7 +2760,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct Printf out `"do " A2 pCompBody (off + 1) body `" " A1 pea cond `";" % | pstmt' _ (StmtReturn ea) out = - Printf out `"return " A1 pea ea `";" % + Printf out `"return " Popt pea ea `";" % | pstmt' _ StmtBreak out = Printf out `"break;" % | pstmt' _ StmtContinue out = Printf out `"continue;" % @@ -2697,14 +2784,29 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct case id of NONE => P.error pos `"expected parameter name\n" % | SOME _ => checkParams tail + + fun checkParamTypes (arg :: args) = + if not $ isScalar arg then + P.error pos `"function has parameter with non-scalar type" % + else + checkParamTypes args + | checkParamTypes [] = () + + val (rt, args) = funcParts t + + val () = + if isScalar rt orelse rt = void_t then + () + else + P.error pos `"function return type is not scalar or void" % in - checkParams $ valOf params + checkParams $ valOf params; + checkParamTypes args end fun ctxPrepareForFunc ctx t params = let - val paramTypes = - case t of function_t (_, ts) => ts | _ => raise Unreachable + val (rt, paramTypes) = funcParts t fun createLocalVars (acc, scope) [] [] = (acc, scope) | createLocalVars (acc, scope) (t :: ts) ((SOME id, pos) :: params) = @@ -2718,8 +2820,10 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct val (localVars, scope) = createLocalVars ([], Tree.empty) paramTypes params + in - updateCtx ctx s#localVars localVars s#localScopes [scope] % + updateCtx ctx s#localVars localVars s#localScopes [scope] + s#funcRetType (SOME rt) % end fun finishLocalVars (Ctx ctx) = Vector.fromList o rev o #localVars $ ctx |