feat(compiler)!: Short integer values (#1669)

* feat(compiler)!: Short integer values

* updated internal representation

update snapshot, formatting

added tagging primitives, updated multiply op

updated docs

moved coerce funcs into numbers.gr, update docs

compiler/src/codegen/comp_utils.re

@@ -34,6 +34,12 @@ let wrap_float64 = n => Literal.float64(n);
 let grain_number_max = 0x3fffffff;
 let grain_number_min = (-0x3fffffff); // 0xC0000001
 
+type int_type =
+  | Int8Type
+  | Int16Type
+  | Uint8Type
+  | Uint16Type;
+
 /** Constant compilation */
 
 let rec compile_const = (c): Literal.t => {
@@ -44,20 +50,48 @@ let rec compile_const = (c): Literal.t => {
   let conv_uint64 = n => Int64.(add(mul(2L, n), 1L));
   let conv_float32 = identity;
   let conv_float64 = identity;
+  let conv_char = char => {
+    let uchar = List.hd @@ Utf8.decodeUtf8String(char);
+    let uchar_int: int = Utf8__Uchar.toInt(uchar);
+    Int32.of_int(uchar_int lsl 8 lor 0b010);
+  };
+  let conv_short_int = (int, int_type) => {
+    let tag =
+      switch (int_type) {
+      | Int8Type => 1l
+      | Int16Type => 2l
+      | Uint8Type => 3l
+      | Uint16Type => 4l
+      };
+    let (<<) = Int32.shift_left;
+    let (||) = Int32.logor;
+    let shifted_tag = tag << 3;
+    int << 8 || shifted_tag || 0b010l;
+  };
   switch (c) {
   | MConstLiteral(MConstLiteral(_) as c) => compile_const(c)
+  | MConstI8(n) => Literal.int32(conv_short_int(n, Int8Type))
+  | MConstI16(n) => Literal.int32(conv_short_int(n, Int16Type))
   | MConstI32(n) => Literal.int32(conv_int32(n))
   | MConstI64(n) => Literal.int64(conv_int64(n))
+  | MConstU8(n) => Literal.int32(conv_short_int(n, Uint8Type))
+  | MConstU16(n) => Literal.int32(conv_short_int(n, Uint16Type))
   | MConstU32(n) => Literal.int32(conv_uint32(n))
   | MConstU64(n) => Literal.int64(conv_uint64(n))
   | MConstF32(n) => Literal.float32(conv_float32(n))
   | MConstF64(n) => Literal.float64(conv_float64(n))
+  | MConstChar(c) => Literal.int32(conv_char(c))
+  | MConstLiteral(MConstI8(n))
+  | MConstLiteral(MConstI16(n))
   | MConstLiteral(MConstI32(n)) => Literal.int32(n)
   | MConstLiteral(MConstI64(n)) => Literal.int64(n)
+  | MConstLiteral(MConstU8(n))
+  | MConstLiteral(MConstU16(n))
   | MConstLiteral(MConstU32(n)) => Literal.int32(n)
   | MConstLiteral(MConstU64(n)) => Literal.int64(n)
   | MConstLiteral(MConstF32(n)) => Literal.float32(n)
   | MConstLiteral(MConstF64(n)) => Literal.float64(n)
+  | MConstLiteral(MConstChar(c)) => Literal.int32(conv_char(c))
   };
 };
 

compiler/src/codegen/compcore.re

@@ -1725,12 +1725,11 @@ let allocate_bytes_uninitialized = (wasm_mod, env, size) => {
   );
 };
 
-let create_char = (wasm_mod, env, char) => {
-  let uchar = List.hd @@ Utf8.decodeUtf8String(char);
-  let uchar_int: int = Utf8__Uchar.toInt(uchar);
-  let grain_char = uchar_int lsl 8 lor 0b010;
-  Expression.Const.make(wasm_mod, const_int32(grain_char));
-};
+type int_type =
+  | Int8Type
+  | Int16Type
+  | Uint8Type
+  | Uint16Type;
 
 let allocate_closure =
     (
@@ -2367,6 +2366,20 @@ let allocate_big_int = (wasm_mod, env, n, d) => {
   allocate_number(wasm_mod, env, BigInt(n, d));
 };
 
+let tag_short_value = (wasm_mod, compiled_arg, tag) => {
+  Expression.Binary.make(
+    wasm_mod,
+    Op.xor_int32,
+    Expression.Binary.make(
+      wasm_mod,
+      Op.shl_int32,
+      compiled_arg,
+      Expression.Const.make(wasm_mod, const_int32(0x8)),
+    ),
+    Expression.Const.make(wasm_mod, const_int32(tag)),
+  );
+};
+
 let compile_prim0 = (wasm_mod, env, p0): Expression.t => {
   switch (p0) {
   | AllocateInt32 => allocate_number_uninitialized(wasm_mod, env, BoxedInt32)
@@ -2427,19 +2440,16 @@ let compile_prim1 = (wasm_mod, env, p1, arg, loc): Expression.t => {
       compiled_arg,
       Expression.Const.make(wasm_mod, const_int32(0x1)),
     )
-  | TagChar =>
-    Expression.Binary.make(
-      wasm_mod,
-      Op.xor_int32,
-      Expression.Binary.make(
-        wasm_mod,
-        Op.shl_int32,
-        compiled_arg,
-        Expression.Const.make(wasm_mod, const_int32(0x8)),
-      ),
-      Expression.Const.make(wasm_mod, const_int32(0b10)),
-    )
-  | UntagChar =>
+  | TagChar => tag_short_value(wasm_mod, compiled_arg, 0b10)
+  | TagInt8 => tag_short_value(wasm_mod, compiled_arg, 0b1010)
+  | TagInt16 => tag_short_value(wasm_mod, compiled_arg, 0b10010)
+  | TagUint8 => tag_short_value(wasm_mod, compiled_arg, 0b11010)
+  | TagUint16 => tag_short_value(wasm_mod, compiled_arg, 0b100010)
+  | UntagChar
+  | UntagInt8
+  | UntagInt16
+  | UntagUint8
+  | UntagUint16 =>
     Expression.Binary.make(
       wasm_mod,
       Op.shr_s_int32,
@@ -2802,7 +2812,6 @@ let compile_allocation = (wasm_mod, env, alloc_type) =>
   | MRecord(ttag, elts) => allocate_record(wasm_mod, env, ttag, elts)
   | MBytes(bytes) => allocate_bytes(wasm_mod, env, bytes)
   | MString(str) => allocate_string(wasm_mod, env, str)
-  | MChar(char) => create_char(wasm_mod, env, char)
   | MADT(ttag, vtag, elts) => allocate_adt(wasm_mod, env, ttag, vtag, elts)
   | MInt32(i) =>
     allocate_int32(

compiler/src/codegen/mashtree.re

@@ -203,6 +203,14 @@ type prim1 =
     | UntagSimpleNumber
     | TagChar
     | UntagChar
+    | TagInt8
+    | UntagInt8
+    | TagInt16
+    | UntagInt16
+    | TagUint8
+    | UntagUint8
+    | TagUint16
+    | UntagUint16
     | Not
     | Box
     | Unbox
@@ -286,12 +294,17 @@ type primn =
 
 [@deriving sexp]
 type constant =
+  | MConstI8(int32)
+  | MConstI16(int32)
   | MConstI32(int32)
   | MConstI64(int64)
+  | MConstU8(int32)
+  | MConstU16(int32)
   | MConstU32(int32)
   | MConstU64(int64)
   | MConstF32(float)
   | MConstF64(float)
+  | MConstChar(string)
   | MConstLiteral(constant); /* Special case for things which should not be encoded */
 
 [@deriving sexp]
@@ -325,7 +338,6 @@ type allocation_type =
   | MADT(immediate, immediate, list(immediate)) /* Type Tag, Variant Tag, Elements */
   | MBytes(bytes)
   | MString(string)
-  | MChar(string)
   | MInt32(int32)
   | MInt64(int64)
   | MUint32(int32)

compiler/src/codegen/transl_anf.re

@@ -526,11 +526,14 @@ let compile_const = (c: Asttypes.constant) =>
     failwith("compile_const: Const_number float/rational post-ANF")
   | Const_bytes(_) => failwith("compile_const: Const_bytes post-ANF")
   | 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_int8(i8) => MConstI8(i8)
+  | Const_int16(i16) => MConstI16(i16)
   | Const_int32(i32) => MConstI32(i32)
   | Const_int64(i64) => MConstI64(i64)
+  | Const_uint8(u8) => MConstU8(u8)
+  | Const_uint16(u16) => MConstU16(u16)
   | Const_uint32(u32) => MConstU32(u32)
   | Const_uint64(u64) => MConstU64(u64)
   | Const_float32(f) => MConstF32(f)
@@ -539,6 +542,7 @@ let compile_const = (c: Asttypes.constant) =>
   | Const_wasmi64(i64) => MConstLiteral(MConstI64(i64))
   | Const_wasmf32(f32) => MConstLiteral(MConstF32(f32))
   | Const_wasmf64(f64) => MConstLiteral(MConstF64(f64))
+  | Const_char(c) => MConstChar(c)
   | Const_bool(b) when b == true => const_true
   | Const_bool(_) => const_false
   | Const_void => const_void
@@ -863,7 +867,6 @@ let rec compile_comp = (~id=?, env, c) => {
       )
     | CBytes(b) => MAllocate(MBytes(b))
     | CString(s) => MAllocate(MString(s))
-    | CChar(c) => MAllocate(MChar(c))
     | CNumber(Const_number_int(n))
         when n <= Literals.simple_number_max && n >= Literals.simple_number_min =>
       MImmediate(MImmConst(MConstI32(Int64.to_int32(n))))

compiler/src/codegen/value_tags.re

@@ -73,5 +73,5 @@ let boxed_number_tag_type_of_tag_val =
 type tag_type =
   | NumberTagType
   | ConstTagType
-  | CharTagType
+  | ShortValTagType
   | GenericHeapType(option(heap_tag_type));

compiler/src/middle_end/analyze_free_vars.re

@@ -136,8 +136,7 @@ module FreeVarsArg: Anf_iterator.IterArgument = {
       | CFloat32(_)
       | CFloat64(_)
       | CBytes(_)
-      | CString(_)
-      | CChar(_) => Ident.Set.empty
+      | CString(_) => Ident.Set.empty
       | CImmExpr(i) => imm_free_vars(i)
       }
     );

compiler/src/middle_end/analyze_purity.re

@@ -64,6 +64,14 @@ module PurityArg: Anf_iterator.IterArgument = {
           UntagSimpleNumber |
           TagChar |
           UntagChar |
+          TagInt8 |
+          UntagInt8 |
+          TagInt16 |
+          UntagInt16 |
+          TagUint8 |
+          UntagUint8 |
+          TagUint16 |
+          UntagUint16 |
           Not |
           Box |
           Unbox |
@@ -145,8 +153,7 @@ module PurityArg: Anf_iterator.IterArgument = {
       | CFloat32(_)
       | CFloat64(_)
       | CBytes(_)
-      | CString(_)
-      | CChar(_) => true
+      | CString(_) => true
       }
     );
 

compiler/src/middle_end/analyze_tail_calls.re

@@ -76,7 +76,6 @@ let rec analyze_comp_expression =
   | CBreak
   | CBytes(_)
   | CString(_)
-  | CChar(_)
   | CNumber(_)
   | CInt32(_)
   | CInt64(_)

compiler/src/middle_end/anf_helper.re

@@ -229,8 +229,6 @@ module Comp = {
     mk(~loc?, ~attributes?, ~allocation_type=Managed, ~env?, CBytes(b));
   let string = (~loc=?, ~attributes=?, ~env=?, s) =>
     mk(~loc?, ~attributes?, ~allocation_type=Managed, ~env?, CString(s));
-  let char = (~loc=?, ~attributes=?, ~env=?, c) =>
-    mk(~loc?, ~attributes?, ~allocation_type=Managed, ~env?, CChar(c));
 };
 
 module AExp = {

compiler/src/middle_end/anf_helper.rei

@@ -326,9 +326,6 @@ module Comp: {
   let string:
     (~loc: loc=?, ~attributes: attributes=?, ~env: env=?, string) =>
     comp_expression;
-  let char:
-    (~loc: loc=?, ~attributes: attributes=?, ~env: env=?, string) =>
-    comp_expression;
 };
 
 module AExp: {

compiler/src/middle_end/anf_iterator.re

@@ -102,7 +102,6 @@ module MakeIter = (Iter: IterArgument) => {
     | CLambda(_, idents, (expr, _), _) => iter_anf_expression(expr)
     | CBytes(s) => ()
     | CString(s) => ()
-    | CChar(c) => ()
     | CNumber(i) => ()
     | CInt32(i) => ()
     | CInt64(i) => ()

compiler/src/middle_end/anf_mapper.re

@@ -254,7 +254,6 @@ module MakeMap = (Iter: MapArgument) => {
       push_input(AnfNode(expr));
     | CBytes(b) => leave_with(CBytes(b))
     | CString(s) => leave_with(CString(s))
-    | CChar(c) => leave_with(CChar(c))
     | CNumber(i) => leave_with(CNumber(i))
     | CInt32(i) => leave_with(CInt32(i))
     | CInt64(i) => leave_with(CInt64(i))

compiler/src/middle_end/anftree.re

@@ -189,6 +189,14 @@ type prim1 =
     | UntagSimpleNumber
     | TagChar
     | UntagChar
+    | TagInt8
+    | UntagInt8
+    | TagInt16
+    | UntagInt16
+    | TagUint8
+    | UntagUint8
+    | TagUint16
+    | UntagUint16
     | Not
     | Box
     | Unbox
@@ -367,7 +375,6 @@ and comp_expression_desc =
     )
   | CBytes(bytes)
   | CString(string)
-  | CChar(string)
   | CNumber(Asttypes.number_type)
   | CInt32(int32)
   | CInt64(int64)

compiler/src/middle_end/anftree.rei

@@ -190,6 +190,14 @@ type prim1 =
     | UntagSimpleNumber
     | TagChar
     | UntagChar
+    | TagInt8
+    | UntagInt8
+    | TagInt16
+    | UntagInt16
+    | TagUint8
+    | UntagUint8
+    | TagUint16
+    | UntagUint16
     | Not
     | Box
     | Unbox
@@ -347,7 +355,6 @@ and comp_expression_desc =
     )
   | CBytes(bytes)
   | CString(string)
-  | CChar(string)
   | CNumber(Asttypes.number_type)
   | CInt32(int32)
   | CInt64(int64)

compiler/src/middle_end/linearize.re

@@ -212,8 +212,6 @@ let transl_const =
     Right(with_bind("bytes", tmp => [BLet(tmp, Comp.bytes(b), Nonglobal)]))
   | Const_string(s) =>
     Right(with_bind("str", tmp => [BLet(tmp, Comp.string(s), Nonglobal)]))
-  | Const_char(c) =>
-    Right(with_bind("char", tmp => [BLet(tmp, Comp.char(c), Nonglobal)]))
   | _ => Left(Imm.const(c))
   };
 };

compiler/src/middle_end/matchcomp.re

@@ -547,6 +547,10 @@ let equality_type =
   | Const_void
   | Const_bool(_)
   | Const_char(_)
+  | Const_int8(_)
+  | Const_int16(_)
+  | Const_uint8(_)
+  | Const_uint16(_)
   | Const_wasmi32(_) => PhysicalEquality(WasmI32)
   | Const_wasmi64(_) => PhysicalEquality(WasmI64)
   | Const_wasmf32(_) => PhysicalEquality(WasmF32)

compiler/src/parsing/ast_helper.re

@@ -61,8 +61,12 @@ module Constant = {
   let string = s => PConstString(s);
   let char = c => PConstChar(c);
   let number = i => PConstNumber(i);
+  let int8 = i => PConstInt8(i);
+  let int16 = i => PConstInt16(i);
   let int32 = i => PConstInt32(i);
   let int64 = i => PConstInt64(i);
+  let uint8 = (is_neg, i) => PConstUint8(is_neg, i);
+  let uint16 = (is_neg, i) => PConstUint16(is_neg, i);
   let uint32 = (is_neg, i) => PConstUint32(is_neg, i);
   let uint64 = (is_neg, i) => PConstUint64(is_neg, i);
   let float32 = f => PConstFloat32(f);

compiler/src/parsing/ast_helper.rei

@@ -37,8 +37,12 @@ module Constant: {
   let string: string => constant;
   let char: string => constant;
   let number: number_type => constant;
+  let int8: string => constant;
+  let int16: string => constant;
   let int32: string => constant;
   let int64: string => constant;
+  let uint8: (bool, string) => constant;
+  let uint16: (bool, string) => constant;
   let uint32: (bool, string) => constant;
   let uint64: (bool, string) => constant;
   let float32: string => constant;