Skip to content

Commit 64d4e15

Browse files
cometkimcometkim
committed
revert changes on comparison
1 parent 7551045 commit 64d4e15

File tree

1 file changed

+105
-137
lines changed

1 file changed

+105
-137
lines changed

‎compiler/ml/translcore.ml

Lines changed: 105 additions & 137 deletions
Original file line numberDiff line numberDiff line change
@@ -59,182 +59,157 @@ let translate_unified_application (env : Env.t) (prim : Primitive.description)
5959
*)
6060

6161
type specialized = {
62-
obj: Lambda.primitive;
63-
int: Lambda.primitive;
64-
bool: Lambda.primitive;
65-
float: Lambda.primitive;
66-
string: Lambda.primitive;
67-
bigint: Lambda.primitive;
62+
objcomp: Lambda.primitive;
63+
intcomp: Lambda.primitive;
64+
boolcomp: Lambda.primitive;
65+
floatcomp: Lambda.primitive;
66+
stringcomp: Lambda.primitive;
67+
bigintcomp: Lambda.primitive;
6868
simplify_constant_constructor: bool;
6969
}
7070

71-
let infix_table =
72-
create_hashtable
73-
[|
74-
( "%add",
75-
{
76-
obj = Paddint;
77-
int = Paddint;
78-
bool = Pinfix Inf_invariant;
79-
float = Paddfloat;
80-
string = Pstringadd;
81-
bigint = Paddbigint;
82-
simplify_constant_constructor = false;
83-
} );
84-
( "%sub",
85-
{
86-
obj = Paddint;
87-
int = Psubint;
88-
bool = Pinfix Inf_invariant;
89-
float = Psubfloat;
90-
string = Pinfix Inf_invariant;
91-
bigint = Psubbigint;
92-
simplify_constant_constructor = false;
93-
} );
94-
|]
95-
9671
let comparisons_table =
9772
create_hashtable
9873
[|
9974
( "%equal",
10075
{
101-
obj = Pobjcomp Ceq;
102-
int = Pintcomp Ceq;
103-
bool = Pboolcomp Ceq;
104-
float = Pfloatcomp Ceq;
105-
string = Pstringcomp Ceq;
106-
bigint = Pbigintcomp Ceq;
76+
objcomp = Pobjcomp Ceq;
77+
intcomp = Pintcomp Ceq;
78+
boolcomp = Pboolcomp Ceq;
79+
floatcomp = Pfloatcomp Ceq;
80+
stringcomp = Pstringcomp Ceq;
81+
bigintcomp = Pbigintcomp Ceq;
10782
simplify_constant_constructor = true;
10883
} );
10984
( "%notequal",
11085
{
111-
obj = Pobjcomp Cneq;
112-
int = Pintcomp Cneq;
113-
bool = Pboolcomp Cneq;
114-
float = Pfloatcomp Cneq;
115-
string = Pstringcomp Cneq;
116-
bigint = Pbigintcomp Cneq;
86+
objcomp = Pobjcomp Cneq;
87+
intcomp = Pintcomp Cneq;
88+
boolcomp = Pboolcomp Cneq;
89+
floatcomp = Pfloatcomp Cneq;
90+
stringcomp = Pstringcomp Cneq;
91+
bigintcomp = Pbigintcomp Cneq;
11792
simplify_constant_constructor = true;
11893
} );
11994
( "%lessthan",
12095
{
121-
obj = Pobjcomp Clt;
122-
int = Pintcomp Clt;
123-
bool = Pboolcomp Clt;
124-
float = Pfloatcomp Clt;
125-
string = Pstringcomp Clt;
126-
bigint = Pbigintcomp Clt;
96+
objcomp = Pobjcomp Clt;
97+
intcomp = Pintcomp Clt;
98+
boolcomp = Pboolcomp Clt;
99+
floatcomp = Pfloatcomp Clt;
100+
stringcomp = Pstringcomp Clt;
101+
bigintcomp = Pbigintcomp Clt;
127102
simplify_constant_constructor = false;
128103
} );
129104
( "%greaterthan",
130105
{
131-
obj = Pobjcomp Cgt;
132-
int = Pintcomp Cgt;
133-
bool = Pboolcomp Cgt;
134-
float = Pfloatcomp Cgt;
135-
string = Pstringcomp Cgt;
136-
bigint = Pbigintcomp Cgt;
106+
objcomp = Pobjcomp Cgt;
107+
intcomp = Pintcomp Cgt;
108+
boolcomp = Pboolcomp Cgt;
109+
floatcomp = Pfloatcomp Cgt;
110+
stringcomp = Pstringcomp Cgt;
111+
bigintcomp = Pbigintcomp Cgt;
137112
simplify_constant_constructor = false;
138113
} );
139114
( "%lessequal",
140115
{
141-
obj = Pobjcomp Cle;
142-
int = Pintcomp Cle;
143-
bool = Pboolcomp Cle;
144-
float = Pfloatcomp Cle;
145-
string = Pstringcomp Cle;
146-
bigint = Pbigintcomp Cle;
116+
objcomp = Pobjcomp Cle;
117+
intcomp = Pintcomp Cle;
118+
boolcomp = Pboolcomp Cle;
119+
floatcomp = Pfloatcomp Cle;
120+
stringcomp = Pstringcomp Cle;
121+
bigintcomp = Pbigintcomp Cle;
147122
simplify_constant_constructor = false;
148123
} );
149124
( "%greaterequal",
150125
{
151-
obj = Pobjcomp Cge;
152-
int = Pintcomp Cge;
153-
bool = Pboolcomp Cge;
154-
float = Pfloatcomp Cge;
155-
string = Pstringcomp Cge;
156-
bigint = Pbigintcomp Cge;
126+
objcomp = Pobjcomp Cge;
127+
intcomp = Pintcomp Cge;
128+
boolcomp = Pboolcomp Cge;
129+
floatcomp = Pfloatcomp Cge;
130+
stringcomp = Pstringcomp Cge;
131+
bigintcomp = Pbigintcomp Cge;
157132
simplify_constant_constructor = false;
158133
} );
159134
( "%compare",
160135
{
161-
obj = Pobjorder;
162-
int = Pintorder;
163-
bool = Pboolorder;
164-
float = Pfloatorder;
165-
string = Pstringorder;
166-
bigint = Pbigintorder;
136+
objcomp = Pobjorder;
137+
intcomp = Pintorder;
138+
boolcomp = Pboolorder;
139+
floatcomp = Pfloatorder;
140+
stringcomp = Pstringorder;
141+
bigintcomp = Pbigintorder;
167142
simplify_constant_constructor = false;
168143
} );
169144
( "%max",
170145
{
171-
obj = Pobjmax;
172-
int = Pintmax;
173-
bool = Pboolmax;
174-
float = Pboolmax;
175-
string = Pstringmax;
176-
bigint = Pbigintmax;
146+
objcomp = Pobjmax;
147+
intcomp = Pintmax;
148+
boolcomp = Pboolmax;
149+
floatcomp = Pboolmax;
150+
stringcomp = Pstringmax;
151+
bigintcomp = Pbigintmax;
177152
simplify_constant_constructor = false;
178153
} );
179154
( "%min",
180155
{
181-
obj = Pobjmin;
182-
int = Pintmin;
183-
bool = Pboolmin;
184-
float = Pfloatmin;
185-
string = Pstringmin;
186-
bigint = Pbigintmin;
156+
objcomp = Pobjmin;
157+
intcomp = Pintmin;
158+
boolcomp = Pboolmin;
159+
floatcomp = Pfloatmin;
160+
stringcomp = Pstringmin;
161+
bigintcomp = Pbigintmin;
187162
simplify_constant_constructor = false;
188163
} );
189164
( "%equal_null",
190165
{
191-
obj = Pobjcomp Ceq;
192-
int = Pintcomp Ceq;
193-
bool = Pboolcomp Ceq;
194-
float = Pfloatcomp Ceq;
195-
string = Pstringcomp Ceq;
196-
bigint = Pbigintcomp Ceq;
166+
objcomp = Pobjcomp Ceq;
167+
intcomp = Pintcomp Ceq;
168+
boolcomp = Pboolcomp Ceq;
169+
floatcomp = Pfloatcomp Ceq;
170+
stringcomp = Pstringcomp Ceq;
171+
bigintcomp = Pbigintcomp Ceq;
197172
simplify_constant_constructor = false;
198173
} );
199174
( "%equal_undefined",
200175
{
201-
obj = Pobjcomp Ceq;
202-
int = Pintcomp Ceq;
203-
bool = Pboolcomp Ceq;
204-
float = Pfloatcomp Ceq;
205-
string = Pstringcomp Ceq;
206-
bigint = Pbigintcomp Ceq;
176+
objcomp = Pobjcomp Ceq;
177+
intcomp = Pintcomp Ceq;
178+
boolcomp = Pboolcomp Ceq;
179+
floatcomp = Pfloatcomp Ceq;
180+
stringcomp = Pstringcomp Ceq;
181+
bigintcomp = Pbigintcomp Ceq;
207182
simplify_constant_constructor = false;
208183
} );
209184
( "%equal_nullable",
210185
{
211-
obj = Pobjcomp Ceq;
212-
int = Pintcomp Ceq;
213-
bool = Pboolcomp Ceq;
214-
float = Pfloatcomp Ceq;
215-
string = Pstringcomp Ceq;
216-
bigint = Pbigintcomp Ceq;
186+
objcomp = Pobjcomp Ceq;
187+
intcomp = Pintcomp Ceq;
188+
boolcomp = Pboolcomp Ceq;
189+
floatcomp = Pfloatcomp Ceq;
190+
stringcomp = Pstringcomp Ceq;
191+
bigintcomp = Pbigintcomp Ceq;
217192
simplify_constant_constructor = false;
218193
} );
219194
(* FIXME: Core compatibility *)
220195
( "%bs_min",
221196
{
222-
obj = Pobjmax;
223-
int = Pintmax;
224-
bool = Pboolmax;
225-
float = Pboolmax;
226-
string = Pstringmax;
227-
bigint = Pbigintmax;
197+
objcomp = Pobjmax;
198+
intcomp = Pintmax;
199+
boolcomp = Pboolmax;
200+
floatcomp = Pboolmax;
201+
stringcomp = Pstringmax;
202+
bigintcomp = Pbigintmax;
228203
simplify_constant_constructor = false;
229204
} );
230205
( "%bs_max",
231206
{
232-
obj = Pobjmin;
233-
int = Pintmin;
234-
bool = Pboolmin;
235-
float = Pfloatmin;
236-
string = Pstringmin;
237-
bigint = Pbigintmin;
207+
objcomp = Pobjmin;
208+
intcomp = Pintmin;
209+
boolcomp = Pboolmin;
210+
floatcomp = Pfloatmin;
211+
stringcomp = Pstringmin;
212+
bigintcomp = Pbigintmin;
238213
simplify_constant_constructor = false;
239214
} );
240215
|]
@@ -409,36 +384,31 @@ let primitives_table =
409384

410385
let find_primitive prim_name = Hashtbl.find primitives_table prim_name
411386

412-
let specialize_op ({obj; int; float; string; bigint; bool} : specialized) env ty
413-
=
387+
let specialize_comparison
388+
({objcomp; intcomp; floatcomp; stringcomp; bigintcomp; boolcomp} :
389+
specialized) env ty =
414390
match () with
415391
| ()
416392
when is_base_type env ty Predef.path_int
417393
|| is_base_type env ty Predef.path_char
418394
|| maybe_pointer_type env ty = Immediate ->
419-
int
420-
| () when is_base_type env ty Predef.path_float -> float
421-
| () when is_base_type env ty Predef.path_string -> string
422-
| () when is_base_type env ty Predef.path_bigint -> bigint
423-
| () when is_base_type env ty Predef.path_bool -> bool
424-
| () -> obj
395+
intcomp
396+
| () when is_base_type env ty Predef.path_float -> floatcomp
397+
| () when is_base_type env ty Predef.path_string -> stringcomp
398+
| () when is_base_type env ty Predef.path_bigint -> bigintcomp
399+
| () when is_base_type env ty Predef.path_bool -> boolcomp
400+
| () -> objcomp
425401

426402
(* Specialize a primitive from available type information,
427403
raise Not_found if primitive is unknown *)
428404

429405
let specialize_primitive p env ty (* ~has_constant_constructor *) =
430406
try
431-
let table = Hashtbl.find infix_table p.prim_name in
407+
let table = Hashtbl.find comparisons_table p.prim_name in
432408
match is_function_type env ty with
433-
| Some (lhs, _rhs) -> specialize_op table env lhs
434-
| None -> table.obj
435-
with Not_found -> (
436-
try
437-
let table = Hashtbl.find comparisons_table p.prim_name in
438-
match is_function_type env ty with
439-
| Some (lhs, _rhs) -> specialize_op table env lhs
440-
| None -> table.obj
441-
with Not_found -> find_primitive p.prim_name)
409+
| Some (lhs, _rhs) -> specialize_comparison table env lhs
410+
| None -> table.objcomp
411+
with Not_found -> find_primitive p.prim_name
442412

443413
(* Eta-expand a primitive *)
444414

@@ -502,9 +472,7 @@ let transl_primitive_application loc prim env ty args =
502472
| [arg1; _]
503473
when is_base_type env arg1.exp_type Predef.path_bool
504474
&& Hashtbl.mem comparisons_table prim_name ->
505-
(Hashtbl.find comparisons_table prim_name).bool
506-
| [arg1; _] when Hashtbl.mem infix_table prim_name ->
507-
specialize_op (Hashtbl.find infix_table prim_name) env arg1.exp_type
475+
(Hashtbl.find comparisons_table prim_name).boolcomp
508476
| _ ->
509477
let has_constant_constructor =
510478
match args with
@@ -517,7 +485,7 @@ let transl_primitive_application loc prim env ty args =
517485
in
518486
if has_constant_constructor then
519487
match Hashtbl.find_opt comparisons_table prim_name with
520-
| Some table when table.simplify_constant_constructor -> table.int
488+
| Some table when table.simplify_constant_constructor -> table.intcomp
521489
| Some _ | None -> specialize_primitive prim env ty
522490
(* ~has_constant_constructor*)
523491
else specialize_primitive prim env ty

0 commit comments

Comments
 (0)