Merge pull request #4908 from rescript-lang/js_ir

no higher order types in js ir for easier code generation

Author: bobzhang

jscomp/core/j.ml

@@ -305,8 +305,8 @@ and statement_desc =
     {[ goto : label option ; ]}
   *)
 
-  | Int_switch of expression * int case_clause list * block option 
-  | String_switch of expression * string case_clause list * block option 
+  | Int_switch of expression * int_clause list * block option 
+  | String_switch of expression * string_clause list * block option 
   | Throw of expression
   | Try of block * (exception_ident * block) option * block option
   | Debugger
@@ -329,9 +329,9 @@ and variable_declaration = {
   property : property;
   ident_info : ident_info;
 }
-
-and 'a case_clause = { 
-  switch_case : 'a ; 
+and string_clause = string * case_clause
+and int_clause =  int * case_clause
+and case_clause = {   
   switch_body : block ;
   should_break :  bool ;  (* true means break *)
   comment : string option ;

jscomp/core/js_dump.ml

@@ -488,9 +488,9 @@ and  pp_function ~is_method
     since it can be either [int] or [string]
 *)
 and pp_one_case_clause : 'a .
-  _ -> P.t -> (P.t -> 'a -> unit) -> 'a J.case_clause -> _
+  _ -> P.t -> (P.t -> 'a -> unit) -> ('a * J.case_clause) -> _
   = fun cxt f  pp_cond
-    ({switch_case; switch_body ; should_break; comment; } : _ J.case_clause) ->
+    (switch_case, ({switch_body ; should_break; comment; } :  J.case_clause)) ->
     let cxt =
       P.group f 1  (fun _ ->
           P.group f 1 (fun _ ->
@@ -520,7 +520,7 @@ and pp_one_case_clause : 'a .
     cxt
 
 and loop_case_clauses  :  'a . cxt ->
-  P.t -> (P.t -> 'a -> unit) -> 'a J.case_clause list -> cxt
+  P.t -> (P.t -> 'a -> unit) -> ('a * J.case_clause) list -> cxt
   = fun  cxt  f pp_cond cases ->
     Ext_list.fold_left cases cxt (fun acc x -> pp_one_case_clause acc f pp_cond x)              
 

jscomp/core/js_fold.ml

@@ -43,7 +43,7 @@ let eval (arg : J.expression) (dispatches : (string * string) list ) : E.t =
       E.of_block
         [(S.string_switch arg
             (Ext_list.map dispatches (fun (i,r) ->
-                 {J.switch_case = i ;
+                 i, J.{
                   switch_body = [S.return_stmt (E.str r)];
                   should_break = false; (* FIXME: if true, still print break*)
                   comment = None;
@@ -71,7 +71,7 @@ let eval_as_event (arg : J.expression) (dispatches : (string * string) list opti
 
         (S.string_switch (E.poly_var_tag_access arg)
         (Ext_list.map dispatches (fun (i,r) ->
-              {J.switch_case = i ;
+              i, J.{
                switch_body = [S.return_stmt (E.str r)];
                should_break = false; (* FIXME: if true, still print break*)
                comment = None;
@@ -103,7 +103,7 @@ let eval_as_int (arg : J.expression) (dispatches : (string * int) list ) : E.t
     E.of_block
       [(S.string_switch arg
       (Ext_list.map dispatches (fun (i,r) ->
-              {J.switch_case = i ;
+              i, J.{
                switch_body = [S.return_stmt (E.int (Int32.of_int  r))];
                should_break = false; (* FIXME: if true, still print break*)
                comment = None;

jscomp/core/js_map.ml

@@ -98,13 +98,13 @@ let int_switch
     ?(declaration : (J.property * Ident.t) option )
     ?(default : J.block option)
     (e : J.expression)  
-    (clauses : int J.case_clause list): t = 
+    (clauses : (int * J.case_clause) list): t = 
   match e.expression_desc with 
   | Number (Int {i; _}) -> 
     let continuation =  
       match Ext_list.find_opt clauses
-              (fun x ->
-                 if x.switch_case = Int32.to_int i then
+              (fun (switch_case,x) ->
+                 if switch_case = Int32.to_int i then
                    Some x.switch_body else None ) 
       with 
       | Some case -> case 
@@ -137,12 +137,12 @@ let string_switch
   ?(declaration : (J.property * Ident.t) option) 
   ?(default : J.block option)
   (e : J.expression)  
-  (clauses : string J.case_clause list): t= 
+  (clauses : (string * J.case_clause) list): t= 
   match e.expression_desc with 
   | Str (_,s) -> 
     let continuation = 
-      match Ext_list.find_opt clauses (fun  x ->
-                 if x.switch_case = s then 
+      match Ext_list.find_opt clauses (fun  (switch_case, x) ->
+                 if switch_case = s then 
                    Some x.switch_body
                  else None  
               ) with 

jscomp/core/js_of_lam_variant.ml

@@ -84,15 +84,15 @@ val int_switch :
   ?declaration:Lam_compat.let_kind * Ident.t -> 
   ?default:J.block -> 
   J.expression -> 
-  int J.case_clause list -> 
+  (int * J.case_clause) list -> 
   t 
 
 val string_switch : 
   ?comment:string -> 
   ?declaration:Lam_compat.let_kind * Ident.t -> 
   ?default:J.block ->
   J.expression -> 
-  string J.case_clause list ->
+  (string * J.case_clause) list ->
   t
 
 (** Just declaration without initialization *)  

jscomp/core/js_stmt_make.ml

@@ -490,7 +490,7 @@ and compile_general_cases
   Lam_compile_context.t ->
   (?default:J.block ->
    ?declaration:Lam_compat.let_kind * Ident.t  ->
-   _ -> 'a J.case_clause list ->  J.statement) ->
+   _ -> ('a * J.case_clause) list ->  J.statement) ->
   _ ->
   ('a * Lam.t) list -> default_case -> J.block
   = fun
@@ -501,7 +501,7 @@ and compile_general_cases
   (switch :
   ?default:J.block ->
    ?declaration:Lam_compat.let_kind * Ident.t  ->
-   _ -> _ J.case_clause list ->  J.statement
+   _ -> (_ * J.case_clause) list ->  J.statement
    )
    (switch_exp : J.expression)
    (cases : (_ * Lam.t) list)
@@ -571,13 +571,13 @@ and compile_general_cases
                               should_break
                             else
                               should_break && Lam_exit_code.has_exit lam in
-                        {J.switch_case ;
+                          switch_case , J.{
                             switch_body;
                             should_break;
                             comment = make_comment switch_case;
                         }
                       else
-                        { switch_case; switch_body = []; should_break = false; comment = make_comment switch_case; }
+                      switch_case, {switch_body = []; should_break = false; comment = make_comment switch_case; }
                     )                   
 
               (* TODO: we should also group default *)