Remove fp support

1 files changed, 111 insertions, 44 deletions

diff --git a/parser.fun b/parser.fun
index e0cd0ba..97b091d 100644
--- a/parser.fun
+++ b/parser.fun
@@ -90,9 +90,10 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     ulong_t |
     longlong_t |
     ulonglong_t |
+    (*
     float_t |
     double_t |
-
+    *)
     pointer_t of int * ctype |
     function_t of ctype * ctype list |
     array_t of Word64.word * ctype
@@ -141,7 +142,10 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     StmtIf of exprAug * stmt * stmt option |
     StmtFor of exprAug option * exprAug option * exprAug option * stmt |
     StmtWhile of exprAug * stmt |
-    StmtDoWhile of stmt * exprAug
+    StmtDoWhile of stmt * exprAug |
+    StmtReturn of exprAug |
+    StmtBreak |
+    StmtContinue
 
   datatype parseBinopRes = BRbinop of exprPart | BRfinish of int
 
@@ -178,7 +182,9 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     localVars: (int * P.tkPos * ctype) list,
     globalDecls: (int, P.tkPos * declClass * ctype * linkage) Tree.t,
 
-    tokenBuf: P.t * (token * P.tkPos) list list
+    tokenBuf: P.t * (token * P.tkPos) list list,
+
+    loopLevel: int
   }
 
   val intCompare = fn a => fn b => Int.compare (a, b)
@@ -187,12 +193,12 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
 
   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
+    fun from localScopes localVars globalDecls tokenBuf loopLevel =
+      { localScopes, localVars, globalDecls, tokenBuf, loopLevel }
+    fun to f { localScopes, localVars, globalDecls, tokenBuf, loopLevel } =
+      f localScopes localVars globalDecls tokenBuf loopLevel
   in
-    FRU.makeUpdate4 (from, from, to) ctx (fn (a, f) => z (a, Ctx o f))
+    FRU.makeUpdate5 (from, from, to) ctx (fn (a, f) => z (a, Ctx o f))
   end
 
   datatype declParts =
@@ -260,8 +266,10 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     | 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 %
@@ -323,8 +331,10 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
         [T.kwSigned, T.kwLong, T.kwLong, T.kwInt]]),
     (ulonglong_t, [[T.kwUnsigned, T.kwLong, T.kwLong],
         [T.kwUnsigned, T.kwLong, T.kwLong, T.kwInt]]),
+    (*
     (float_t, [[T.kwFloat]]),
     (double_t, [[T.kwDouble]])
+    *)
   ]
 
   fun genReprChildren l =
@@ -523,8 +533,8 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
 
   fun isArith t =
     case t of
-      float_t | double_t => true
-    | t => isIntegral t
+      (* float_t | double_t => true | *)
+      _ => isIntegral t
 
   fun isScalar t =
     case t of
@@ -543,9 +553,21 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     localScopes = [],
     localVars = [],
     globalDecls = Tree.empty,
-    tokenBuf = (P.create { fname, incDirs, debugMode = false }, [])
+    tokenBuf = (P.create { fname, incDirs, debugMode = false }, []),
+    loopLevel = 0
   }
 
+  fun loopWrapper ctx f =
+  let
+    val ctx = updateCtx ctx u#loopLevel (fn l => l + 1) %
+    val (r, ctx) = f ctx
+    val ctx = updateCtx ctx u#loopLevel (fn l => l - 1) %
+  in
+    (r, ctx)
+  end
+
+  fun isInLoop (Ctx ctx) = #loopLevel ctx > 0
+
   fun getToken (ppc, []) =
   let
     fun first T.RParen = "'('"
@@ -668,7 +690,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     | EmemberByP p => mem p "->"
     | EsizeofType ctype => Printf out `"sizeof(" Pctype ctype `")" %
     | EfuncCall (func, args) =>
-        Printf out A1 pea func Plist pea args (", ", true) %
+        Printf out `"fcall " A1 pea func `", " Plist pea args (", ", false) %
     | Eternary (cond, ifB, elseB) =>
         Printf out A1 pea cond `"?" A1 pea ifB `":" A1 pea elseB %
     | Ebinop(BinopTernaryIncomplete _, _, _) => raise Unreachable
@@ -997,6 +1019,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     find 0
   end
 
+  (*
   and parseFP pos s =
   let
     val lastC = String.sub (s, String.size s - 1)
@@ -1018,9 +1041,12 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     | #"L" => P.error pos `"long double is not supported" %
     | _ => (double_t, Ndouble o handleStatus o parseDouble $ s)
   end
+  *)
 
   and parseNumber pos s =
-    (if isFPconst s then parseFP else parseInteger) pos s
+    (if isFPconst s then
+      P.error pos `"floating-point numbers are not implemented" %
+        else parseInteger) pos s
 
   and parsePrimaryExpr ctx =
   let
@@ -1168,20 +1194,29 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
       end
   end
 
-  and intRank t =
+  and typeRank t =
     case t of
-      char_t | uchar_t => 0
-    | short_t | ushort_t => 1
-    | int_t | uint_t => 2
-    | long_t | ulong_t => 3
-    | longlong_t | ulonglong_t => 4
-    | _ => raise Unreachable
+      char_t => 0
+    | uchar_t => 1
+    | short_t => 2
+    | ushort_t => 3
+    | int_t => 4
+    | uint_t => 5
+    | long_t => 6
+    | ulong_t => 7
+    | longlong_t => 8
+    | ulonglong_t => 9
+    | void_t => 12
+    | pointer_t _ => 13
+    | array_t _ => 14
+    | function_t _ => 15
+    | unknown_t => raise Unreachable
 
   and convEA t (E as EA (_, pos, _, _)) =
     EA (Eunop (UnopCast, E), pos, false, t)
 
   and promoteToInt (E as EA (_, _, _, t)) =
-    if intRank t < 2 then
+    if typeRank t < typeRank int_t then
       convEA int_t E
     else
       E
@@ -1679,6 +1714,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
 
     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 %
@@ -1828,16 +1864,47 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     collectDeclarators [] ctx
   end
 
+  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
+
+  fun parseJmp (ctx, pos) stmt =
+  let
+    val () =
+      if not $ isInLoop ctx then
+        P.error pos `"loop jump outside of loop" %
+      else
+        ()
+    val ctx' = skipExpected T.Semicolon ctx
+  in
+    (stmt, ctx')
+  end
+
   fun parseStmt ctx =
   let
-    val (tk, _, ctx') = getTokenCtx ctx
+    val (tk, pos, ctx') = getTokenCtx ctx
+    val loopWrapper = loopWrapper ctx'
+    val parseJmp = parseJmp (ctx', pos)
   in
     case tk of
       TkBraces list => ctxWithLayer ctx' list (parseStmtCompound false)
-    | Tk T.kwIf => parseStmtIf ctx'
-    | Tk T.kwFor => parseStmtFor ctx'
-    | Tk T.kwWhile => parseStmtWhile ctx'
-    | Tk T.kwDo => parseStmtDoWhile ctx'
+    | Tk T.kwIf => parseIf ctx'
+    | Tk T.kwFor => loopWrapper parseFor
+    | Tk T.kwWhile => loopWrapper parseWhile
+    | Tk T.kwDo => loopWrapper parseDoWhile
+    | Tk T.kwBreak => parseJmp StmtBreak
+    | Tk T.kwContinue => parseJmp StmtContinue
+    | Tk T.kwReturn => parseReturn ctx'
     | _ => parseStmtExpr ctx
   end
 
@@ -1850,6 +1917,16 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     | _ => P.clerror pos [P.Ctk T.LParen]
   end
 
+  and parseReturn ctx =
+  let
+    val ((status, ea), ctx) = parseExpr [T.Semicolon] ctx
+  in
+    if status = 0 then
+      P.clerror (#2 $ getTokenCtx ctx) [P.Ctk T.Semicolon]
+    else
+      (StmtReturn ea, ctx)
+  end
+
   and parseExprFor last ctx =
   let
     val (tk, pos, ctx') = getTokenCtx ctx
@@ -1877,7 +1954,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     | _ => P.clerror pos (if last then lastExp else notlastExp)
   end
 
-  and parseStmtFor ctx =
+  and parseFor ctx =
   let
     fun parseHeader ctx =
     let
@@ -1903,7 +1980,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     (ea, ctx)
   end
 
-  and parseStmtIf ctx =
+  and parseIf ctx =
   let
     val (cond, ctx) = parseExprInParens ctx
     val (stmt, ctx) = parseStmt ctx
@@ -1917,7 +1994,7 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     (StmtIf (cond, stmt, elseBody), ctx)
   end
 
-  and parseStmtWhile ctx =
+  and parseWhile ctx =
   let
     val (cond, ctx) = parseExprInParens ctx
     val (stmt, ctx) = parseStmt ctx
@@ -1925,22 +2002,8 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     (StmtWhile (cond, stmt), ctx)
   end
 
-  and parseStmtDoWhile ctx =
+  and parseDoWhile 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
@@ -2036,6 +2099,10 @@ functor Parser(structure Tree: TREE; structure P: PPC): PARSER = struct
     | pstmt' off (StmtDoWhile (body, cond)) out =
       Printf out `"do " A2 pCompBody (off + 1) body
         `" " A1 pea cond `";" %
+    | pstmt' _ (StmtReturn ea) out =
+        Printf out `"return " A1 pea ea `";" %
+    | pstmt' _ StmtBreak out = Printf out `"break;" %
+    | pstmt' _ StmtContinue out = Printf out `"continue;" %
 
   and pCompBody off (S as (StmtCompound _)) out =
     Printf out A2 pstmt' (off - 1) S %