sizeof, initializers

1 files 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)