Merge pull request #1579 from chambart/split_backend_primitives

Use a different type for primitives in clambda and lambda

16 files changed, 84 insertions, 102 deletions

diff --git a/middle_end/closure_conversion.ml b/middle_end/closure_conversion.ml
index a852ae8d13..9bdd30ead9 100755
--- a/middle_end/closure_conversion.ml
+++ b/middle_end/closure_conversion.ml
@@ -29,6 +29,7 @@ type t = {
   current_unit_id : Ident.t;
   symbol_for_global' : (Ident.t -> Symbol.t);
   filename : string;
+  backend : (module Backend_intf.S);
   mutable imported_symbols : Symbol.Set.t;
   mutable declared_symbols : (Symbol.t * Flambda.constant_defining_value) list;
 }
@@ -159,6 +160,15 @@ let close_const t (const : Lambda.structured_constant)
   | Symbol s, name ->
     Symbol s, name
 
+let lambda_const_bool b : Lambda.structured_constant =
+  if b then
+    Const_pointer 1
+  else
+    Const_pointer 0
+
+let lambda_const_int i : Lambda.structured_constant =
+  Const_base (Const_int i)
+
 let rec close t env (lam : Lambda.lambda) : Flambda.t =
   match lam with
   | Lvar id ->
@@ -339,7 +349,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
         Allocated_const (Nativeint 0n)
       | _ -> assert false
     in
-    let prim : Lambda.primitive =
+    let prim : Clambda_primitives.primitive =
       match prim with
       | Pdivint _ -> Pdivint Unsafe
       | Pmodint _ -> Pmodint Unsafe
@@ -347,7 +357,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
       | Pmodbint { size } -> Pmodbint { size; is_safe = Unsafe }
       | _ -> assert false
     in
-    let comparison : Lambda.primitive =
+    let comparison : Clambda_primitives.primitive =
       match prim with
       | Pdivint _ | Pmodint _ -> Pintcomp Ceq
       | Pdivbint { size } | Pmodbint { size } -> Pbintcomp (size,Ceq)
@@ -394,7 +404,15 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
         (If_then_else (cond, arg2, Var const_false)))
   | Lprim ((Psequand | Psequor), _, _) ->
     Misc.fatal_error "Psequand / Psequor must have exactly two arguments"
-  | Lprim (Pidentity, [arg], _) -> close t env arg
+  | Lprim ((Pidentity | Pbytes_to_string | Pbytes_of_string), [arg], _) ->
+    close t env arg
+  | Lprim (Pignore, [arg], _) ->
+    let var = Variable.create Names.ignore in
+    let defining_expr =
+      close_let_bound_expression t var env arg
+    in
+    Flambda.create_let var defining_expr
+      (name_expr (Const (Const_pointer 0)) ~name:Names.unit)
   | Lprim (Pdirapply, [funct; arg], loc)
   | Lprim (Prevapply, [arg; funct], loc) ->
     let apply : Lambda.lambda_apply =
@@ -417,6 +435,25 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
       (name_expr
         (Prim (Praise kind, [arg_var], dbg))
         ~name:Names.raise)
+  | Lprim (Pctconst c, [arg], _loc) ->
+      let module Backend = (val t.backend) in
+      let const =
+        begin match c with
+        | Big_endian -> lambda_const_bool Backend.big_endian
+        | Word_size -> lambda_const_int (8*Backend.size_int)
+        | Int_size -> lambda_const_int (8*Backend.size_int - 1)
+        | Max_wosize ->
+            lambda_const_int ((1 lsl ((8*Backend.size_int) - 10)) - 1)
+        | Ostype_unix -> lambda_const_bool (String.equal Sys.os_type "Unix")
+        | Ostype_win32 -> lambda_const_bool (String.equal Sys.os_type "Win32")
+        | Ostype_cygwin -> lambda_const_bool (String.equal Sys.os_type "Cygwin")
+        | Backend_type ->
+            Lambda.Const_pointer 0 (* tag 0 is the same as Native *)
+        end
+      in
+      close t env
+        (Lambda.Llet(Strict, Pgenval, Ident.create_local "dummy",
+                     arg, Lconst const))
   | Lprim (Pfield _, [Lprim (Pgetglobal id, [],_)], _)
       when Ident.same id t.current_unit_id ->
     Misc.fatal_errorf "[Pfield (Pgetglobal ...)] for the current compilation \
@@ -433,7 +470,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
     let symbol = t.symbol_for_global' id in
     t.imported_symbols <- Symbol.Set.add symbol t.imported_symbols;
     name_expr (Symbol symbol) ~name:Names.pgetglobal
-  | Lprim (p, args, loc) ->
+  | Lprim (lambda_p, args, loc) ->
     (* One of the important consequences of the ANF-like representation
        here is that we obtain names corresponding to the components of
        blocks being made (with [Pmakeblock]).  This information can be used
@@ -441,12 +478,13 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
        the allocation, since some field accesses can be tracked back to known
        field values. *)
     let dbg = Debuginfo.from_location loc in
+    let p = Convert_primitives.convert lambda_p in
     Lift_code.lifting_helper (close_list t env args)
       ~evaluation_order:`Right_to_left
-      ~name:(Names.of_primitive_arg p)
+      ~name:(Names.of_primitive_arg lambda_p)
       ~create_body:(fun args ->
         name_expr (Prim (p, args, dbg))
-          ~name:(Names.of_primitive p))
+          ~name:(Names.of_primitive lambda_p))
   | Lswitch (arg, sw, _loc) ->
     let scrutinee = Variable.create Names.switch in
     let aux (i, lam) = i, close t env lam in
@@ -649,6 +687,7 @@ let lambda_to_flambda ~backend ~module_ident ~size ~filename lam
     { current_unit_id = Compilation_unit.get_persistent_ident compilation_unit;
       symbol_for_global' = Backend.symbol_for_global';
       filename;
+      backend;
       imported_symbols = Symbol.Set.empty;
       declared_symbols = [];
     }
diff --git a/middle_end/effect_analysis.ml b/middle_end/effect_analysis.ml
index b5ab6186ff..d0cbd44180 100644
--- a/middle_end/effect_analysis.ml
+++ b/middle_end/effect_analysis.ml
@@ -17,7 +17,7 @@
 [@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
 open! Int_replace_polymorphic_compare
 
-let no_effects_prim (prim : Lambda.primitive) =
+let no_effects_prim (prim : Clambda_primitives.primitive) =
   match Semantics_of_primitives.for_primitive prim with
   | (No_effects | Only_generative_effects), (No_coeffects | Has_coeffects) ->
     true
diff --git a/middle_end/flambda.ml b/middle_end/flambda.ml
index a16b51a19c..858d6d90b1 100644
--- a/middle_end/flambda.ml
+++ b/middle_end/flambda.ml
@@ -85,7 +85,7 @@ and named =
   | Project_closure of project_closure
   | Move_within_set_of_closures of move_within_set_of_closures
   | Project_var of project_var
-  | Prim of Lambda.primitive * Variable.t list * Debuginfo.t
+  | Prim of Clambda_primitives.primitive * Variable.t list * Debuginfo.t
   | Expr of t
 
 and let_expr = {
@@ -348,7 +348,7 @@ and print_named ppf (named : named) =
   | Set_of_closures (set_of_closures) ->
     print_set_of_closures ppf set_of_closures
   | Prim(prim, args, dbg) ->
-    fprintf ppf "@[<2>(%a<%s>%a)@]" Printlambda.primitive prim
+    fprintf ppf "@[<2>(%a<%s>%a)@]" Printclambda_primitives.primitive prim
       (Debuginfo.to_string dbg)
       Variable.print_list args
   | Expr expr ->
diff --git a/middle_end/flambda.mli b/middle_end/flambda.mli
index a301dd4712..325c15ee1c 100755
--- a/middle_end/flambda.mli
+++ b/middle_end/flambda.mli
@@ -151,7 +151,7 @@ and named =
   | Project_closure of project_closure
   | Move_within_set_of_closures of move_within_set_of_closures
   | Project_var of project_var
-  | Prim of Lambda.primitive * Variable.t list * Debuginfo.t
+  | Prim of Clambda_primitives.primitive * Variable.t list * Debuginfo.t
   | Expr of t  (** ANF escape hatch. *)
 
 (* CR-someday mshinwell: use [letcont]-style construct to remove e.g.
diff --git a/middle_end/flambda_invariants.ml b/middle_end/flambda_invariants.ml
index f236fd0801..250a2e9af7 100755
--- a/middle_end/flambda_invariants.ml
+++ b/middle_end/flambda_invariants.ml
@@ -41,7 +41,7 @@ let ignore_bool (_ : bool) = ()
 let ignore_string (_ : string) = ()
 let ignore_static_exception (_ : Static_exception.t) = ()
 let ignore_direction_flag (_ : Asttypes.direction_flag) = ()
-let ignore_primitive ( _ : Lambda.primitive) = ()
+let ignore_primitive ( _ : Clambda_primitives.primitive) = ()
 let ignore_const (_ : Flambda.const) = ()
 let ignore_allocated_const (_ : Allocated_const.t) = ()
 let ignore_set_of_closures_id (_ : Set_of_closures_id.t) = ()
@@ -74,12 +74,8 @@ exception Free_variables_set_is_lying of
 exception Set_of_closures_free_vars_map_has_wrong_range of Variable.Set.t
 exception Static_exception_not_caught of Static_exception.t
 exception Static_exception_caught_in_multiple_places of Static_exception.t
-exception Access_to_global_module_identifier of Lambda.primitive
-exception Pidentity_should_not_occur
-exception Pdirapply_should_be_expanded
-exception Prevapply_should_be_expanded
 exception Sequential_logical_operator_primitives_must_be_expanded of
-  Lambda.primitive
+  Clambda_primitives.primitive
 exception Var_within_closure_bound_multiple_times of Var_within_closure.t
 exception Declared_closure_from_another_unit of Compilation_unit.t
 exception Closure_id_is_bound_multiple_times of Closure_id.t
@@ -456,21 +452,12 @@ let variable_and_symbol_invariants (program : Flambda.program) =
   in
   loop_program_body env program.program_body
 
-let primitive_invariants flam ~no_access_to_global_module_identifiers =
+let primitive_invariants flam =
   Flambda_iterators.iter_named (function
       | Prim (prim, _, _) ->
         begin match prim with
         | Psequand | Psequor ->
           raise (Sequential_logical_operator_primitives_must_be_expanded prim)
-        | Pgetglobal id ->
-          if no_access_to_global_module_identifiers
-            && not (Ident.is_predef id) then
-          begin
-            raise (Access_to_global_module_identifier prim)
-          end
-        | Pidentity -> raise Pidentity_should_not_occur
-        | Pdirapply -> raise Pdirapply_should_be_expanded
-        | Prevapply -> raise Prevapply_should_be_expanded
         | _ -> ()
         end
       | _ -> ())
@@ -678,7 +665,7 @@ let _every_move_within_set_of_closures_is_to_a_function_in_the_free_vars
                          (fun_var, missing_dependencies)))
           funs)
 
-let check_exn ?(kind=Normal) ?(cmxfile=false) (flam:Flambda.program) =
+let check_exn ?(kind=Normal) (flam:Flambda.program) =
   ignore kind;
   try
     variable_and_symbol_invariants flam;
@@ -695,7 +682,7 @@ let check_exn ?(kind=Normal) ?(cmxfile=false) (flam:Flambda.program) =
     (* every_move_within_set_of_closures_is_to_a_function_in_the_free_vars
         flam; *)
     Flambda_iterators.iter_exprs_at_toplevel_of_program flam ~f:(fun flam ->
-      primitive_invariants flam ~no_access_to_global_module_identifiers:cmxfile;
+      primitive_invariants flam;
       every_static_exception_is_caught flam;
       every_static_exception_is_caught_at_a_single_position flam;
       every_declared_closure_is_from_current_compilation_unit flam)
@@ -772,7 +759,7 @@ let check_exn ?(kind=Normal) ?(cmxfile=false) (flam:Flambda.program) =
     | Sequential_logical_operator_primitives_must_be_expanded prim ->
       Format.eprintf ">> Sequential logical operator primitives must be \
           expanded (see closure_conversion.ml): %a"
-        Printlambda.primitive prim
+        Printclambda_primitives.primitive prim
     | Var_within_closure_bound_multiple_times var ->
       Format.eprintf ">> Variable within a closure is bound multiple times: \
           %a"
@@ -801,21 +788,6 @@ let check_exn ?(kind=Normal) ?(cmxfile=false) (flam:Flambda.program) =
     | Static_exception_caught_in_multiple_places static_exn ->
       Format.eprintf ">> Static exception caught in multiple places: %a"
         Static_exception.print static_exn
-    | Access_to_global_module_identifier prim ->
-      (* CR-someday mshinwell: backend-specific checks should move to another
-         module, in the asmcomp/ directory. *)
-      Format.eprintf ">> Forbidden access to a global module identifier (not \
-          allowed in Flambda that will be exported to a .cmx file): %a"
-        Printlambda.primitive prim
-    | Pidentity_should_not_occur ->
-      Format.eprintf ">> The Pidentity primitive should never occur in an \
-        Flambda expression (see closure_conversion.ml)"
-    | Pdirapply_should_be_expanded ->
-      Format.eprintf ">> The Pdirapply primitive should never occur in an \
-        Flambda expression (see simplif.ml); use Apply instead"
-    | Prevapply_should_be_expanded ->
-      Format.eprintf ">> The Prevapply primitive should never occur in an \
-        Flambda expression (see simplif.ml); use Apply instead"
     | Move_to_a_closure_not_in_the_free_variables (start_from, move_to) ->
       Format.eprintf ">> A Move_within_set_of_closures from the closure %a \
         to closures that are not parts of its free variables: %a"
diff --git a/middle_end/flambda_invariants.mli b/middle_end/flambda_invariants.mli
index 6a24ef30c1..252578e88e 100644
--- a/middle_end/flambda_invariants.mli
+++ b/middle_end/flambda_invariants.mli
@@ -24,6 +24,5 @@ type flambda_kind =
     a check fails. *)
 val check_exn
    : ?kind:flambda_kind
-  -> ?cmxfile:bool
   -> Flambda.program
   -> unit
diff --git a/middle_end/flambda_utils.ml b/middle_end/flambda_utils.ml
index 1bb3a2a8e3..fa8d052715 100644
--- a/middle_end/flambda_utils.ml
+++ b/middle_end/flambda_utils.ml
@@ -192,7 +192,7 @@ and same_named (named1 : Flambda.named) (named2 : Flambda.named) =
   | Move_within_set_of_closures _, _ | _, Move_within_set_of_closures _ ->
     false
   | Prim (p1, al1, _), Prim (p2, al2, _) ->
-    Lambda.equal_primitive p1 p2
+    Clambda_primitives.equal p1 p2
       && Misc.Stdlib.List.equal Variable.equal al1 al2
   | Prim _, _ | _, Prim _ -> false
   | Expr e1, Expr e2 -> same e1 e2
@@ -735,7 +735,7 @@ module Switch_storer = Switch.Store (struct
   and key_named =
     | Symbol of Symbol.t
     | Const of Flambda.const
-    | Prim of Lambda.primitive * Variable.t list
+    | Prim of Clambda_primitives.primitive * Variable.t list
     | Expr of key
 
   exception Not_comparable
diff --git a/middle_end/inconstant_idents.ml b/middle_end/inconstant_idents.ml
index 3d8ba904d5..59f8aa8a8c 100755
--- a/middle_end/inconstant_idents.ml
+++ b/middle_end/inconstant_idents.ml
@@ -326,8 +326,6 @@ module Inconstants (P:Param) (Backend:Backend_intf.S) = struct
     | Read_symbol_field (symbol, index) ->
       register_implication ~in_nc:(Symbol_field (symbol, index))
         ~implies_in_nc:curr
-    (* Globals are symbols: handle like symbols *)
-    | Prim (Lambda.Pgetglobal _id, [], _) -> ()
     (* Constant constructors: those expressions are constant if all their
        parameters are:
        - makeblock is compiled to a constant block
@@ -337,7 +335,7 @@ module Inconstants (P:Param) (Backend:Backend_intf.S) = struct
        makeblock(Mutable) can be a 'constant' if it is allocated at
        toplevel: if this expression is evaluated only once.
     *)
-    | Prim (Lambda.Pmakeblock (_tag, Asttypes.Immutable, _value_kind), args,
+    | Prim (Pmakeblock (_tag, Asttypes.Immutable, _value_kind), args,
             _dbg) ->
       mark_vars args curr
 (*  (* CR-someday pchambart: If global mutables are allowed: *)
@@ -389,7 +387,7 @@ module Inconstants (P:Param) (Backend:Backend_intf.S) = struct
         mark_var closure curr
       else
         mark_curr curr
-    | Prim (Lambda.Pfield _, [f1], _) ->
+    | Prim (Pfield _, [f1], _) ->
       mark_curr curr;
       mark_var f1 curr
     | Prim (_, args, _) ->
diff --git a/middle_end/inline_and_simplify.ml b/middle_end/inline_and_simplify.ml
index c1e6ff5661..7d304cd88f 100755
--- a/middle_end/inline_and_simplify.ml
+++ b/middle_end/inline_and_simplify.ml
@@ -991,8 +991,6 @@ and simplify_named env r (tree : Flambda.named) : Flambda.named * R.t =
     simplify_free_variables_named env args ~f:(fun env args args_approxs ->
       let tree = Flambda.Prim (prim, args, dbg) in
       begin match prim, args, args_approxs with
-      | Pgetglobal _, _, _ ->
-        Misc.fatal_error "Pgetglobal is forbidden in Inline_and_simplify"
       (* CR-someday mshinwell: Optimise [Pfield_computed]. *)
       | Pfield field_index, [arg], [arg_approx] ->
         let projection : Projection.t = Field (field_index, arg) in
@@ -1049,7 +1047,7 @@ and simplify_named env r (tree : Flambda.named) : Flambda.named * R.t =
           | _ ->
             kind
         in
-        let prim : Lambda.primitive = match prim with
+        let prim : Clambda_primitives.primitive = match prim with
           | Parraysetu _ -> Parraysetu kind
           | Parraysets _ -> Parraysets kind
           | _ -> assert false
@@ -1070,7 +1068,7 @@ and simplify_named env r (tree : Flambda.named) : Flambda.named * R.t =
         let expr, approx, benefit =
           let module Backend = (val (E.backend env) : Backend_intf.S) in
           Simplify_primitives.primitive p (args, args_approxs) tree dbg
-            ~size_int:Backend.size_int ~big_endian:Backend.big_endian
+            ~size_int:Backend.size_int
         in
         let r = R.map_benefit r (B.(+) benefit) in
         let approx =
diff --git a/middle_end/inlining_cost.ml b/middle_end/inlining_cost.ml
index f2af293f59..88675f8d1a 100644
--- a/middle_end/inlining_cost.ml
+++ b/middle_end/inlining_cost.ml
@@ -19,11 +19,8 @@ open! Int_replace_polymorphic_compare
 
 (* Simple approximation of the space cost of a primitive. *)
 
-let prim_size (prim : Lambda.primitive) args =
+let prim_size (prim : Clambda_primitives.primitive) args =
   match prim with
-  | Pidentity -> 0
-  | Pgetglobal _ -> 1
-  | Psetglobal _ -> 1
   | Pmakeblock _ -> 5 + List.length args
   | Pfield _ -> 1
   | Psetfield (_, isptr, init) ->
diff --git a/middle_end/internal_variable_names.ml b/middle_end/internal_variable_names.ml
index ee40085603..8edeb8c194 100644
--- a/middle_end/internal_variable_names.ml
+++ b/middle_end/internal_variable_names.ml
@@ -55,6 +55,7 @@ let get_symbol_field = "get_symbol_field"
 let const_immstring = "const_immstring"
 let const_int32 = "const_int32"
 let const_int64 = "const_int64"
+let ignore = "ignore"
 let is_zero = "is_zero"
 let lifted_let_rec_block = "lifted_let_rec_block"
 let meth = "meth"
@@ -288,6 +289,7 @@ let symbol_field_block = "symbol_field_block"
 let the_dead_constant = "the_dead_constant"
 let toplevel_substitution_named = "toplevel_substitution_named"
 let unbox_free_vars_of_closures = "unbox_free_vars_of_closures"
+let unit = "unit"
 let zero = "zero"
 
 let anon_fn_with_loc (loc: Location.t) =
diff --git a/middle_end/internal_variable_names.mli b/middle_end/internal_variable_names.mli
index 24712e89a6..11a8231e95 100644
--- a/middle_end/internal_variable_names.mli
+++ b/middle_end/internal_variable_names.mli
@@ -54,6 +54,7 @@ val get_symbol_field : t
 val const_immstring : t
 val const_int32 : t
 val const_int64 : t
+val ignore : t
 val is_zero : t
 val lifted_let_rec_block : t
 val meth : t
@@ -86,6 +87,7 @@ val symbol_field_block : t
 val the_dead_constant : t
 val toplevel_substitution_named : t
 val unbox_free_vars_of_closures : t
+val unit : t
 val zero : t
 
 val of_primitive : Lambda.primitive -> t
diff --git a/middle_end/simplify_boxed_integer_ops.ml b/middle_end/simplify_boxed_integer_ops.ml
index 24d51e5361..1f95a1ec2d 100644
--- a/middle_end/simplify_boxed_integer_ops.ml
+++ b/middle_end/simplify_boxed_integer_ops.ml
@@ -47,8 +47,8 @@ end) : Simplify_boxed_integer_ops_intf.S with type t := I.t = struct
 
   let equal_kind = Lambda.equal_boxed_integer
 
-  let simplify_unop (p : Lambda.primitive) (kind : I.t A.boxed_int)
-        expr (n : I.t) =
+  let simplify_unop (p : Clambda_primitives.primitive)
+        (kind : I.t A.boxed_int) expr (n : I.t) =
     let eval op = S.const_boxed_int_expr expr kind (op n) in
     let eval_conv kind op = S.const_boxed_int_expr expr kind (op n) in
     let eval_unboxed op = S.const_int_expr expr (op n) in
@@ -62,8 +62,8 @@ end) : Simplify_boxed_integer_ops_intf.S with type t := I.t = struct
     | Pbbswap kind when equal_kind kind I.kind -> eval I.swap
     | _ -> expr, A.value_unknown Other, C.Benefit.zero
 
-  let simplify_binop (p : Lambda.primitive) (kind : I.t A.boxed_int)
-        expr (n1 : I.t) (n2 : I.t) =
+  let simplify_binop (p : Clambda_primitives.primitive)
+        (kind : I.t A.boxed_int) expr (n1 : I.t) (n2 : I.t) =
     let eval op = S.const_boxed_int_expr expr kind (op n1 n2) in
     let non_zero n = (I.compare I.zero n) <> 0 in
     match p with
@@ -81,8 +81,8 @@ end) : Simplify_boxed_integer_ops_intf.S with type t := I.t = struct
       S.const_integer_comparison_expr expr c n1 n2
     | _ -> expr, A.value_unknown Other, C.Benefit.zero
 
-  let simplify_binop_int (p : Lambda.primitive) (kind : I.t A.boxed_int)
-        expr (n1 : I.t) (n2 : int) ~size_int =
+  let simplify_binop_int (p : Clambda_primitives.primitive)
+        (kind : I.t A.boxed_int) expr (n1 : I.t) (n2 : int) ~size_int =
     let eval op = S.const_boxed_int_expr expr kind (op n1 n2) in
     let precond = 0 <= n2 && n2 < 8 * size_int in
     match p with
diff --git a/middle_end/simplify_boxed_integer_ops_intf.mli b/middle_end/simplify_boxed_integer_ops_intf.mli
index ee62100291..f30987ae11 100644
--- a/middle_end/simplify_boxed_integer_ops_intf.mli
+++ b/middle_end/simplify_boxed_integer_ops_intf.mli
@@ -20,14 +20,14 @@ module type S = sig
   type t
 
   val simplify_unop
-     : Lambda.primitive
+     : Clambda_primitives.primitive
     -> t Simple_value_approx.boxed_int
     -> Flambda.named
     -> t
     -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
 
   val simplify_binop
-     : Lambda.primitive
+     : Clambda_primitives.primitive
     -> t Simple_value_approx.boxed_int
     -> Flambda.named
     -> t
@@ -35,7 +35,7 @@ module type S = sig
     -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
 
   val simplify_binop_int
-     : Lambda.primitive
+     : Clambda_primitives.primitive
     -> t Simple_value_approx.boxed_int
     -> Flambda.named
     -> t
diff --git a/middle_end/simplify_primitives.ml b/middle_end/simplify_primitives.ml
index a7107f7294..349d2f40ba 100644
--- a/middle_end/simplify_primitives.ml
+++ b/middle_end/simplify_primitives.ml
@@ -84,27 +84,28 @@ let is_empty = function
   | _ :: _ -> false
 
 let is_pisint = function
-  | Lambda.Pisint -> true
+  | Clambda_primitives.Pisint -> true
   | _ -> false
 
 let is_pstring_length = function
-  | Lambda.Pstringlength -> true
+  | Clambda_primitives.Pstringlength -> true
   | _ -> false
 
 let is_pbytes_length = function
-  | Lambda.Pbyteslength -> true
+  | Clambda_primitives.Pbyteslength -> true
   | _ -> false
 
 let is_pstringrefs = function
-  | Lambda.Pstringrefs -> true
+  | Clambda_primitives.Pstringrefs -> true
   | _ -> false
 
 let is_pbytesrefs = function
-  | Lambda.Pbytesrefs -> true
+  | Clambda_primitives.Pbytesrefs -> true
   | _ -> false
 
-let primitive (p : Lambda.primitive) (args, approxs) expr dbg ~size_int
-      ~big_endian : Flambda.named * A.t * Inlining_cost.Benefit.t =
+let primitive (p : Clambda_primitives.primitive) (args, approxs)
+      expr dbg ~size_int
+    : Flambda.named * A.t * Inlining_cost.Benefit.t =
   let fpc = !Clflags.float_const_prop in
   match p with
   | Pmakeblock(tag_int, Asttypes.Immutable, shape) ->
@@ -119,12 +120,6 @@ let primitive (p : Lambda.primitive) (args, approxs) expr dbg ~size_int
     A.value_block tag (Array.of_list approxs), C.Benefit.zero
   | Praise _ ->
     expr, A.value_bottom, C.Benefit.zero
-  | Pignore -> begin
-      match args, A.descrs approxs with
-      | [arg], [(Value_int 0 | Value_constptr 0)] ->
-        S.const_ptr_expr (Flambda.Expr (Var arg)) 0
-      | _ -> S.const_ptr_expr expr 0
-    end
   | Pmakearray(_, _) when is_empty approxs ->
     Prim (Pmakeblock(0, Asttypes.Immutable, Some []), [], dbg),
     A.value_block (Tag.create_exn 0) [||], C.Benefit.zero
@@ -173,7 +168,6 @@ let primitive (p : Lambda.primitive) (args, approxs) expr dbg ~size_int
     match A.descrs approxs with
     | [Value_int x] ->
       begin match p with
-      | Pidentity -> S.const_int_expr expr x
       | Pnot -> S.const_bool_expr expr (x = 0)
       | Pnegint -> S.const_int_expr expr (-x)
       | Pbswap16 -> S.const_int_expr expr (S.swap16 x)
@@ -212,27 +206,9 @@ let primitive (p : Lambda.primitive) (args, approxs) expr dbg ~size_int
       begin match p with
       (* [Pidentity] should probably never appear, but is here for
          completeness. *)
-      | Pidentity -> S.const_ptr_expr expr x
       | Pnot -> S.const_bool_expr expr (x = 0)
       | Pisint -> S.const_bool_expr expr true
       | Poffsetint y -> S.const_ptr_expr expr (x + y)
-      | Pctconst c ->
-        begin match c with
-        | Big_endian -> S.const_bool_expr expr big_endian
-        | Word_size -> S.const_int_expr expr (8*size_int)
-        | Int_size -> S.const_int_expr expr (8*size_int - 1)
-        | Max_wosize ->
-          (* CR-someday mshinwell: this function should maybe not live here. *)
-          S.const_int_expr expr ((1 lsl ((8*size_int) - 10)) - 1)
-        | Ostype_unix ->
-          S.const_bool_expr expr (String.equal Sys.os_type "Unix")
-        | Ostype_win32 ->
-          S.const_bool_expr expr (String.equal Sys.os_type "Win32")
-        | Ostype_cygwin ->
-          S.const_bool_expr expr (String.equal Sys.os_type "Cygwin")
-        | Backend_type ->
-          S.const_ptr_expr expr 0 (* tag 0 is the same as Native *)
-        end
       | _ -> expr, A.value_unknown Other, C.Benefit.zero
       end
     | [Value_float (Some x)] when fpc ->
diff --git a/middle_end/simplify_primitives.mli b/middle_end/simplify_primitives.mli
index 7f1f149b85..a6b6330c03 100644
--- a/middle_end/simplify_primitives.mli
+++ b/middle_end/simplify_primitives.mli
@@ -19,10 +19,9 @@
 (** Simplifies an application of a primitive based on approximation
     information. *)
 val primitive
-   : Lambda.primitive
+   : Clambda_primitives.primitive
   -> (Variable.t list * (Simple_value_approx.t list))
   -> Flambda.named
   -> Debuginfo.t
   -> size_int:int
-  -> big_endian:bool
   -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t