Proper constant parsing

1 files changed, 195 insertions, 4 deletions

diff --git a/parser.fun b/parser.fun
index 5e69692..7b41ee1 100644
--- a/parser.fun
+++ b/parser.fun
@@ -54,9 +54,14 @@ functor Parser(P: PPC): PARSER = struct
 
     BrComma
 
+  and cnum =
+      Ninteger of ctype * Word64.word
+    | Nfloat of Real32.real
+    | Ndouble of Real64.real
+
   and expr =
-    Enum |
     Eid of int |
+    Econst of int * cnum |
     Estrlit of int |
     EmemberByV of int * exprAug |
     EmemberByP of int * exprAug |
@@ -575,7 +580,12 @@ functor Parser(P: PPC): PARSER = struct
     printf R off %;
     case e of
       Eid id => Printf out P.?id P %
-    | Enum => Printf out `"num" P %
+    | 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 %
+    )
     | Estrlit s => Printf out P.?s P %
     | EmemberByV pair => member pair "."
     | EmemberByP pair => member pair "->"
@@ -743,6 +753,186 @@ functor Parser(P: PPC): PARSER = struct
     | NONE => (eAug, ctx)
   end
 
+  and determineMinNumType candidates acc =
+  let
+    open IntInf
+    fun p n = pow (fromInt 2, n)
+
+    val limits = [
+        (int_t, p 31),
+        (uint_t, p 32),
+        (long_t, p 63),
+        (ulong_t, p 64)
+    ]
+
+    fun findLimit longlong_t = p 63
+      | findLimit ulonglong_t = p 64
+      | findLimit ctype =
+        case List.find (fn (t, _) => t = ctype) limits of
+          NONE => raise Unreachable
+        | SOME (_, limit) => limit
+
+    fun find [] = (ulonglong_t, Word64.fromLargeInt acc)
+      | find (t :: tail) =
+        if acc < (findLimit t) then
+          (t, Word64.fromLargeInt acc)
+        else
+          find tail
+  in
+    find candidates
+  end
+
+  and getSuffix pos repr =
+  let
+
+    fun suffixChar c =
+    let
+      val c = Char.toLower c
+    in
+      c = #"u" orelse c = #"l"
+    end
+
+    fun findBorder idx =
+      if suffixChar $ String.sub (repr, idx) then
+        findBorder (idx - 1)
+      else
+        idx + 1
+
+    val startIdx = findBorder $ String.size repr - 1
+    val suffix = String.extract (repr, startIdx, NONE)
+
+    val suffixCode =
+      case suffix of
+        "" => 0
+      | "u" | "U" => 1
+      | "l" | "L" => 2
+      | "ul" | "uL" | "Ul" | "UL" | "lu" | "lU" | "Lu" | "LU" => 3
+      | "ll" | "LL" => 4
+      | "ull" | "uLL" | "Ull" | "ULL" | "llu" | "llU" | "LLu" | "LLU" => 5
+      | _ => P.error pos `"unknown integer constant suffix" %
+  in
+    (String.substring (repr, 0, startIdx), suffixCode)
+  end
+
+  and determiteIntNumType isDec (acc, suffix) =
+  let
+    val candidates = [
+     ([int_t, long_t, longlong_t], [int_t, uint_t, long_t, ulong_t,
+        longlong_t]),
+     ([uint_t, ulong_t], [uint_t, ulong_t]),
+     ([long_t, longlong_t], [long_t, ulong_t, longlong_t]),
+     ([ulong_t], [ulong_t]),
+     ([longlong_t], [longlong_t]),
+     ([], [])
+    ]
+
+    val candArray = Array.fromList candidates
+    val (dec, other) = Array.sub (candArray, suffix)
+  in
+    determineMinNumType (if isDec then dec else other) acc
+  end
+
+  and parseNumGeneric (pos, conv) (idx, s) acc radix =
+    if idx = String.size s then
+      acc
+    else
+      let
+        val d =
+          case conv $ String.sub (s, idx) of
+            NONE => P.error pos `"invalid integer constant" %
+          | SOME v => IntInf.fromInt v
+        val idx = idx + 1
+        open IntInf
+      in
+        parseNumGeneric (pos, conv) (idx, s)
+            (acc * radix + d) radix
+      end
+
+  and collectNum pos num =
+  let
+    fun hexDigit c =
+      if Char.isDigit c then
+        SOME $ ord c - ord #"0"
+      else if Char.isHexDigit c then
+        SOME $ ord c - ord #"a" + 10
+      else
+        NONE
+
+    fun octDigit c =
+      if ord c >= ord #"0" andalso ord c < ord #"8" then
+        SOME $ ord c - ord #"0"
+      else
+        NONE
+
+    fun decDigit c =
+      if Char.isDigit c then
+        SOME $ ord c - ord #"0"
+      else
+        NONE
+  in
+    if String.sub (num, 0) = #"0" then
+      (if String.size num > 1 andalso
+        Char.toLower (String.sub (num, 1)) = #"x"
+      then
+        parseNumGeneric (pos, hexDigit) (2, num) 0 16
+      else
+        parseNumGeneric (pos, octDigit) (1, num) 0 8, false)
+    else
+      (parseNumGeneric (pos, decDigit) (0, num) 0 10, true)
+  end
+
+  and parseInteger pos s =
+  let
+    val (num, suffix) = getSuffix pos s
+    val (acc, isDec) = collectNum pos num
+    val p = determiteIntNumType isDec (acc, suffix)
+  in
+    Ninteger p
+  end
+
+  and isFPconst s =
+  let
+    open String
+    fun find idx =
+      if idx = size s then
+        false
+      else
+        case sub (s, idx) of
+          #"." | #"e" | #"E" => true
+        | c =>
+          if Char.isDigit c then
+            find (idx + 1)
+          else
+            false
+  in
+    find 0
+  end
+
+  and parseFP pos s =
+  let
+    val lastC = String.sub (s, String.size s - 1)
+    fun handleStatus (status, v) =
+      case status of
+        0 => v
+      | 1 => P.error pos `"floating-point constant overflow" %
+      | ~1 => P.error pos `"floating-point constant underflow" %
+      | 2 => P.error pos `"invalid floating-point constant" %
+      | _ => raise Unreachable
+  in
+    case Char.toLower lastC of
+      #"f" =>
+      let
+        val repr = String.substring (s, 0, String.size s - 1)
+      in
+        Nfloat o handleStatus o parseFloat $ repr
+      end
+    | #"L" => P.error pos `"long double is not supported" %
+    | _ => Ndouble o handleStatus o parseDouble $ s
+  end
+
+  and parseNumber pos s =
+    (if isFPconst s then parseFP else parseInteger) pos s
+
   and parsePrimaryExpr ctx =
   let
     val (tk, pos, ctx) = getTokenCtx ctx
@@ -751,8 +941,9 @@ functor Parser(P: PPC): PARSER = struct
     case tk of
       Tk (T.Id id) => wrap $ Eid id
     | Tk (T.Strlit id) => wrap $ Estrlit id
-    | Tk (T.CharConst _) => raise Unimplemented
-    | Tk (T.Num _) => wrap Enum
+    | 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)
     | TkParens list =>
       let
         val ((_, ea), ctx) = ctxWithLayer ctx list (parseExpr [])