Numeric poly variant support (#349)

* Extend grammar of poly variants with integers
* Implement printer support for numeric poly var
* Add extra test cases for numeric poly variants with payloads.
* Implement numeric poly var printing for outcome printer

Author: IwanKaramazow

src/res_core.ml

@@ -673,6 +673,9 @@ let parseHashIdent ~startPos p =
     Parser.next p;
     let text = if p.mode = ParseForTypeChecker then parseStringLiteral text else text in
     (text, mkLoc startPos p.prevEndPos)
+  | Int {i} ->
+    Parser.next p;
+    (i, mkLoc startPos p.prevEndPos)
   | _ ->
     parseIdent ~startPos ~msg:ErrorMessages.variantIdent p
 
@@ -1176,6 +1179,9 @@ let rec parsePattern ?(alias=true) ?(or_=true) p =
         Parser.next p;
         let text = if p.mode = ParseForTypeChecker then parseStringLiteral text else text in
         (text, mkLoc startPos p.prevEndPos)
+      | Int {i} ->
+        Parser.next p;
+        (i, mkLoc startPos p.prevEndPos)
       | _ ->
         parseIdent ~msg:ErrorMessages.variantIdent ~startPos p
       in

src/res_outcome_printer.ml

@@ -10,6 +10,28 @@
 module Doc = Res_doc
 module Token = Res_token
 
+let rec unsafe_for_all_range s ~start ~finish p =
+  start > finish ||
+  p (String.unsafe_get s start) &&
+  unsafe_for_all_range s ~start:(start + 1) ~finish p
+
+let for_all_from s start  p =
+  let len = String.length s in
+  unsafe_for_all_range s ~start ~finish:(len - 1) p
+
+(* See https://github.com/rescript-lang/rescript-compiler/blob/726cfa534314b586e5b5734471bc2023ad99ebd9/jscomp/ext/ext_string.ml#L510 *)
+let isValidNumericPolyvarNumber (x : string) =
+  let len = String.length x in
+  len > 0 && (
+    let a = Char.code (String.unsafe_get x 0) in
+    a <= 57 &&
+    (if len > 1 then
+       a > 48 &&
+       for_all_from x 1 (function '0' .. '9' -> true | _ -> false)
+     else
+       a >= 48 )
+  )
+
 (* checks if ident contains "arity", like in "arity1", "arity2", "arity3" etc. *)
 let isArityIdent ident =
   if String.length ident >= 6 then
@@ -57,13 +79,17 @@ let printIdentLike ~allowUident txt =
   | NormalIdent -> Doc.text txt
 
 let printPolyVarIdent txt =
-  match classifyIdentContent ~allowUident:true txt with
-  | ExoticIdent -> Doc.concat [
-     Doc.text "\"";
-     Doc.text txt;
-     Doc.text"\""
-   ]
-  | NormalIdent -> Doc.text txt
+  (* numeric poly-vars don't need quotes: #644 *)
+  if isValidNumericPolyvarNumber txt then
+    Doc.text txt
+  else
+    match classifyIdentContent ~allowUident:true txt with
+    | ExoticIdent -> Doc.concat [
+       Doc.text "\"";
+       Doc.text txt;
+       Doc.text"\""
+     ]
+    | NormalIdent -> Doc.text txt
 
   (* ReScript doesn't have parenthesized identifiers.
    * We don't support custom operators. *)

src/res_printer.ml

@@ -425,15 +425,41 @@ let printIdentLike ?allowUident txt =
     ]
   | NormalIdent -> Doc.text txt
 
+let rec unsafe_for_all_range s ~start ~finish p =
+  start > finish ||
+  p (String.unsafe_get s start) &&
+  unsafe_for_all_range s ~start:(start + 1) ~finish p
+
+let for_all_from s start  p =
+  let len = String.length s in
+  unsafe_for_all_range s ~start ~finish:(len - 1) p
+
+(* See https://github.com/rescript-lang/rescript-compiler/blob/726cfa534314b586e5b5734471bc2023ad99ebd9/jscomp/ext/ext_string.ml#L510 *)
+let isValidNumericPolyvarNumber (x : string) =
+  let len = String.length x in
+  len > 0 && (
+    let a = Char.code (String.unsafe_get x 0) in
+    a <= 57 &&
+    (if len > 1 then
+       a > 48 &&
+       for_all_from x 1 (function '0' .. '9' -> true | _ -> false)
+     else
+       a >= 48 )
+  )
+
 (* Exotic identifiers in poly-vars have a "lighter" syntax: #"ease-in" *)
 let printPolyVarIdent txt =
-  match classifyIdentContent ~allowUident:true txt with
-  | ExoticIdent -> Doc.concat [
-      Doc.text "\"";
-      Doc.text txt;
-      Doc.text"\""
-    ]
-  | NormalIdent -> Doc.text txt
+  (* numeric poly-vars don't need quotes: #644 *)
+  if isValidNumericPolyvarNumber txt then
+    Doc.text txt
+  else
+    match classifyIdentContent ~allowUident:true txt with
+    | ExoticIdent -> Doc.concat [
+        Doc.text "\"";
+        Doc.text txt;
+        Doc.text"\""
+      ]
+    | NormalIdent -> Doc.text txt
 
 
 let printLident l = match l with

tests/oprint/oprint.res

@@ -279,3 +279,18 @@ type multiSpreadedCoordinate = {
 }
 
 type dotdotObjectCoordinate<'a> =  {.. "suuuuuuuuuuuperLooooooooooooongFieldNaaaaaaaaaaaame": float, "suuuuuuuuuuuperLooooooooooooongFieldNaaaaaaaaaaaame2222222222222": float} as 'a
+
+type permissions = [
+   | #777
+   | #644
+ ]
+
+ type numericPolyVarWithPayload = [
+   | #1(string)
+   | #2(int, string)
+ ]
+
+ let numericPolyVarMatch = switch #644 {
+   | #777 => #1("payload")
+   | #644 => #2(42, "test")
+ }

tests/oprint/oprint.res.snapshot

@@ -147,7 +147,7 @@ type t21 = [#"va r ia nt"]
 type t22 = [#"Variant ⛰"]
 type \"let" = int
 type \"type" = [#"Point🗿"(\"let", float)]
-type t23 = [#"1" | #"10space" | #"123"]
+type t23 = [#1 | #"10space" | #123]
 type exoticUser = {\"let": string, \"type": float}
 module Js = {
   type t<'a> = 'a
@@ -437,4 +437,7 @@ type dotdotObjectCoordinate<'a> = 'a
   constraint 'a = {..
     "suuuuuuuuuuuperLooooooooooooongFieldNaaaaaaaaaaaame": float,
     "suuuuuuuuuuuperLooooooooooooongFieldNaaaaaaaaaaaame2222222222222": float,
-  }
+  }
+type permissions = [#644 | #777]
+type numericPolyVarWithPayload = [#1(string) | #2(int, string)]
+let numericPolyVarMatch: [> #1(string) | #2(int, string)]

tests/parsing/grammar/expressions/expected/polyvariant.res.txt

@@ -1,4 +1,9 @@
 let x = `Red
 let z = `Rgb ()
 let v = `Vertex (1., 2., 3., 4.)
-let animation = `ease-in
+let animation = `ease-in
+let one = `1
+let fortyTwo = `42
+let long = `42444
+let oneString = `1 "payload"
+let twoIntString = `2 (3, "payload")

tests/parsing/grammar/expressions/polyvariant.res

@@ -6,3 +6,10 @@ let z = #Rgb()
 let v = #Vertex(1., 2., 3., 4.)
 
 let animation = #"ease-in"
+
+let one = #1
+let fortyTwo = #42
+let long = #42444
+
+let oneString = #1("payload")
+let twoIntString = #2(3, "payload")

tests/parsing/grammar/pattern/expected/variants.res.txt

@@ -61,4 +61,9 @@ let f (`Instance (comp : Component.t) : React.t) = ()
 ;;for `Point { x; y; z } = x to y do () done
 ;;for `Point { x; y; z } = x to y do () done
 ;;for `Point { x; y; z } as p = x to y do () done
-;;match x with | #typeVar -> () | `lowercase -> ()
+;;match x with | #typeVar -> () | `lowercase -> ()
+;;match numericPolyVar with
+  | `1 -> ()
+  | `42 -> ()
+  | `42444 -> ()
+  | `3 (x, y, z) -> Js.log3 x y z

tests/parsing/grammar/pattern/variants.res

@@ -82,3 +82,10 @@ switch x {
     | #...typeVar => ()
     | #lowercase => ()
     }
+
+switch numericPolyVar {
+| #1 => ()
+| #42 => ()
+| #42444 => ()
+| #3(x, y, z) => Js.log3(x, y, z)
+}

tests/parsing/grammar/typexpr/expected/polyVariant.res.txt

@@ -10,4 +10,6 @@ module type Conjunctive  =
         -> unit
   end
 type nonrec t = [ s]
-type nonrec t = [ ListStyleType.t]
+type nonrec t = [ ListStyleType.t]
+type nonrec number = [ `1  | `42  | `4244 ]
+type nonrec complexNumbericPolyVar = [ `1 of string  | `2 of (int * string) ]

tests/parsing/grammar/typexpr/polyVariant.res

@@ -15,3 +15,14 @@ module type Conjunctive = {
 
 type t = [s]
 type t = [ListStyleType.t];
+
+type number = [
+  | #1
+  | #42
+  | #4244
+]
+
+type complexNumbericPolyVar = [
+  | #1(string)
+  | #2(int, string)
+]

tests/printer/expr/expected/polyvariant.res.txt

@@ -108,12 +108,12 @@ let r = #lident(a, b)
 let r = #"exotic lident"
 let r = #"exotic lident"(a, b)
 
-let x = #"1"
-let x = #"123"
+let x = #1
+let x = #123
 let x = #"10space"
 let x = #space10
 
-let a = #"1"
+let a = #1
 let b = #"1a"
 let c = #a2
 let d = #abcd
@@ -140,3 +140,6 @@ external openSync: (
 
 let x = #a()
 let x = #a()
+
+let oneString = #1("payload")
+let twoIntString = #2(3, "payload")

tests/printer/expr/polyvariant.res

@@ -135,3 +135,6 @@ external openSync: (
 
 let x = #a(())
 let x = #a()
+
+let oneString = #1("payload")
+let twoIntString = #2(3, "payload")

tests/printer/pattern/expected/variant.res.txt

@@ -3,8 +3,8 @@ let #Shape = x
 let #"type" = x
 let #"test 🏚" = x
 let #"Shape✅" = x
-let #"1" = x
-let #"123" = x
+let #1 = x
+let #123 = x
 let #"10space" = x
 
 let #space10 = x
@@ -27,8 +27,8 @@ let cmp = (selectedChoice, value) =>
   | (#...a: typ) => true
   | lazy #...a => true
   | exception #...a => true
-  | #"1" => true
-  | #"123" => true
+  | #1 => true
+  | #123 => true
   | #"10space" => x
   | #space10 => x
   | _ => false
@@ -38,3 +38,8 @@ switch x {
 | #a() => ()
 | #a() => ()
 }
+
+switch numericPolyVar {
+| #42 => ()
+| #3(x, y, z) => Js.log3(x, y, z)
+}

tests/printer/pattern/variant.res

@@ -38,3 +38,8 @@ switch x {
 | #a(()) => ()
 | #a() => ()
 }
+
+switch numericPolyVar {
+| #42 => ()
+| #3(x, y, z) => Js.log3(x, y, z)
+}

tests/printer/typexpr/expected/variant.res.txt

@@ -102,3 +102,13 @@ type currencyPoly = [
 
 type t = [s]
 type t = [ListStyleType.t]
+
+type permissions = [
+  | #777
+  | #644
+]
+
+type t = [
+  | #1(string)
+  | #2(int, string)
+]

tests/printer/typexpr/variant.res

@@ -96,3 +96,13 @@ type currencyPoly = [#UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUSD | #CAAA
 
 type t = [s]
 type t = [ListStyleType.t];
+
+type permissions = [
+  | #777
+  | #644
+]
+
+type t = [
+  | #1(string)
+  | #2(int, string)
+]