Skip to content

Commit 1628e56

Browse files
committed
split caml_format
1 parent 8d13694 commit 1628e56

File tree

2 files changed

+114
-99
lines changed

2 files changed

+114
-99
lines changed

jscomp/runtime/caml_format.ml

Lines changed: 111 additions & 99 deletions
Original file line numberDiff line numberDiff line change
@@ -374,13 +374,113 @@ let caml_format_int fmt i =
374374
let f = parse_format fmt in
375375
aux f i
376376

377+
(* This can handle unsigned integer (-1L) and print it as "%Lu" which
378+
will overflow signed integer in general
379+
*)
380+
let dec_of_pos_int64 x =
381+
let s = ref "" in
382+
let wbase = 10L in
383+
let cvtbl = "0123456789" in
384+
385+
(if x < 0L then
386+
let y = Caml_int64.discard_sign x in
387+
(* 2 ^ 63 + y `div_mod` 10 *)
388+
389+
let quotient_l = 922337203685477580L (* 2 ^ 63 / 10 *)
390+
(* {lo = -858993460n; hi = 214748364n} *)
391+
(* TODO: int64 constant folding so that we can do idiomatic code
392+
2 ^ 63 / 10 *)in
393+
let modulus_l = 8L in
394+
(* let c, d = Caml_int64.div_mod (Caml_int64.add y modulus_l) wbase in
395+
we can not do the code above, it can overflow when y is really large
396+
*)
397+
let c, d = Caml_int64.div_mod y wbase in
398+
let e ,f = Caml_int64.div_mod (Caml_int64_extern.add modulus_l d) wbase in
399+
let quotient =
400+
ref (Caml_int64_extern.add (Caml_int64_extern.add quotient_l c )
401+
e) in
402+
let modulus = ref f in
403+
s .contents<-
404+
Caml_string_extern.get_string_unsafe
405+
cvtbl (Caml_int64_extern.to_int modulus.contents) ^ s.contents ;
406+
407+
while quotient.contents <> 0L do
408+
let a, b = Caml_int64.div_mod (quotient.contents) wbase in
409+
quotient .contents<- a;
410+
modulus .contents<- b;
411+
s .contents<- Caml_string_extern.get_string_unsafe cvtbl (Caml_int64_extern.to_int modulus.contents) ^ s.contents ;
412+
done;
413+
414+
else
415+
let a, b = Caml_int64.div_mod x wbase in
416+
let quotient = ref a in
417+
let modulus = ref b in
418+
s .contents<-
419+
Caml_string_extern.get_string_unsafe
420+
cvtbl ( Caml_int64_extern.to_int modulus.contents) ^ s.contents ;
421+
422+
while quotient.contents <> 0L do
423+
let a, b = Caml_int64.div_mod (quotient.contents) wbase in
424+
quotient .contents<- a;
425+
modulus .contents<- b;
426+
s .contents<- Caml_string_extern.get_string_unsafe cvtbl (Caml_int64_extern.to_int modulus.contents) ^ s.contents ;
427+
done); s.contents
428+
429+
let oct_of_int64 x =
430+
let s = ref "" in
431+
let wbase = 8L in
432+
let cvtbl = "01234567" in
433+
(if x < 0L then
434+
begin
435+
let y = Caml_int64.discard_sign x in
436+
(* 2 ^ 63 + y `div_mod` 8 *)
437+
let quotient_l = 1152921504606846976L
438+
(* {lo = 0n; hi = 268435456n } *) (* 2 ^ 31 / 8 *)
439+
in
440+
441+
(* let c, d = Caml_int64.div_mod (Caml_int64.add y modulus_l) wbase in
442+
we can not do the code above, it can overflow when y is really large
443+
*)
444+
let c, d = Caml_int64.div_mod y wbase in
445+
446+
let quotient =
447+
ref (Caml_int64_extern.add quotient_l c ) in
448+
let modulus = ref d in
449+
s .contents<-
450+
Caml_string_extern.get_string_unsafe
451+
cvtbl (Caml_int64_extern.to_int modulus.contents) ^ s.contents ;
452+
453+
while quotient.contents <> 0L do
454+
let a, b = Caml_int64.div_mod quotient.contents wbase in
455+
quotient .contents<- a;
456+
modulus .contents<- b;
457+
s .contents<- Caml_string_extern.get_string_unsafe cvtbl (Caml_int64_extern.to_int modulus.contents) ^ s.contents ;
458+
done;
459+
end
460+
else
461+
let a, b = Caml_int64.div_mod x wbase in
462+
let quotient = ref a in
463+
let modulus = ref b in
464+
s .contents<-
465+
Caml_string_extern.get_string_unsafe
466+
cvtbl (Caml_int64_extern.to_int modulus.contents) ^ s.contents ;
467+
468+
while quotient.contents <> 0L do
469+
let a, b = Caml_int64.div_mod (quotient.contents) wbase in
470+
quotient .contents<- a;
471+
modulus .contents<- b;
472+
s .contents<- Caml_string_extern.get_string_unsafe cvtbl (Caml_int64_extern.to_int modulus.contents) ^ s.contents ;
473+
done); s.contents
474+
475+
377476
(* FIXME: improve codegen for such cases
378477
let div_mod (x : int64) (y : int64) : int64 * int64 =
379478
let a, b = Caml_int64.(div_mod (unsafe_of_int64 x) (unsafe_of_int64 y)) in
380479
Caml_int64.unsafe_to_int64 a , Caml_int64.unsafe_to_int64 b
381480
*)
382481
let caml_int64_format fmt x =
383-
let module String = Caml_string_extern in
482+
if fmt = "%d" then Caml_int64.to_string x
483+
else
384484
let f = parse_format fmt in
385485
let x =
386486
if f.signedconv && x < 0L then
@@ -389,114 +489,26 @@ let caml_int64_format fmt x =
389489
Caml_int64_extern.neg x
390490
end
391491
else x in
392-
let s = ref "" in
492+
let s =
393493

394494
begin match f.base with
395495
| Hex ->
396-
s .contents<- Caml_int64.to_hex x ^ s.contents
496+
Caml_int64.to_hex x
397497
| Oct ->
398-
let wbase = 8L in
399-
let cvtbl = "01234567" in
400-
401-
if x < 0L then
402-
begin
403-
let y = Caml_int64.discard_sign x in
404-
(* 2 ^ 63 + y `div_mod` 8 *)
405-
let quotient_l = 1152921504606846976L
406-
(* {lo = 0n; hi = 268435456n } *) (* 2 ^ 31 / 8 *)
407-
in
408-
409-
(* let c, d = Caml_int64.div_mod (Caml_int64.add y modulus_l) wbase in
410-
we can not do the code above, it can overflow when y is really large
411-
*)
412-
let c, d = Caml_int64.div_mod y wbase in
413-
414-
let quotient =
415-
ref (Caml_int64_extern.add quotient_l c ) in
416-
let modulus = ref d in
417-
s .contents<-
418-
Caml_string_extern.of_char
419-
cvtbl.[ Caml_int64_extern.to_int modulus.contents] ^ s.contents ;
420-
421-
while quotient.contents <> 0L do
422-
let a, b = Caml_int64.div_mod quotient.contents wbase in
423-
quotient .contents<- a;
424-
modulus .contents<- b;
425-
s .contents<- Caml_string_extern.of_char cvtbl.[Caml_int64_extern.to_int modulus.contents] ^ s.contents ;
426-
done;
427-
end
428-
else
429-
let a, b = Caml_int64.div_mod x wbase in
430-
let quotient = ref a in
431-
let modulus = ref b in
432-
s .contents<-
433-
Caml_string_extern.of_char
434-
cvtbl.[ Caml_int64_extern.to_int modulus.contents] ^ s.contents ;
435-
436-
while quotient.contents <> 0L do
437-
let a, b = Caml_int64.div_mod (quotient.contents) wbase in
438-
quotient .contents<- a;
439-
modulus .contents<- b;
440-
s .contents<- Caml_string_extern.of_char cvtbl.[Caml_int64_extern.to_int modulus.contents] ^ s.contents ;
441-
done
442-
498+
oct_of_int64 x
443499
| Dec ->
444-
let wbase = 10L in
445-
let cvtbl = "0123456789" in
446-
447-
if x < 0L then
448-
let y = Caml_int64.discard_sign x in
449-
(* 2 ^ 63 + y `div_mod` 10 *)
450-
451-
let quotient_l = 922337203685477580L (* 2 ^ 63 / 10 *)
452-
(* {lo = -858993460n; hi = 214748364n} *)
453-
(* TODO: int64 constant folding so that we can do idiomatic code
454-
2 ^ 63 / 10 *)in
455-
let modulus_l = 8L in
456-
(* let c, d = Caml_int64.div_mod (Caml_int64.add y modulus_l) wbase in
457-
we can not do the code above, it can overflow when y is really large
458-
*)
459-
let c, d = Caml_int64.div_mod y wbase in
460-
let e ,f = Caml_int64.div_mod (Caml_int64_extern.add modulus_l d) wbase in
461-
let quotient =
462-
ref (Caml_int64_extern.add (Caml_int64_extern.add quotient_l c )
463-
e) in
464-
let modulus = ref f in
465-
s .contents<-
466-
Caml_string_extern.of_char
467-
cvtbl.[Caml_int64_extern.to_int modulus.contents] ^ s.contents ;
468-
469-
while quotient.contents <> 0L do
470-
let a, b = Caml_int64.div_mod (quotient.contents) wbase in
471-
quotient .contents<- a;
472-
modulus .contents<- b;
473-
s .contents<- Caml_string_extern.of_char cvtbl.[Caml_int64_extern.to_int modulus.contents] ^ s.contents ;
474-
done;
475-
476-
else
477-
let a, b = Caml_int64.div_mod x wbase in
478-
let quotient = ref a in
479-
let modulus = ref b in
480-
s .contents<-
481-
Caml_string_extern.of_char
482-
cvtbl.[ Caml_int64_extern.to_int modulus.contents] ^ s.contents ;
483-
484-
while quotient.contents <> 0L do
485-
let a, b = Caml_int64.div_mod (quotient.contents) wbase in
486-
quotient .contents<- a;
487-
modulus .contents<- b;
488-
s .contents<- Caml_string_extern.of_char cvtbl.[Caml_int64_extern.to_int modulus.contents] ^ s.contents ;
489-
done;
490-
end;
500+
dec_of_pos_int64 x
501+
end in
502+
let fill_s =
491503
if f.prec >= 0 then
492504
begin
493505
f.filter <- " ";
494-
let n = f.prec -Caml_string_extern.length s.contents in
506+
let n = f.prec -Caml_string_extern.length s in
495507
if n > 0 then
496-
s .contents<- repeat n "0" ^ s.contents
497-
end;
508+
repeat n "0" ^ s else s
509+
end else s in
498510

499-
finish_formatting f s.contents
511+
finish_formatting f fill_s
500512

501513
let caml_format_float fmt x =
502514
let module String = Caml_string_extern in

jscomp/runtime/caml_string_extern.ml

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,9 @@
3535
(*ATT: this relies on we encode `char' as int *)
3636
external of_char : char -> string = "String.fromCharCode"
3737
[@@bs.val]
38+
external get_string_unsafe : string -> int -> string = ""
39+
[@@bs.get_index]
40+
3841
external toUpperCase : string -> string = "toUpperCase" [@@bs.send]
3942
external of_int : int -> base:int -> string = "toString" [@@bs.send]
4043
external of_nativeint : nativeint -> base:int -> string = "toString" [@@bs.send]

0 commit comments

Comments
 (0)