Source file Number.ml

(** JavaScript Number built-in object

    This module mirrors the JavaScript Number API with prototype methods for
    number-to-string conversion. *)

module Dtoa = Quickjs_c.Dtoa
module Cutils = Quickjs_c.Cutils

(* JS_DTOA flags from dtoa.h *)
let js_dtoa_format_free = 0
let js_dtoa_format_fixed = 1
let js_dtoa_format_frac = 2
let js_dtoa_exp_auto = 0
let js_dtoa_exp_enabled = 1 lsl 2
let js_dtoa_exp_disabled = 2 lsl 2
let js_dtoa_minus_zero = 1 lsl 4

(* JS_DTOA_MAX_DIGITS from dtoa.h - hard limit of the C implementation *)
let max_digits = 101

(* JavaScript's RangeError limit for toFixed/toPrecision/toExponential *)
let js_max_digits = 100

(* Maximum buffer size for integer conversions: worst case is
   i64toa_radix(Int64.min_int, 2) = '-' plus 64 binary digits (the functions
   do not NUL-terminate) *)
let max_int_buf_size = 65

(** Number of digits to use *)
type format =
  | Free  (** Use minimum digits needed for exact round-trip *)
  | Fixed of int  (** Use n significant digits (1-101) *)
  | Fractional of int  (** Use n fractional digits (0-101) *)

(** Exponential notation control *)
type exponent =
  | Auto  (** Use exponential when appropriate *)
  | Always  (** Always use exponential notation *)
  | Never  (** Never use exponential notation *)

type options = {
  format : format;
  exponent : exponent;
  radix : int;
  show_minus_zero : bool;
}

let default_options =
  { format = Free; exponent = Auto; radix = 10; show_minus_zero = false }

let validate_radix radix =
  if radix < 2 || radix > 36 then
    invalid_arg
      (Printf.sprintf "Number: radix must be between 2 and 36, got %d" radix)

(* Validation mirrors the constraints js_dtoa asserts on (dtoa.h/dtoa.c):
   - FIXED requires 1 <= n_digits <= 101, FRAC requires 0 <= n_digits <= 101
   - radix != 10 is only supported with the FREE format
   Violating them would abort the process inside the C library, so they are
   rejected here with Invalid_argument instead. *)
let validate_options options =
  validate_radix options.radix;
  (match options.format with
  | Free -> ()
  | Fixed n ->
      if n < 1 || n > max_digits then
        invalid_arg
          (Printf.sprintf
             "Number: Fixed digits must be between 1 and %d, got %d" max_digits
             n)
  | Fractional n ->
      if n < 0 || n > max_digits then
        invalid_arg
          (Printf.sprintf
             "Number: Fractional digits must be between 0 and %d, got %d"
             max_digits n));
  match (options.format, options.radix) with
  | Free, _ | _, 10 -> ()
  | (Fixed _ | Fractional _), radix ->
      invalid_arg
        (Printf.sprintf
           "Number: radix %d is only supported with the Free format (the C \
            implementation restricts fixed/fractional formatting to radix 10)"
           radix)

let options_to_flags options =
  let format_flag =
    match options.format with
    | Free -> js_dtoa_format_free
    | Fixed _ -> js_dtoa_format_fixed
    | Fractional _ -> js_dtoa_format_frac
  in
  let exp_flag =
    match options.exponent with
    | Auto -> js_dtoa_exp_auto
    | Always -> js_dtoa_exp_enabled
    | Never -> js_dtoa_exp_disabled
  in
  let minus_zero_flag =
    if options.show_minus_zero then js_dtoa_minus_zero else 0
  in
  format_flag lor exp_flag lor minus_zero_flag

let n_digits_from_format format =
  match format with Free -> 0 | Fixed n -> n | Fractional n -> n

module Prototype = struct
  let to_string ?(options = default_options) d =
    validate_options options;
    let n_digits = n_digits_from_format options.format in
    let flags = options_to_flags options in
    let max_len = Dtoa.max_len d options.radix n_digits flags in
    let buf = Ctypes.allocate_n Ctypes.char ~count:(max_len + 1) in
    let tmp_mem = Ctypes.allocate_n Ctypes.uint64_t ~count:37 in
    let tmp_mem_ptr = Ctypes.to_voidp tmp_mem in
    let actual_len =
      Dtoa.to_string buf d options.radix n_digits flags tmp_mem_ptr
    in
    Ctypes.string_from_ptr buf ~length:actual_len

  let to_fixed n d =
    if n < 0 || n > js_max_digits then
      invalid_arg
        (Printf.sprintf
           "Number.to_fixed: digits must be between 0 and %d, got %d"
           js_max_digits n);
    to_string
      ~options:
        {
          format = Fractional n;
          exponent = Never;
          radix = 10;
          show_minus_zero = false;
        }
      d

  let to_precision n d =
    if n < 1 || n > js_max_digits then
      invalid_arg
        (Printf.sprintf
           "Number.to_precision: precision must be between 1 and %d, got %d"
           js_max_digits n);
    to_string
      ~options:
        {
          format = Fixed n;
          exponent = Auto;
          radix = 10;
          show_minus_zero = false;
        }
      d

  let to_exponential n d =
    if n < 0 || n > js_max_digits then
      invalid_arg
        (Printf.sprintf
           "Number.to_exponential: digits must be between 0 and %d, got %d"
           js_max_digits n);
    to_string
      ~options:
        {
          format = Fixed (n + 1);
          exponent = Always;
          radix = 10;
          show_minus_zero = false;
        }
      d

  let to_radix radix d =
    validate_radix radix;
    to_string
      ~options:
        { format = Free; exponent = Auto; radix; show_minus_zero = false }
      d
end

(* Integer-to-string conversions *)

let of_int32 n =
  let buf = Ctypes.allocate_n Ctypes.char ~count:max_int_buf_size in
  let len = Cutils.i32toa buf n in
  Ctypes.string_from_ptr buf ~length:(Unsigned.Size_t.to_int len)

let of_uint32 n =
  let buf = Ctypes.allocate_n Ctypes.char ~count:max_int_buf_size in
  let len = Cutils.u32toa buf n in
  Ctypes.string_from_ptr buf ~length:(Unsigned.Size_t.to_int len)

let of_int64 n =
  let buf = Ctypes.allocate_n Ctypes.char ~count:max_int_buf_size in
  let len = Cutils.i64toa buf n in
  Ctypes.string_from_ptr buf ~length:(Unsigned.Size_t.to_int len)

let of_uint64 n =
  let buf = Ctypes.allocate_n Ctypes.char ~count:max_int_buf_size in
  let len = Cutils.u64toa buf n in
  Ctypes.string_from_ptr buf ~length:(Unsigned.Size_t.to_int len)

let of_int n = of_int64 (Int64.of_int n)

let of_int32_radix ~radix n =
  validate_radix radix;
  let buf = Ctypes.allocate_n Ctypes.char ~count:max_int_buf_size in
  let len = Cutils.i64toa_radix buf (Int64.of_int32 n) radix in
  Ctypes.string_from_ptr buf ~length:(Unsigned.Size_t.to_int len)

let of_int64_radix ~radix n =
  validate_radix radix;
  let buf = Ctypes.allocate_n Ctypes.char ~count:max_int_buf_size in
  let len = Cutils.i64toa_radix buf n radix in
  Ctypes.string_from_ptr buf ~length:(Unsigned.Size_t.to_int len)

let of_int_radix ~radix n = of_int64_radix ~radix (Int64.of_int n)