Skip to content

Commit 0b088ec

Browse files
bobzhangbobzhang
committedDec 25, 2017
re-org primitive comparisons
·
9.1.42.2.3
1 parent 8a76d82 commit 0b088ec

18 files changed

+138
-121
lines changed
 

‎jscomp/core/js_runtime_modules.ml

+1
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ let hash = "Caml_hash"
3838
let oo = "Caml_oo"
3939
let curry = "Curry"
4040
let caml_oo_curry = "Caml_oo_curry"
41+
let caml_primitive = "Caml_primitive"
4142
let int64 = "Caml_int64"
4243
let md5 = "Caml_md5"
4344
let weak = "Caml_weak"

‎jscomp/core/lam_dispatch_primitive.ml

+40-35
Original file line numberDiff line numberDiff line change
@@ -317,7 +317,7 @@ let translate loc (prim_name : string)
317317
| "caml_modf_float"
318318
| "caml_ldexp_float"
319319
| "caml_frexp_float"
320-
| "caml_float_compare"
320+
321321
| "caml_copysign_float"
322322
| "caml_expm1_float"
323323
| "caml_hypot_float"
@@ -392,8 +392,45 @@ let translate loc (prim_name : string)
392392
call Js_runtime_modules.string
393393
end
394394

395-
| "caml_string_get"
396-
| "caml_string_compare"
395+
| "caml_int_compare"
396+
| "caml_int32_compare"
397+
| "caml_nativeint_compare"
398+
| "caml_float_compare"
399+
| "caml_string_compare"
400+
->
401+
call Js_runtime_modules.caml_primitive
402+
403+
| "caml_int_min"
404+
| "caml_float_min"
405+
| "caml_string_min"
406+
| "caml_nativeint_min"
407+
| "caml_int32_min"
408+
409+
->
410+
begin match args with
411+
| [a;b] ->
412+
if Js_analyzer.is_okay_to_duplicate a && Js_analyzer.is_okay_to_duplicate b then
413+
E.econd (E.js_comp Clt a b) a b
414+
else
415+
call Js_runtime_modules.caml_primitive
416+
| _ -> assert false
417+
end
418+
| "caml_int_max"
419+
| "caml_float_max"
420+
| "caml_string_max"
421+
| "caml_nativeint_max"
422+
| "caml_int32_max"
423+
->
424+
begin match args with
425+
| [a;b] ->
426+
if Js_analyzer.is_okay_to_duplicate a && Js_analyzer.is_okay_to_duplicate b then
427+
E.econd (E.js_comp Cgt a b) a b
428+
else
429+
call Js_runtime_modules.caml_primitive
430+
| _ -> assert false
431+
end
432+
433+
| "caml_string_get"
397434
| "string_of_bytes"
398435
| "bytes_of_string"
399436

@@ -579,43 +616,11 @@ let translate loc (prim_name : string)
579616
| _ -> assert false
580617
end
581618

582-
| "caml_int_min"
583-
| "caml_float_min"
584-
| "caml_string_min"
585-
| "caml_nativeint_min"
586-
| "caml_int32_min"
587-
588-
->
589-
begin match args with
590-
| [a;b] ->
591-
if Js_analyzer.is_okay_to_duplicate a && Js_analyzer.is_okay_to_duplicate b then
592-
E.econd (E.js_comp Clt a b) a b
593-
else
594-
call Js_runtime_modules.obj_runtime
595-
| _ -> assert false
596-
end
597-
| "caml_int_max"
598-
| "caml_float_max"
599-
| "caml_string_max"
600-
| "caml_nativeint_max"
601-
| "caml_int32_max"
602-
->
603-
begin match args with
604-
| [a;b] ->
605-
if Js_analyzer.is_okay_to_duplicate a && Js_analyzer.is_okay_to_duplicate b then
606-
E.econd (E.js_comp Cgt a b) a b
607-
else
608-
call Js_runtime_modules.obj_runtime
609-
| _ -> assert false
610-
end
611619

612620
| "caml_obj_dup"
613621
| "caml_update_dummy"
614622
| "caml_obj_truncate"
615623
| "caml_lazy_make_forward"
616-
| "caml_int_compare"
617-
| "caml_int32_compare"
618-
| "caml_nativeint_compare"
619624
->
620625
call Js_runtime_modules.obj_runtime
621626

‎jscomp/others/.depend

+2-2
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ bs_internalAVLtree.cmj :
2222
bs_internalMutableAVLSet.cmj : bs_internalAVLset.cmj
2323
bs_Hash.cmj : bs_Hash.cmi
2424
bs_Queue.cmj : bs_Array.cmj bs_Queue.cmi
25-
bs_List.cmj : bs_Array.cmj bs_List.cmi
25+
bs_List.cmj : js_json.cmj bs_Array.cmj bs_List.cmi
2626
bs_internalBucketsType.cmj : bs_Array.cmj
2727
bs_internalSetBuckets.cmj : bs_internalBucketsType.cmj bs_Array.cmj bs.cmj
2828
bs_internalBuckets.cmj : bs_internalBucketsType.cmj bs_Array.cmj
@@ -69,7 +69,7 @@ js_mapperRt.cmi :
6969
bs_Array.cmi :
7070
bs_Hash.cmi :
7171
bs_Queue.cmi :
72-
bs_List.cmi :
72+
bs_List.cmi : js_json.cmi
7373
bs_HashMap.cmi : bs_Hash.cmi bs_Bag.cmj
7474
bs_HashSet.cmi : bs_Hash.cmi bs_Bag.cmj
7575
bs_HashSetString.cmi :

‎jscomp/others/bs_List.ml

+3-2
Original file line numberDiff line numberDiff line change
@@ -358,12 +358,13 @@ let rec fillAuxMap arr i x f =
358358
Bs_Array.unsafe_set arr i (f h [@bs]) ;
359359
fillAuxMap arr (i + 1) t f
360360

361-
module J = Js.Json
361+
module J = Js_json
362+
type json = J.t
362363
let toJson x f =
363364
let len = length x in
364365
let arr = Bs_Array.makeUninitializedUnsafe len in
365366
fillAuxMap arr 0 x f;
366-
Js.Json.array arr
367+
J.array arr
367368

368369
(* TODO: best practice about raising excpetion
369370
1. raise OCaml exception, no stacktrace

‎jscomp/others/bs_List.mli

+4-2
Original file line numberDiff line numberDiff line change
@@ -52,8 +52,10 @@ val length : 'a t -> int
5252

5353
val toArray : 'a t -> 'a array
5454

55-
val toJson : 'a t -> ('a -> Js.Json.t [@bs]) -> Js.Json.t
56-
val fromJson : Js.Json.t -> (Js.Json.t -> 'a [@bs]) -> 'a t
55+
type json = Js_json.t
56+
57+
val toJson : 'a t -> ('a -> json [@bs]) -> json
58+
val fromJson : json -> (json -> 'a [@bs]) -> 'a t
5759

5860
val revAppend : 'a t -> 'a t -> 'a t
5961

‎jscomp/others/bs_internalBuckets.ml

+3-2
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,6 @@ let rec bucket_length accu buckets =
4646
| None -> accu
4747
| Some cell -> bucket_length (accu + 1) (next cell)
4848

49-
let max (m : int) n = if m > n then m else n
5049

5150

5251
let rec do_bucket_iter ~f buckets =
@@ -83,7 +82,9 @@ let fold0 f h init =
8382

8483
let logStats0 h =
8584
let mbl =
86-
Bs_Array.foldLeft (fun[@bs] m b -> max m (bucket_length 0 b)) 0 (C.buckets h) in
85+
Bs_Array.foldLeft (fun[@bs] m b ->
86+
let len = (bucket_length 0 b) in
87+
Pervasives.max m len) 0 (C.buckets h) in
8788
let histo = Bs_Array.make (mbl + 1) 0 in
8889
Bs_Array.iter
8990
(fun[@bs] b ->

‎jscomp/others/bs_internalMutableAVLSet.ml

+11-6
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ type ('elt,'id) t0 = 'elt node Js.null
88

99
external unsafeCoerce : 'a Js.null -> 'a = "%identity"
1010

11-
let maxInt (x : int) y = if x > y then x else y
11+
1212

1313
let empty = N.empty0
1414
let isEmpty = N.isEmpty0
@@ -31,17 +31,21 @@ let rotateWithLeftChild k2 =
3131
let k1 = unsafeCoerce (N.left k2) in
3232
N.(leftSet k2 (right k1));
3333
N.(rightSet k1 (return k2 ));
34+
let hlk2, hrk2 = N.(height (left k2), (height (right k2))) in
3435
N.(hSet k2
35-
(maxInt (height (left k2)) (height (right k2)) + 1));
36-
N.(hSet k1 (maxInt (height (left k1)) (h k2) + 1));
36+
(Pervasives.max hlk2 hrk2 + 1));
37+
let hlk1, hk2 = N.(height (left k1), (h k2)) in
38+
N.(hSet k1 (Pervasives.max hlk1 hk2 + 1));
3739
k1
3840
(* right rotation *)
3941
let rotateWithRightChild k1 =
4042
let k2 = unsafeCoerce (N.right k1) in
4143
N.(rightSet k1 (left k2));
4244
N.(leftSet k2 (return k1));
43-
N.(hSet k1 (maxInt (height (left k1)) (height (right k1)) + 1));
44-
N.(hSet k2 (maxInt (height (right k2)) (h k1) + 1));
45+
let hlk1, hrk1 = N.((height (left k1)), (height (right k1))) in
46+
N.(hSet k1 (Pervasives.max hlk1 hrk1 + 1));
47+
let hrk2, hk1 = N.(height (right k2), (h k1)) in
48+
N.(hSet k2 (Pervasives.max hrk2 hk1 + 1));
4549
k2
4650

4751
(*
@@ -91,7 +95,8 @@ let rec add (x : key) (t : _ t0) =
9195
)
9296
end
9397
) in
98+
let hlt, hrt = N.(height (left t),(height (right t))) in
9499
N.hSet t
95-
N.(maxInt (height (left t)) (height (right t)) + 1);
100+
N.(Pervasives.max hlt hrt + 1);
96101
N.return t
97102
end

‎jscomp/others/bs_internalSetBuckets.ml

+3-2
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,6 @@ let rec bucket_length accu buckets =
4343
| None -> accu
4444
| Some cell -> bucket_length (accu + 1) (next cell)
4545

46-
let max (m : int) n = if m > n then m else n
4746

4847

4948
let rec do_bucket_iter ~f buckets =
@@ -100,7 +99,9 @@ let fold0 f h init =
10099

101100
let logStats0 h =
102101
let mbl =
103-
Bs_Array.foldLeft (fun[@bs] m b -> max m (bucket_length 0 b)) 0 (C.buckets h) in
102+
Bs_Array.foldLeft (fun[@bs] m b ->
103+
let len = (bucket_length 0 b) in
104+
max m len) 0 (C.buckets h) in
104105
let histo = Bs_Array.make (mbl + 1) 0 in
105106
Bs_Array.iter
106107
(fun[@bs] b ->

‎jscomp/runtime/.depend

-2
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,6 @@ caml_io.cmj : js_undefined.cmj js.cmj bs_string.cmj
1111
caml_float.cmj : js_typed_array.cmj js_float.cmj caml_float.cmi
1212
caml_lexer.cmj : caml_lexer.cmi
1313
caml_parser.cmj : caml_parser.cmi
14-
caml_primitive.cmj : caml_primitive.cmi
1514
caml_format.cmj : js_nativeint.cmj js_int64.cmj js_float.cmj caml_utils.cmj \
1615
bs_string.cmj caml_format.cmi
1716
caml_md5.cmj : bs_string.cmj caml_md5.cmi
@@ -48,7 +47,6 @@ caml_sys.cmi :
4847
caml_float.cmi :
4948
caml_lexer.cmi :
5049
caml_parser.cmi :
51-
caml_primitive.cmi :
5250
caml_format.cmi :
5351
caml_md5.cmi :
5452
caml_queue.cmi :

‎jscomp/runtime/Makefile

+4-3
Original file line numberDiff line numberDiff line change
@@ -5,14 +5,14 @@ COMPILER=../../lib/bsc.exe
55
OTHERS= caml_array caml_string caml_bytes\
66
caml_obj caml_int64 \
77
caml_exceptions caml_utils caml_sys caml_io\
8-
caml_float caml_lexer caml_parser caml_primitive\
8+
caml_float caml_lexer caml_parser \
99
caml_format caml_md5 caml_queue caml_hash caml_weak\
1010
caml_backtrace caml_int32 caml_gc js_typed_array \
1111
js_primitive caml_basic caml_oo curry caml_oo_curry caml_module \
1212
caml_missing_polyfill\
1313
bs_string js_float js_exn bs_obj js_nativeint js_int js_null js_undefined
1414

15-
SOURCE_LIST= $(OTHERS) caml_builtin_exceptions block js js_unsafe js_internal
15+
SOURCE_LIST= $(OTHERS) caml_builtin_exceptions block js js_unsafe js_internal caml_primitive
1616

1717
caml_sys.cmj: js_undefined.cmj
1818
caml_oo.cmj : caml_array.cmj
@@ -23,10 +23,11 @@ caml_format.cmj: caml_int64.cmj caml_int32.cmj caml_utils.cmj caml_string.cmj
2323
caml_weak.cmj caml_module.cmj: caml_obj.cmj js_primitive.cmj
2424
caml_builtin_exceptions.cmj: caml_builtin_exceptions.cmi js_unsafe.cmi
2525
block.cmj: block.cmi
26+
caml_primitive.cmj: caml_primitive.cmi
2627
caml_int64.cmj : caml_obj.cmj
2728
# or we can do a post-processing to add missing cmj dependency manually
2829
js_exn.cmj : caml_exceptions.cmj
29-
$(addsuffix .cmj, $(OTHERS)): caml_builtin_exceptions.cmj block.cmj js.cmj js_unsafe.cmj
30+
$(addsuffix .cmj, $(OTHERS)): caml_builtin_exceptions.cmj block.cmj js.cmj js_unsafe.cmj caml_primitive.cmj
3031
$(addsuffix .cmj, $(OTHERS)) caml_builtin_exceptions.cmj block.cmj js.cmj js_unsafe.cmj : js_internal.cmi
3132
## since we use ppx
3233
$(addsuffix .cmi, $(OTHERS)): js.cmi js_unsafe.cmj js_unsafe.cmi js.cmj

‎jscomp/runtime/caml_float.ml

+1-7
Original file line numberDiff line numberDiff line change
@@ -105,13 +105,7 @@ let caml_frexp_float (x: float): float * int =
105105
end
106106
end
107107

108-
let caml_float_compare (x : float) (y : float ) =
109-
if x = y then 0
110-
else if x < y then -1
111-
else if x > y then 1
112-
else if x = x then 1
113-
else if y = y then -1
114-
else 0
108+
115109

116110
let caml_copysign_float (x : float) (y : float) : float =
117111
let x = abs_float x in

‎jscomp/runtime/caml_float.mli

+1-1
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ val caml_modf_float : float -> float * float
3636

3737
val caml_ldexp_float : float -> int -> float
3838
val caml_frexp_float : float -> float * int
39-
val caml_float_compare : float -> float -> int
39+
4040
val caml_copysign_float : float -> float -> float
4141
val caml_expm1_float : float -> float
4242

‎jscomp/runtime/caml_obj.ml

+6-36
Original file line numberDiff line numberDiff line change
@@ -125,40 +125,12 @@ let caml_update_dummy x y =
125125
let y_tag = Obj.tag y in
126126
if y_tag <> 0 then
127127
Obj.set_tag x y_tag
128-
129-
type 'a selector = 'a -> 'a -> 'a
130128
(* Bs_obj.set_length x (Bs_obj.length y) *)
131129
(* [set_length] seems redundant here given that it is initialized as an array
132130
*)
133-
let caml_int_compare (x : int) (y: int) : int =
134-
if x < y then -1 else if x = y then 0 else 1
135-
136-
(* could be replaced by [Math.min], but it seems those built-ins are slower *)
137-
let caml_int_min (x : int) (y : int) : int =
138-
if x < y then x else y
139-
let caml_float_min (x : float) y =
140-
if x < y then x else y
141-
let caml_string_min (x : string) y =
142-
if x < y then x else y
143-
let caml_nativeint_min (x : nativeint) y =
144-
if x < y then x else y
145-
let caml_int32_min (x : int32) y =
146-
if x < y then x else y
147-
148-
let caml_int_max (x : int) (y : int) : int =
149-
if x > y then x else y
150-
let caml_float_max (x : float) y =
151-
if x > y then x else y
152-
let caml_string_max (x : string) y =
153-
if x > y then x else y
154-
let caml_nativeint_max (x : nativeint) y =
155-
if x > y then x else y
156-
let caml_int32_max (x : int32) y =
157-
if x > y then x else y
158-
159-
160-
let caml_string_compare (x : string) (y: string) : int =
161-
if x < y then -1 else if x = y then 0 else 1
131+
132+
type 'a selector = 'a -> 'a -> 'a
133+
162134

163135
let unsafe_js_compare x y =
164136
if x == y then 0 else
@@ -187,13 +159,13 @@ let rec caml_compare (a : Obj.t) (b : Obj.t) : int =
187159
let a_type = Js.typeof a in
188160
let b_type = Js.typeof b in
189161
if a_type = "string" then
190-
caml_string_compare (Obj.magic a) (Obj.magic b )
162+
Pervasives.compare (Obj.magic a : string) (Obj.magic b )
191163
else
192164
let is_a_number = a_type = "number" in
193165
let is_b_number = b_type = "number" in
194166
match is_a_number , is_b_number with
195167
| true, true ->
196-
caml_int_compare (Obj.magic a) (Obj.magic b )
168+
Pervasives.compare (Obj.magic a : int) (Obj.magic b : int)
197169
| true , false -> -1 (* Integer < Block in OCaml runtime GPR #1195 *)
198170
| false, true -> 1
199171
| false, false ->
@@ -218,7 +190,7 @@ let rec caml_compare (a : Obj.t) (b : Obj.t) : int =
218190
else if tag_b = 250 then
219191
caml_compare a (Obj.field b 0)
220192
else if tag_a = 248 (* object/exception *) then
221-
caml_int_compare (Obj.magic @@ Obj.field a 1) (Obj.magic @@ Obj.field b 1 )
193+
Pervasives.compare (Obj.magic @@ Obj.field a 1 : int) (Obj.magic @@ Obj.field b 1 )
222194
else if tag_a = 251 (* abstract_tag *) then
223195
raise (Invalid_argument "equal: abstract value")
224196
else if tag_a <> tag_b then
@@ -307,8 +279,6 @@ and aux_equal_length (a : Obj.t) (b : Obj.t) i same_length =
307279

308280
let caml_notequal a b = not (caml_equal a b)
309281

310-
let caml_int32_compare = caml_int_compare
311-
let caml_nativeint_compare = caml_int_compare
312282
let caml_greaterequal a b = caml_compare a b >= 0
313283

314284
let caml_greaterthan a b = caml_compare a b > 0

‎jscomp/runtime/caml_obj.mli

-14
Original file line numberDiff line numberDiff line change
@@ -37,9 +37,6 @@ val caml_lazy_make_forward : 'a -> 'a lazy_t
3737

3838
val caml_update_dummy : Obj.t -> Obj.t -> unit
3939

40-
val caml_int_compare : int -> int -> int
41-
val caml_int32_compare : int -> int -> int
42-
val caml_nativeint_compare : int -> int -> int
4340

4441
val caml_compare : Obj.t -> Obj.t -> int
4542

@@ -54,17 +51,6 @@ val caml_lessequal : eq
5451

5552
type 'a selector = 'a -> 'a -> 'a
5653

57-
val caml_int_min : int selector
58-
val caml_float_min : float selector
59-
val caml_string_min : string selector
60-
val caml_nativeint_min : nativeint selector
61-
val caml_int32_min : int32 selector
62-
63-
val caml_int_max : int selector
64-
val caml_float_max : float selector
65-
val caml_string_max : string selector
66-
val caml_nativeint_max : nativeint selector
67-
val caml_int32_max : int32 selector
6854

6955
val caml_min : Obj.t selector
7056
val caml_max : Obj.t selector

‎jscomp/runtime/caml_primitive.ml

+37-1
Original file line numberDiff line numberDiff line change
@@ -23,15 +23,51 @@
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424

2525

26+
let caml_int_compare (x : int) (y: int) : int =
27+
if x < y then -1 else if x = y then 0 else 1
2628

2729

30+
let caml_int32_compare = caml_int_compare
31+
let caml_nativeint_compare = caml_int_compare
2832

33+
let caml_float_compare (x : float) (y : float ) =
34+
if x = y then 0
35+
else if x < y then -1
36+
else if x > y then 1
37+
else if x = x then 1
38+
else if y = y then -1
39+
else 0
2940

41+
let caml_string_compare (s1 : string) (s2 : string) : int =
42+
if s1 = s2 then 0
43+
else if s1 < s2 then -1
44+
else 1
3045

46+
type 'a selector = 'a -> 'a -> 'a
3147

48+
(* could be replaced by [Math.min], but it seems those built-ins are slower *)
49+
let caml_int_min (x : int) (y : int) : int =
50+
if x < y then x else y
51+
let caml_float_min (x : float) y =
52+
if x < y then x else y
53+
let caml_string_min (x : string) y =
54+
if x < y then x else y
55+
let caml_nativeint_min (x : nativeint) y =
56+
if x < y then x else y
57+
let caml_int32_min (x : int32) y =
58+
if x < y then x else y
3259

60+
let caml_int_max (x : int) (y : int) : int =
61+
if x > y then x else y
62+
let caml_float_max (x : float) y =
63+
if x > y then x else y
64+
let caml_string_max (x : string) y =
65+
if x > y then x else y
66+
let caml_nativeint_max (x : nativeint) y =
67+
if x > y then x else y
68+
let caml_int32_max (x : int32) y =
69+
if x > y then x else y
3370

3471

3572

3673

37-
(** *)

‎jscomp/runtime/caml_primitive.mli

+20-1
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,26 @@
2828

2929

3030

31+
type 'a selector = 'a -> 'a -> 'a
3132

3233

33-
(** *)
3434

35+
val caml_int_compare : int -> int -> int
36+
val caml_float_compare : float -> float -> int
37+
val caml_nativeint_compare : int -> int -> int
38+
val caml_string_compare : string -> string -> int
39+
val caml_int32_compare : int -> int -> int
40+
41+
42+
43+
val caml_int_min : int selector
44+
val caml_float_min : float selector
45+
val caml_string_min : string selector
46+
val caml_nativeint_min : nativeint selector
47+
val caml_int32_min : int32 selector
48+
49+
val caml_int_max : int selector
50+
val caml_float_max : float selector
51+
val caml_string_max : string selector
52+
val caml_nativeint_max : nativeint selector
53+
val caml_int32_max : int32 selector

‎jscomp/runtime/caml_string.ml

+1-4
Original file line numberDiff line numberDiff line change
@@ -57,10 +57,7 @@ let caml_create_string len : bytes =
5757
else new_uninitialized len
5858

5959

60-
let caml_string_compare (s1 : string) (s2 : string) : int =
61-
if s1 = s2 then 0
62-
else if s1 < s2 then -1
63-
else 1
60+
6461

6562
let caml_fill_string (s : bytes) i l (c : char) =
6663
if l > 0 then

‎jscomp/runtime/caml_string.mli

+1-1
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ val bytes_to_string : bytes -> string
3636
val caml_is_printable : char -> bool
3737
val caml_string_of_char_array : char array -> string
3838
val caml_string_get : string -> int -> char
39-
val caml_string_compare : string -> string -> int
39+
4040
val caml_create_string : int -> bytes
4141
val caml_fill_string : bytes -> int -> int -> char -> unit
4242
val caml_blit_string : string -> int -> bytes -> int -> int -> unit

0 commit comments

Comments
 (0)
Please sign in to comment.