Merge pull request #4969 from rescript-lang/clean_downgrade

continue clean up since removal of classes

Author: bobzhang

jscomp/core/lam_convert.ml

@@ -701,7 +701,7 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
 
         | "#fn_mk" -> Pjs_fn_make (Ext_pervasives.nat_of_string_exn p.prim_native_name)
         | "#fn_method" -> Pjs_fn_method 
-        | "#unsafe_downgrade" -> Pjs_unsafe_downgrade {name = Ext_string.empty; loc ; setter = false}
+        | "#unsafe_downgrade" -> Pjs_unsafe_downgrade {name = Ext_string.empty;  setter = false}
         | _ -> Location.raise_errorf ~loc
                  "@{<error>Error:@} internal error, using unrecognized primitive %s" s
       in
@@ -816,27 +816,23 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
       Lam.for_ id (convert_aux from_) (convert_aux to_) dir (convert_aux loop)
     | Lassign (id, body) ->
       Lam.assign id (convert_aux body)
-    | Lsend (kind, _,b,ls, _loc) ->
+    | Lsend (Public(Some name), _, obj, _, _loc) ->
       (* Format.fprintf Format.err_formatter "%a@." Printlambda.lambda b ; *)
-        (match convert_aux b with
-        | Lprim {primitive =  Pjs_unsafe_downgrade {loc};  args}
+        (match convert_aux obj with
+        | Lprim {primitive =  Pjs_unsafe_downgrade _;  args;loc}
           ->
-          begin match kind, ls with
-            | Public (Some name), [] ->
               let setter = Ext_string.ends_with name Literals.setter_suffix in 
               let property = 
                 if setter then   
                   Lam_methname.translate 
                     (String.sub name 0
                        (String.length name - Literals.setter_suffix_len))
                 else Lam_methname.translate  name in 
-              prim ~primitive:(Pjs_unsafe_downgrade {name = property;loc; setter})
-                ~args loc
-            | _ -> assert false
-          end
+              prim ~primitive:(Pjs_unsafe_downgrade {name = property; setter})
+                ~args loc                
         | _ ->
           assert false)
-      
+    | Lsend _ -> assert false  
     | Levent _ ->
       (* disabled by upstream*)
       assert false

jscomp/core/lam_primitive.ml

@@ -115,7 +115,6 @@ type t =
     { 
       name : string ;
       setter : bool;
-      loc : Location.t;
      }
   | Pinit_mod
   | Pupdate_mod
@@ -280,7 +279,7 @@ let eq_primitive_approx ( lhs : t) (rhs : t) =
   | Pasrint64   -> rhs = Pasrint64
   | Pint64comp ( comparison) -> (match rhs with Pint64comp(comparison1) -> Lam_compat.eq_comparison comparison comparison1 | _ -> false)  
   | Pctconst compile_time_constant -> (match rhs with Pctconst compile_time_constant1 -> Lam_compat.eq_compile_time_constant compile_time_constant compile_time_constant1 | _ -> false)
-  | Pjs_unsafe_downgrade {name; loc=_; setter } -> (match rhs with Pjs_unsafe_downgrade rhs -> name = rhs.name && setter = rhs.setter | _ -> false)  
+  | Pjs_unsafe_downgrade {name;  setter } -> (match rhs with Pjs_unsafe_downgrade rhs -> name = rhs.name && setter = rhs.setter | _ -> false)  
   | Pjs_fn_make i -> (match rhs with Pjs_fn_make i1 -> i = i1 | _ -> false)
   | Pvoid_run  -> rhs = Pvoid_run
   | Pfull_apply -> rhs = Pfull_apply 

jscomp/core/lam_primitive.mli

@@ -112,7 +112,6 @@ type t =
     { 
       name : string ; 
       setter : bool;
-      loc : Location.t;
     }
   | Pinit_mod
   | Pupdate_mod

lib/4.06.1/unstable/js_compiler.ml

@@ -72685,6 +72685,7 @@ let try_ids = Hashtbl.create 8
 
 let rec transl_exp e =
   List.iter (Translattribute.check_attribute e) e.exp_attributes;
+
   let eval_once =
     (* Whether classes for immediate objects must be cached *)
     match e.exp_desc with
@@ -73008,6 +73009,7 @@ and transl_exp0 e =
   | Texp_for(param, _, low, high, dir, body) ->
       Lfor(param, transl_exp low, transl_exp high, dir,
            event_before body (transl_exp body))
+
   | Texp_send(_, _, Some exp) -> transl_exp exp
   | Texp_send(expr, met, None) ->
       let obj = transl_exp expr in
@@ -73020,6 +73022,7 @@ and transl_exp0 e =
             Lsend (kind, tag, obj, cache, e.exp_loc)
       in
       event_after e lam
+      
   | Texp_new (cl, {Location.loc=loc}, _) ->
       Lapply{ap_should_be_tailcall=false;
              ap_loc=loc;
@@ -73033,6 +73036,7 @@ and transl_exp0 e =
   | Texp_setinstvar(path_self, path, _, expr) ->
       transl_setinstvar e.exp_loc (transl_normal_path path_self) path expr
   | Texp_override(path_self, modifs) ->
+  
       let cpy = Ident.create "copy" in
       Llet(Strict, Pgenval, cpy,
            Lapply{ap_should_be_tailcall=false;
@@ -73047,6 +73051,7 @@ and transl_exp0 e =
                             (Lvar cpy) path expr, rem))
              modifs
              (Lvar cpy))
+             
   | Texp_letmodule(id, loc, modl, body) ->
       let defining_expr =
 
@@ -80216,7 +80221,7 @@ open Typedtree
 open Lambda
 open Translobj
 open Translcore
-open Translclass
+
 
 type error =
   Circular_dependency of Ident.t
@@ -80561,7 +80566,7 @@ let transl_class_bindings cl_list =
   (ids,
    List.map
      (fun ({ci_id_class=id; ci_expr=cl; ci_virt=vf}, meths) ->
-       (id, transl_class ids id meths cl vf))
+       (id, Translclass.transl_class ids id meths cl vf))
      cl_list)
 
 (* Compile one or more functors, merging curried functors to produce
@@ -80823,13 +80828,15 @@ and transl_structure loc fields cc rootpath final_env = function
               body
           in
           lam, size
+          
       | Tstr_class cl_list ->
           let (ids, class_bindings) = transl_class_bindings cl_list in
           let body, size =
             transl_structure loc (List.rev_append ids fields)
               cc rootpath final_env rem
           in
           Lletrec(class_bindings, body), size
+          
       | Tstr_include incl ->
           let ids = bound_value_identifiers incl.incl_type in
           let modl = incl.incl_mod in
@@ -81163,6 +81170,7 @@ let transl_store_structure glob map prims str =
               bindings
               (Lsequence(store_idents Location.none ids,
                          transl_store rootpath (add_idents true ids subst) rem))
+        
         | Tstr_class cl_list ->
             let (ids, class_bindings) = transl_class_bindings cl_list in
             let lam =
@@ -81426,12 +81434,14 @@ let transl_toplevel_item item =
         (fun id modl _loc -> transl_module Tcoerce_none (Some(Pident id)) modl)
         bindings
         (make_sequence toploop_setvalue_id idents)
+  
   | Tstr_class cl_list ->
       (* we need to use unique names for the classes because there might
          be a value named identically *)
       let (ids, class_bindings) = transl_class_bindings cl_list in
       List.iter set_toplevel_unique_name ids;
       Lletrec(class_bindings, make_sequence toploop_setvalue_id ids)
+      
   | Tstr_include incl ->
       let ids = bound_value_identifiers incl.incl_type in
       let modl = incl.incl_mod in
@@ -95427,7 +95437,6 @@ type t =
     { 
       name : string ; 
       setter : bool;
-      loc : Location.t;
     }
   | Pinit_mod
   | Pupdate_mod
@@ -95580,7 +95589,6 @@ type t =
     { 
       name : string ;
       setter : bool;
-      loc : Location.t;
      }
   | Pinit_mod
   | Pupdate_mod
@@ -95745,7 +95753,7 @@ let eq_primitive_approx ( lhs : t) (rhs : t) =
   | Pasrint64   -> rhs = Pasrint64
   | Pint64comp ( comparison) -> (match rhs with Pint64comp(comparison1) -> Lam_compat.eq_comparison comparison comparison1 | _ -> false)  
   | Pctconst compile_time_constant -> (match rhs with Pctconst compile_time_constant1 -> Lam_compat.eq_compile_time_constant compile_time_constant compile_time_constant1 | _ -> false)
-  | Pjs_unsafe_downgrade {name; loc=_; setter } -> (match rhs with Pjs_unsafe_downgrade rhs -> name = rhs.name && setter = rhs.setter | _ -> false)  
+  | Pjs_unsafe_downgrade {name;  setter } -> (match rhs with Pjs_unsafe_downgrade rhs -> name = rhs.name && setter = rhs.setter | _ -> false)  
   | Pjs_fn_make i -> (match rhs with Pjs_fn_make i1 -> i = i1 | _ -> false)
   | Pvoid_run  -> rhs = Pvoid_run
   | Pfull_apply -> rhs = Pfull_apply 
@@ -395027,7 +395035,7 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
 
         | "#fn_mk" -> Pjs_fn_make (Ext_pervasives.nat_of_string_exn p.prim_native_name)
         | "#fn_method" -> Pjs_fn_method 
-        | "#unsafe_downgrade" -> Pjs_unsafe_downgrade {name = Ext_string.empty; loc ; setter = false}
+        | "#unsafe_downgrade" -> Pjs_unsafe_downgrade {name = Ext_string.empty;  setter = false}
         | _ -> Location.raise_errorf ~loc
                  "@{<error>Error:@} internal error, using unrecognized primitive %s" s
       in
@@ -395142,27 +395150,23 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
       Lam.for_ id (convert_aux from_) (convert_aux to_) dir (convert_aux loop)
     | Lassign (id, body) ->
       Lam.assign id (convert_aux body)
-    | Lsend (kind, _,b,ls, _loc) ->
+    | Lsend (Public(Some name), _, obj, _, _loc) ->
       (* Format.fprintf Format.err_formatter "%a@." Printlambda.lambda b ; *)
-        (match convert_aux b with
-        | Lprim {primitive =  Pjs_unsafe_downgrade {loc};  args}
+        (match convert_aux obj with
+        | Lprim {primitive =  Pjs_unsafe_downgrade _;  args;loc}
           ->
-          begin match kind, ls with
-            | Public (Some name), [] ->
               let setter = Ext_string.ends_with name Literals.setter_suffix in 
               let property = 
                 if setter then   
                   Lam_methname.translate 
                     (String.sub name 0
                        (String.length name - Literals.setter_suffix_len))
                 else Lam_methname.translate  name in 
-              prim ~primitive:(Pjs_unsafe_downgrade {name = property;loc; setter})
-                ~args loc
-            | _ -> assert false
-          end
+              prim ~primitive:(Pjs_unsafe_downgrade {name = property; setter})
+                ~args loc                
         | _ ->
           assert false)
-      
+    | Lsend _ -> assert false  
     | Levent _ ->
       (* disabled by upstream*)
       assert false