clean up code

Author: cristianoc

compiler/core/lam_compile.ml

@@ -673,8 +673,6 @@ let compile output_prefix =
               also if last statement is throw -- should we drop remaining
               statement?
     *)
-    (* Printf.eprintf "XXX switch_arg: %s\n\n"
-       (Lam_print.lambda_to_string switch_arg); *)
     let ({
            sw_consts_full;
            sw_consts;
@@ -715,55 +713,42 @@ let compile output_prefix =
         block
         @
         if sw_consts_full && sw_consts = [] then
-          (* let _ = Printf.eprintf "QQQ sw_consts_full\n\n" in *)
           compile_cases ~block_cases ~untagged ~cxt
             ~switch_exp:(if untagged then e else E.tag ~name:tag_name e)
             ~default:sw_blocks_default ~get_tag:get_block_tag sw_blocks
         else if sw_blocks_full && sw_blocks = [] then
-          (* let _ = Printf.eprintf "QQQ sw_blocks_full\n\n" in *)
           compile_cases ~cxt ~switch_exp:e ~block_cases ~default:sw_num_default
             ~get_tag:get_const_tag sw_consts
         else
-          (* let _ = Printf.eprintf "QQQ else\n\n" in *)
           (* [e] will be used twice  *)
           let dispatch e =
             let is_a_literal_case =
               if untagged then
-                let literal_case =
-                  E.is_a_literal_case
-                    ~literal_cases:(get_literal_cases sw_names)
-                    ~block_cases e
-                in
-                (* Printf.eprintf "LLL literal_case: %s\n\n"
-                   (Js_dump.string_of_expression literal_case); *)
-                literal_case
+                E.is_a_literal_case
+                  ~literal_cases:(get_literal_cases sw_names)
+                  ~block_cases e
               else
                 E.is_int_tag
                   ~has_null_undefined_other:(has_null_undefined_other sw_names)
                   e
             in
-            let qconsts =
-              use_compile_literal_cases sw_consts ~get_tag:get_const_tag
-            in
-            let qblocks =
-              use_compile_literal_cases sw_blocks ~get_tag:get_block_tag
-            in
             let eq_default d1 d2 =
               match (d1, d2) with
               | Default lam1, Default lam2 -> Lam.eq_approx lam1 lam2
               | Complete, Complete -> true
               | NonComplete, NonComplete -> true
               | _ -> false
             in
-            match (qconsts, qblocks) with
-            | Some consts_cases, Some blocks_cases
-              when untagged
-                   && List.length blocks_cases >= 1
-                   && List.length consts_cases = 0
-                   && eq_default sw_num_default sw_blocks_default ->
-              compile_cases ~untagged ~cxt ~switch_exp:e ~block_cases
-                ~default:sw_blocks_default ~get_tag:get_block_tag sw_blocks
-            | _ ->
+            if
+              untagged
+              && List.length sw_consts = 0
+              && eq_default sw_num_default sw_blocks_default
+            then
+              compile_cases ~untagged ~cxt
+                ~switch_exp:(if untagged then e else E.tag ~name:tag_name e)
+                ~block_cases ~default:sw_blocks_default ~get_tag:get_block_tag
+                sw_blocks
+            else
               [
                 S.if_ is_a_literal_case
                   (compile_cases ~cxt ~switch_exp:e ~block_cases
@@ -781,7 +766,7 @@ let compile output_prefix =
           | _ ->
             let v = Ext_ident.create_tmp () in
             (* Necessary avoid duplicated computation*)
-            [S.define_variable ~kind:Variable v e] @ dispatch (E.var v))
+            S.define_variable ~kind:Variable v e :: dispatch (E.var v))
     in
     match lambda_cxt.continuation with
     (* Needs declare first *)
@@ -791,19 +776,15 @@ let compile output_prefix =
          when branches are minimial (less than 2)
       *)
       let v = Ext_ident.create_tmp () in
-      let res = compile_whole {lambda_cxt with continuation = Assign v} in
-      (* Printf.eprintf "XXX res 1: %s\n\n" (Js_dump.string_of_block res); *)
       Js_output.make
-        (S.declare_variable ~kind:Variable v :: res)
+        (S.declare_variable ~kind:Variable v
+        :: compile_whole {lambda_cxt with continuation = Assign v})
         ~value:(E.var v)
     | Declare (kind, id) ->
-      let res = compile_whole {lambda_cxt with continuation = Assign id} in
-      (* Printf.eprintf "XXX res 2: %s\n\n" (Js_dump.string_of_block res); *)
-      Js_output.make (S.declare_variable ~kind id :: res) ~value:(E.var id)
-    | EffectCall _ | Assign _ ->
-      let res = compile_whole lambda_cxt in
-      (* Printf.eprintf "XXX res 3: %s\n\n" (Js_dump.string_of_block res); *)
-      Js_output.make res
+      Js_output.make
+        (S.declare_variable ~kind id
+        :: compile_whole {lambda_cxt with continuation = Assign id})
+    | EffectCall _ | Assign _ -> Js_output.make (compile_whole lambda_cxt)
   and compile_string_cases ~cxt ~switch_exp ~default cases : initialization =
     cases
     |> compile_general_cases ~make_exp:E.tag_type