diff options
Diffstat (limited to 'parser.fun')
| -rw-r--r-- | parser.fun | 177 |
1 files changed, 104 insertions, 73 deletions
@@ -100,7 +100,7 @@ functor Parser(P: PPC): PARSER = struct SpecStatic | SpecRegister - datatype stmt = StmtCompound of exprAug + datatype stmt = StmtCompound of exprAug list type declaredId = { id: int option, @@ -168,23 +168,18 @@ functor Parser(P: PPC): PARSER = struct (BrComma, T.Comma, 1, true) ] - val PstorSpec = fn z => - let - fun f (out, s) = - Printf out `( - case s of - SpecTypedef => "typedef" - | SpecExtern => "extern" - | SpecRegister => "register" - | SpecStatic => "static" - ) % - in - bind A1 f - end z + fun pStorSpec s out = + Printf out `( + case s of + SpecTypedef => "typedef" + | SpecExtern => "extern" + | SpecRegister => "register" + | SpecStatic => "static" + ) % val Pctype = fn z => let - fun Pctype (out, t) = + fun pctype t out = let fun &s = Printf out `s % in @@ -203,20 +198,13 @@ functor Parser(P: PPC): PARSER = struct | float_t => &"float" | double_t => &"double" | pointer_t (plevel, t) => - Printf out `"[" I plevel `"]" A1 Pctype t % - | function_t (ret, params) => - let - fun Pparams (_, []) = () - | Pparams (out, [p]) = Printf out A1 Pctype p % - | Pparams (out, (p1 :: p2 :: t)) = - Printf out A1 Pctype p1 `", " A1 Pparams (p2 :: t) % - in - Printf out `"(" A1 Pparams params `") -> " A1 Pctype ret % - end - | array_t el => Printf out `"() -> " A1 Pctype el % + Printf out `"{" I plevel `"} " A1 pctype t % + | function_t (ret, params) => Printf out + Plist pctype params (", ", true) `" -> " A1 pctype ret % + | array_t el => Printf out `"[] -> " A1 pctype el % end in - bind A1 Pctype + bind A1 pctype end z val typeSpecs = [ @@ -343,11 +331,11 @@ functor Parser(P: PPC): PARSER = struct SOME (repr, _) => repr | NONE => raise Unreachable - fun printRepr (out, l) = + fun printRepr l out = let - fun printRepr' (_, []) = () - | printRepr' (out, [tk]) = Printf out P.Ptk tk % - | printRepr' (out, tk1 :: tk2 :: tail) = + fun printRepr' [] _ = () + | printRepr' [tk] out = Printf out P.Ptk tk % + | printRepr' (tk1 :: tk2 :: tail) out = Printf out P.Ptk tk1 `", " A1 printRepr' (tk2 :: tail) % in Printf out `"[" A1 printRepr' l `"]" % @@ -441,20 +429,23 @@ functor Parser(P: PPC): PARSER = struct fun typeRepr2type typeReprId = valOf o #1 o Array.sub $ (prefixFsm, typeReprId) - fun PtokenL (_, []) = () - | PtokenL (out, head :: tail) = + fun pTokenL l out = + let + fun pToken (tk, _) out = let - fun printL list s e = - Printf out `s`"| " A1 PtokenL list `" |"`e `", " A1 PtokenL tail % - val (tk, _) = head + fun printList list opr cpr = Printf out `(opr ^ "| ") + Plist pToken list (",", false) `(" |" ^ cpr) % in case tk of - Tk tk => Printf out P.Ptk tk `"," A1 PtokenL tail % - | TkParens list => printL list "(" ")" - | TkBrackets list => printL list "[" "]" - | TkBraces list => printL list "{" "}" - | TkTernary list => printL list "?" ":" + Tk tk => Printf out P.Ptk tk % + | TkParens list => printList list "(" ")" + | TkBrackets list => printList list "[" "]" + | TkBraces list => printList list "{" "}" + | TkTernary list => printList list "?" ":" end + in + Printf out Plist pToken l (",", false) % + end type parseCtx = P.t * (token * P.tkPos) list list @@ -530,7 +521,7 @@ functor Parser(P: PPC): PARSER = struct (v, (fn (ppc, layers) => (ppc, tl layers)) ctx) end - fun Punop (out, unop) = + fun Punop unop out = let fun ~s = Printf out `s % in @@ -546,15 +537,15 @@ functor Parser(P: PPC): PARSER = struct | UnopCast ctype => Printf out Pctype ctype % end - and Pbinop (out, binop) = + and Pbinop binop out = case List.find (fn (binop', _, _, _) => binop' = binop) binopTable of SOME (_, tk, _, _) => Printf out P.Ptk tk % | NONE => raise Unreachable - and printExpr (out, off, ea) = + and printExpr off ea out = let - fun printExpr' (out, off, EAug (e, pos)) = + fun printExpr' off (EAug (e, pos)) out = let val P = fn z => let @@ -842,8 +833,10 @@ functor Parser(P: PPC): PARSER = struct if typeReprId = 0 then let val (_, pos, _) = getTokenCtx ctx + val ets = "expected type specifier" + val etss = "expected type or storage specifier" in - P.error pos `"expected type specifier" % + P.error pos `(if isSome storSpec then ets else etss) % end else ((storSpec, typeRepr2type typeReprId), ctx) @@ -860,7 +853,7 @@ functor Parser(P: PPC): PARSER = struct collect ctx (NONE, 0) end - and Ppart (out, part) = + and Ppart part out = case part of Pointer plevel => Printf out `"[" I plevel `"] " % | Id _ => Printf out `"id" % @@ -872,7 +865,6 @@ functor Parser(P: PPC): PARSER = struct isSome $ List.find (fn tk' => case tk of Tk tk => tk = tk' | _ => false) typeSpecs - and parseTypeName ctx = let val (prefix, ctx) = parseDeclPrefix ctx @@ -987,6 +979,15 @@ functor Parser(P: PPC): PARSER = struct parts, ctx) end + and checkParamUniqueness _ [] = () + | checkParamUniqueness acc ((SOME id, pos, _) :: ids) = ( + case List.find (fn id' => id' = id) acc of + SOME _ => P.error pos `"parameter redefinition" % + | NONE => checkParamUniqueness (id :: acc) ids + ) + | checkParamUniqueness acc ((NONE, _, _) :: ids) = + checkParamUniqueness acc ids + and assembleDeclarator (storSpec, ctype) parts = let val parts = rev parts @@ -1001,7 +1002,7 @@ functor Parser(P: PPC): PARSER = struct pointer_t (plevel, complete tail) | complete (FuncApp params :: tail) = let - (* TODO: check params uniqness *) + val () = checkParamUniqueness [] params val params = map (fn (_, _, ctype) => ctype) params in function_t (complete tail, params) @@ -1019,20 +1020,15 @@ functor Parser(P: PPC): PARSER = struct { id, pos, spec = storSpec, ctype = complete $ tl parts, params } end - fun printDeclId ({ id, spec, ctype, params, ... }: declaredId) = - let - fun Pstor (_, NONE) = () - | Pstor (out, SOME s) = Printf out PstorSpec s % - in - printf A1 Pstor spec Popt P.? id `": " Pctype ctype `"\n" %; + fun pDeclId ({ id, spec, ctype, params, ... }: declaredId) out = ( + Printf out Popt pStorSpec spec `" " Popt P.psid id `": " + Pctype ctype `"\n" %; + case params of NONE => () - | SOME params => ( - printf `"params: " %; - List.app (fn (id, _) => printf Popt P.?id `", " %) params; - printf `"\n" % - ) - end + | SOME params => Printf out + `"params: " Plist (popt P.psid) (map #1 params) (", ", false) `"\n" % + ) datatype declaration = DeclIds of declaredId list | @@ -1074,15 +1070,38 @@ functor Parser(P: PPC): PARSER = struct fun parseStmtCompound ctx = let - val (ea, ctx) = parseExpr ctx (SOME T.Semicolon) - val (_, _, ctx) = getTokenCtx ctx - val (tk, pos, ctx) = getTokenCtx ctx + fun collect acc ctx = + let + val (tk, _, _) = getTokenCtx ctx + in + case tk of + Tk T.EOS => (rev acc, ctx) + | _ => + let + val (ea, ctx) = parseExpr ctx (SOME T.Semicolon) + val (tk, pos, ctx) = getTokenCtx ctx + in + case tk of + Tk T.Semicolon => collect (ea :: acc) ctx + | _ => P.clerror pos [P.Ctk T.Semicolon] + end + end + + val (eas, ctx) = collect [] ctx in - case tk of - Tk T.EOS => (StmtCompound ea, ctx) - | _ => P.clerror pos [P.Ctk T.RBrace] + (StmtCompound eas, ctx) end + val Pstmt = fn z => + let + fun Pstmt off (StmtCompound eas) out = + Printf out R off `"{\n" + Plist (printExpr (off + 1)) eas ("", false) + R off `"}\n" % + in + bind A2 Pstmt + end z + fun parseFuncDefinition id ctx = let val (stmt, ctx) = parseStmtCompound ctx @@ -1090,14 +1109,26 @@ functor Parser(P: PPC): PARSER = struct (Definition (id, stmt), ctx) end + fun printDef (Definition (id, stmt)) = + printf `"Function: " A1 pDeclId id Pstmt 0 stmt % + | printDef (Declaration ids) = printf Plist pDeclId ids ("", false) % + fun parseDef ctx = let - val (toplev, ctx) = parseDeclaration ctx true + val (tk, _, _) = getTokenCtx ctx in - case toplev of - DeclIds ids => (Declaration ids, ctx) - | FuncDef (id, body) => - ctxWithLayer ctx body (fn ctx => - parseFuncDefinition id ctx) + case tk of + Tk T.EOS => NONE + | _ => + let + val (toplev, ctx) = parseDeclaration ctx true + in + SOME (case toplev of + DeclIds ids => (Declaration ids, ctx) + | FuncDef (id, body) => + ctxWithLayer ctx body (fn ctx => + parseFuncDefinition id ctx)) + end + end end |