diff options
Diffstat (limited to 'parser.fun')
| -rw-r--r-- | parser.fun | 199 |
1 files changed, 195 insertions, 4 deletions
@@ -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 []) |