change bigint model to sign * string

Author: mununki

jscomp/core/js_analyzer.ml

@@ -158,8 +158,8 @@ let rec eq_expression ({ expression_desc = x0 } : J.expression)
   | Undefined x -> y0 = Undefined x
   | Number (Int { i }) -> (
       match y0 with Number (Int { i = j }) -> i = j | _ -> false)
-  | Number (Bigint { i }) -> (
-    match y0 with Number (Bigint { i = j }) -> i = j | _ -> false)
+  | Number (Bigint (s0, i )) -> (
+    match y0 with Number (Bigint (s1, j)) -> s0 = s1 && i = j | _ -> false)
   | Number (Float _) -> false
   (* begin match y0 with
      | Number (Float j) ->

jscomp/core/js_dump.ml

@@ -664,7 +664,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
             Int32.to_string i
             (* check , js convention with ocaml lexical convention *)
         | Uint i -> Format.asprintf "%lu" i
-        | Bigint { i } -> Format.asprintf "%sn" i
+        | Bigint (sign, i) -> Format.asprintf "%sn" (Bigint_utils.to_string sign i)
       in
       let need_paren =
         if s.[0] = '-' then level > 13

jscomp/core/js_exp_make.ml

@@ -312,9 +312,9 @@ let obj_int_tag_literal : t =
 
 let int ?comment ?c i : t = { expression_desc = Number (Int { i; c }); comment }
 
-let bigint ?comment i : t = { expression_desc = Number (Bigint { i }); comment}
+let bigint ?comment sign i : t = { expression_desc = Number (Bigint (sign, i)); comment}
 
-let zero_bigint_literal : t = {expression_desc = Number (Bigint {i = "0"}); comment = None}
+let zero_bigint_literal : t = {expression_desc = Number (Bigint (true, "0")); comment = None}
 
 let small_int i : t =
   match i with
@@ -807,7 +807,11 @@ let tag_type = function
   | Ast_untagged_variants.String s -> str s ~delim:DStarJ
   | Int i -> small_int i
   | Float f -> float f
-  | Bigint i -> bigint i
+  | Bigint i -> 
+    let open Bigint_utils in
+    let sign, i = i |> remove_leading_sign in
+    let i = remove_leading_zeros i in
+    bigint sign i
   | Bool b -> bool b
   | Null -> nil
   | Undefined -> undefined

jscomp/core/js_exp_make.mli

@@ -111,7 +111,7 @@ val uint32 : ?comment:string -> int32 -> t
 
 val small_int : int -> t
 
-val bigint : ?comment:string -> string -> t
+val bigint : ?comment:string -> bool -> string -> t
 
 val float : ?comment:string -> string -> t
 

jscomp/core/js_op.ml

@@ -126,13 +126,11 @@ type 'a access = Getter | Setter
 (* literal char *)
 type float_lit = { f : string } [@@unboxed]
 
-type bigint_lit = { i: string } [@@unboxed]
-
 type number =
   | Float of float_lit
   | Int of { i : int32; c : int option }
   | Uint of int32
-  | Bigint of bigint_lit
+  | Bigint of bool * string
 
 (* becareful when constant folding +/-,
    since we treat it as js nativeint, bitwise operators:

jscomp/core/lam.ml

@@ -506,7 +506,7 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t =
           (* FIXME: could raise? *)
           Lift.bool
             (Lam_compat.cmp_float cmp (float_of_string a) (float_of_string b))
-      | Pbigintcomp cmp, Const_bigint a, Const_bigint b -> default ()
+      | Pbigintcomp cmp, Const_bigint (_, a), Const_bigint (_, b) -> default ()
       | Pintcomp ((Ceq | Cneq) as op), Const_pointer a, Const_pointer b ->
           Lift.bool
             (match op with

jscomp/core/lam_analysis.ml

@@ -27,7 +27,7 @@ let not_zero_constant (x : Lam_constant.t) =
   match x with
   | Const_int { i } -> i <> 0l
   | Const_int64 i -> i <> 0L
-  | Const_bigint i -> i <> "0"
+  | Const_bigint (_, i) -> i <> "0"
   | _ -> false
 
 let rec no_side_effects (lam : Lam.t) : bool =

jscomp/core/lam_compile_const.ml

@@ -74,7 +74,7 @@ and translate (x : Lam_constant.t) : J.expression =
       (* E.float (Int64.to_string i) *)
       Js_long.of_const i
       (* https://github.com/google/closure-library/blob/master/closure%2Fgoog%2Fmath%2Flong.js *)
-  | Const_bigint i -> E.bigint i
+  | Const_bigint (sign, i) -> E.bigint sign i
   | Const_float f -> E.float f (* TODO: preserve float *)
   | Const_string { s; unicode = false } -> E.str s
   | Const_string { s; unicode = true } -> E.str ~delim:DStarJ s

jscomp/core/lam_constant_convert.ml

@@ -36,7 +36,7 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
   | Const_base (Const_float i) -> Const_float i
   | Const_base (Const_int32 i) -> Const_int { i; comment = None }
   | Const_base (Const_int64 i) -> Const_int64 i
-  | Const_base (Const_bigint i) -> Const_bigint i
+  | Const_base (Const_bigint (sign, i)) -> Const_bigint (sign, i)
   | Const_pointer (0, Pt_constructor { name = "()"; const = 1; non_const = 0 })
     ->
       Const_js_undefined {isUnit = true}

jscomp/core/lam_print.ml

@@ -25,7 +25,7 @@ let rec struct_const ppf (cst : Lam_constant.t) =
   | Const_string { s } -> fprintf ppf "%S" s
   | Const_float f -> fprintf ppf "%s" f
   | Const_int64 n -> fprintf ppf "%LiL" n
-  | Const_bigint i -> fprintf ppf "%sn" i
+  | Const_bigint (sign, i) -> fprintf ppf "%sn" (Bigint_utils.to_string sign i)
   | Const_pointer name -> fprintf ppf "`%s" name
   | Const_some n -> fprintf ppf "[some-c]%a" struct_const n
   | Const_block (tag, _, []) -> fprintf ppf "[%i]" tag

jscomp/frontend/external_ffi_types.ml

@@ -301,7 +301,9 @@ let inline_int64_primitive (i : int64) : string list =
   [""; to_string (Ffi_inline_const (Const_int64 i))]
 
 let inline_bigint_primitive (i : string) : string list =
-  [""; to_string (Ffi_inline_const (Const_bigint i))]
+  let sign, i = i |> Bigint_utils.remove_leading_sign in
+  let i = Bigint_utils.remove_leading_zeros i in
+  [""; to_string (Ffi_inline_const (Const_bigint (sign, i)))]
 
 let inline_float_primitive (i : string) : string list =
   [""; to_string (Ffi_inline_const (Const_float i))]

jscomp/frontend/lam_constant.ml

@@ -50,7 +50,7 @@ type t =
   | Const_string of {s: string; unicode: bool}
   | Const_float of string
   | Const_int64 of int64
-  | Const_bigint of string
+  | Const_bigint of bool * string
   | Const_pointer of string
   | Const_block of int * Lambda.tag_info * t list
   | Const_float_array of string list
@@ -87,9 +87,9 @@ let rec eq_approx (x : t) (y : t) =
     match y with
     | Const_int64 iy -> ix = iy
     | _ -> false)
-  | Const_bigint ix -> (
+  | Const_bigint (sx, ix) -> (
     match y with
-    | Const_bigint iy -> ix = iy
+    | Const_bigint (sy, iy) -> sx = sy && ix = iy
     | _ -> false)
   | Const_pointer ix -> (
     match y with

jscomp/frontend/lam_constant.mli

@@ -46,7 +46,7 @@ type t =
   | Const_string of {s: string; unicode: bool}
   | Const_float of string
   | Const_int64 of int64
-  | Const_bigint of string
+  | Const_bigint of bool * string
   | Const_pointer of string
   | Const_block of int * Lambda.tag_info * t list
   | Const_float_array of string list

jscomp/ml/asttypes.ml

@@ -22,7 +22,7 @@ type constant =
   | Const_float of string
   | Const_int32 of int32
   | Const_int64 of int64
-  | Const_bigint of string
+  | Const_bigint of bool * string
 
 type rec_flag = Nonrecursive | Recursive
 

jscomp/ml/bigint_utils.ml

@@ -1,3 +1,15 @@
+let is_neg s = String.length s > 0 && s.[0] = '-'
+let is_pos s = String.length s > 0 && s.[0] = '+'
+
+let to_string sign s = (if sign then "" else "-") ^ s
+
+let remove_leading_sign str : bool * string =
+  let len = String.length str in
+  if len = 0 then (false, str)
+  else
+    if is_neg str || is_pos str then (not (is_neg str), String.sub str 1 (len -1))
+    else (not (is_neg str), str)
+
 (* 
   Removes leading zeros from the string only if the first non-zero character
   encountered is a digit. Unlike int and float, bigint cannot be of_string, so
@@ -32,7 +44,7 @@ let remove_leading_zeros str =
   let str = String.concat "" (String.split_on_char '_' str) in
   (* Check if negative *)
   let starts_with_minus = str <> "" && str.[0] = '-' in
-  let str = if starts_with_minus then String.sub str 1 (String.length str - 1) else str in
+  let str = if is_neg str || is_pos str then String.sub str 1 (String.length str - 1) else str in
   let processed_str = aux str in
   if starts_with_minus then "-" ^ processed_str else processed_str
 
@@ -42,7 +54,7 @@ let is_numeric s =
   else
     let is_digit c = (c >= '0' && c <= '9') || c = '_' in
     let first_char = s.[0] in
-    if first_char <> '-' && not (is_digit first_char) then false
+    if first_char <> '-' && first_char <> '+' && not (is_digit first_char) then false
     else
       let rec check idx =
         if idx >= len then true
@@ -53,18 +65,16 @@ let is_numeric s =
       in
       check 1
 
-let compare s0 s1 =
-  (* check if negative *)
-  let is_neg s = String.length s > 0 && s.[0] = '-' in
-  match (is_neg s0, is_neg s1) with
-  | (true, false) -> -1  (* If only s0 is negative, it's smaller. *)
-  | (false, true) -> 1   (* If only s1 is negative, s0 is larger. *)
+let compare (p0, s0) (p1, s1) =
+  match (p0, p1) with
+  | (false, true) -> -1  (* If only s1 is positive, s0 is smaller. *)
+  | (true, false) -> 1   (* If only s0 is positive, s0 is larger. *)
   | _ ->
     (* If both numbers are either negative or positive, compare their lengths. *)
     let len0, len1 = (String.length s0, String.length s1) in
     if len0 = len1 then
-      if is_neg s0 then String.compare s1 s0 else String.compare s0 s1  (* If lengths are equal, compare the strings directly. *)
+      if p0 then String.compare s0 s1 else String.compare s1 s0   (* If lengths are equal, compare the strings directly. *)
     else if len0 > len1 then 
-      if is_neg s0 then -1 else 1  (* A longer s0 means it's larger unless it's negative. *)
+      if p0 then 1 else -1  (* A longer s0 means it's larger unless it's negative. *)
     else  (* len0 < len1 *)
-      if is_neg s1 then 1 else -1  (* A longer s1 means s0 is smaller unless s1 is negative. *)
+      if p0 then -1 else 1  (* A longer s1 means s0 is smaller unless s1 is negative. *)

jscomp/ml/bigint_utils.mli

@@ -1,3 +1,7 @@
+val is_neg: string -> bool
+val is_pos: string -> bool
+val to_string: bool -> string -> string
+val remove_leading_sign : string -> bool * string
 val remove_leading_zeros : string -> string
 val is_numeric : string -> bool
-val compare : string -> string -> int
+val compare : bool * string -> bool * string -> int

jscomp/ml/parmatch.ml

@@ -264,8 +264,8 @@ let const_compare x y =
   match x,y with
   | Const_float f1, Const_float f2 ->
       compare (float_of_string f1) (float_of_string f2)
-  | Const_bigint b1, Const_bigint b2 ->
-      Bigint_utils.compare b1 b2
+  | Const_bigint (s1, b1), Const_bigint (s2, b2) ->
+      Bigint_utils.compare (s1, b1) (s2, b2)
   | Const_string (s1, _), Const_string (s2, _) ->
       String.compare s1 s2
   | _, _ -> compare x y
@@ -386,7 +386,7 @@ let pretty_const c = match c with
 | Const_float f -> Printf.sprintf "%s" f
 | Const_int32 i -> Printf.sprintf "%ldl" i
 | Const_int64 i -> Printf.sprintf "%LdL" i
-| Const_bigint i -> Printf.sprintf "%s" i
+| Const_bigint (sign, i) -> Printf.sprintf "%s" (Bigint_utils.to_string sign i)
 
 let rec pretty_val ppf v =
   match v.pat_extra with
@@ -1106,8 +1106,8 @@ let build_other ext env : Typedtree.pattern = match env with
       0L Int64.succ p env
 | ({pat_desc=(Tpat_constant (Const_bigint _))} as p,_) :: _ ->
     build_other_constant
-      (function Tpat_constant(Const_bigint i) -> String.length i | _ -> assert false)
-      (function i -> Tpat_constant(Const_bigint (String.make i '*')))
+      (function Tpat_constant(Const_bigint (sign, i)) -> String.length (Bigint_utils.to_string sign i) | _ -> assert false)
+      (function i -> Tpat_constant(Const_bigint (true, (String.make i '*'))))
       0 succ p env
 | ({pat_desc=(Tpat_constant (Const_string _))} as p,_) :: _ ->
     build_other_constant

jscomp/ml/printlambda.ml

@@ -27,7 +27,7 @@ let rec struct_const ppf = function
   | Const_base(Const_float f) -> fprintf ppf "%s" f
   | Const_base(Const_int32 n) -> fprintf ppf "%lil" n
   | Const_base(Const_int64 n) -> fprintf ppf "%LiL" n
-  | Const_base(Const_bigint n) -> fprintf ppf "%sn" n
+  | Const_base(Const_bigint (sign, n)) -> fprintf ppf "%sn" (Bigint_utils.to_string sign n)
   | Const_pointer (n,_) -> fprintf ppf "%ia" n
   | Const_block(tag_info, []) ->
       let tag = Lambda.tag_of_tag_info tag_info in 

jscomp/ml/printtyped.ml

@@ -65,7 +65,7 @@ let fmt_constant f x =
   | Const_float (s) -> fprintf f "Const_float %s" s;
   | Const_int32 (i) -> fprintf f "Const_int32 %ld" i;
   | Const_int64 (i) -> fprintf f "Const_int64 %Ld" i;
-  | Const_bigint (i) -> fprintf f "Const_bigint %s" i;
+  | Const_bigint (sign, i) -> fprintf f "Const_bigint %s" (Bigint_utils.to_string sign i);
 ;;
 
 let fmt_mutable_flag f x =

jscomp/ml/typecore.ml

@@ -76,7 +76,6 @@ type error =
   | Empty_record_literal
   | Uncurried_arity_mismatch of type_expr * int * int
   | Field_not_optional of string * type_expr
-  | Invalid_decimal of string
 exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error
 
@@ -261,9 +260,9 @@ let constant : Parsetree.constant -> (Asttypes.constant, error) result =
        with Failure _ -> Error (Literal_overflow "int64")
      end
   | Pconst_integer (i,Some 'n') ->
-      if Bigint_utils.is_numeric i then
-        Ok (Const_bigint (Bigint_utils.remove_leading_zeros i))
-      else Error (Invalid_decimal i)
+    let sign, i = i |> Bigint_utils.remove_leading_sign in
+    let i = Bigint_utils.remove_leading_zeros i in
+    Ok (Const_bigint (sign, i))
   | Pconst_integer (i,Some c) -> Error (Unknown_literal (i, c))
   | Pconst_char c -> Ok (Const_char c)
   | Pconst_string (s,d) -> Ok (Const_string (s,d))
@@ -4079,9 +4078,6 @@ let report_error env ppf = function
     fprintf ppf
     "Field @{<info>%s@} is not optional in type %a. Use without ?" name
     type_expr typ
-  | Invalid_decimal s ->
-    fprintf ppf
-    "Invalid decimal literal '%sn'. Only decimal literal is allowed for bigint" s
 
 
 let super_report_error_no_wrap_printing_env = report_error

jscomp/ml/typecore.mli

@@ -111,7 +111,6 @@ type error =
   | Empty_record_literal
   | Uncurried_arity_mismatch of type_expr * int * int
   | Field_not_optional of string * type_expr
-  | Invalid_decimal of string
 exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error
 

jscomp/ml/untypeast.ml

@@ -114,7 +114,8 @@ let constant = function
   | Const_int i -> Pconst_integer (string_of_int i, None)
   | Const_int32 i -> Pconst_integer (Int32.to_string i, Some 'l')
   | Const_int64 i -> Pconst_integer (Int64.to_string i, Some 'L')
-  | Const_bigint i -> Pconst_integer (i, Some 'n')
+  | Const_bigint (sign, i) -> 
+    Pconst_integer (Bigint_utils.to_string sign i, Some 'n')
   | Const_float f -> Pconst_float (f,None)
 
 let attribute sub (s, p) = (map_loc sub s, p)

jscomp/syntax/src/res_core.ml

@@ -812,6 +812,12 @@ let parseConstant p =
   let constant =
     match p.Parser.token with
     | Int {i; suffix} ->
+      (* Only decimal literal is allowed for bigint *)
+      if suffix = Some 'n' && not (Bigint_utils.is_numeric i) then
+        Parser.err p
+          (Diagnostics.message
+             "Invalid decimal literal. Only decimal literal is allowed for \
+              bigint.");
       let intTxt = if isNegative then "-" ^ i else i in
       Parsetree.Pconst_integer (intTxt, suffix)
     | Float {f; suffix} ->