diff options
author | Tom Kelly <ctk21@cl.cam.ac.uk> | 2020-04-17 10:55:36 +0100 |
---|---|---|
committer | Tom Kelly <ctk21@cl.cam.ac.uk> | 2020-04-17 10:55:36 +0100 |
commit | 6dc414f3a6845ca773708d23f5d6168c2f00b2cd (patch) | |
tree | ea10540c9d39b8c2c25d17c489ca67ed19185d9f /middle_end | |
parent | 06dd45a94a57507a931b6294c14c8f080ded6990 (diff) | |
parent | c4d0fec0251883decc6e82fc243159b785c4e874 (diff) | |
download | ocaml-6dc414f3a6845ca773708d23f5d6168c2f00b2cd.tar.gz |
Merge commit 'c4d0fec0251883decc6e82fc243159b785c4e874' into parallel_minor_gc_4_09
Diffstat (limited to 'middle_end')
-rwxr-xr-x | middle_end/closure_conversion.ml | 51 | ||||
-rw-r--r-- | middle_end/effect_analysis.ml | 2 | ||||
-rw-r--r-- | middle_end/flambda.ml | 4 | ||||
-rwxr-xr-x | middle_end/flambda.mli | 2 | ||||
-rwxr-xr-x | middle_end/flambda_invariants.ml | 40 | ||||
-rw-r--r-- | middle_end/flambda_invariants.mli | 1 | ||||
-rw-r--r-- | middle_end/flambda_utils.ml | 4 | ||||
-rwxr-xr-x | middle_end/inconstant_idents.ml | 6 | ||||
-rwxr-xr-x | middle_end/inline_and_simplify.ml | 6 | ||||
-rw-r--r-- | middle_end/inlining_cost.ml | 5 | ||||
-rw-r--r-- | middle_end/internal_variable_names.ml | 2 | ||||
-rw-r--r-- | middle_end/internal_variable_names.mli | 2 | ||||
-rw-r--r-- | middle_end/simplify_boxed_integer_ops.ml | 12 | ||||
-rw-r--r-- | middle_end/simplify_boxed_integer_ops_intf.mli | 6 | ||||
-rw-r--r-- | middle_end/simplify_primitives.ml | 40 | ||||
-rw-r--r-- | middle_end/simplify_primitives.mli | 3 |
16 files changed, 84 insertions, 102 deletions
diff --git a/middle_end/closure_conversion.ml b/middle_end/closure_conversion.ml index e66e5aa36a..4aa702fb4f 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 fdd4d6598e..9e5624754a 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 1aa63ce5ca..74fd021bb9 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 792c01fe56..f89c363131 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" @@ -308,6 +309,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 |