Add case over int.

1 files changed, 53 insertions, 0 deletions

diff --git a/cps.sml b/cps.sml
index adb29c0..ad3e0e8 100644
--- a/cps.sml
+++ b/cps.sml
@@ -57,6 +57,59 @@ struct
                 toCPS expr (fn v => go exprs (v :: vars))
         in go exprs []
         end
+    | Syntax.LSwitch (expr, arms, otherwise) =>
+        let
+          val sortedArms = Sort.sort (fn ((x, _), (y, _)) => Int.compare (x, y)) arms
+          val addr = Gensym.new ()
+          val arg = Gensym.new ()
+          fun go _ [] cont = toCPS otherwise cont
+            | go v [(x, arm)] cont =
+                let val b = Gensym.new ()
+                in
+                  Syntax.CPrimop
+                    ( Syntax.PEq
+                    , [v, Syntax.VInt x]
+                    , [b]
+                    , [ Syntax.CPrimop
+                          ( Syntax.PIf
+                          , [Syntax.VVar b]
+                          , []
+                          , [toCPS arm cont, toCPS otherwise cont]
+                          )
+                      ]
+                    )
+                end
+            | go v arms cont =
+                let
+                  val b = Gensym.new ()
+                  val h = length arms div 2
+                  val half1 = List.take (arms, h)
+                  val half2 = List.drop (arms, h)
+                  val (x, _) = hd half2
+                in
+                  Syntax.CPrimop
+                    ( Syntax.PLess
+                    , [v, Syntax.VInt x]
+                    , [b]
+                    , [ Syntax.CPrimop
+                          ( Syntax.PIf
+                          , [Syntax.VVar b]
+                          , []
+                          , [go v half1 cont, go v half2 cont]
+                          )
+                      ]
+                    )
+                end
+        in
+          Syntax.CFix
+            ( [(addr, [arg], cont (Syntax.VVar arg))]
+            , toCPS expr
+                (fn v =>
+                  go v sortedArms
+                    (fn x =>
+                      Syntax.CApp (Syntax.VVar addr, [x])))
+            )
+        end
     | _ => raise Fail ("malformed expression " ^ Syntax.lexpToString e)
 
   fun hoist (expr : Syntax.cexp) : Syntax.cexp =