Registration of declarations

1 files changed, 653 insertions, 230 deletions

diff --git a/parser.fun b/parser.fun
index 7b41ee1..ea86fa2 100644
--- a/parser.fun
+++ b/parser.fun
@@ -1,4 +1,4 @@
-functor Parser(P: PPC): PARSER = struct
+functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
 
   structure P = P
   structure T = P.T
@@ -13,7 +13,7 @@ functor Parser(P: PPC): PARSER = struct
     UnopComp |
     UnopLogNeg |
     UnopSizeof |
-    UnopCast of ctype |
+    UnopCast |
 
     UnopPostInc |
     UnopPostDec
@@ -55,7 +55,7 @@ functor Parser(P: PPC): PARSER = struct
     BrComma
 
   and cnum =
-      Ninteger of ctype * Word64.word
+      Ninteger of Word64.word
     | Nfloat of Real32.real
     | Ndouble of Real64.real
 
@@ -66,16 +66,17 @@ functor Parser(P: PPC): PARSER = struct
     EmemberByV of int * exprAug |
     EmemberByP of int * exprAug |
     EfuncCall of exprAug * exprAug list |
-    ETernary of exprAug * exprAug * exprAug |
+    Eternary of exprAug * exprAug * exprAug |
     EsizeofType of ctype |
     Eunop of unop * exprAug |
     Ebinop of binop * exprAug * exprAug
 
-  and exprAug = EAug of expr * P.tkPos
+  and exprAug = EA of expr * P.tkPos * ctype
 
   and binop = BR of binopReg | BinopTernaryIncomplete of exprAug
 
   and ctype =
+    unknown_t |
     void_t |
     char_t |
     uchar_t |
@@ -101,10 +102,13 @@ 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
+  type unopList = (unop * P.tkPos * ctype) list
 
   datatype exprPrefix =
-    NormalPrefix of unopList | SizeofType of unopList * ctype * P.tkPos
+    NormalPrefix of unopList |
+    SizeofType of unopList * ctype * P.tkPos * ctype
+
+  datatype ini = IniExpr of exprAug | IniCompound of ini list
 
   datatype storageSpec =
     SpecTypedef |
@@ -112,26 +116,38 @@ functor Parser(P: PPC): PARSER = struct
     SpecStatic |
     SpecRegister
 
-  type declaredId = {
+  type rawDecl = {
     id: int option,
     pos: P.tkPos,
     spec: storageSpec option,
-    ctype: ctype,
-    value: exprAug option,
+    t: ctype,
+    ini: ini option,
     params: (int option * P.tkPos) list option
   }
 
+  val updateRD = fn z =>
+  let
+    fun from id pos spec t ini params = { id, pos, spec, t, ini, params }
+    fun to f { id, pos, spec, t, ini, params } = f id pos spec t ini params
+  in
+    FRU.makeUpdate6 (from, from, to)
+  end z
+
+  type declaredId = {
+    id: int,
+    pos: P.tkPos,
+    ctype: ctype,
+    ini: ini option
+  }
+
   datatype stmt =
     StmtExpr of exprAug |
-    StmtCompound of declaredId list * stmt list |
+    StmtCompound of (int * ini option) list * stmt list |
     StmtIf of exprAug * stmt * stmt option |
     StmtFor of exprAug option * exprAug option * exprAug option * stmt |
     StmtWhile of exprAug * stmt |
     StmtDoWhile of stmt * exprAug
 
-  datatype def = Declaration of declaredId list |
-    Definition of declaredId * stmt
-
   datatype parseBinopRes = BRbinop of exprPart | BRfinish of int
 
   datatype token =
@@ -141,7 +157,49 @@ functor Parser(P: PPC): PARSER = struct
     TkBraces of (token * P.tkPos) list |
     TkTernary of (token * P.tkPos) list
 
-  type parseCtx = P.t * (token * P.tkPos) list list
+  datatype linkage = LinkInternal | LinkExternal
+  datatype declClass = DeclRegular | DeclTentative | DeclDefined
+  (* datatype id = Lid of int | Gid of int *)
+
+  type objDef = int * P.tkPos * ctype * ini * linkage
+
+  type funcInfo = {
+    name: int,
+    pos: P.tkPos,
+    t: ctype,
+    paramNum: int,
+    localVars: (int * P.tkPos * ctype) vector,
+    stmt: stmt
+  }
+
+  datatype def = Objects of objDef list | Definition of funcInfo
+
+  type nid = int
+
+  type scope = (nid, int) Tree.t
+
+  datatype ctx = Ctx of {
+    localScopes: scope list,
+
+    localVars: (int * P.tkPos * ctype) list,
+    globalDecls: (int, P.tkPos * declClass * ctype * linkage) Tree.t,
+
+    tokenBuf: P.t * (token * P.tkPos) list list
+  }
+
+  val intCompare = fn a => fn b => Int.compare (a, b)
+  val lookup = fn z => Tree.lookup intCompare z
+  val lookup2 = fn z => Tree.lookup2 intCompare z
+
+  fun updateCtx (Ctx ctx) = fn z =>
+  let
+    fun from localScopes localVars globalDecls tokenBuf =
+      { localScopes, localVars, globalDecls, tokenBuf }
+    fun to f { localScopes, localVars, globalDecls, tokenBuf } =
+      f localScopes localVars globalDecls tokenBuf
+  in
+    FRU.makeUpdate4 (from, from, to) ctx (fn (a, f) => z (a, Ctx o f))
+  end
 
   datatype declParts =
     Pointer of int |
@@ -191,44 +249,37 @@ functor Parser(P: PPC): PARSER = struct
     (BrComma, T.Comma, 1, true)
   ]
 
-  fun pStorSpec s out =
-    Printf out `(
-      case s of
-        SpecTypedef => "typedef"
-      | SpecExtern => "extern"
-      | SpecRegister => "register"
-      | SpecStatic => "static"
-    ) %
-
-  val Pctype = fn z =>
+  fun pctype short t out =
   let
-    fun pctype t out =
-    let
-      fun &s = Printf out `s %
-    in
-      case t of
-        void_t => &"void"
-      | char_t => &"char"
-      | uchar_t => &"unsigned char"
-      | short_t => &"short"
-      | ushort_t => &"usigned short"
-      | int_t => &"int"
-      | uint_t => &"unsigned int"
-      | long_t => &"long"
-      | ulong_t => &"unsigned long"
-      | longlong_t => &"long long"
-      | ulonglong_t => &"unsigned long long"
-      | float_t => &"float"
-      | double_t => &"double"
-      | pointer_t (plevel, t) =>
-          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
+    fun &(f, s) = Printf out `(if short then s else f) %
   in
-    bind A1 pctype
-  end z
+    case t of
+      unknown_t => & ("unknown", "u")
+    | void_t => & ("void", "v")
+    | char_t => & ("char", "c")
+    | uchar_t => & ("unsigned char", "C")
+    | short_t => & ("short", "s")
+    | ushort_t => & ("usigned short", "S")
+    | int_t => & ("int", "i")
+    | uint_t => & ("unsigned int", "I")
+    | long_t => & ("long", "l")
+    | ulong_t => & ("unsigned long", "L")
+    | longlong_t => & ("long long", "w")
+    | ulonglong_t => & ("unsigned long long", "W")
+    | float_t => & ("float", "f")
+    | double_t => & ("double", "d")
+    | pointer_t (plevel, t) =>
+        if short then
+          Printf out I plevel A2 pctype true t %
+        else
+          Printf out `"{" I plevel `"} " A2 pctype false t %
+    | function_t (ret, params) => Printf out
+      Plist (pctype short) params (if short then "" else ", ", true)
+        `(if short then "" else " -> ") A2 pctype short ret %
+    | array_t el => Printf out `"[] " A2 pctype short el %
+  end
+
+  val Pctype = fn z => bind A1 (pctype false) z
 
   val typeSpecs = [
       T.kwVoid,
@@ -470,10 +521,14 @@ functor Parser(P: PPC): PARSER = struct
     Printf out Plist pToken l (",", false) %
   end
 
-  fun createParseCtx fname incDirs =
-    (P.create { fname, incDirs, debugMode = false }, [])
+  fun createCtx fname incDirs = Ctx {
+    localScopes = [],
+    localVars = [],
+    globalDecls = Tree.empty,
+    tokenBuf = (P.create { fname, incDirs, debugMode = false }, [])
+  }
 
-  fun getTokenCtx (ppc, []) =
+  fun getToken (ppc, []) =
   let
     fun first T.RParen = "'('"
       | first T.RBracket = "'['"
@@ -527,19 +582,29 @@ functor Parser(P: PPC): PARSER = struct
         (fn (tk, pos, ppc) => (tk, pos, (ppc, []))) $ collect ppc [layer]
     | NONE => (Tk tk, pos, (ppc, []))
   end
-  | getTokenCtx (C as (_, [(Tk T.EOS, pos)] :: _)) =
+  | getToken (C as (_, [(Tk T.EOS, pos)] :: _)) =
     (Tk T.EOS, pos, C)
-  | getTokenCtx (_, [_] :: _) = raise Unreachable
-  | getTokenCtx (_, [] :: _) = raise Unreachable
-  | getTokenCtx (ppc, ((tk, pos) :: tail) :: layers) =
+  | getToken (_, [_] :: _) = raise Unreachable
+  | getToken (_, [] :: _) = raise Unreachable
+  | getToken (ppc, ((tk, pos) :: tail) :: layers) =
     (tk, pos, (ppc, tail :: layers))
 
-  fun ctxWithLayer (ppc, layers) list cl =
+  fun getTokenCtx (C as Ctx { tokenBuf, ... }) =
+  let
+    val (tk, pos, tokenBuf) = getToken tokenBuf
+  in
+    (tk, pos, updateCtx C s#tokenBuf tokenBuf %)
+  end
+
+  fun isGlobalScope (Ctx { localScopes, ... }) = null localScopes
+
+  fun ctxWithLayer (C as Ctx { tokenBuf = (ppc, layers), ... }) list cl =
   let
-    val ctx = (ppc, list :: layers)
+    val ctx = updateCtx C s#tokenBuf (ppc, list :: layers) %
     val (v, ctx) = cl ctx
+    val restore = fn (ppc, layers) => (ppc, tl layers)
   in
-    (v, (fn (ppc, layers) => (ppc, tl layers)) ctx)
+    (v, updateCtx ctx u#tokenBuf restore %)
   end
 
   fun Punop unop out =
@@ -556,7 +621,7 @@ functor Parser(P: PPC): PARSER = struct
     | UnopDeref => ~"*"
     | UnopComp => ~"~"
     | UnopLogNeg => ~"!"
-    | UnopCast ctype => Printf out Pctype ctype %
+    | UnopCast => raise Unreachable
   end
 
   and Pbinop binop out =
@@ -565,60 +630,51 @@ functor Parser(P: PPC): PARSER = struct
       SOME (_, tk, _, _) => Printf out P.Ptk tk %
     | NONE => raise Unreachable
 
-  and printExpr' off (EAug (e, pos)) out =
+  and pexpr e out =
   let
-    val P = fn z =>
-    let
-      fun Ppos out = Printf out `"| " P.PtkPos pos %
-    in
-      bind A0 Ppos
-    end z
-
-    fun member (member, ea) s = Printf out
-      `"(" `s P.?member P `"\n" A2 printExpr' (off + 1) ea `")" %;
+    fun mem (id, ea) s = Printf out A1 pea ea `s P.? id %
   in
-    printf R off %;
     case e of
-      Eid id => Printf out P.?id P %
+      Eid id => Printf out P.? id %
     | Econst (id, n) => (
         case n of
-          Ninteger (t, _) => Printf out P.?id `":" Pctype t `" " P %
-        | Nfloat _ => Printf out P.?id `":float" P %
-        | Ndouble _ => Printf out P.?id `":double" P %
+          Ninteger _ => Printf out P.? id %
+        | Nfloat _ => Printf out P.? id `":float" %
+        | Ndouble _ => Printf out P.? id `":double" %
     )
-    | Estrlit s => Printf out P.?s P %
-    | EmemberByV pair => member pair "."
-    | EmemberByP pair => member pair "->"
-    | EfuncCall (func, args) => (
-      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) =>
-      let
-        val binop =
-          if binop = BrSubscript then
-            "[]"
-          else
-            sprintf A1 Pbinop binop %
-      in
-        Printf out `"(" `binop P `"\n"
-          A2 printExpr (off + 1) left
-          A2 printExpr' (off + 1) right `")" %
-      end
+    | Estrlit id => Printf out P.? id %
+    | EmemberByV p => mem p "."
+    | EmemberByP p => mem p "->"
+    | EsizeofType ctype => Printf out `"sizeof(" Pctype ctype `")" %
+    | EfuncCall (func, args) =>
+        Printf out A1 pea func Plist pea args (", ", true) %
+    | Eternary (cond, ifB, elseB) =>
+        Printf out A1 pea cond `"?" A1 pea ifB `":" A1 pea elseB %
     | Ebinop(BinopTernaryIncomplete _, _, _) => raise Unreachable
-    | ETernary (cond, trueBody, falseBody) =>
-        Printf out `"(?:" P `"\n"
-          A2 printExpr (off + 1) cond
-          A2 printExpr (off + 1) trueBody
-          A2 printExpr' (off + 1) falseBody `")" %
+    | Ebinop(BR binop, left, right) =>
+    let
+      val binop =
+        if binop = BrSubscript then "[]" else sprintf A1 Pbinop binop %
+    in
+      Printf out A1 pea left `" " `binop `" " A1 pea right %
+    end
+    | Eunop (UnopCast, _) => raise Unreachable
+    | Eunop (unop, ea) => Printf out A1 Punop unop `" " A1 pea ea %
   end
 
-  and printExpr off ea out = Printf out A2 printExpr' off ea `"\n" %
+  and pea (EA (e, _, t)) out =
+  let
+    fun pType out = Printf out A2 pctype true t %
+    fun exprPrinter e out =
+      case e of
+        Eid _ | Econst _ | Estrlit _ =>
+          Printf out A1 pexpr e `":" A0 pType %
+      | Eunop (UnopCast, ea) =>
+        Printf out A1 pea ea `"@" A0 pType %
+      | _ => Printf out `"(" A1 pexpr e `"):" A0 pType %
+  in
+    Printf out A1 exprPrinter e %
+  end
 
   and isTypeInParens tk ctx =
     case tk of
@@ -651,28 +707,37 @@ functor Parser(P: PPC): PARSER = struct
     case tk of
       Tk tk => (
         case List.find (fn (tk', _) => tk' = tk) unopPreTable of
-          SOME (_, unop) => parseUnaryPrefix ctx' ((unop, pos) :: acc)
+          SOME (_, unop) =>
+            parseUnaryPrefix ctx' ((unop, pos, unknown_t) :: acc)
         | _ => (NormalPrefix 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)
+            (SizeofType (tl acc, ctype, #2 $ hd acc, ulong_t), ctx)
           else
-            parseUnaryPrefix ctx ((UnopCast ctype, pos) :: acc)
+            parseUnaryPrefix ctx ((UnopCast, pos, ctype) :: acc)
       | NONE => (NormalPrefix acc, ctx)
     )
   end
 
-  and parseBinop ctx endTks =
+  and oneOfEndTks tk terms =
   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
+    fun f idx tk (tk' :: tks) =
+      if tk = tk' then idx else f (idx + 1) tk tks
+      | f _ _ [] = 0
   in
     case tk of
+      Tk tk => f 1 tk terms
+    | _ => 0
+  end
+
+  and parseBinop ctx endTks =
+  let
+    val (tk', pos, ctx) = getTokenCtx ctx
+  in
+    case tk' of
       TkTernary list =>
       let
         val ((_, ea), ctx) = ctxWithLayer ctx list (parseExpr [])
@@ -685,7 +750,7 @@ functor Parser(P: PPC): PARSER = struct
         (BRfinish 0, ctx)
       else
         let
-          val status = oneOfEndTks tk 1 endTks
+          val status = oneOfEndTks tk' endTks
         in
           if status > 0 then
             (BRfinish status, ctx)
@@ -698,33 +763,35 @@ functor Parser(P: PPC): PARSER = struct
     | _ => P.clerror pos [P.Cbinop]
   end
 
-  and parseFuncCall ctx funcEa list pos =
+  and parseFuncCall funcEa pos ctx =
   let
-    fun collectArgs ctx acc =
+    fun collectArgs acc ctx =
     let
       val ((status, ea), ctx) = parseExpr [T.Comma] ctx
     in
       if status = 0 then
         (rev $ ea :: acc, ctx)
       else
-        collectArgs ctx (ea :: acc)
+        collectArgs (ea :: acc) ctx
     end
-    val (args, ctx) = ctxWithLayer ctx list (fn ctx => collectArgs ctx [])
+    val (args, ctx) = collectArgs [] ctx
   in
-    (SOME $ EAug (EfuncCall (funcEa, args), pos), ctx)
+    (SOME $ EA (EfuncCall (funcEa, args), pos, unknown_t), ctx)
   end
 
   and parseExprSuffix1 eAug ctx =
   let
     val (tk, pos1, ctx1) = getTokenCtx ctx
 
-    fun formUnop1 unop = (SOME (EAug (Eunop (unop, eAug), pos1)), ctx1)
+    fun formUnop1 unop =
+      (SOME $ EA (Eunop (unop, eAug), pos1, unknown_t), ctx1)
     fun formMemberOp unop =
     let
       val (tk, pos2, ctx2) = getTokenCtx ctx1
     in
       case tk of
-        Tk (T.Id id) => (SOME (EAug (unop (id, eAug), pos1)), ctx2)
+        Tk (T.Id id) =>
+            (SOME $ EA (unop (id, eAug), pos1, unknown_t), ctx2)
       | _ => P.clerror pos2 [P.Cid]
     end
   in
@@ -737,10 +804,11 @@ functor Parser(P: PPC): PARSER = struct
         let
           val ((_, ea), ctx) =
             ctxWithLayer ctx1 list (parseExpr [])
+          val ea = EA (Ebinop (BR BrSubscript, eAug, ea), pos1, unknown_t)
         in
-          (SOME $ EAug (Ebinop (BR BrSubscript, eAug, ea), pos1), ctx)
+          (SOME ea, ctx)
         end
-    | TkParens list => parseFuncCall ctx1 eAug list pos1
+    | TkParens list => ctxWithLayer ctx1 list (parseFuncCall eAug pos1)
     | _ => (NONE, ctx)
   end
 
@@ -885,9 +953,9 @@ functor Parser(P: PPC): PARSER = struct
   let
     val (num, suffix) = getSuffix pos s
     val (acc, isDec) = collectNum pos num
-    val p = determiteIntNumType isDec (acc, suffix)
+    val (t, v) = determiteIntNumType isDec (acc, suffix)
   in
-    Ninteger p
+    (t, Ninteger v)
   end
 
   and isFPconst s =
@@ -924,10 +992,10 @@ functor Parser(P: PPC): PARSER = struct
       let
         val repr = String.substring (s, 0, String.size s - 1)
       in
-        Nfloat o handleStatus o parseFloat $ repr
+        (float_t, Nfloat o handleStatus o parseFloat $ repr)
       end
     | #"L" => P.error pos `"long double is not supported" %
-    | _ => Ndouble o handleStatus o parseDouble $ s
+    | _ => (double_t, Ndouble o handleStatus o parseDouble $ s)
   end
 
   and parseNumber pos s =
@@ -936,14 +1004,14 @@ functor Parser(P: PPC): PARSER = struct
   and parsePrimaryExpr ctx =
   let
     val (tk, pos, ctx) = getTokenCtx ctx
-    fun wrap e = (EAug (e, pos), ctx)
+    fun wrap e = (EA (e, pos, unknown_t), ctx)
+    fun wrapNum id (t, v) = (EA (Econst (id, v), pos, t), ctx)
   in
     case tk of
       Tk (T.Id id) => wrap $ Eid id
     | Tk (T.Strlit id) => wrap $ Estrlit id
-    | Tk (T.CharConst (id, v)) =>
-        wrap $ Econst (id, Ninteger (int_t, Word64.fromInt v))
-    | Tk (T.Num id) => wrap $ Econst (id, parseNumber pos $ P.?? id)
+    | Tk (T.CharConst (id, v)) => wrapNum id (int_t, Ninteger v)
+    | Tk (T.Num id) => wrapNum id $ parseNumber pos $ P.?? id
     | TkParens list =>
       let
         val ((_, ea), ctx) = ctxWithLayer ctx list (parseExpr [])
@@ -957,8 +1025,8 @@ functor Parser(P: PPC): PARSER = struct
   let
     val (prefix, ctx) = parseUnaryPrefix ctx []
     fun applyPrefix prefix ea =
-        List.foldl (fn ((unop, pos), e) =>
-            EAug (Eunop (unop, e), pos)) ea prefix
+        List.foldl (fn ((unop, pos, t), e) =>
+            EA (Eunop (unop, e), pos, t)) ea prefix
   in
     case prefix of
       NormalPrefix unopList =>
@@ -968,8 +1036,8 @@ functor Parser(P: PPC): PARSER = struct
       in
        (applyPrefix unopList ea, ctx)
       end
-    | SizeofType (unopList, ctype, pos) =>
-        (applyPrefix unopList (EAug (EsizeofType ctype, pos)), ctx)
+    | SizeofType (unopList, ctype, pos, resType) =>
+      (applyPrefix unopList (EA (EsizeofType ctype, pos, resType)), ctx)
   end
 
   and constructExpr parts =
@@ -988,13 +1056,13 @@ functor Parser(P: PPC): PARSER = struct
       val (right, left, vstack) = take2 vstack
       val (binop, pos, _) = hd opstack
 
-      val head = EAug (
+      val head =
         case binop of
           BR binop => Ebinop (BR binop, left, right)
         | BinopTernaryIncomplete trueBody =>
-            ETernary(left, trueBody, right), pos)
+            Eternary(left, trueBody, right)
     in
-      (head :: vstack, tl opstack)
+      (EA (head, pos, unknown_t) :: vstack, tl opstack)
     end
 
     fun insert (Q as (binop, pos, p, _)) (vstack, opstack) =
@@ -1108,9 +1176,16 @@ functor Parser(P: PPC): PARSER = struct
     val (parts, ctx) = parseDeclarator (true, APenforced) [] ctx
     val declId = assembleDeclarator prefix parts
   in
-    (#ctype declId, ctx)
+    (#t declId, ctx)
   end
 
+  and checkParamStorSpec ({ spec = spec, pos, ... }: rawDecl) =
+    case spec of
+      SOME SpecRegister =>
+        P.warning pos `"declaration with register storage specifier" %
+    | SOME _ => P.error pos `"parameter with invalid storage specifier" %
+    | _ => ()
+
   and parseFuncParams ctx =
   let
     fun collect ctx acc =
@@ -1119,6 +1194,7 @@ functor Parser(P: PPC): PARSER = struct
       val (parts, ctx) = parseDeclarator (false, APpermitted) [] ctx
       val declaredId = assembleDeclarator prefix parts
 
+      val () = checkParamStorSpec declaredId
       val (tk, pos, ctx) = getTokenCtx ctx
     in
       case tk of
@@ -1138,7 +1214,7 @@ functor Parser(P: PPC): PARSER = struct
 
     val (params, ctx) = collect2 ()
     val params =
-      map (fn { id, pos, ctype, ... } => (id, pos, ctype)) params
+      map (fn { id, pos, t, ... } => (id, pos, t)) params
   in
     (FuncApp params, ctx)
   end
@@ -1180,7 +1256,7 @@ functor Parser(P: PPC): PARSER = struct
           else
             (Id (id, pos) :: parts, ctx')
       | TkParens list => ctxWithLayer ctx' list
-                (fn ctx => parseDeclarator (true, absPolicy) parts ctx)
+                (parseDeclarator (true, absPolicy) parts)
       | _ => (
           case absPolicy of
             APprohibited => P.clerror pos [P.Cid, P.Ctk T.LParen]
@@ -1254,75 +1330,310 @@ functor Parser(P: PPC): PARSER = struct
       | _ => NONE
 
   in
-    { id, pos, spec = storSpec, ctype = complete $ tl parts,
-        value = NONE, params }
+    { id, pos, spec = storSpec, t = complete $ tl parts,
+        ini = NONE, params }
+  end
+
+  fun printIni (IniExpr ea) out = Printf out A1 pea ea %
+    | printIni (IniCompound inis) out = Printf out
+        `"{" Plist (printIni) inis (", ", false) `"}" %
+
+  fun pDeclId off ({ id, ctype, ini, pos = _}: declaredId) out =
+    Printf out R off
+        P.?id `": " Pctype ctype
+        Popt (fn ini => fn out =>
+            Printf out `" = " A1 printIni ini %) ini `"\n" %
+
+  fun dieExpTerms pos terms = P.clerror pos $ map P.Ctk terms
+
+  fun parseCompoundInitializer ctx =
+  let
+    fun collect ctx acc =
+    let
+      val (status, ini, ctx) = parseInitializer [T.Comma] ctx
+    in
+      if status = 0 then
+        (rev $ ini :: acc, ctx)
+      else
+        collect ctx (ini :: acc)
+    end
+
+    val (inis, ctx) = collect ctx []
+  in
+    (IniCompound inis, ctx)
+  end
+
+  and parseInitializer terms ctx =
+  let
+    val (tk, _, ctx') = getTokenCtx ctx
+  in
+    case tk of
+      TkBraces list =>
+      let
+        val (ini, ctx) = ctxWithLayer ctx' list parseCompoundInitializer
+        val (tk, pos, ctx) = getTokenCtx ctx
+        val status = oneOfEndTks tk terms
+      in
+        if status = 0 then
+          dieExpTerms pos terms
+        else
+          (status, ini, ctx)
+      end
+    | _ =>
+      let
+        val ((status, ea), ctx) = parseExpr terms ctx
+        fun isToplev [_, _] = true
+          | isToplev _ = false
+      in
+        if status = 0 andalso isToplev terms then
+          dieExpTerms (#2 $ getTokenCtx ctx) terms
+        else
+          (status, IniExpr ea, ctx)
+      end
+  end
+
+  fun tryParseInitializer ctx rawId =
+  let
+    val (status, ini, ctx) = parseInitializer [T.Comma, T.Semicolon] ctx
+  in
+    (status, updateRD rawId s#ini (SOME ini) %, ctx)
   end
 
-  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 (printExpr (off + 1)) value %;
+  val isFunc = fn
+      function_t _ => true
+    | _ => false
+
+  val isScalar = fn
+      function_t _ | array_t _ => false
+    | _ => true
 
-    case params of
-      NONE => ()
-    | SOME params => Printf out `"params: "
-        Plist (poptN "none" P.psid) (map #1 params) (", ", false) `"\n" %
-  )
+  fun getLinkage ctx (D as { spec = NONE, t, ... }) =
+    if isFunc t then
+      getLinkage ctx (updateRD D s#spec (SOME SpecExtern) %)
+    else
+      LinkExternal
+    | getLinkage _ { spec = SOME SpecStatic, ... } = LinkInternal
+    | getLinkage (Ctx ctx) { spec = SOME SpecExtern, id, ... } =
+    let
+      val prevLinkage =
+        case lookup (#globalDecls ctx) (valOf id) of
+          NONE => NONE
+        | SOME (_, _, _, linkage) => SOME linkage
+    in
+      case prevLinkage of
+        SOME linkage => linkage
+      | NONE => LinkExternal
+    end
+   | getLinkage _ { pos, ... } =
+      P.error pos `"declaration with invalid storage specifier" %
 
-  datatype declaration =
-    DeclIds of declaredId list |
-    FuncDef of declaredId * (token * P.tkPos) list
+  fun getToplevFuncDeclKind ctx (D as { id, pos, t, ... }: rawDecl) =
+  let
+    val linkage = getLinkage ctx D
+  in
+    (DeclRegular, (valOf id, pos, t, linkage), NONE)
+  end
+
+  fun getToplevObjDeclKind ctx
+    (D as { ini, id, pos, t, spec, ... }: rawDecl) =
+  let
+    val linkage = getLinkage ctx D
+    val decl = (valOf id, pos, t, linkage)
+  in
+    case ini of
+      SOME _ => (DeclDefined, decl, ini)
+    | NONE =>
+      let
+        val class =
+          case spec of
+            SOME SpecExtern => DeclRegular
+          | NONE | SOME SpecStatic =>
+              if isFunc t then DeclRegular else DeclTentative
+          | _ => raise Unreachable
+      in
+        (class, decl, ini)
+      end
+  end
+
+  fun getToplevDeclKind ctx (id as { t, ... }: rawDecl) =
+    (if isFunc t then getToplevFuncDeclKind else getToplevObjDeclKind)
+        ctx id
+
+  fun link2str LinkInternal = "internal"
+    | link2str LinkExternal = "external"
+
+  fun class2str DeclRegular = "regular"
+    | class2str DeclTentative = "tentative"
+    | class2str DeclDefined = "definition"
+
+  fun addDeclaration (Ctx ctx) (id, pos, t, linkage) class =
+  let
+    fun f NONE = ((), SOME (pos, class, t, linkage))
+      | f (SOME (_, class', t', linkage')) =
+      if linkage' <> linkage then
+        P.error pos `"declaration linkage conflict" %
+      else if t <> t' then
+        P.error pos `"declaration type conflict" %
+      else
+        let
+          val newClass =
+            case (class, class') of
+              (DeclRegular, DeclRegular) => DeclRegular
+            | (DeclRegular, DeclTentative) | (DeclTentative, DeclRegular) |
+              (DeclTentative, DeclTentative) => DeclTentative
+            | (DeclDefined, DeclDefined) =>
+                P.error pos `"redefinition" %
+            | _ => DeclDefined
+        in
+          ((), SOME (pos, newClass, t, linkage))
+        end
+
+    val () = printf `(class2str class) `" decl "
+      `(link2str linkage) `" " P.?id `": " Pctype t `"\n" %
+    val ((), tree) = lookup2 (#globalDecls ctx) id f
+  in
+    updateCtx (Ctx ctx) s#globalDecls tree %
+  end
+
+  datatype idData = ToplevId of objDef | LocalId of int * ini option
+
+  fun handleToplevDecl ctx rawDecl =
+  let
+    val (class, D as (id, pos, t, linkage), ini) =
+        getToplevDeclKind ctx rawDecl
+    val ctx = addDeclaration ctx D class
+  in
+    if class = DeclDefined then
+      (SOME $ ToplevId (id, pos, t, valOf ini, linkage), ctx)
+    else
+      (NONE, ctx)
+  end
+
+  fun warnRegister pos (SOME SpecRegister) =
+    P.warning pos `"register storage specifier" %
+    | warnRegister _ _ = ()
+
+  fun checkLocalVarType pos t =
+    if isFunc t then
+      P.error pos `"variable with function type" %
+    else
+      ()
+
+  fun insertLocalVar (Ctx ctx) ({ id, pos, t, ... }: rawDecl) =
+  let
+    val id = valOf id
+    val scope = hd $ #localScopes ctx
+    val oldVal = lookup scope id
+  in
+    case oldVal of
+      SOME _ => P.error pos `"local variable redefinition" %
+    | NONE =>
+        let
+          val varId = length $ #localVars ctx
+          val localVars = (id, pos, t) :: #localVars ctx
+          val (_, scope) = Tree.insert intCompare scope id varId
+        in
+          (varId, id, updateCtx (Ctx ctx)
+            u#localScopes (fn scs => scope :: tl scs)
+            s#localVars localVars %)
+        end
+  end
+
+  fun handleLocalVar ctx (D as { spec, pos, t, ini, ... }: rawDecl) =
+  let
+    val () = warnRegister pos spec
+    val () = checkLocalVarType pos t
+    val (varId, nid, ctx) = insertLocalVar ctx D
+
+    val offset = case ctx of Ctx v => length $ #localScopes v
+  in
+    printf R offset
+        `"local var " P.?nid `"(" I varId `"): " Pctype t `"\n" %;
+
+    if isSome ini orelse not $ isScalar t then
+      (SOME $ LocalId (varId, ini), ctx)
+    else
+      (NONE, ctx)
+  end
+
+  fun handleRawDecl ctx (D as { spec, pos, ... }: rawDecl) =
+    case spec of
+      SOME SpecTypedef => P.error pos `"typedef is not supported yet\n" %
+    | _ =>
+      (if isGlobalScope ctx then handleToplevDecl else handleLocalVar)
+        ctx D
 
   datatype fdecRes =
-    FDnormal of bool * declaredId | FDFuncDef of declaration
+    FDnormal of (bool * idData option) |
+    FDFuncDef of rawDecl * (token * P.tkPos) list
 
-  fun finishDeclarator (declId: declaredId) expectFDef ctx =
+  fun finishDeclarator rawId expectFdef ctx =
   let
     val (tk, pos, ctx) = getTokenCtx ctx
+    fun ret continue rawId ctx =
+    let
+      val (def, ctx) = handleRawDecl ctx rawId
+    in
+      (FDnormal (continue, def), ctx)
+    end
   in
     case tk of
-      Tk T.Comma => (FDnormal (true, declId), ctx)
-    | Tk T.Semicolon => (FDnormal (false, declId), ctx)
+      Tk T.Comma => ret true rawId ctx
+    | Tk T.Semicolon => ret false rawId 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 }
+        val (status, rawId, ctx) = tryParseInitializer ctx rawId
       in
-        if status = 0 then
-          P.clerror pos [P.Ctk T.Comma, P.Ctk T.Semicolon]
-        else
-          (FDnormal (status = 1, declId), ctx)
+        ret (status = 1) rawId ctx
       end
     | _ =>
-      if expectFDef then
+      if expectFdef then
         case tk of
-          TkBraces list => (FDFuncDef $ FuncDef (declId, list), ctx)
+          TkBraces list => (FDFuncDef (rawId, 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 =
+  datatype toplev =
+    ObjDefs of objDef list |
+    LocalVarInits of (int * ini option) list |
+    FuncDef of rawDecl * (token * P.tkPos) list
+
+  fun parseDeclaration ctx =
   let
+    val toplev = isGlobalScope ctx
     val (prefix, ctx) = parseDeclPrefix ctx
 
+    fun finishNormal acc =
+    let
+      val acc = rev acc
+    in
+      if toplev then
+        ObjDefs $ map (fn ToplevId v => v | _ => raise Unreachable) acc
+      else
+        LocalVarInits $ map (fn LocalId v => v | _ => raise Unreachable)
+          acc
+    end
+
     fun collectDeclarators acc ctx =
     let
+      fun add (SOME v) = v :: acc
+        | add NONE = acc
+
       val (parts, ctx) = parseDeclarator (false, APprohibited) [] ctx
-      val declaredId = assembleDeclarator prefix parts
-      val (res, ctx) = finishDeclarator declaredId
-            (expectFdef andalso null acc) ctx
+      val declIdRaw = assembleDeclarator prefix parts
+      val (res, ctx) = finishDeclarator declIdRaw
+            (toplev andalso null acc) ctx
     in
       case res of
-        FDFuncDef fd => (fd, ctx)
-      | FDnormal (continue, declId) =>
+        FDFuncDef fd => (FuncDef fd, ctx)
+      | FDnormal (continue, toplevMaybe) =>
         if continue then
-          collectDeclarators (declId :: acc) ctx
+          collectDeclarators (add toplevMaybe) ctx
         else
-          (DeclIds $ rev $ declId :: acc, ctx)
+          (finishNormal $ add toplevMaybe, ctx)
     end
   in
     collectDeclarators [] ctx
@@ -1333,8 +1644,7 @@ functor Parser(P: PPC): PARSER = struct
     val (tk, _, ctx') = getTokenCtx ctx
   in
     case tk of
-      TkBraces list =>
-        ctxWithLayer ctx' list (fn ctx => parseStmtCompound ctx)
+      TkBraces list => ctxWithLayer ctx' list (parseStmtCompound false)
     | Tk T.kwIf => parseStmtIf ctx'
     | Tk T.kwFor => parseStmtFor ctx'
     | Tk T.kwWhile => parseStmtWhile ctx'
@@ -1428,8 +1738,24 @@ functor Parser(P: PPC): PARSER = struct
 
   and parseStmtDoWhile ctx =
   let
+    fun skipExpected expectedTk ctx =
+    let
+      val (tk, pos, ctx) = getTokenCtx ctx
+      fun die () = P.clerror pos [P.Ctk expectedTk]
+    in
+      case tk of
+        Tk tk =>
+          if tk = expectedTk then
+            ctx
+          else
+            die ()
+      | _ => die ()
+    end
+
     val (stmt, ctx) = parseStmt ctx
+    val ctx = skipExpected T.kwWhile ctx
     val (cond, ctx) = parseExprInParens ctx
+    val ctx = skipExpected T.Semicolon ctx
   in
     (StmtDoWhile (stmt, cond), ctx)
   end
@@ -1444,7 +1770,7 @@ functor Parser(P: PPC): PARSER = struct
       (StmtExpr ea, ctx)
   end
 
-  and parseStmtCompound ctx =
+  and parseStmtCompound isFuncBody ctx =
   let
     fun collectDecls acc ctx =
     let
@@ -1452,16 +1778,16 @@ functor Parser(P: PPC): PARSER = struct
     in
       if isTypeNameStart tk then
         let
-          val (decl, ctx) = parseDeclaration ctx false
-          val declaredIds =
-            case decl of
-              DeclIds ids => ids
+          val (res , ctx) = parseDeclaration ctx
+          val inits =
+            case res of
+              LocalVarInits l => l
             | _ => raise Unreachable
         in
-          collectDecls (declaredIds :: acc) ctx
+          collectDecls (List.revAppend (inits, acc)) ctx
         end
       else
-        (List.concat $ rev acc, ctx)
+        (rev acc, ctx)
     end
 
     fun collectStmts acc ctx =
@@ -1478,57 +1804,155 @@ functor Parser(P: PPC): PARSER = struct
         end
     end
 
-    val (decls, ctx) = collectDecls [] ctx
+    val ctx =
+      if isFuncBody then
+        ctx
+      else
+        updateCtx ctx u#localScopes (fn scs => Tree.empty :: scs) %
+
+    val (inits, ctx) = collectDecls [] ctx
     val (stmts, ctx) = collectStmts [] ctx
+
+    val ctx = updateCtx ctx u#localScopes tl %
   in
-    (StmtCompound (decls, stmts), ctx)
+    (StmtCompound (rev inits, stmts), ctx)
   end
 
-  fun pstmt off (StmtCompound (decls, stmts)) out =
-    Printf out R off `"{\n"
-      Plist (pDeclId (off + 1)) decls ("", false)
-        `(if null decls then "" else "\n")
+  fun pinit off (id, ini) out =
+    Printf out R off
+        `"%" I id `" = " A3 poptN "alloc" printIni ini `"\n" %
+
+  fun pstmt' off (StmtCompound (inits, stmts)) out =
+    Printf out `"{\n"
+      Plist (pinit (off + 1)) inits ("", false)
       Plist (pstmt (off + 1)) stmts ("\n", false)
-      R off `"}\n" %
+      R off `"}" %
 
-    | pstmt off (StmtExpr ea) out =
-      Printf out A2 printExpr' off ea `";\n" %
+    | pstmt' _ (StmtExpr ea) out = Printf out A1 pea ea `";" %
 
-    | pstmt off (StmtIf (cond, ifBody, elseBody)) out = (
-      Printf out R off `"if\n" A2 printExpr (off + 1) cond
-          `"\n" A2 pstmt (off + 1) ifBody %;
-      case elseBody of
-        NONE => ()
-      | SOME stmt => Printf out R off `"else\n" A2 pstmt (off + 1) stmt %
-    )
-    | pstmt off (StmtFor (pre, cond, post, body)) out =
-    let
-      fun pe NONE out = Printf out R (off + 1) `"none\n" %
-        | pe (SOME expr) out = Printf out A2 printExpr (off + 1) expr %
-    in
-      Printf out R off `"for\n" A1 pe pre A1 pe cond A1 pe post
-        `"\n" A2 pstmt (off + 1) body %
-    end
-    | pstmt off (StmtWhile (cond, body)) out =
-      Printf out R off `"while\n" A2 printExpr (off + 1) cond
-        `"\n" A2 pstmt (off + 1) body %
-    | pstmt off (StmtDoWhile (body, cond)) out =
-      Printf out R off `"do\n" A2 pstmt (off + 1) body
-        `"\n" A2 printExpr (off + 1) cond %
+    | pstmt' off (StmtIf (cond, ifBody, elseBody)) out =
+      Printf out `"if " A1 pea cond `" " A2 pCompBody (off + 1) ifBody
+      Popt (fn stmt => fn out =>
+        Printf out R off `"else " A2 pCompBody (off + 1) stmt %) elseBody %
+
+    | pstmt' off (StmtFor (pre, cond, post, body)) out =
+      Printf out
+        `"for " Popt pea pre `"; " Popt pea cond `"; " Popt pea post
+        A2 pCompBody (off + 1) body %
+
+    | pstmt' off (StmtWhile (cond, body)) out =
+      Printf out `"while " A1 pea cond `" "
+        A2 pCompBody (off + 1) body %
+
+    | pstmt' off (StmtDoWhile (body, cond)) out =
+      Printf out `"do " A2 pCompBody (off + 1) body
+        `" " A1 pea cond `";" %
+
+  and pCompBody off (S as (StmtCompound _)) out =
+    Printf out A2 pstmt' (off - 1) S %
+    | pCompBody (off:int) stmt out = Printf out `"\n" A2 pstmt off stmt %
+
+  and pstmt off stmt out = Printf out R off A2 pstmt' off stmt `"\n" %
 
   val Pstmt = fn z => bind A2 pstmt z
 
-  fun parseFuncDefinition id ctx =
+  fun validateFuncHeader ({ t, pos, params, ... }: rawDecl) =
   let
-    val (stmt, ctx) = parseStmtCompound ctx
+    val () =
+      if not $ isFunc t then
+        P.error pos `"identifier not of function type\n" %
+      else
+        ()
+    fun checkParams [] = ()
+      | checkParams ((id, pos) :: tail) =
+        case id of
+          NONE => P.error pos `"expected parameter name\n" %
+        | SOME _ => checkParams tail
+  in
+    checkParams $ valOf params
+  end
+
+  fun ctxPrepareForFunc ctx t params =
+  let
+    val paramTypes =
+      case t of function_t (_, ts) => ts | _ => raise Unreachable
+
+    fun createLocalVars acc [] [] = acc
+      | createLocalVars acc (t :: ts) ((id, pos) :: params) =
+        createLocalVars ((valOf id, pos, t) :: acc) ts params
+      | createLocalVars _ _ _ = raise Unreachable
+
+    val localVars = createLocalVars [] paramTypes params
   in
-    (Definition (id, stmt), ctx)
+    updateCtx ctx s#localVars localVars s#localScopes [Tree.empty] %
   end
 
-  fun printDef (Definition (id, stmt)) =
-    printf `"Function: " A2 pDeclId 0 id Pstmt 0 stmt %
-  | printDef (Declaration ids) =
-        printf Plist (pDeclId 0) ids ("", false) %
+  fun finishLocalVars (Ctx ctx) = Vector.fromList o rev o #localVars $ ctx
+
+  fun parseFuncDefinition (D as { id, pos, t, params, ... }: rawDecl) ctx =
+  let
+    val () = validateFuncHeader D
+    val (id, params) = (valOf id, valOf params)
+
+    val ctx = ctxPrepareForFunc ctx t params
+
+    val linkage = getLinkage ctx D
+    val ctx = addDeclaration ctx (id, pos, t, linkage) DeclDefined
+
+    val (stmt, ctx) = parseStmtCompound true ctx
+    val localVars = finishLocalVars ctx
+  in
+    (Definition {
+        name = id,
+        pos,
+        t,
+        paramNum = length params,
+        localVars,
+        stmt },
+    ctx)
+  end
+
+  fun printFuncHeader ({ name, localVars, paramNum, t, ... }: funcInfo) =
+  let
+    fun getParams acc idx =
+      if idx = paramNum then
+        rev acc
+      else
+        let
+          val param = #3 $ Vector.sub (localVars, idx)
+        in
+          getParams ((idx, param) :: acc) (idx + 1)
+        end
+
+    val params = getParams [] 0
+    fun printParam (id, t) out = Printf out `"%" I id `": " Pctype t %
+    val ret = case t of function_t (ret, _) => ret | _ => raise Unreachable
+  in
+    printf P.?name Plist printParam params (", ", true)
+        `" -> " Pctype ret `"\n" %
+  end
+
+  fun printDef (Objects objs) =
+  let
+    fun pobj (id, _, t, ini, linkage) out =
+    let
+      val link = if linkage = LinkInternal then "static" else "global"
+    in
+      Printf out `link `" " P.?id `":" Pctype t
+        `" = " A1 printIni ini `"\n" %
+    end
+  in
+    printf Plist pobj objs ("", false) %
+  end
+  | printDef (Definition (D as { stmt, localVars, ... })) =
+  let
+    fun pLocalVar i (id, _, t) out =
+      Printf out `"%" I i `"(" P.?id `"): " Pctype t `"\n" %
+  in
+    printFuncHeader D;
+    printf Pstmt 0 stmt %;
+    Vector.appi (fn (i, var) => printf A2 pLocalVar i var %) localVars
+  end
 
   fun parseDef ctx =
   let
@@ -1538,14 +1962,13 @@ functor Parser(P: PPC): PARSER = struct
       Tk T.EOS => NONE
     | _ =>
       let
-        val (toplev, ctx) = parseDeclaration ctx true
+        val (toplev, ctx) = parseDeclaration ctx
       in
         SOME (case toplev of
-          DeclIds ids => (Declaration ids, ctx)
+          ObjDefs objDefList => (Objects objDefList, ctx)
         | FuncDef (id, body) =>
-            ctxWithLayer ctx body (fn ctx =>
-              parseFuncDefinition id ctx))
+            ctxWithLayer ctx body (parseFuncDefinition id)
+        | LocalVarInits _ => raise Unreachable)
       end
-
   end
 end