diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 3a4babd31..bcdfbcd28 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -178,18 +178,12 @@ let rec expr_size env = function let transl_constant dbg = function | Uconst_int n -> int_const dbg n - | Uconst_ptr n -> - if n <= max_repr_int && n >= min_repr_int - then Cconst_int((n lsl 1) + 1, dbg) - else Cconst_natint - (Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n, - dbg) | Uconst_ref (label, _) -> Cconst_symbol (label, dbg) let emit_constant cst cont = match cst with - | Uconst_int n | Uconst_ptr n -> + | Uconst_int n -> cint_const n :: cont | Uconst_ref (sym, _) -> @@ -435,7 +429,7 @@ let rec transl env e = Cphantom_const_symbol sym | Uphantom_read_symbol_field { sym; field; } -> Cphantom_read_symbol_field { sym; field; } - | Uphantom_const (Uconst_int i) | Uphantom_const (Uconst_ptr i) -> + | Uphantom_const (Uconst_int i) -> Cphantom_const_int (targetint_const i) | Uphantom_var var -> Cphantom_var var | Uphantom_read_field { var; field; } -> @@ -1178,9 +1172,9 @@ and transl_if env (approx : then_else) (then_dbg : Debuginfo.t) then_ (else_dbg : Debuginfo.t) else_ = match cond with - | Uconst (Uconst_ptr 0) -> else_ - | Uconst (Uconst_ptr 1) -> then_ - | Uifthenelse (arg1, arg2, Uconst (Uconst_ptr 0)) -> + | Uconst (Uconst_int 0) -> else_ + | Uconst (Uconst_int 1) -> then_ + | Uifthenelse (arg1, arg2, Uconst (Uconst_int 0)) -> (* CR mshinwell: These Debuginfos will flow through from Clambda *) let inner_dbg = Debuginfo.none in let ifso_dbg = Debuginfo.none in @@ -1195,7 +1189,7 @@ and transl_if env (approx : then_else) inner_dbg arg2 then_dbg then_ else_dbg else_ - | Uifthenelse (arg1, Uconst (Uconst_ptr 1), arg2) -> + | Uifthenelse (arg1, Uconst (Uconst_int 1), arg2) -> let inner_dbg = Debuginfo.none in let ifnot_dbg = Debuginfo.none in transl_sequor env approx @@ -1214,13 +1208,13 @@ and transl_if env (approx : then_else) dbg arg else_dbg else_ then_dbg then_ - | Uifthenelse (Uconst (Uconst_ptr 1), ifso, _) -> + | Uifthenelse (Uconst (Uconst_int 1), ifso, _) -> let ifso_dbg = Debuginfo.none in transl_if env approx ifso_dbg ifso then_dbg then_ else_dbg else_ - | Uifthenelse (Uconst (Uconst_ptr 0), _, ifnot) -> + | Uifthenelse (Uconst (Uconst_int 0), _, ifnot) -> let ifnot_dbg = Debuginfo.none in transl_if env approx ifnot_dbg ifnot diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml index 03251eb04..1b744f3fe 100644 --- a/bytecomp/emitcode.ml +++ b/bytecomp/emitcode.ml @@ -77,7 +77,6 @@ exception AsInt let const_as_int = function | Const_base(Const_int i) -> i | Const_base(Const_char c) -> Char.code c - | Const_pointer i -> i | _ -> raise AsInt let is_immed i = immed_min <= i && i <= immed_max @@ -240,10 +239,6 @@ let emit_instr = function else (out opCONSTINT; out_int i) | Const_base(Const_char c) -> out opCONSTINT; out_int (Char.code c) - | Const_pointer i -> - if i >= 0 && i <= 3 - then out (opCONST0 + i) - else (out opCONSTINT; out_int i) | Const_block(t, []) -> if t = 0 then out opATOM0 else (out opATOM; out_int t) | _ -> @@ -372,10 +367,6 @@ let rec emit = function else (out opPUSHCONSTINT; out_int i) | Const_base(Const_char c) -> out opPUSHCONSTINT; out_int(Char.code c) - | Const_pointer i -> - if i >= 0 && i <= 3 - then out (opPUSHCONST0 + i) - else (out opPUSHCONSTINT; out_int i) | Const_block(t, []) -> if t = 0 then out opPUSHATOM0 else (out opPUSHATOM; out_int t) | _ -> diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml index dad4cafe5..8516034d6 100644 --- a/bytecomp/symtable.ml +++ b/bytecomp/symtable.ml @@ -222,7 +222,6 @@ let rec transl_const = function | Const_base(Const_int32 i) -> Obj.repr i | Const_base(Const_int64 i) -> Obj.repr i | Const_base(Const_nativeint i) -> Obj.repr i - | Const_pointer i -> Obj.repr i | Const_immstring s -> Obj.repr s | Const_block(tag, fields) -> let block = Obj.new_block tag (List.length fields) in diff --git a/lambda/lambda.ml b/lambda/lambda.ml index 3a776bee3..585d29b7a 100644 --- a/lambda/lambda.ml +++ b/lambda/lambda.ml @@ -207,7 +207,6 @@ let equal_value_kind x y = type structured_constant = Const_base of constant - | Const_pointer of int | Const_block of int * structured_constant list | Const_float_array of string list | Const_immstring of string @@ -342,7 +341,9 @@ type program = required_globals : Ident.Set.t; code : lambda } -let const_unit = Const_pointer 0 +let const_int n = Const_base (Const_int n) + +let const_unit = const_int 0 let lambda_unit = Lconst const_unit diff --git a/lambda/lambda.mli b/lambda/lambda.mli index d18169812..ed0e47240 100644 --- a/lambda/lambda.mli +++ b/lambda/lambda.mli @@ -198,7 +198,6 @@ val equal_boxed_integer : boxed_integer -> boxed_integer -> bool type structured_constant = Const_base of constant - | Const_pointer of int | Const_block of int * structured_constant list | Const_float_array of string list | Const_immstring of string @@ -341,6 +340,7 @@ type program = val make_key: lambda -> lambda option val const_unit: structured_constant +val const_int : int -> structured_constant val lambda_unit: lambda val name_lambda: let_kind -> lambda -> (Ident.t -> lambda) -> lambda val name_lambda_list: lambda list -> (lambda list -> lambda) -> lambda diff --git a/lambda/printlambda.ml b/lambda/printlambda.ml index 87340608f..73d029eb0 100644 --- a/lambda/printlambda.ml +++ b/lambda/printlambda.ml @@ -29,7 +29,6 @@ let rec struct_const ppf = function | Const_base(Const_int32 n) -> fprintf ppf "%lil" n | Const_base(Const_int64 n) -> fprintf ppf "%LiL" n | Const_base(Const_nativeint n) -> fprintf ppf "%nin" n - | Const_pointer n -> fprintf ppf "%ia" n | Const_block(tag, []) -> fprintf ppf "[%i]" tag | Const_block(tag, sc1::scl) -> diff --git a/lambda/translclass.ml b/lambda/translclass.ml index 1f39ea103..774bd270a 100644 --- a/lambda/translclass.ml +++ b/lambda/translclass.ml @@ -64,7 +64,7 @@ let lfield v i = Lprim(Pfield i, [Lvar v], Loc_unknown) let transl_label l = share (Const_immstring l) let transl_meth_list lst = - if lst = [] then Lconst (Const_pointer 0) else + if lst = [] then Lconst (const_int 0) else share (Const_block (0, List.map (fun lab -> Const_immstring lab) lst)) @@ -379,7 +379,7 @@ let rec build_class_init ~scopes cla cstr super inh_init cl_init msubst top cl = Llet (Strict, Pgenval, inh, mkappl(oo_prim "inherits", narrow_args @ [path_lam; - Lconst(Const_pointer(if top then 1 else 0))]), + Lconst(const_int (if top then 1 else 0))]), Llet(StrictOpt, Pgenval, obj_init, lfield inh 0, cl_init))) | _ -> let core cl_init = @@ -547,7 +547,7 @@ let rec builtin_meths self env env2 body = | Lprim(Parrayrefu _, [Lvar s; Lvar n], _) when List.mem s self -> "var", [Lvar n] | Lprim(Pfield n, [Lvar e], _) when Ident.same e env -> - "env", [Lvar env2; Lconst(Const_pointer n)] + "env", [Lvar env2; Lconst(const_int n)] | Lsend(Self, met, Lvar s, [], _) when List.mem s self -> "meth", [met] | _ -> raise Not_found @@ -618,7 +618,7 @@ module M = struct | "send_env" -> SendEnv | "send_meth" -> SendMeth | _ -> assert false - in Lconst(Const_pointer(Obj.magic tag)) :: args + in Lconst(const_int (Obj.magic tag)) :: args end open M diff --git a/lambda/translcore.ml b/lambda/translcore.ml index 5d479f3f7..411b4f3e6 100644 --- a/lambda/translcore.ml +++ b/lambda/translcore.ml @@ -64,7 +64,7 @@ let transl_extension_constructor ~scopes env path ext = Text_decl _ -> Lprim (Pmakeblock (Obj.object_tag, Immutable, None), [Lconst (Const_base (Const_string (name, ext.ext_loc, None))); - Lprim (prim_fresh_oo_id, [Lconst (Const_base (Const_int 0))], loc)], + Lprim (prim_fresh_oo_id, [Lconst (const_int 0)], loc)], loc) | Text_rebind(path, _lid) -> transl_extension_path loc env path @@ -309,7 +309,7 @@ and transl_exp0 ~scopes e = | _ -> assert false end else begin match cstr.cstr_tag with Cstr_constant n -> - Lconst(Const_pointer n) + Lconst(const_int n) | Cstr_unboxed -> (match ll with [v] -> v | _ -> assert false) | Cstr_block n -> @@ -332,15 +332,15 @@ and transl_exp0 ~scopes e = | Texp_variant(l, arg) -> let tag = Btype.hash_variant l in begin match arg with - None -> Lconst(Const_pointer tag) + None -> Lconst(const_int tag) | Some arg -> let lam = transl_exp ~scopes arg in try - Lconst(Const_block(0, [Const_base(Const_int tag); + Lconst(Const_block(0, [const_int tag; extract_constant lam])) with Not_constant -> Lprim(Pmakeblock(0, Immutable, None), - [Lconst(Const_base(Const_int tag)); lam], + [Lconst(const_int tag); lam], of_location ~scopes e.exp_loc) end | Texp_record {fields; representation; extended_expression} -> diff --git a/lambda/translmod.ml b/lambda/translmod.ml index e578ee7e5..db54bdd64 100644 --- a/lambda/translmod.ml +++ b/lambda/translmod.ml @@ -217,8 +217,8 @@ let undefined_location loc = let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in Lconst(Const_block(0, [Const_base(Const_string (fname, loc, None)); - Const_base(Const_int line); - Const_base(Const_int char)])) + const_int line; + const_int char])) exception Initialization_failure of unsafe_info @@ -242,9 +242,9 @@ let init_shape id modl = let init_v = match Ctype.expand_head env ty with {desc = Tarrow(_,_,_,_)} -> - Const_pointer 0 (* camlinternalMod.Function *) + const_int 0 (* camlinternalMod.Function *) | {desc = Tconstr(p, _, _)} when Path.same p Predef.path_lazy_t -> - Const_pointer 1 (* camlinternalMod.Lazy *) + const_int 1 (* camlinternalMod.Lazy *) | _ -> let not_a_function = Unsafe {reason=Unsafe_non_function; loc; subid } @@ -270,7 +270,7 @@ let init_shape id modl = | Sig_modtype(id, minfo, _) :: rem -> init_shape_struct (Env.add_modtype id minfo env) rem | Sig_class _ :: rem -> - Const_pointer 2 (* camlinternalMod.Class *) + const_int 2 (* camlinternalMod.Class *) :: init_shape_struct env rem | Sig_class_type _ :: rem -> init_shape_struct env rem diff --git a/lambda/translprim.ml b/lambda/translprim.ml index 9cee91b93..e7b43fb56 100644 --- a/lambda/translprim.ml +++ b/lambda/translprim.ml @@ -644,7 +644,7 @@ let lambda_of_prim prim_name prim loc args arg_exps = | Primitive (prim, arity), args when arity = List.length args -> Lprim(prim, args, loc) | External prim, args when prim = prim_sys_argv -> - Lprim(Pccall prim, Lconst (Const_pointer 0) :: args, loc) + Lprim(Pccall prim, Lconst (const_int 0) :: args, loc) | External prim, args -> Lprim(Pccall prim, args, loc) | Comparison(comp, knd), ([_;_] as args) -> diff --git a/middle_end/clambda.ml b/middle_end/clambda.ml index 59402629f..11b51bccb 100644 --- a/middle_end/clambda.ml +++ b/middle_end/clambda.ml @@ -34,7 +34,6 @@ type ustructured_constant = and uconstant = | Uconst_ref of string * ustructured_constant option | Uconst_int of int - | Uconst_ptr of int and uphantom_defining_expr = | Uphantom_const of uconstant @@ -162,11 +161,8 @@ let compare_constants c1 c2 = match, because of string constants that must not be reshared. *) | Uconst_int n1, Uconst_int n2 -> Stdlib.compare n1 n2 - | Uconst_ptr n1, Uconst_ptr n2 -> Stdlib.compare n1 n2 | Uconst_ref _, _ -> -1 | Uconst_int _, Uconst_ref _ -> 1 - | Uconst_int _, Uconst_ptr _ -> -1 - | Uconst_ptr _, _ -> 1 let rec compare_constant_lists l1 l2 = match l1, l2 with diff --git a/middle_end/clambda.mli b/middle_end/clambda.mli index 9d74eb665..600778ae9 100644 --- a/middle_end/clambda.mli +++ b/middle_end/clambda.mli @@ -34,7 +34,6 @@ type ustructured_constant = and uconstant = | Uconst_ref of string * ustructured_constant option | Uconst_int of int - | Uconst_ptr of int and uphantom_defining_expr = | Uphantom_const of uconstant diff --git a/middle_end/closure/closure.ml b/middle_end/closure/closure.ml index 4ab577904..700ec9c40 100644 --- a/middle_end/closure/closure.ml +++ b/middle_end/closure/closure.ml @@ -237,8 +237,7 @@ let make_const_ref c = make_const(Uconst_ref(Compilenv.new_structured_constant ~shared:true c, Some c)) let make_const_int n = make_const (Uconst_int n) -let make_const_ptr n = make_const (Uconst_ptr n) -let make_const_bool b = make_const_ptr(if b then 1 else 0) +let make_const_bool b = make_const_int(if b then 1 else 0) let make_integer_comparison cmp x y = let open Clambda_primitives in @@ -279,7 +278,7 @@ let simplif_arith_prim_pure ~backend fpc p (args, approxs) dbg = let default = (Uprim(p, args, dbg), Value_unknown) in match approxs with (* int (or enumerated type) *) - | [ Value_const(Uconst_int n1 | Uconst_ptr n1) ] -> + | [ Value_const(Uconst_int n1) ] -> begin match p with | Pnot -> make_const_bool (n1 = 0) | Pnegint -> make_const_int (- n1) @@ -293,8 +292,8 @@ let simplif_arith_prim_pure ~backend fpc p (args, approxs) dbg = | _ -> default end (* int (or enumerated type), int (or enumerated type) *) - | [ Value_const(Uconst_int n1 | Uconst_ptr n1); - Value_const(Uconst_int n2 | Uconst_ptr n2) ] -> + | [ Value_const(Uconst_int n1); + Value_const(Uconst_int n2) ] -> begin match p with | Psequand -> make_const_bool (n1 <> 0 && n2 <> 0) | Psequor -> make_const_bool (n1 <> 0 || n2 <> 0) @@ -493,7 +492,7 @@ let simplif_prim_pure ~backend fpc p (args, approxs) dbg = (* Kind test *) | Pisint, _, [a1] -> begin match a1 with - | Value_const(Uconst_int _ | Uconst_ptr _) -> make_const_bool true + | Value_const(Uconst_int _) -> make_const_bool true | Value_const(Uconst_ref _) -> make_const_bool false | Value_closure _ | Value_tuple _ -> make_const_bool false | _ -> (Uprim(p, args, dbg), Value_unknown) @@ -607,7 +606,7 @@ let rec substitute loc ((backend, fpc) as st) sb rn ulam = match sarg with | Uconst (Uconst_ref (_, Some (Uconst_block (tag, _)))) -> find_action sw.us_index_blocks sw.us_actions_blocks tag - | Uconst (Uconst_ptr tag) -> + | Uconst (Uconst_int tag) -> find_action sw.us_index_consts sw.us_actions_consts tag | _ -> None in @@ -663,7 +662,7 @@ let rec substitute loc ((backend, fpc) as st) sb rn ulam = (V.Map.add (VP.var id) (Uvar (VP.var id')) sb) rn u2) | Uifthenelse(u1, u2, u3) -> begin match substitute loc st sb rn u1 with - Uconst (Uconst_ptr n) -> + Uconst (Uconst_int n) -> if n <> 0 then substitute loc st sb rn u2 else @@ -799,8 +798,7 @@ let direct_apply env fundesc ufunct uargs ~loc ~attribute = then app else Usequence(ufunct, app) -(* Add [Value_integer] or [Value_constptr] info to the approximation - of an application *) +(* Add [Value_integer] info to the approximation of an application *) let strengthen_approx appl approx = match approx_ulam appl with @@ -808,7 +806,7 @@ let strengthen_approx appl approx = intapprox | _ -> approx -(* If a term has approximation Value_integer or Value_constptr and is pure, +(* If a term has approximation Value_integer and is pure, replace it by an integer constant *) let check_constant_result ulam approx = @@ -875,7 +873,6 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam = let rec transl = function | Const_base(Const_int n) -> Uconst_int n | Const_base(Const_char c) -> Uconst_int (Char.code c) - | Const_pointer n -> Uconst_ptr n | Const_block (tag, fields) -> str (Uconst_block (tag, List.map transl fields)) | Const_float_array sl -> @@ -1057,13 +1054,13 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam = | Ostype_win32 -> make_const_bool (Sys.os_type = "Win32") | Ostype_cygwin -> make_const_bool (Sys.os_type = "Cygwin") | Backend_type -> - make_const_ptr 0 (* tag 0 is the same as Native here *) + make_const_int 0 (* tag 0 is the same as Native here *) in let arg, _approx = close env arg in let id = Ident.create_local "dummy" in Ulet(Immutable, Pgenval, VP.create id, arg, cst), approx | Lprim(Pignore, [arg], _loc) -> - let expr, approx = make_const_ptr 0 in + let expr, approx = make_const_int 0 in Usequence(fst (close env arg), expr), approx | Lprim((Pidentity | Pbytes_to_string | Pbytes_of_string), [arg], _loc) -> close env arg @@ -1161,7 +1158,7 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam = (Utrywith(ubody, VP.create id, uhandler), Value_unknown) | Lifthenelse(arg, ifso, ifnot) -> begin match close env arg with - (uarg, Value_const (Uconst_ptr n)) -> + (uarg, Value_const (Uconst_int n)) -> sequence_constant_expr uarg (close env (if n = 0 then ifnot else ifso)) | (uarg, _ ) -> @@ -1435,7 +1432,7 @@ let collect_exported_structured_constants a = Compilenv.add_exported_constant s; structured_constant c | Uconst_ref (_s, None) -> assert false (* Cannot be generated *) - | Uconst_int _ | Uconst_ptr _ -> () + | Uconst_int _ -> () and structured_constant = function | Uconst_block (_, ul) -> List.iter const ul | Uconst_float _ | Uconst_int32 _ diff --git a/middle_end/flambda/build_export_info.ml b/middle_end/flambda/build_export_info.ml index 2025feddc..554b69a2e 100644 --- a/middle_end/flambda/build_export_info.ml +++ b/middle_end/flambda/build_export_info.ml @@ -171,7 +171,7 @@ end = struct | export_id -> export_id let new_unit_descr t = - new_descr t (Value_constptr 0) + new_descr t (Value_int 0) let add_approx t var approx = if Variable.Map.mem var t.var then begin @@ -199,12 +199,8 @@ end let descr_of_constant (c : Flambda.const) : Export_info.descr = match c with - (* [Const_pointer] is an immediate value of a type whose values may be - boxed (typically a variant type with both constant and non-constant - constructors). *) | Int i -> Value_int i | Char c -> Value_char c - | Const_pointer i -> Value_constptr i let descr_of_allocated_constant (c : Allocated_const.t) : Export_info.descr = match c with @@ -602,7 +598,6 @@ let build_transient ~(backend : (module Backend_intf.S)) | Value_mutable_block _ | Value_int _ | Value_char _ - | Value_constptr _ | Value_float _ | Value_float_array _ | Value_string _ @@ -644,7 +639,6 @@ let build_transient ~(backend : (module Backend_intf.S)) | Value_mutable_block _ | Value_int _ | Value_char _ - | Value_constptr _ | Value_float _ | Value_float_array _ | Value_string _ diff --git a/middle_end/flambda/closure_conversion.ml b/middle_end/flambda/closure_conversion.ml index 31da98ac4..b47fb80c1 100644 --- a/middle_end/flambda/closure_conversion.ml +++ b/middle_end/flambda/closure_conversion.ml @@ -137,7 +137,6 @@ let rec declare_const t (const : Lambda.structured_constant) Names.const_int64 | Const_base (Const_nativeint c) -> register_const t (Allocated_const (Nativeint c)) Names.const_nativeint - | Const_pointer c -> Const (Const_pointer c), Names.const_ptr | Const_immstring c -> register_const t (Allocated_const (Immutable_string c)) Names.const_immstring @@ -162,9 +161,9 @@ let close_const t (const : Lambda.structured_constant) let lambda_const_bool b : Lambda.structured_constant = if b then - Const_pointer 1 + Lambda.const_int 1 else - Const_pointer 0 + Lambda.const_int 0 let lambda_const_int i : Lambda.structured_constant = Const_base (Const_int i) @@ -391,7 +390,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t = let arg2 = close t env arg2 in let const_true = Variable.create Names.const_true in let cond = Variable.create Names.cond_sequor in - Flambda.create_let const_true (Const (Const_pointer 1)) + Flambda.create_let const_true (Const (Int 1)) (Flambda.create_let cond (Expr arg1) (If_then_else (cond, Var const_true, arg2))) | Lprim (Psequand, [arg1; arg2], _) -> @@ -399,7 +398,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t = let arg2 = close t env arg2 in let const_false = Variable.create Names.const_false in let cond = Variable.create Names.const_sequand in - Flambda.create_let const_false (Const (Const_pointer 0)) + Flambda.create_let const_false (Const (Int 0)) (Flambda.create_let cond (Expr arg1) (If_then_else (cond, arg2, Var const_false))) | Lprim ((Psequand | Psequor), _, _) -> @@ -412,7 +411,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t = close_let_bound_expression t var env arg in Flambda.create_let var defining_expr - (name_expr (Const (Const_pointer 0)) ~name:Names.unit) + (name_expr (Const (Int 0)) ~name:Names.unit) | Lprim (Pdirapply, [funct; arg], loc) | Lprim (Prevapply, [arg; funct], loc) -> let apply : Lambda.lambda_apply = @@ -448,7 +447,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t = | 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 *) + Lambda.const_int 0 (* tag 0 is the same as Native *) end in close t env diff --git a/middle_end/flambda/export_info.ml b/middle_end/flambda/export_info.ml index 22dbb6c58..dc47be5e1 100644 --- a/middle_end/flambda/export_info.ml +++ b/middle_end/flambda/export_info.ml @@ -41,7 +41,6 @@ type descr = | Value_mutable_block of Tag.t * int | Value_int of int | Value_char of char - | Value_constptr of int | Value_float of float | Value_float_array of value_float_array | Value_boxed_int : 'a A.boxed_int * 'a -> descr @@ -113,8 +112,6 @@ let equal_descr (d1:descr) (d2:descr) : bool = i1 = i2 | Value_char c1, Value_char c2 -> c1 = c2 - | Value_constptr i1, Value_constptr i2 -> - i1 = i2 | Value_float f1, Value_float f2 -> f1 = f2 | Value_float_array s1, Value_float_array s2 -> @@ -129,12 +126,12 @@ let equal_descr (d1:descr) (d2:descr) : bool = | Value_set_of_closures s1, Value_set_of_closures s2 -> equal_set_of_closures s1 s2 | ( Value_block (_, _) | Value_mutable_block (_, _) | Value_int _ - | Value_char _ | Value_constptr _ | Value_float _ | Value_float_array _ + | Value_char _ | Value_float _ | Value_float_array _ | Value_boxed_int _ | Value_string _ | Value_closure _ | Value_set_of_closures _ | Value_unknown_descr ), ( Value_block (_, _) | Value_mutable_block (_, _) | Value_int _ - | Value_char _ | Value_constptr _ | Value_float _ | Value_float_array _ + | Value_char _ | Value_float _ | Value_float_array _ | Value_boxed_int _ | Value_string _ | Value_closure _ | Value_set_of_closures _ | Value_unknown_descr ) -> @@ -396,7 +393,6 @@ let print_raw_descr ppf descr = fprintf ppf "(Value_mutable-block (%a %d))" Tag.print tag i | Value_int i -> fprintf ppf "(Value_int %d)" i | Value_char c -> fprintf ppf "(Value_char %c)" c - | Value_constptr p -> fprintf ppf "(Value_constptr %d)" p | Value_float f -> fprintf ppf "(Value_float %.3f)" f | Value_float_array value_float_array -> fprintf ppf "(Value_float_array %a)" @@ -445,7 +441,6 @@ let print_approx_components ppf ~symbol_id ~values match descr with | Value_int i -> Format.pp_print_int ppf i | Value_char c -> fprintf ppf "%c" c - | Value_constptr i -> fprintf ppf "%ip" i | Value_block (tag, fields) -> fprintf ppf "[%a:%a]" Tag.print tag print_fields fields | Value_mutable_block (tag, size) -> diff --git a/middle_end/flambda/export_info.mli b/middle_end/flambda/export_info.mli index f93698be4..4068a168d 100644 --- a/middle_end/flambda/export_info.mli +++ b/middle_end/flambda/export_info.mli @@ -44,7 +44,6 @@ type descr = | Value_mutable_block of Tag.t * int | Value_int of int | Value_char of char - | Value_constptr of int | Value_float of float | Value_float_array of value_float_array | Value_boxed_int : 'a A.boxed_int * 'a -> descr diff --git a/middle_end/flambda/export_info_for_pack.ml b/middle_end/flambda/export_info_for_pack.ml index ebed55936..f4baa29b8 100644 --- a/middle_end/flambda/export_info_for_pack.ml +++ b/middle_end/flambda/export_info_for_pack.ml @@ -99,7 +99,6 @@ let import_descr_for_pack units pack (descr : Export_info.descr) match descr with | Value_int _ | Value_char _ - | Value_constptr _ | Value_string _ | Value_float _ | Value_float_array _ diff --git a/middle_end/flambda/flambda.ml b/middle_end/flambda/flambda.ml index 2866c697e..55ffb87da 100644 --- a/middle_end/flambda/flambda.ml +++ b/middle_end/flambda/flambda.ml @@ -24,7 +24,6 @@ type call_kind = type const = | Int of int | Char of char - | Const_pointer of int type apply = { func : Variable.t; @@ -428,7 +427,6 @@ and print_const ppf (c : const) = match c with | Int n -> fprintf ppf "%i" n | Char c -> fprintf ppf "%C" c - | Const_pointer n -> fprintf ppf "%ia" n let print_function_declarations ppf (fd : function_declarations) = let funs ppf = @@ -1189,11 +1187,8 @@ let compare_const (c1:const) (c2:const) = match c1, c2 with | Int i1, Int i2 -> compare i1 i2 | Char i1, Char i2 -> Char.compare i1 i2 - | Const_pointer i1, Const_pointer i2 -> compare i1 i2 - | Int _, (Char _ | Const_pointer _) -> -1 - | (Char _ | Const_pointer _), Int _ -> 1 - | Char _, Const_pointer _ -> -1 - | Const_pointer _, Char _ -> 1 + | Int _, Char _ -> -1 + | Char _, Int _ -> 1 let compare_constant_defining_value_block_field (c1:constant_defining_value_block_field) diff --git a/middle_end/flambda/flambda.mli b/middle_end/flambda/flambda.mli index 325c15ee1..8665b5a41 100644 --- a/middle_end/flambda/flambda.mli +++ b/middle_end/flambda/flambda.mli @@ -29,10 +29,6 @@ type const = | Int of int | Char of char (** [Char] is kept separate from [Int] to improve printing *) - | Const_pointer of int - (** [Const_pointer] is an immediate value of a type whose values may be - boxed (typically a variant type with both constant and non-constant - constructors). *) (** The application of a function to a list of arguments. *) type apply = { diff --git a/middle_end/flambda/flambda_to_clambda.ml b/middle_end/flambda/flambda_to_clambda.ml index d53034c8e..6b4fae246 100644 --- a/middle_end/flambda/flambda_to_clambda.ml +++ b/middle_end/flambda/flambda_to_clambda.ml @@ -232,7 +232,6 @@ let to_clambda_const env (const : Flambda.constant_defining_value_block_field) | Symbol symbol -> to_clambda_symbol' env symbol | Const (Int i) -> Uconst_int i | Const (Char c) -> Uconst_int (Char.code c) - | Const (Const_pointer i) -> Uconst_ptr i let rec to_clambda t env (flam : Flambda.t) : Clambda.ulambda = match flam with @@ -357,7 +356,6 @@ let rec to_clambda t env (flam : Flambda.t) : Clambda.ulambda = and to_clambda_named t env var (named : Flambda.named) : Clambda.ulambda = match named with | Symbol sym -> to_clambda_symbol env sym - | Const (Const_pointer n) -> Uconst (Uconst_ptr n) | Const (Int n) -> Uconst (Uconst_int n) | Const (Char c) -> Uconst (Uconst_int (Char.code c)) | Allocated_const _ -> @@ -612,7 +610,7 @@ let to_clambda_initialize_symbol t env symbol fields : Clambda.ulambda = Debuginfo.none) in match fields with - | [] -> Uconst (Uconst_ptr 0) + | [] -> Uconst (Uconst_int 0) | h :: t -> List.fold_left (fun acc (p, field) -> Clambda.Usequence (build_setfield (p, field), acc)) @@ -681,7 +679,6 @@ let to_clambda_program t env constants (program : Flambda.program) = match const with | Int i -> i | Char c -> Char.code c - | Const_pointer i -> i in Some (Clambda.Uconst_field_int n) | Some (Flambda.Symbol sym) -> @@ -705,7 +702,7 @@ let to_clambda_program t env constants (program : Flambda.program) = let e2, constants, preallocated_blocks = loop env constants program in Usequence (e1, e2), constants, preallocated_blocks | End _ -> - Uconst (Uconst_ptr 0), constants, [] + Uconst (Uconst_int 0), constants, [] in loop env constants program.program_body diff --git a/middle_end/flambda/import_approx.ml b/middle_end/flambda/import_approx.ml index 64fbbb8bf..f5c004aa6 100644 --- a/middle_end/flambda/import_approx.ml +++ b/middle_end/flambda/import_approx.ml @@ -126,7 +126,6 @@ let rec import_ex ex = | Value_unknown_descr -> A.value_unknown Other | Value_int i -> A.value_int i | Value_char c -> A.value_char c - | Value_constptr i -> A.value_constptr i | Value_float f -> A.value_float f | Value_float_array float_array -> begin match float_array.contents with diff --git a/middle_end/flambda/inline_and_simplify.ml b/middle_end/flambda/inline_and_simplify.ml index a4b3a5688..775268a2c 100644 --- a/middle_end/flambda/inline_and_simplify.ml +++ b/middle_end/flambda/inline_and_simplify.ml @@ -175,7 +175,6 @@ let simplify_const (const : Flambda.const) = match const with | Int i -> A.value_int i | Char c -> A.value_char c - | Const_pointer i -> A.value_constptr i let approx_for_allocated_const (const : Allocated_const.t) = match const with @@ -1213,10 +1212,10 @@ and simplify env r (tree : Flambda.t) : Flambda.t * R.t = if arg is not effectful we can also drop it. *) simplify_free_variable env arg ~f:(fun env arg arg_approx -> begin match arg_approx.descr with - | Value_constptr 0 | Value_int 0 -> (* Constant [false]: keep [ifnot] *) + | Value_int 0 -> (* Constant [false]: keep [ifnot] *) let ifnot, r = simplify env r ifnot in ifnot, R.map_benefit r B.remove_branch - | Value_constptr _ | Value_int _ + | Value_int _ | Value_block _ -> (* Constant [true]: keep [ifso] *) let ifso, r = simplify env r ifso in ifso, R.map_benefit r B.remove_branch diff --git a/middle_end/flambda/remove_unused_arguments.ml b/middle_end/flambda/remove_unused_arguments.ml index f70da729a..21ce9670e 100644 --- a/middle_end/flambda/remove_unused_arguments.ml +++ b/middle_end/flambda/remove_unused_arguments.ml @@ -35,7 +35,7 @@ let remove_params unused (fun_decl: Flambda.function_declaration) in let body = List.fold_left (fun body param -> - Flambda.create_let (Parameter.var param) (Const (Const_pointer 0)) body) + Flambda.create_let (Parameter.var param) (Const (Int 0)) body) fun_decl.body unused_params in diff --git a/middle_end/flambda/simple_value_approx.ml b/middle_end/flambda/simple_value_approx.ml index d527674f8..d2e0b21ef 100644 --- a/middle_end/flambda/simple_value_approx.ml +++ b/middle_end/flambda/simple_value_approx.ml @@ -48,7 +48,6 @@ and descr = | Value_block of Tag.t * t array | Value_int of int | Value_char of char - | Value_constptr of int | Value_float of float option | Value_boxed_int : 'a boxed_int * 'a -> descr | Value_set_of_closures of value_set_of_closures @@ -171,7 +170,6 @@ let print_function_declarations ppf (fd : function_declarations) = let rec print_descr ppf = function | Value_int i -> Format.pp_print_int ppf i | Value_char c -> Format.fprintf ppf "%c" c - | Value_constptr i -> Format.fprintf ppf "%ia" i | Value_block (tag,fields) -> let p ppf fields = Array.iter (fun v -> Format.fprintf ppf "%a@ " print v) fields in @@ -253,7 +251,6 @@ let augment_with_kind t (kind:Lambda.value_kind) = | Value_block _ | Value_int _ | Value_char _ - | Value_constptr _ | Value_boxed_int _ | Value_set_of_closures _ | Value_closure _ @@ -280,7 +277,6 @@ let augment_kind_with_approx t (kind:Lambda.value_kind) : Lambda.value_kind = let value_unknown reason = approx (Value_unknown reason) let value_int i = approx (Value_int i) let value_char i = approx (Value_char i) -let value_constptr i = approx (Value_constptr i) let value_float f = approx (Value_float (Some f)) let value_any_float = approx (Value_float None) let value_boxed_int bi i = approx (Value_boxed_int (bi,i)) @@ -392,19 +388,8 @@ let make_const_char n = let name = Internal_variable_names.const_char in name_expr_fst (make_const_char_named n) ~name -let make_const_ptr_named n : Flambda.named * t = - Const (Const_pointer n), value_constptr n -let make_const_ptr (n : int) = - let name = - match n with - | 0 -> Internal_variable_names.const_ptr_zero - | 1 -> Internal_variable_names.const_ptr_one - | _ -> Internal_variable_names.const_ptr - in - name_expr_fst (make_const_ptr_named n) ~name - let make_const_bool_named b : Flambda.named * t = - make_const_ptr_named (if b then 1 else 0) + make_const_int_named (if b then 1 else 0) let make_const_bool b = name_expr_fst (make_const_bool_named b) ~name:Internal_variable_names.const_bool @@ -444,9 +429,6 @@ let simplify t (lam : Flambda.t) : simplification_result = | Value_char n -> let const, approx = make_const_char n in const, Replaced_term, approx - | Value_constptr n -> - let const, approx = make_const_ptr n in - const, Replaced_term, approx | Value_float (Some f) -> let const, approx = make_const_float f in const, Replaced_term, approx @@ -472,9 +454,6 @@ let simplify_named t (named : Flambda.named) : simplification_result_named = | Value_char n -> let const, approx = make_const_char_named n in const, Replaced_term, approx - | Value_constptr n -> - let const, approx = make_const_ptr_named n in - const, Replaced_term, approx | Value_float (Some f) -> let const, approx = make_const_float_named f in const, Replaced_term, approx @@ -496,7 +475,6 @@ let simplify_var t : (Flambda.named * t) option = match t.descr with | Value_int n -> Some (make_const_int_named n) | Value_char n -> Some (make_const_char_named n) - | Value_constptr n -> Some (make_const_ptr_named n) | Value_float (Some f) -> Some (make_const_float_named f) | Value_boxed_int (t, i) -> Some (make_const_boxed_int_named t i) | Value_symbol sym -> Some (Symbol sym, t) @@ -559,14 +537,14 @@ let known t = | Value_unknown _ -> false | Value_string _ | Value_float_array _ | Value_bottom | Value_block _ | Value_int _ | Value_char _ - | Value_constptr _ | Value_set_of_closures _ | Value_closure _ + | Value_set_of_closures _ | Value_closure _ | Value_extern _ | Value_float _ | Value_boxed_int _ | Value_symbol _ -> true let useful t = match t.descr with | Value_unresolved _ | Value_unknown _ | Value_bottom -> false | Value_string _ | Value_float_array _ | Value_block _ | Value_int _ - | Value_char _ | Value_constptr _ | Value_set_of_closures _ + | Value_char _ | Value_set_of_closures _ | Value_float _ | Value_boxed_int _ | Value_closure _ | Value_extern _ | Value_symbol _ -> true @@ -576,7 +554,7 @@ let warn_on_mutation t = match t.descr with | Value_block(_, fields) -> Array.length fields > 0 | Value_string { contents = Some _ } - | Value_int _ | Value_char _ | Value_constptr _ + | Value_int _ | Value_char _ | Value_set_of_closures _ | Value_float _ | Value_boxed_int _ | Value_closure _ -> true | Value_string { contents = None } | Value_float_array _ @@ -601,7 +579,7 @@ let get_field t ~field_index:i : get_field_result = (* CR-someday mshinwell: This should probably return Unreachable in more cases. I added a couple more. *) | Value_bottom - | Value_int _ | Value_char _ | Value_constptr _ -> + | Value_int _ | Value_char _ -> (* Something seriously wrong is happening: either the user is doing something exceptionally unsafe, or it is an unreachable branch. We consider this as unreachable and mark the result accordingly. *) @@ -637,7 +615,7 @@ let check_approx_for_block t = | Value_block (tag, fields) -> Ok (tag, fields) | Value_bottom - | Value_int _ | Value_char _ | Value_constptr _ + | Value_int _ | Value_char _ | Value_float_array _ | Value_string _ | Value_float _ | Value_boxed_int _ | Value_set_of_closures _ | Value_closure _ @@ -687,8 +665,6 @@ let equal_floats f1 f2 = let rec meet_descr ~really_import_approx d1 d2 = match d1, d2 with | Value_int i, Value_int j when i = j -> d1 - | Value_constptr i, Value_constptr j when i = j -> - d1 | Value_symbol s1, Value_symbol s2 when Symbol.equal s1 s2 -> d1 | Value_extern e1, Value_extern e2 when Export_id.equal e1 e2 -> @@ -780,7 +756,7 @@ let check_approx_for_set_of_closures t : checked_approx_for_set_of_closures = to the set now out of scope. *) Ok (t.var, value_set_of_closures) | Value_closure _ | Value_block _ | Value_int _ | Value_char _ - | Value_constptr _ | Value_float _ | Value_boxed_int _ | Value_unknown _ + | Value_float _ | Value_boxed_int _ | Value_unknown _ | Value_bottom | Value_extern _ | Value_string _ | Value_float_array _ | Value_symbol _ -> Wrong @@ -818,7 +794,7 @@ let check_approx_for_closure_allowing_unresolved t symbol, value_set_of_closures) | Value_unresolved _ | Value_closure _ | Value_block _ | Value_int _ | Value_char _ - | Value_constptr _ | Value_float _ | Value_boxed_int _ | Value_unknown _ + | Value_float _ | Value_boxed_int _ | Value_unknown _ | Value_bottom | Value_extern _ | Value_string _ | Value_float_array _ | Value_symbol _ -> Wrong @@ -827,7 +803,7 @@ let check_approx_for_closure_allowing_unresolved t Unknown_because_of_unresolved_value value | Value_unresolved symbol -> Unresolved symbol | Value_set_of_closures _ | Value_block _ | Value_int _ | Value_char _ - | Value_constptr _ | Value_float _ | Value_boxed_int _ + | Value_float _ | Value_boxed_int _ | Value_bottom | Value_extern _ | Value_string _ | Value_float_array _ | Value_symbol _ -> Wrong @@ -866,7 +842,7 @@ let check_approx_for_float t : float option = | Value_unresolved _ | Value_unknown _ | Value_string _ | Value_float_array _ | Value_bottom | Value_block _ | Value_int _ | Value_char _ - | Value_constptr _ | Value_set_of_closures _ | Value_closure _ + | Value_set_of_closures _ | Value_closure _ | Value_extern _ | Value_boxed_int _ | Value_symbol _ -> None @@ -883,7 +859,7 @@ let float_array_as_constant (t:value_float_array) : float list option = (Value_float None | Value_unresolved _ | Value_unknown _ | Value_string _ | Value_float_array _ | Value_bottom | Value_block _ | Value_int _ | Value_char _ - | Value_constptr _ | Value_set_of_closures _ | Value_closure _ + | Value_set_of_closures _ | Value_closure _ | Value_extern _ | Value_boxed_int _ | Value_symbol _) -> None) contents (Some []) @@ -895,7 +871,7 @@ let check_approx_for_string t : string option = | Value_unresolved _ | Value_unknown _ | Value_float_array _ | Value_bottom | Value_block _ | Value_int _ | Value_char _ - | Value_constptr _ | Value_set_of_closures _ | Value_closure _ + | Value_set_of_closures _ | Value_closure _ | Value_extern _ | Value_boxed_int _ | Value_symbol _ -> None @@ -913,11 +889,11 @@ let potentially_taken_const_switch_branch t branch = (* In theory symbol cannot contain integers but this shouldn't matter as this will always be an imported approximation *) Can_be_taken - | Value_constptr i | Value_int i when i = branch -> + | Value_int i when i = branch -> Must_be_taken | Value_char c when Char.code c = branch -> Must_be_taken - | Value_constptr _ | Value_int _ | Value_char _ -> + | Value_int _ | Value_char _ -> Cannot_be_taken | Value_block _ | Value_float _ | Value_float_array _ | Value_string _ | Value_closure _ | Value_set_of_closures _ @@ -931,7 +907,7 @@ let potentially_taken_block_switch_branch t tag = | Value_extern _ | Value_symbol _) -> Can_be_taken - | (Value_constptr _ | Value_int _| Value_char _) -> + | (Value_int _| Value_char _) -> Cannot_be_taken | Value_block (block_tag, _) when Tag.to_int block_tag = tag -> Must_be_taken diff --git a/middle_end/flambda/simple_value_approx.mli b/middle_end/flambda/simple_value_approx.mli index dd38652f5..693e641ff 100644 --- a/middle_end/flambda/simple_value_approx.mli +++ b/middle_end/flambda/simple_value_approx.mli @@ -124,7 +124,6 @@ and descr = private | Value_block of Tag.t * t array | Value_int of int | Value_char of char - | Value_constptr of int | Value_float of float option | Value_boxed_int : 'a boxed_int * 'a -> descr | Value_set_of_closures of value_set_of_closures @@ -248,7 +247,6 @@ val value_mutable_float_array : size:int -> t val value_immutable_float_array : t array -> t val value_string : int -> string option -> t val value_boxed_int : 'i boxed_int -> 'i -> t -val value_constptr : int -> t val value_block : Tag.t -> t array -> t val value_extern : Export_id.t -> t val value_symbol : Symbol.t -> t @@ -280,14 +278,12 @@ val value_set_of_closures together with an Flambda expression representing it. *) val make_const_int : int -> Flambda.t * t val make_const_char : char -> Flambda.t * t -val make_const_ptr : int -> Flambda.t * t val make_const_bool : bool -> Flambda.t * t val make_const_float : float -> Flambda.t * t val make_const_boxed_int : 'i boxed_int -> 'i -> Flambda.t * t val make_const_int_named : int -> Flambda.named * t val make_const_char_named : char -> Flambda.named * t -val make_const_ptr_named : int -> Flambda.named * t val make_const_bool_named : bool -> Flambda.named * t val make_const_float_named : float -> Flambda.named * t val make_const_boxed_int_named : 'i boxed_int -> 'i -> Flambda.named * t diff --git a/middle_end/flambda/simplify_common.ml b/middle_end/flambda/simplify_common.ml index fcbbcfbcb..021ec68aa 100644 --- a/middle_end/flambda/simplify_common.ml +++ b/middle_end/flambda/simplify_common.ml @@ -35,11 +35,6 @@ let const_char_expr expr c = let (new_expr, approx) = A.make_const_char_named c in new_expr, approx, C.Benefit.remove_code_named expr C.Benefit.zero else expr, A.value_char c, C.Benefit.zero -let const_ptr_expr expr n = - if Effect_analysis.no_effects_named expr then - let (new_expr, approx) = A.make_const_ptr_named n in - new_expr, approx, C.Benefit.remove_code_named expr C.Benefit.zero - else expr, A.value_constptr n, C.Benefit.zero let const_bool_expr expr b = const_int_expr expr (if b then 1 else 0) let const_float_expr expr f = diff --git a/middle_end/flambda/simplify_common.mli b/middle_end/flambda/simplify_common.mli index c667bfffe..ff1016717 100644 --- a/middle_end/flambda/simplify_common.mli +++ b/middle_end/flambda/simplify_common.mli @@ -42,11 +42,6 @@ val const_bool_expr -> bool -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t -val const_ptr_expr - : Flambda.named - -> int - -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t - val const_float_expr : Flambda.named -> float diff --git a/middle_end/flambda/simplify_primitives.ml b/middle_end/flambda/simplify_primitives.ml index a228fe825..c7344db23 100644 --- a/middle_end/flambda/simplify_primitives.ml +++ b/middle_end/flambda/simplify_primitives.ml @@ -40,7 +40,7 @@ let phys_equal (approxs:A.t list) = let is_known_to_be_some_kind_of_int (arg:A.descr) = match arg with - | Value_int _ | Value_char _ | Value_constptr _ -> true + | Value_int _ | Value_char _ -> true | Value_block (_, _) | Value_float _ | Value_set_of_closures _ | Value_closure _ | Value_string _ | Value_float_array _ | A.Value_boxed_int _ | Value_unknown _ | Value_extern _ @@ -50,13 +50,13 @@ let is_known_to_be_some_kind_of_block (arg:A.descr) = match arg with | Value_block _ | Value_float _ | Value_float_array _ | A.Value_boxed_int _ | Value_closure _ | Value_string _ -> true - | Value_set_of_closures _ | Value_int _ | Value_char _ | Value_constptr _ + | Value_set_of_closures _ | Value_int _ | Value_char _ | Value_unknown _ | Value_extern _ | Value_symbol _ | Value_unresolved _ | Value_bottom -> false let rec structurally_different (arg1:A.t) (arg2:A.t) = match arg1.descr, arg2.descr with - | (Value_int n1 | Value_constptr n1), (Value_int n2 | Value_constptr n2) + | (Value_int n1), (Value_int n2) when n1 <> n2 -> true | Value_block (tag1, fields1), Value_block (tag2, fields2) -> @@ -171,6 +171,7 @@ let primitive (p : Clambda_primitives.primitive) (args, approxs) | Pnot -> S.const_bool_expr expr (x = 0) | Pnegint -> S.const_int_expr expr (-x) | Pbswap16 -> S.const_int_expr expr (S.swap16 x) + | Pisint -> S.const_bool_expr expr true | Poffsetint y -> S.const_int_expr expr (x + y) | Pfloatofint when fpc -> S.const_float_expr expr (float_of_int x) | Pbintofint Pnativeint -> @@ -179,7 +180,7 @@ let primitive (p : Clambda_primitives.primitive) (args, approxs) | Pbintofint Pint64 -> S.const_boxed_int_expr expr Int64 (Int64.of_int x) | _ -> expr, A.value_unknown Other, C.Benefit.zero end - | [(Value_int x | Value_constptr x); (Value_int y | Value_constptr y)] -> + | [Value_int x; Value_int y] -> let shift_precond = 0 <= y && y < 8 * size_int in begin match p with | Paddint -> S.const_int_expr expr (x + y) @@ -204,15 +205,6 @@ let primitive (p : Clambda_primitives.primitive) (args, approxs) | Pcompare_ints -> S.const_int_expr expr (Char.compare x y) | _ -> expr, A.value_unknown Other, C.Benefit.zero end - | [Value_constptr x] -> - begin match p with - (* [Pidentity] should probably never appear, but is here for - completeness. *) - | Pnot -> S.const_bool_expr expr (x = 0) - | Pisint -> S.const_bool_expr expr true - | Poffsetint y -> S.const_ptr_expr expr (x + y) - | _ -> expr, A.value_unknown Other, C.Benefit.zero - end | [Value_float (Some x)] when fpc -> begin match p with | Pintoffloat -> S.const_int_expr expr (int_of_float x) @@ -258,7 +250,7 @@ let primitive (p : Clambda_primitives.primitive) (args, approxs) when (is_pstring_length p || is_pbytes_length p) -> S.const_int_expr expr size | [Value_string { size; contents = Some s }; - (Value_int x | Value_constptr x)] when x >= 0 && x < size -> + (Value_int x)] when x >= 0 && x < size -> begin match p with | Pstringrefu | Pstringrefs @@ -268,14 +260,14 @@ let primitive (p : Clambda_primitives.primitive) (args, approxs) | _ -> expr, A.value_unknown Other, C.Benefit.zero end | [Value_string { size; contents = None }; - (Value_int x | Value_constptr x)] + (Value_int x)] when x >= 0 && x < size && is_pstringrefs p -> Flambda.Prim (Pstringrefu, args, dbg), A.value_unknown Other, (* we improved it, but there is no way to account for that: *) C.Benefit.zero | [Value_string { size; contents = None }; - (Value_int x | Value_constptr x)] + (Value_int x)] when x >= 0 && x < size && is_pbytesrefs p -> Flambda.Prim (Pbytesrefu, args, dbg), A.value_unknown Other, diff --git a/middle_end/printclambda.ml b/middle_end/printclambda.ml index fceb34851..3b8ffab09 100644 --- a/middle_end/printclambda.ml +++ b/middle_end/printclambda.ml @@ -95,7 +95,6 @@ and uconstant ppf = function fprintf ppf "%S=%a" s structured_constant c | Uconst_ref (s, None) -> fprintf ppf "%S"s | Uconst_int i -> fprintf ppf "%i" i - | Uconst_ptr i -> fprintf ppf "%ia" i and lam ppf = function | Uvar id -> diff --git a/testsuite/tests/basic-modules/anonymous.ocamlc.reference b/testsuite/tests/basic-modules/anonymous.ocamlc.reference index aba92cbde..dd27f037c 100644 --- a/testsuite/tests/basic-modules/anonymous.ocamlc.reference +++ b/testsuite/tests/basic-modules/anonymous.ocamlc.reference @@ -13,11 +13,11 @@ (apply (field 1 (global CamlinternalMod!)) [0: [0]] B (module-defn(B) Anonymous anonymous.ml(33):703-773 (let (x = [0: "foo" "bar"]) (makeblock 0)))) - (let (f = (function param 0a) s = (makemutable 0 "")) + (let (f = (function param 0) s = (makemutable 0 "")) (seq (ignore (let (*match* = (setfield_ptr 0 s "Hello World!")) (makeblock 0))) (let - (drop = (function param 0a) *match* = (apply drop (field 0 s))) + (drop = (function param 0) *match* = (apply drop (field 0 s))) (makeblock 0 A B f s drop)))))))) diff --git a/testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference b/testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference index 6f9a7cba3..16b747f10 100644 --- a/testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference +++ b/testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference @@ -12,10 +12,9 @@ (apply (field 1 (global CamlinternalMod!)) [0: [0]] B (module-defn(B) Anonymous anonymous.ml(33):703-773 (let (x = [0: "foo" "bar"]) (makeblock 0)))) - (let (f = (function param 0a) s = (makemutable 0 "")) + (let (f = (function param 0) s = (makemutable 0 "")) (seq (ignore (let (*match* = (setfield_ptr 0 s "Hello World!")) (makeblock 0))) - (let - (drop = (function param 0a) *match* = (apply drop (field 0 s))) + (let (drop = (function param 0) *match* = (apply drop (field 0 s))) (makeblock 0 A B f s drop))))))) diff --git a/testsuite/tests/basic-modules/anonymous.ocamlopt.reference b/testsuite/tests/basic-modules/anonymous.ocamlopt.reference index 6d29841fe..c0ed05ccf 100644 --- a/testsuite/tests/basic-modules/anonymous.ocamlopt.reference +++ b/testsuite/tests/basic-modules/anonymous.ocamlopt.reference @@ -12,7 +12,7 @@ (let (x = [0: "foo" "bar"]) (makeblock 0))) (setfield_ptr(root-init) 0 (global Anonymous!) A) (setfield_ptr(root-init) 1 (global Anonymous!) B) - (let (f = (function param 0a)) + (let (f = (function param 0)) (setfield_ptr(root-init) 2 (global Anonymous!) f)) (let (s = (makemutable 0 "")) (setfield_ptr(root-init) 3 (global Anonymous!) s)) @@ -21,11 +21,11 @@ (*match* = (setfield_ptr 0 (field 3 (global Anonymous!)) "Hello World!")) (makeblock 0))) - (let (drop = (function param 0a)) + (let (drop = (function param 0)) (setfield_ptr(root-init) 4 (global Anonymous!) drop)) (let (*match* = (apply (field 4 (global Anonymous!)) (field 0 (field 3 (global Anonymous!))))) - 0a) - 0a))) + 0) + 0))) diff --git a/testsuite/tests/basic/patmatch_split_no_or.ml b/testsuite/tests/basic/patmatch_split_no_or.ml index 4f494656e..86a689fb4 100644 --- a/testsuite/tests/basic/patmatch_split_no_or.ml +++ b/testsuite/tests/basic/patmatch_split_no_or.ml @@ -49,7 +49,7 @@ val last_is_vars : bool * bool -> int = type t = .. type t += A | B of unit | C of bool * int;; [%%expect{| -0a +0 type t = .. (let (A/25 = (makeblock 248 "A" (caml_fresh_oo_id 0)) diff --git a/testsuite/tests/translprim/comparison_table.compilers.reference b/testsuite/tests/translprim/comparison_table.compilers.reference index a9a7cce92..e518956cf 100644 --- a/testsuite/tests/translprim/comparison_table.compilers.reference +++ b/testsuite/tests/translprim/comparison_table.compilers.reference @@ -137,14 +137,14 @@ eta_int32_ge = (function prim prim stub (Int32.>= prim prim)) eta_int64_ge = (function prim prim stub (Int64.>= prim prim)) eta_nativeint_ge = (function prim prim stub (Nativeint.>= prim prim)) - int_vec = [0: [0: 1 1] [0: [0: 1 2] [0: [0: 2 1] 0a]]] - bool_vec = [0: [0: 0a 0a] [0: [0: 0a 1a] [0: [0: 1a 0a] 0a]]] - intlike_vec = [0: [0: 0a 0a] [0: [0: 0a 1a] [0: [0: 1a 0a] 0a]]] - float_vec = [0: [0: 1. 1.] [0: [0: 1. 2.] [0: [0: 2. 1.] 0a]]] - string_vec = [0: [0: "1" "1"] [0: [0: "1" "2"] [0: [0: "2" "1"] 0a]]] - int32_vec = [0: [0: 1l 1l] [0: [0: 1l 2l] [0: [0: 2l 1l] 0a]]] - int64_vec = [0: [0: 1L 1L] [0: [0: 1L 2L] [0: [0: 2L 1L] 0a]]] - nativeint_vec = [0: [0: 1n 1n] [0: [0: 1n 2n] [0: [0: 2n 1n] 0a]]] + int_vec = [0: [0: 1 1] [0: [0: 1 2] [0: [0: 2 1] 0]]] + bool_vec = [0: [0: 0 0] [0: [0: 0 1] [0: [0: 1 0] 0]]] + intlike_vec = [0: [0: 0 0] [0: [0: 0 1] [0: [0: 1 0] 0]]] + float_vec = [0: [0: 1. 1.] [0: [0: 1. 2.] [0: [0: 2. 1.] 0]]] + string_vec = [0: [0: "1" "1"] [0: [0: "1" "2"] [0: [0: "2" "1"] 0]]] + int32_vec = [0: [0: 1l 1l] [0: [0: 1l 2l] [0: [0: 2l 1l] 0]]] + int64_vec = [0: [0: 1L 1L] [0: [0: 1L 2L] [0: [0: 2L 1L] 0]]] + nativeint_vec = [0: [0: 1n 1n] [0: [0: 1n 2n] [0: [0: 2n 1n] 0]]] test_vec = (function cmp eq ne lt gt le ge vec (let @@ -163,7 +163,7 @@ (makeblock 0 (makeblock 0 gen_lt lt) (makeblock 0 (makeblock 0 gen_gt gt) (makeblock 0 (makeblock 0 gen_le le) - (makeblock 0 (makeblock 0 gen_ge ge) 0a))))))))))) + (makeblock 0 (makeblock 0 gen_ge ge) 0))))))))))) (seq (apply test_vec int_cmp int_eq int_ne int_lt int_gt int_le int_ge int_vec) @@ -203,7 +203,7 @@ (makeblock 0 (makeblock 0 eta_gen_lt lt) (makeblock 0 (makeblock 0 eta_gen_gt gt) (makeblock 0 (makeblock 0 eta_gen_le le) - (makeblock 0 (makeblock 0 eta_gen_ge ge) 0a))))))))))) + (makeblock 0 (makeblock 0 eta_gen_ge ge) 0))))))))))) (seq (apply eta_test_vec eta_int_cmp eta_int_eq eta_int_ne eta_int_lt eta_int_gt eta_int_le eta_int_ge int_vec) diff --git a/testsuite/tests/translprim/ref_spec.compilers.reference b/testsuite/tests/translprim/ref_spec.compilers.reference index 72b48d4f0..8e27f04bb 100644 --- a/testsuite/tests/translprim/ref_spec.compilers.reference +++ b/testsuite/tests/translprim/ref_spec.compilers.reference @@ -1,27 +1,27 @@ (setglobal Ref_spec! (let (int_ref = (makemutable 0 (int) 1) - var_ref = (makemutable 0 65a) - vargen_ref = (makemutable 0 65a) - cst_ref = (makemutable 0 0a) - gen_ref = (makemutable 0 0a) + var_ref = (makemutable 0 65) + vargen_ref = (makemutable 0 65) + cst_ref = (makemutable 0 0) + gen_ref = (makemutable 0 0) flt_ref = (makemutable 0 (float) 0.)) - (seq (setfield_imm 0 int_ref 2) (setfield_imm 0 var_ref 66a) - (setfield_ptr 0 vargen_ref [0: 66 0]) (setfield_ptr 0 vargen_ref 67a) - (setfield_imm 0 cst_ref 1a) (setfield_ptr 0 gen_ref [0: "foo"]) - (setfield_ptr 0 gen_ref 0a) (setfield_ptr 0 flt_ref 1.) + (seq (setfield_imm 0 int_ref 2) (setfield_imm 0 var_ref 66) + (setfield_ptr 0 vargen_ref [0: 66 0]) (setfield_ptr 0 vargen_ref 67) + (setfield_imm 0 cst_ref 1) (setfield_ptr 0 gen_ref [0: "foo"]) + (setfield_ptr 0 gen_ref 0) (setfield_ptr 0 flt_ref 1.) (let - (int_rec = (makemutable 0 (*,int) 0a 1) - var_rec = (makemutable 0 0a 65a) - vargen_rec = (makemutable 0 0a 65a) - cst_rec = (makemutable 0 0a 0a) - gen_rec = (makemutable 0 0a 0a) - flt_rec = (makemutable 0 (*,float) 0a 0.) + (int_rec = (makemutable 0 (*,int) 0 1) + var_rec = (makemutable 0 0 65) + vargen_rec = (makemutable 0 0 65) + cst_rec = (makemutable 0 0 0) + gen_rec = (makemutable 0 0 0) + flt_rec = (makemutable 0 (*,float) 0 0.) flt_rec' = (makearray[float] 0. 0.)) - (seq (setfield_imm 1 int_rec 2) (setfield_imm 1 var_rec 66a) + (seq (setfield_imm 1 int_rec 2) (setfield_imm 1 var_rec 66) (setfield_ptr 1 vargen_rec [0: 66 0]) - (setfield_ptr 1 vargen_rec 67a) (setfield_imm 1 cst_rec 1a) - (setfield_ptr 1 gen_rec [0: "foo"]) (setfield_ptr 1 gen_rec 0a) + (setfield_ptr 1 vargen_rec 67) (setfield_imm 1 cst_rec 1) + (setfield_ptr 1 gen_rec [0: "foo"]) (setfield_ptr 1 gen_rec 0) (setfield_ptr 1 flt_rec 1.) (setfloatfield 1 flt_rec' 1.) (let (set_open_poly = (function r y (setfield_ptr 0 r y)) diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml index a1fce6103..e2b8b4d10 100644 --- a/tools/dumpobj.ml +++ b/tools/dumpobj.ml @@ -92,7 +92,6 @@ let rec print_struct_const = function | Const_base(Const_int32 i) -> printf "%ldl" i | Const_base(Const_nativeint i) -> printf "%ndn" i | Const_base(Const_int64 i) -> printf "%LdL" i - | Const_pointer n -> printf "%da" n | Const_block(tag, args) -> printf "<%d>" tag; begin match args with