From 2f168e6c941662d9a3b4c0e5440f9f4cdf0bb710 Mon Sep 17 00:00:00 2001 From: Vladimir Azarov Date: Mon, 4 Aug 2025 00:11:18 +0200 Subject: Typedef support --- common.sml | 8 ++++++ parser.fun | 95 ++++++++++++++++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 88 insertions(+), 15 deletions(-) diff --git a/common.sml b/common.sml index 6b23c4d..4bde818 100644 --- a/common.sml +++ b/common.sml @@ -194,3 +194,11 @@ let in printf `"error: " (fn (a, _) => g (a, finish)) end + +fun printfn g = +let + fun finish (true, _) = () + | finish (false, (output, _)) = output "\n" +in + printf (fn (a, _) => g (a, finish)) +end diff --git a/parser.fun b/parser.fun index 0c5aa5a..638f2c1 100644 --- a/parser.fun +++ b/parser.fun @@ -235,7 +235,8 @@ functor Parser(structure Tree: TREE; structure P: PPC; datatype globalSym = GsDecl of P.tkPos * declClass * ctype * linkage | - GsEnumConst of int + GsEnumConst of int | + GsTypedef of int datatype ctx = Ctx of { aggrTypeNames: scope, @@ -282,7 +283,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; datatype abstructPolicy = APpermitted | APenforced | APprohibited datatype specType = - StorageSpec of storageSpec | TypeSpec of T.token + StorageSpec of storageSpec | TypeSpec of T.token | TypeName of ctype val binopTable = [ (BrSubscript, T.Invalid, 0, false), @@ -598,7 +599,6 @@ functor Parser(structure Tree: TREE; structure P: PPC; fun typeRepr2type typeReprId = valOf o #1 o Array.sub $ (prefixFsm, typeReprId) - (* fun pTokenL l out = let fun pToken (tk, _) out = @@ -616,7 +616,6 @@ functor Parser(structure Tree: TREE; structure P: PPC; in Printf out Plist pToken l (",", false) % end - *) fun isIntegral t = case resolveType t of @@ -872,7 +871,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; and parseTypeInParens tk ctx = case tk of TkParens list => - if isTypeNameStart (#1 $ hd list) then + if isTypeNameStart ctx (#1 $ hd list) then let val (ctype, ctx) = ctxWithLayer ctx list parseTypeName in @@ -1348,6 +1347,8 @@ functor Parser(structure Tree: TREE; structure P: PPC; SOME (GsDecl (_, _, t, _)) => (Gid id, not $ isFunc t, convAggr sizeofOrAddr t, NONE) | SOME (GsEnumConst v) => (Gid id, false, int_t, SOME v) + | SOME (GsTypedef _) => + P.error pos `"type in place of an identifier" % | NONE => P.error pos `"unknown identifier" % end end @@ -1836,6 +1837,20 @@ functor Parser(structure Tree: TREE; structure P: PPC; | Econst _ | Estrlit _ => E end + and tryGetTypedefName (Ctx ctx) id = + let + val res = lookup (#globalSyms ctx) id + in + case res of + SOME (GsTypedef bufId) => + let + val { t, ... } = D.get types bufId + in + SOME t + end + | _ => NONE + end + and tryGetSpec ctx = let val (tk, pos, ctx') = getTokenCtx ctx @@ -1855,7 +1870,14 @@ functor Parser(structure Tree: TREE; structure P: PPC; | NONE => ( case List.find cmp2 storageSpecs of SOME (_, spec) => (SOME (StorageSpec spec, pos), ctx') - | NONE => (NONE, ctx) + | NONE => + case tk of + Tk (T.Id id) => ( + case tryGetTypedefName ctx id of + NONE => (NONE, ctx) + | SOME bufId => (SOME (TypeName bufId, pos), ctx') + ) + | _ => (NONE, ctx) ) end @@ -2194,6 +2216,9 @@ functor Parser(structure Tree: TREE; structure P: PPC; collect ctx (storSpec, TypeId $ advanceTypeRepr id (tk, pos)) | (SOME (TypeSpec _, pos), _) => P.error pos `"invalid type specifier" % + | (SOME (TypeName t, _), TypeId 0) => ((storSpec, t), ctx) + | (SOME (TypeName _, pos), _) => + P.error pos `"unexpected typedef'ed name" % end in collect ctx (NONE, TypeId 0) @@ -2290,6 +2315,8 @@ functor Parser(structure Tree: TREE; structure P: PPC; P.error pos `"symbol already denotes a declaration" % | f (SOME (GsEnumConst _)) = P.error pos `"symbol already denotes a enum constast" % + | f (SOME (GsTypedef _)) = + P.error pos `"symbol is already typedef'ed" % val ((), globalSyms) = lookup2 (#globalSyms ctx) id f in @@ -2563,9 +2590,15 @@ functor Parser(structure Tree: TREE; structure P: PPC; | ArrayApplication _ => Printf out `"[]" % *) - and isTypeNameStart tk = - isSome $ List.find - (fn tk' => case tk of Tk tk => tk = tk' | _ => false) typeSpecs + and isTypeNameStart ctx tk = + case List.find (fn tk' => case tk of Tk tk => tk = tk' | _ => false) + typeSpecs of + SOME _ => true + | NONE => ( + case tk of + Tk (T.Id id) => isSome $ tryGetTypedefName ctx id + | _ => false + ) and parseTypeName ctx = let @@ -2644,10 +2677,10 @@ functor Parser(structure Tree: TREE; structure P: PPC; (parts, ctx) end - and isParams list = + and isParams ctx list = case (#1 $ hd list) of Tk T.EOS => true - | tk => isTypeNameStart tk + | tk => isTypeNameStart ctx tk and parseDDeclarator (untilEnd, absPolicy) ctx parts = let @@ -2662,7 +2695,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; P.error pos `"unexpected identifier in abstract declarator" % | (Tk (T.Id id), _) => (Id (id, pos) :: parts, ctx') | (TkParens list, _) => ( - case (isParams list, absPolicy) of + case (isParams ctx list, absPolicy) of (true, APprohibited) => P.clerror (#2 $ hd list) [P.Cid, P.Ctk T.Asterisk] | (true, _) => consAbstruct () @@ -2825,6 +2858,8 @@ functor Parser(structure Tree: TREE; structure P: PPC; | SOME (GsDecl (_, _, _, linkage)) => SOME linkage | SOME (GsEnumConst _) => P.error pos `"symbol is already defined as a enum costant" % + | SOME (GsTypedef _) => + P.error pos `"symbol is already typedef'ed" % in case prevLinkage of SOME linkage => linkage @@ -2894,7 +2929,9 @@ functor Parser(structure Tree: TREE; structure P: PPC; ((), SOME (GsDecl (pos, newClass, t, linkage))) end | f (SOME (GsEnumConst _)) = - P.error pos `"enum constant with such name is already defined" % + P.error pos `"enum constant with such name is already defined" % + | f (SOME (GsTypedef _)) = + P.error pos `"symbol is already typedef'ed" % val () = printf `(class2str class) `" decl " `(link2str linkage) `" " P.?id `": " Pctype t `"\n" % @@ -2987,11 +3024,39 @@ functor Parser(structure Tree: TREE; structure P: PPC; (NONE, ctx) end + fun handleTypedef (C as Ctx ctx) ({ pos, t, id, ini, ... }: rawDecl) = + let + val () = + if isSome ini then + P.error pos `"typedef with initializer" % + else + () + + val id = valOf id + val info = { name = id, pos, t } + val bufId = D.length types + + fun f NONE = ((), SOME (GsTypedef bufId)) + | f (SOME (GsTypedef _)) = + P.error pos `"symbol is already typedef'ed" % + | f (SOME (GsDecl _)) = + P.error pos `"there is a already a declaration with such name" % + | f (SOME (GsEnumConst _)) = + P.error pos `"there is already an enum constant with such name" % + + val ((), globalSyms) = lookup2 (#globalSyms ctx) id f + val () = D.push types info + + val () = printfn `"new typedef'ed name: " P.? id % + in + (NONE, updateCtx C s#globalSyms globalSyms %) + end + fun handleRawDecl ctx (D as { spec, pos, ... }: rawDecl) = case spec of SOME SpecTypedef => if isGlobalScope ctx then - raise Unimplemented + handleTypedef ctx D else P.error pos `"typedef in local scope is not supported\n" % | _ => @@ -3289,7 +3354,7 @@ functor Parser(structure Tree: TREE; structure P: PPC; let val (tk, _, _) = getTokenCtx ctx in - if isTypeNameStart tk then + if isTypeNameStart ctx tk then let val (res, ctx) = parseDeclaration ctx val inits = -- cgit v1.2.3