Typedef support

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 =