From 868e6313e3824d68b3121c5c95c7f29bc088c0e9 Mon Sep 17 00:00:00 2001 From: Vladimir Azarov Date: Sat, 31 May 2025 16:06:59 +0200 Subject: sizeof, initializers --- parser.fun | 204 ++++++++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 133 insertions(+), 71 deletions(-) diff --git a/parser.fun b/parser.fun index 8a5e77b..5e69692 100644 --- a/parser.fun +++ b/parser.fun @@ -12,6 +12,7 @@ functor Parser(P: PPC): PARSER = struct UnopNeg | UnopComp | UnopLogNeg | + UnopSizeof | UnopCast of ctype | UnopPostInc | @@ -61,6 +62,7 @@ functor Parser(P: PPC): PARSER = struct EmemberByP of int * exprAug | EfuncCall of exprAug * exprAug list | ETernary of exprAug * exprAug * exprAug | + EsizeofType of ctype | Eunop of unop * exprAug | Ebinop of binop * exprAug * exprAug @@ -94,6 +96,11 @@ functor Parser(P: PPC): PARSER = struct (* last two are prio and leftAssoc *) EPbinop of binop * P.tkPos * int * bool + type unopList = (unop * P.tkPos) list + + datatype exprPrefix = + NormalPrefix of unopList | SizeofType of unopList * ctype * P.tkPos + datatype storageSpec = SpecTypedef | SpecExtern | @@ -105,6 +112,7 @@ functor Parser(P: PPC): PARSER = struct pos: P.tkPos, spec: storageSpec option, ctype: ctype, + value: exprAug option, params: (int option * P.tkPos) list option } @@ -119,7 +127,7 @@ functor Parser(P: PPC): PARSER = struct datatype def = Declaration of declaredId list | Definition of declaredId * stmt - datatype parseBinopRes = BRbinop of exprPart | BRfinish of bool + datatype parseBinopRes = BRbinop of exprPart | BRfinish of int datatype token = Tk of T.token | @@ -211,7 +219,7 @@ functor Parser(P: PPC): PARSER = struct 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 % + | array_t el => Printf out `"[] " A1 pctype el % end in bind A1 pctype @@ -536,6 +544,7 @@ functor Parser(P: PPC): PARSER = struct case unop of UnopPreInc | UnopPostInc => ~"++" | UnopPreDec | UnopPostDec => ~"--" + | UnopSizeof => ~"sizeof" | UnopPos => ~"+" | UnopNeg => ~"-" | UnopAddr => ~"&" @@ -571,11 +580,12 @@ functor Parser(P: PPC): PARSER = struct | EmemberByV pair => member pair "." | EmemberByP pair => member pair "->" | EfuncCall (func, args) => ( - Printf out `"(fcall" P `"\n" A2 printExpr' (off + 1) func `"\n" %; - app (fn arg => - (Printf out A2 printExpr' (off + 1) arg `"\n" %)) args; - Printf out R off `")" % + Printf out `"(fcall" P `"\n" A2 printExpr' (off + 1) func `"\n" + Plist (printExpr' (off + 1)) args ("\n", false) + R off `")" % ) + | EsizeofType ctype => + Printf out `"(sizeof " P `"\n" R (off + 1) Pctype ctype `")" % | Eunop (unop, ea) => Printf out `"(" A1 Punop unop P `"\n" A2 printExpr' (off + 1) ea `")" % | Ebinop (BR binop, left, right) => @@ -600,6 +610,19 @@ functor Parser(P: PPC): PARSER = struct and printExpr off ea out = Printf out A2 printExpr' off ea `"\n" % + and isTypeInParens tk ctx = + case tk of + TkParens list => + if isTypeNameStart (#1 $ hd list) handle Empty => false then + let + val (ctype, ctx) = ctxWithLayer ctx list parseTypeName + in + SOME (ctype, ctx) + end + else + NONE + | _ => NONE + and parseUnaryPrefix ctx acc = let val unopPreTable = [ @@ -610,7 +633,8 @@ functor Parser(P: PPC): PARSER = struct (T.Ampersand, UnopAddr), (T.Asterisk, UnopDeref), (T.Tilde, UnopComp), - (T.ExclMark, UnopLogNeg) + (T.ExclMark, UnopLogNeg), + (T.kwSizeof, UnopSizeof) ] val (tk, pos, ctx') = getTokenCtx ctx in @@ -618,44 +642,49 @@ functor Parser(P: PPC): PARSER = struct Tk tk => ( case List.find (fn (tk', _) => tk' = tk) unopPreTable of SOME (_, unop) => parseUnaryPrefix ctx' ((unop, pos) :: acc) - | _ => (acc, ctx) + | _ => (NormalPrefix acc, ctx) ) - | TkParens list => - if isTypeNameStart (#1 $ hd list) handle Empty => false then - let - val (ctype, ctx) = ctxWithLayer ctx' list - (fn ctx => parseTypeName ctx) - in - parseUnaryPrefix ctx ((UnopCast ctype, pos) :: acc) - end - else - (acc, ctx) - | _ => (acc, ctx) + | _ => ( + case isTypeInParens tk ctx' of + SOME (ctype, ctx) => + if #1 (hd acc) = UnopSizeof handle Empty => false then + (SizeofType (tl acc, ctype, #2 $ hd acc), ctx) + else + parseUnaryPrefix ctx ((UnopCast ctype, pos) :: acc) + | NONE => (NormalPrefix acc, ctx) + ) end - and parseBinop ctx endTk = + and parseBinop ctx endTks = let val (tk, pos, ctx) = getTokenCtx ctx + fun oneOfEndTks _ _ [] = 0 + | oneOfEndTks tk idx (tk' :: tks) = + if tk = tk' then idx else oneOfEndTks tk (idx + 1) tks in case tk of TkTernary list => let - val ((_, ea), ctx) = ctxWithLayer ctx list (parseExpr NONE) + val ((_, ea), ctx) = ctxWithLayer ctx list (parseExpr []) in (BRbinop $ EPbinop (BinopTernaryIncomplete ea, pos, ternaryOpPrio, ternaryOpLeftAssoc), ctx) end | Tk tk => - if tk = T.EOS then - (BRfinish true, ctx) - else if isSome endTk andalso tk = valOf endTk then - (BRfinish false, ctx) - else ( - case List.find (fn (_, tk', _, _) => tk' = tk) binopTable of - SOME (binop, _, prio, leftAssoc) => - (BRbinop $ EPbinop (BR binop, pos, prio, leftAssoc), ctx) - | NONE => P.clerror pos [P.Cbinop] - ) + if tk = T.EOS then + (BRfinish 0, ctx) + else + let + val status = oneOfEndTks tk 1 endTks + in + if status > 0 then + (BRfinish status, ctx) + else + case List.find (fn (_, tk', _, _) => tk' = tk) binopTable of + SOME (binop, _, prio, leftAssoc) => + (BRbinop $ EPbinop (BR binop, pos, prio, leftAssoc), ctx) + | NONE => P.clerror pos [P.Cbinop] + end | _ => P.clerror pos [P.Cbinop] end @@ -663,9 +692,9 @@ functor Parser(P: PPC): PARSER = struct let fun collectArgs ctx acc = let - val ((eofReached, ea), ctx) = parseExpr (SOME T.Comma) ctx + val ((status, ea), ctx) = parseExpr [T.Comma] ctx in - if eofReached then + if status = 0 then (rev $ ea :: acc, ctx) else collectArgs ctx (ea :: acc) @@ -697,7 +726,7 @@ functor Parser(P: PPC): PARSER = struct | TkBrackets list => let val ((_, ea), ctx) = - ctxWithLayer ctx1 list (parseExpr NONE) + ctxWithLayer ctx1 list (parseExpr []) in (SOME $ EAug (Ebinop (BR BrSubscript, eAug, ea), pos1), ctx) end @@ -726,7 +755,7 @@ functor Parser(P: PPC): PARSER = struct | Tk (T.Num _) => wrap Enum | TkParens list => let - val ((_, ea), ctx) = ctxWithLayer ctx list (parseExpr NONE) + val ((_, ea), ctx) = ctxWithLayer ctx list (parseExpr []) in (ea, ctx) end @@ -736,13 +765,20 @@ functor Parser(P: PPC): PARSER = struct and parseUnary ctx = let val (prefix, ctx) = parseUnaryPrefix ctx [] - val (eAug, ctx) = parsePrimaryExpr ctx - val (eAug, ctx) = parseExprSuffix eAug ctx - - val eAug = List.foldl - (fn ((unop, pos), e) => EAug (Eunop (unop, e), pos)) eAug prefix + fun applyPrefix prefix ea = + List.foldl (fn ((unop, pos), e) => + EAug (Eunop (unop, e), pos)) ea prefix in - (eAug, ctx) + case prefix of + NormalPrefix unopList => + let + val (ea, ctx) = parsePrimaryExpr ctx + val (ea, ctx) = parseExprSuffix ea ctx + in + (applyPrefix unopList ea, ctx) + end + | SizeofType (unopList, ctype, pos) => + (applyPrefix unopList (EAug (EsizeofType ctype, pos)), ctx) end and constructExpr parts = @@ -789,7 +825,7 @@ functor Parser(P: PPC): PARSER = struct construct ([], []) parts end - and parseExpr endTk ctx = + and parseExpr endTks ctx = let fun collect ctx expVal acc = if expVal then @@ -799,14 +835,14 @@ functor Parser(P: PPC): PARSER = struct collect ctx (not expVal) (EPexpr unary :: acc) end else - case parseBinop ctx endTk of + case parseBinop ctx endTks of (BRbinop binop, ctx) => collect ctx (not expVal) (binop :: acc) - | (BRfinish eofReached, ctx) => (eofReached, rev acc, ctx) + | (BRfinish status, ctx) => (status, rev acc, ctx) - val (eofReached, parts, ctx) = collect ctx true [] + val (eof, parts, ctx) = collect ctx true [] val expr = constructExpr parts in - ((eofReached, expr), ctx) + ((eof, expr), ctx) end and tryGetSpec ctx = @@ -1027,12 +1063,15 @@ functor Parser(P: PPC): PARSER = struct | _ => NONE in - { id, pos, spec = storSpec, ctype = complete $ tl parts, params } + { id, pos, spec = storSpec, ctype = complete $ tl parts, + value = NONE, params } end - fun pDeclId off ({ id, spec, ctype, params, ... }: declaredId) out = ( + fun pDeclId off ({ id, spec, ctype, params, value, ... }: declaredId) + out = ( Printf out R off PoptS pStorSpec spec - Popt P.psid id `": " Pctype ctype `"\n" %; + Popt P.psid id `": " Pctype ctype `"\n" + Popt (printExpr (off + 1)) value %; case params of NONE => () @@ -1044,6 +1083,37 @@ functor Parser(P: PPC): PARSER = struct DeclIds of declaredId list | FuncDef of declaredId * (token * P.tkPos) list + datatype fdecRes = + FDnormal of bool * declaredId | FDFuncDef of declaration + + fun finishDeclarator (declId: declaredId) expectFDef ctx = + let + val (tk, pos, ctx) = getTokenCtx ctx + in + case tk of + Tk T.Comma => (FDnormal (true, declId), ctx) + | Tk T.Semicolon => (FDnormal (false, declId), ctx) + | Tk T.EqualSign => + let + val ((status, ea), ctx) = parseExpr [T.Comma, T.Semicolon] ctx + val { id, pos, spec, ctype, params, ... } = declId + val declId = { id, pos, spec, ctype, value = SOME ea, params } + in + if status = 0 then + P.clerror pos [P.Ctk T.Comma, P.Ctk T.Semicolon] + else + (FDnormal (status = 1, declId), ctx) + end + | _ => + if expectFDef then + case tk of + TkBraces list => (FDFuncDef $ FuncDef (declId, list), ctx) + | _ => P.clerror pos + [P.Ctk T.Comma, P.Ctk T.Semicolon, P.Ctk T.LBrace] + else + P.clerror pos [P.Ctk T.Comma, P.Ctk T.Semicolon] + end + fun parseDeclaration ctx expectFdef = let val (prefix, ctx) = parseDeclPrefix ctx @@ -1052,24 +1122,16 @@ functor Parser(P: PPC): PARSER = struct let val (parts, ctx) = parseDeclarator (false, APprohibited) [] ctx val declaredId = assembleDeclarator prefix parts - - val (tk, pos, ctx) = getTokenCtx ctx - fun fdefPossible () = expectFdef andalso null acc - - fun die () = P.clerror pos [P.Ctk T.Comma, P.Ctk T.Semicolon] - fun die2 () = P.clerror pos - [P.Ctk T.Comma, P.Ctk T.Semicolon, P.Ctk T.LBrace] + val (res, ctx) = finishDeclarator declaredId + (expectFdef andalso null acc) ctx in - case tk of - Tk T.Comma => collectDeclarators (declaredId :: acc) ctx - | Tk T.Semicolon => (DeclIds $ rev $ declaredId :: acc, ctx) - | _ => - if fdefPossible () then - case tk of - TkBraces list => (FuncDef (declaredId, list), ctx) - | _ => die2 () + case res of + FDFuncDef fd => (fd, ctx) + | FDnormal (continue, declId) => + if continue then + collectDeclarators (declId :: acc) ctx else - die () + (DeclIds $ rev $ declId :: acc, ctx) end in collectDeclarators [] ctx @@ -1113,11 +1175,11 @@ functor Parser(P: PPC): PARSER = struct (NONE, ctx') else let - val ((eof, ea), ctx) = parseExpr (SOME T.Semicolon) ctx + val ((status, ea), ctx) = parseExpr [T.Semicolon] ctx in - if eof andalso not last then + if status = 0 andalso not last then P.clerror (#2 $ getTokenCtx ctx) [P.Ctk T.Semicolon] - else if not eof andalso last then + else if status <> 0 andalso last then P.clerror (#2 $ getTokenCtx ctx) [P.Ctk T.RParen] else (SOME ea, ctx) @@ -1146,7 +1208,7 @@ functor Parser(P: PPC): PARSER = struct and parseExprInParens ctx = let val (list, ctx) = getParenInsides ctx - val ((_, ea), ctx) = ctxWithLayer ctx list (parseExpr NONE) + val ((_, ea), ctx) = ctxWithLayer ctx list (parseExpr []) in (ea, ctx) end @@ -1183,9 +1245,9 @@ functor Parser(P: PPC): PARSER = struct and parseStmtExpr ctx = let - val ((eof, ea), ctx) = parseExpr (SOME T.Semicolon) ctx + val ((status, ea), ctx) = parseExpr [T.Semicolon] ctx in - if eof then + if status = 0 then P.clerror (#2 $ getTokenCtx ctx) [P.Ctk T.Semicolon] else (StmtExpr ea, ctx) -- cgit v1.2.3