feat(compiler): Rational number type (#1603)

* feat(compiler): Rational number type

* added numerator, denominator functions

* updated tests

* updated docs

compiler/src/codegen/transl_anf.re

@@ -527,6 +527,7 @@ let compile_const = (c: Asttypes.constant) =>
   | Const_string(_) => failwith("compile_const: Const_string post-ANF")
   | Const_char(_) => failwith("compile_const: Const_char post-ANF")
   | Const_bigint(_) => failwith("compile_const: Const_bigint post-ANF")
+  | Const_rational(_) => failwith("compile_const: Const_rational post-ANF")
   | Const_int32(i32) => MConstI32(i32)
   | Const_int64(i64) => MConstI64(i64)
   | Const_uint32(u32) => MConstU32(u32)

compiler/src/middle_end/linearize.re

@@ -182,6 +182,12 @@ let transl_const =
         [BLet(tmp, Comp.number(Const_number_bigint(data)), Nonglobal)]
       ),
     )
+  | Const_rational(data) =>
+    Right(
+      with_bind("rational", tmp =>
+        [BLet(tmp, Comp.number(Const_number_rational(data)), Nonglobal)]
+      ),
+    )
   | Const_int32(i) =>
     Right(with_bind("int32", tmp => [BLet(tmp, Comp.int32(i), Nonglobal)]))
   | Const_int64(i) =>

compiler/src/middle_end/matchcomp.re

@@ -539,6 +539,7 @@ let equality_type =
   | Const_uint32(_)
   | Const_uint64(_)
   | Const_bigint(_)
+  | Const_rational(_)
   | Const_float32(_)
   | Const_float64(_)
   | Const_bytes(_)

compiler/src/parsing/ast_helper.re

@@ -72,6 +72,14 @@ module Constant = {
   let wasmf32 = f => PConstWasmF32(f);
   let wasmf64 = f => PConstWasmF64(f);
   let bigint = i => PConstBigInt(i);
+  let rational = r => {
+    let (n, d) =
+      switch (String.split_on_char('/', r)) {
+      | [n, d] => (n, d)
+      | _ => failwith("Impossible: rational literal without forward slash")
+      };
+    PConstRational(n, d);
+  };
   let bool = b => PConstBool(b);
   let void = PConstVoid;
 };

compiler/src/parsing/ast_helper.rei

@@ -48,6 +48,7 @@ module Constant: {
   let wasmf32: string => constant;
   let wasmf64: string => constant;
   let bigint: string => constant;
+  let rational: string => constant;
   let bool: bool => constant;
   let void: constant;
 };

compiler/src/parsing/asttypes.re

@@ -26,6 +26,15 @@ type bigint_data = {
   bigint_rep: string,
 };
 
+[@deriving (sexp, yojson)]
+type rational_data = {
+  rational_negative: bool,
+  rational_num_limbs: array(int64),
+  rational_den_limbs: array(int64),
+  rational_num_rep: string,
+  rational_den_rep: string,
+};
+
 [@deriving (sexp, yojson)]
 type constant =
   | Const_number(number_type)
@@ -43,20 +52,15 @@ type constant =
   | Const_wasmf32(float)
   | Const_wasmf64(float)
   | Const_bigint(bigint_data)
+  | Const_rational(rational_data)
   | Const_bool(bool)
   | Const_void
 
 [@deriving (sexp, yojson)]
 and number_type =
   | Const_number_int(int64)
   | Const_number_float(float)
-  | Const_number_rational({
-      rational_negative: bool,
-      rational_num_limbs: array(int64),
-      rational_den_limbs: array(int64),
-      rational_num_rep: string,
-      rational_den_rep: string,
-    })
+  | Const_number_rational(rational_data)
   | Const_number_bigint(bigint_data);
 
 /** Marker for exported/nonexported let bindings */

compiler/src/parsing/lexer.re

@@ -253,6 +253,8 @@ let rec token = lexbuf => {
   | (unsigned_float, 'w') => positioned(WASMF32(sub_lexeme(lexbuf, 0, -1)))
   | (unsigned_float, 'W') => positioned(WASMF64(sub_lexeme(lexbuf, 0, -1)))
   | (unsigned_int, 't') => positioned(BIGINT(sub_lexeme(lexbuf, 0, -1)))
+  | (unsigned_int, '/', Opt('-'), unsigned_int, 'r') =>
+    positioned(RATIONAL(sub_lexeme(lexbuf, 0, -1)))
   | unsigned_int => positioned(NUMBER_INT(Sedlexing.Utf8.lexeme(lexbuf)))
   | "primitive" => positioned(PRIMITIVE)
   | "foreign" => positioned(FOREIGN)

compiler/src/parsing/parser.mly

@@ -12,6 +12,7 @@ module Grain_parsing = struct end
 %}
 
 
+%token <string> RATIONAL
 %token <string> NUMBER_INT NUMBER_FLOAT
 %token <string> INT32 INT64 UINT32 UINT64 FLOAT32 FLOAT64 BIGINT
 %token <string> WASMI32 WASMI64 WASMF32 WASMF64
@@ -208,6 +209,7 @@ const:
   | DASH? WASMF32 { Constant.wasmf32 (if Option.is_some $1 then "-" ^ $2 else $2), $sloc }
   | DASH? WASMF64 { Constant.wasmf64 (if Option.is_some $1 then "-" ^ $2 else $2), $sloc }
   | DASH? BIGINT { Constant.bigint (if Option.is_some $1 then "-" ^ $2 else $2), $sloc }
+  | DASH? RATIONAL { Constant.rational (if Option.is_some $1 then "-" ^ $2 else $2), $sloc }
   | TRUE { Constant.bool true, $loc }
   | FALSE { Constant.bool false, $loc }
   | VOID { Constant.void, $loc }

compiler/src/parsing/parsetree.re

@@ -130,6 +130,7 @@ type constant =
   | PConstWasmF32(string)
   | PConstWasmF64(string)
   | PConstBigInt(string)
+  | PConstRational(string, string)
   | PConstBool(bool)
   | PConstVoid
   | PConstBytes(string)

compiler/src/parsing/well_formedness.re

@@ -255,15 +255,21 @@ let no_letrec_mut = (errs, super) => {
 let no_zero_denominator_rational = (errs, super) => {
   let enter_expression = ({pexp_desc: desc, pexp_loc: loc} as e) => {
     switch (desc) {
-    | PExpConstant(PConstNumber(PConstNumberRational(_, d))) when d == "0" =>
+    | PExpConstant(
+        PConstNumber(PConstNumberRational(_, d)) | PConstRational(_, d),
+      )
+        when d == "0" =>
       errs := [RationalZeroDenominator(loc), ...errs^]
     | _ => ()
     };
     super.enter_expression(e);
   };
   let enter_pattern = ({ppat_desc: desc, ppat_loc: loc} as p) => {
     switch (desc) {
-    | PPatConstant(PConstNumber(PConstNumberRational(_, d))) when d == "0" =>
+    | PPatConstant(
+        PConstNumber(PConstNumberRational(_, d)) | PConstRational(_, d),
+      )
+        when d == "0" =>
       errs := [RationalZeroDenominator(loc), ...errs^]
     | _ => ()
     };

compiler/src/typed/checkertypes.re

@@ -71,6 +71,7 @@ let type_constant =
   | Const_wasmf32(_) => instance_def(Builtin_types.type_wasmf32)
   | Const_wasmf64(_) => instance_def(Builtin_types.type_wasmf64)
   | Const_bigint(_) => instance_def(Builtin_types.type_bigint)
+  | Const_rational(_) => instance_def(Builtin_types.type_rational)
   | Const_bool(_) => instance_def(Builtin_types.type_bool)
   | Const_void => instance_def(Builtin_types.type_void)
   | Const_bytes(_) => instance_def(Builtin_types.type_bytes)
@@ -270,6 +271,30 @@ let constant:
           ),
         )
       }
+    | PConstRational(n, d) =>
+      // TODO(#1168): allow arbitrary-length arguments in rational constants
+      switch (Literals.conv_number_rational(n, d)) {
+      | Some((n, d)) =>
+        // (until above TODO is done, we keep existing behavior and limit to 32-bits (see #1168))
+        Ok(
+          Const_rational({
+            rational_negative: Int32.compare(n, 0l) < 0, // true if rational is less than 0
+            rational_num_limbs: [|Int64.abs(Int64.of_int32(n))|],
+            rational_den_limbs: [|Int64.abs(Int64.of_int32(d))|],
+            rational_num_rep: Int32.to_string(n),
+            rational_den_rep: Int32.to_string(Int32.abs(d)),
+          }),
+        )
+      | None =>
+        Error(
+          Location.errorf(
+            ~loc,
+            "Rational literal %s/%sr is outside of the rational number range of the Number type.",
+            n,
+            d,
+          ),
+        )
+      }
     | PConstWasmI32(n) =>
       switch (Literals.conv_wasmi32(n)) {
       | Some(n) => Ok(Const_wasmi32(n))

compiler/src/typed/parmatch.re

@@ -142,6 +142,7 @@ let all_coherent = column => {
       | (Const_wasmf32(_), Const_wasmf32(_))
       | (Const_wasmf64(_), Const_wasmf64(_))
       | (Const_bigint(_), Const_bigint(_))
+      | (Const_rational(_), Const_rational(_))
       | (Const_bool(_), Const_bool(_))
       | (Const_void, Const_void)
       | (Const_bytes(_), Const_bytes(_))
@@ -157,6 +158,7 @@ let all_coherent = column => {
           Const_wasmf32(_) |
           Const_wasmf64(_) |
           Const_bigint(_) |
+          Const_rational(_) |
           Const_bool(_) |
           Const_void |
           Const_bytes(_) |
@@ -280,6 +282,7 @@ let const_compare = (x, y) =>
       Const_wasmf32(_) |
       Const_wasmf64(_) |
       Const_bigint(_) |
+      Const_rational(_) |
       Const_void |
       Const_int32(_) |
       Const_int64(_) |
@@ -1841,6 +1844,8 @@ let untype_constant =
   | Const_wasmf32(f) => Parsetree.PConstWasmF32(Float.to_string(f))
   | Const_wasmf64(f) => Parsetree.PConstWasmF64(Float.to_string(f))
   | Const_bigint({bigint_rep}) => Parsetree.PConstBigInt(bigint_rep)
+  | Const_rational({rational_num_rep, rational_den_rep}) =>
+    Parsetree.PConstRational(rational_num_rep, rational_den_rep)
   | Const_bytes(b) => Parsetree.PConstBytes(Bytes.to_string(b))
   | Const_string(s) => Parsetree.PConstString(s)
   | Const_char(c) => Parsetree.PConstChar(c)
@@ -2197,7 +2202,8 @@ let inactive = (~partial, pat) =>
         | Const_wasmi64(_)
         | Const_wasmf32(_)
         | Const_wasmf64(_)
-        | Const_bigint(_) => true
+        | Const_bigint(_)
+        | Const_rational(_) => true
         }
       | TPatTuple(ps)
       | TPatConstruct(_, _, ps) => List.for_all(p => loop(p), ps)

compiler/src/typed/printpat.re

@@ -46,6 +46,8 @@ let pretty_const = c =>
   | Const_wasmf32(f) => Printf.sprintf("%fw", f)
   | Const_wasmf64(f) => Printf.sprintf("%fW", f)
   | Const_bigint({bigint_rep}) => bigint_rep
+  | Const_rational({rational_num_rep, rational_den_rep}) =>
+    Printf.sprintf("%s/%sr", rational_num_rep, rational_den_rep)
   | Const_bool(true) => "true"
   | Const_bool(false) => "false"
   | Const_void => "void"

compiler/test/stdlib/rational.test.gr

@@ -0,0 +1,75 @@
+module RationalTest
+
+include "rational"
+from Rational use {
+  fromNumber,
+  toNumber,
+  numerator,
+  denominator,
+  (+),
+  (-),
+  (*),
+  (/),
+}
+
+assert fromNumber(1/2) == 1/2r
+assert fromNumber(0) == 0/1r
+assert fromNumber(1/1) == 1/1r
+assert fromNumber(-1) == -1/1r
+
+assert toNumber(1/2r) == 1/2
+assert toNumber(0/1r) == 0
+assert toNumber(1/1r) == 1
+assert toNumber(-1/2r) == -1/2
+assert toNumber(1/-2r) == -1/2
+
+assert numerator(123/23r) == 123
+assert denominator(123/23r) == 23
+assert numerator(2/4r) == 1
+assert denominator(2/4r) == 2
+assert numerator(1000000000/1r * 1000000000/1r) == 1000000000000000000
+
+assert 1/2r == 1/2r
+assert 1/2r == 2/4r
+assert 1/1r == 2/2r
+assert 1/2r != 3/4r
+assert -1/2r == 1/-2r
+
+match (1/2r) {
+  1/3r => fail "Impossible: 1/2r matched against 1/3r",
+  1/2r => void,
+  _ => fail "Impossible: 1/2r not matched against 1/2r",
+}
+
+assert compare(1/2r, 1/3r) > 0
+assert compare(1/2r, 2/2r) < 0
+assert compare(1/2r, 1/2r) == 0
+
+from Rational use { (==), (!=), (<), (<=), (>), (>=) }
+
+assert 1/2r == 1/2r
+assert 1/2r == 2/4r
+assert 1/1r == 2/2r
+assert 1/2r != 3/4r
+assert -1/2r == 1/-2r
+
+assert 1/8r + 3/8r == 1/2r
+assert 1/4r + 1/2r == 3/4r
+assert 1/2r + 1/2r == 1/1r
+
+assert 1/4r - 1/4r == 0/1r
+assert 3/4r - 1/4r == 1/2r
+
+assert 1/2r * 1/2r == 1/4r
+assert 1/2r * 2/1r == 1/1r
+assert 3/1r * 4/1r == 12/1r
+
+assert 1/2r / 1/2r == 1/1r
+assert 1/4r / 1/2r == 1/2r
+
+assert 1/2r > 1/3r
+assert 1/2r >= 1/3r
+assert 1/2r >= 1/2r
+assert 1/3r < 1/2r
+assert 1/3r <= 1/2r
+assert 1/2r <= 1/2r

compiler/test/suites/numbers.re

@@ -114,6 +114,11 @@ describe("numbers", ({test, testSkip}) => {
     "-99999999999999999999999uL",
     "Uint64 literal -99999999999999999999999uL contains a sign but should be unsigned.",
   );
+  assertCompileError(
+    "numbers_rational_zero_denom",
+    "1/0r",
+    "Rational numbers may not have a denominator of zero.",
+  );
   // runtime errors
   assertRunError(
     "unsigned_overflow_err1",

compiler/test/suites/stdlib.re

@@ -95,6 +95,7 @@ describe("stdlib", ({test, testSkip}) => {
   assertStdlib("pervasives.test");
   assertStdlib("queue.test");
   assertStdlib("range.test");
+  assertStdlib("rational.test");
   assertStdlib("result.test");
   assertStdlib("set.test");
   assertStdlib("immutableset.test");