Skip to content

Commit 066e2ac

Browse files
committed
remove clambda
1 parent 0a69cee commit 066e2ac

File tree

8 files changed

+132
-170
lines changed

8 files changed

+132
-170
lines changed

backend/cmm_helpers.ml

Lines changed: 12 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,12 @@ module VP = Backend_var.With_provenance
2020
open Cmm
2121
open Arch
2222

23+
type arity =
24+
{ function_kind : Lambda.function_kind;
25+
params_layout : Lambda.layout list;
26+
return_layout : Lambda.layout
27+
}
28+
2329
(* Local binding of complex expressions *)
2430

2531
let bind name arg fn =
@@ -151,7 +157,7 @@ let closure_info' ~arity ~startenv ~is_last =
151157
in
152158
pack_closure_info ~arity ~startenv ~is_last
153159

154-
let closure_info ~(arity : Clambda.arity) ~startenv ~is_last =
160+
let closure_info ~(arity : arity) ~startenv ~is_last =
155161
closure_info'
156162
~arity:(arity.function_kind, arity.params_layout)
157163
~startenv ~is_last
@@ -717,7 +723,7 @@ let rec unbox_float dbg =
717723
c
718724
| Cconst_symbol (s, _dbg) as cmm -> (
719725
match Cmmgen_state.structured_constant_of_sym s.sym_name with
720-
| Some (Uconst_float x) -> Cconst_float (x, dbg) (* or keep _dbg? *)
726+
| Some (Const_float x) -> Cconst_float (x, dbg) (* or keep _dbg? *)
721727
| _ -> Cop (mk_load_immut Double, [cmm], dbg))
722728
| Cregion e as cmm -> (
723729
(* It is valid to push unboxing inside a Cregion except when the extra
@@ -749,7 +755,7 @@ let rec unbox_vec128 dbg =
749755
c
750756
| Cconst_symbol (s, _dbg) as cmm -> (
751757
match Cmmgen_state.structured_constant_of_sym s.sym_name with
752-
| Some (Uconst_vec128 { low; high }) ->
758+
| Some (Const_vec128 { low; high }) ->
753759
Cconst_vec128 ({ low; high }, dbg) (* or keep _dbg? *)
754760
| _ -> Cop (mk_load_immut Onetwentyeight_unaligned, [cmm], dbg))
755761
| Cregion e as cmm -> (
@@ -1653,11 +1659,11 @@ let rec unbox_int dbg bi =
16531659
contents
16541660
| Cconst_symbol (s, _dbg) as cmm -> (
16551661
match Cmmgen_state.structured_constant_of_sym s.sym_name, bi with
1656-
| Some (Uconst_nativeint n), Primitive.Pnativeint ->
1662+
| Some (Const_nativeint n), Primitive.Pnativeint ->
16571663
natint_const_untagged dbg n
1658-
| Some (Uconst_int32 n), Primitive.Pint32 ->
1664+
| Some (Const_int32 n), Primitive.Pint32 ->
16591665
natint_const_untagged dbg (Nativeint.of_int32 n)
1660-
| Some (Uconst_int64 n), Primitive.Pint64 ->
1666+
| Some (Const_int64 n), Primitive.Pint64 ->
16611667
natint_const_untagged dbg (Int64.to_nativeint n)
16621668
| _ -> default cmm)
16631669
| Cregion e as cmm -> (

backend/cmm_helpers.mli

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,12 @@
1515

1616
open Cmm
1717

18+
type arity =
19+
{ function_kind : Lambda.function_kind;
20+
params_layout : Lambda.layout list;
21+
return_layout : Lambda.layout
22+
}
23+
1824
(** [bind name arg fn] is equivalent to [let name = arg in fn name], or simply
1925
[fn arg] if [arg] is simple enough *)
2026
val bind : string -> expression -> (expression -> expression) -> expression
@@ -60,8 +66,7 @@ val boxedint64_header : nativeint
6066
val boxedintnat_header : nativeint
6167

6268
(** Closure info for a closure of given arity and distance to environment *)
63-
val closure_info :
64-
arity:Clambda.arity -> startenv:int -> is_last:bool -> nativeint
69+
val closure_info : arity:arity -> startenv:int -> is_last:bool -> nativeint
6570

6671
val closure_info' :
6772
arity:Lambda.function_kind * 'a list ->
@@ -73,11 +78,7 @@ val closure_info' :
7378
val alloc_infix_header : int -> Debuginfo.t -> expression
7479

7580
val alloc_closure_info :
76-
arity:Clambda.arity ->
77-
startenv:int ->
78-
is_last:bool ->
79-
Debuginfo.t ->
80-
expression
81+
arity:arity -> startenv:int -> is_last:bool -> Debuginfo.t -> expression
8182

8283
(** Integers *)
8384

backend/cmmgen_state.ml

Lines changed: 80 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,14 +19,93 @@
1919

2020
module S = Misc.Stdlib.String
2121

22+
type ustructured_constant =
23+
| Const_float of float
24+
| Const_int32 of int32
25+
| Const_int64 of int64
26+
| Const_nativeint of nativeint
27+
| Const_vec128 of { high : int64; low : int64 }
28+
| Const_block of int * uconstant list
29+
| Const_float_array of float list
30+
| Const_string of string
31+
32+
and uconstant =
33+
| Const_ref of string * ustructured_constant option
34+
| Const_int of int
35+
36+
(* Comparison functions for constants. We must not use Stdlib.compare
37+
because it compares "0.0" and "-0.0" equal. (PR#6442) *)
38+
39+
let compare_floats x1 x2 =
40+
Int64.compare (Int64.bits_of_float x1) (Int64.bits_of_float x2)
41+
42+
let rec compare_float_lists l1 l2 =
43+
match l1, l2 with
44+
| [], [] -> 0
45+
| [], _::_ -> -1
46+
| _::_, [] -> 1
47+
| h1::t1, h2::t2 ->
48+
let c = compare_floats h1 h2 in
49+
if c <> 0 then c else compare_float_lists t1 t2
50+
51+
let compare_constants c1 c2 =
52+
match c1, c2 with
53+
| Const_ref(lbl1, _c1), Const_ref(lbl2, _c2) -> String.compare lbl1 lbl2
54+
(* Same labels -> same constants.
55+
Different labels -> different constants, even if the contents
56+
match, because of string constants that must not be
57+
reshared. *)
58+
| Const_int n1, Const_int n2 -> Stdlib.compare n1 n2
59+
| Const_ref _, _ -> -1
60+
| Const_int _, Const_ref _ -> 1
61+
62+
let rec compare_constant_lists l1 l2 =
63+
match l1, l2 with
64+
| [], [] -> 0
65+
| [], _::_ -> -1
66+
| _::_, [] -> 1
67+
| h1::t1, h2::t2 ->
68+
let c = compare_constants h1 h2 in
69+
if c <> 0 then c else compare_constant_lists t1 t2
70+
71+
let rank_structured_constant = function
72+
| Const_float _ -> 0
73+
| Const_int32 _ -> 1
74+
| Const_int64 _ -> 2
75+
| Const_nativeint _ -> 3
76+
| Const_block _ -> 4
77+
| Const_float_array _ -> 5
78+
| Const_string _ -> 6
79+
| Const_vec128 _ -> 8
80+
81+
let compare_structured_constants c1 c2 =
82+
match c1, c2 with
83+
| Const_float x1, Const_float x2 -> compare_floats x1 x2
84+
| Const_int32 x1, Const_int32 x2 -> Int32.compare x1 x2
85+
| Const_int64 x1, Const_int64 x2 -> Int64.compare x1 x2
86+
| Const_nativeint x1, Const_nativeint x2 -> Nativeint.compare x1 x2
87+
| Const_block(t1, l1), Const_block(t2, l2) ->
88+
let c = t1 - t2 (* no overflow possible here *) in
89+
if c <> 0 then c else compare_constant_lists l1 l2
90+
| Const_float_array l1, Const_float_array l2 ->
91+
compare_float_lists l1 l2
92+
| Const_string s1, Const_string s2 -> String.compare s1 s2
93+
| Const_vec128 { high = l0; low = l1},
94+
Const_vec128 { high = r0; low = r1} ->
95+
let cmp = Int64.compare l0 r0 in
96+
if cmp = 0 then Int64.compare l1 r1 else cmp
97+
| _, _ ->
98+
(* no overflow possible here *)
99+
rank_structured_constant c1 - rank_structured_constant c2
100+
22101
type constant =
23102
| Const_table of Cmm.is_global * Cmm.data_item list
24103

25104
type t = {
26105
mutable constants : constant S.Map.t;
27106
mutable data_items : Cmm.data_item list list;
28107
structured_constants :
29-
(string, Cmm.is_global * Clambda.ustructured_constant) Hashtbl.t;
108+
(string, Cmm.is_global * ustructured_constant) Hashtbl.t;
30109
}
31110

32111
let empty = {

backend/cmmgen_state.mli

Lines changed: 25 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,27 @@
1919

2020
[@@@ocaml.warning "+a-4-30-40-41-42"]
2121

22+
type ustructured_constant =
23+
| Const_float of float
24+
| Const_int32 of int32
25+
| Const_int64 of int64
26+
| Const_nativeint of nativeint
27+
| Const_vec128 of { high : int64; low : int64 }
28+
| Const_block of int * uconstant list
29+
| Const_float_array of float list
30+
| Const_string of string
31+
32+
and uconstant =
33+
| Const_ref of string * ustructured_constant option
34+
| Const_int of int
35+
36+
(* Comparison functions for constants *)
37+
38+
val compare_structured_constants:
39+
ustructured_constant -> ustructured_constant -> int
40+
val compare_constants:
41+
uconstant -> uconstant -> int
42+
2243
type constant =
2344
| Const_table of Cmm.is_global * Cmm.data_item list
2445

@@ -30,12 +51,12 @@ val get_and_clear_constants : unit -> constant Misc.Stdlib.String.Map.t
3051

3152
val get_and_clear_data_items : unit -> Cmm.data_item list
3253

33-
val add_structured_constant : Cmm.symbol -> Clambda.ustructured_constant -> unit
54+
val add_structured_constant : Cmm.symbol -> ustructured_constant -> unit
3455

3556
val clear_local_structured_constants : unit -> unit
3657

37-
val add_global_structured_constant : string -> Clambda.ustructured_constant -> unit
58+
val add_global_structured_constant : string -> ustructured_constant -> unit
3859

39-
val get_structured_constant : string -> (Cmm.is_global * Clambda.ustructured_constant) option
60+
val get_structured_constant : string -> (Cmm.is_global * ustructured_constant) option
4061

41-
val structured_constant_of_sym : string -> Clambda.ustructured_constant option
62+
val structured_constant_of_sym : string -> ustructured_constant option

dune

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -75,7 +75,6 @@
7575
cmxs_format
7676
;; middle_end/
7777
backend_var
78-
clambda
7978
compilenv
8079
;; asmcomp/
8180
afl_instrument

middle_end/clambda.ml

Lines changed: 0 additions & 102 deletions
This file was deleted.

middle_end/clambda.mli

Lines changed: 0 additions & 44 deletions
This file was deleted.

0 commit comments

Comments
 (0)