Add missing small sized integers

tjammer · Oct 18, 2024 · e274ce4 · e274ce4
1 parent a1579cf
commit e274ce4
Show file tree

Hide file tree

Showing 10 changed files with 56 additions and 22 deletions.
diff --git a/lib/cleaned_types.ml b/lib/cleaned_types.ml
@@ -2,10 +2,13 @@ type typ =
   | Tint
   | Tbool
   | Tunit
+  | Ti8
   | Tu8
+  | Ti16
   | Tu16
   | Tfloat
   | Ti32
+  | Tu32
   | Tf32
   | Tpoly of string
   | Tfun of param list * typ * fun_kind
@@ -46,7 +49,9 @@ let is_type_polymorphic typ =
               List.fold_left (fun acc cl -> inner acc cl.cltyp) acc cls
         in
         inner acc ret
-    | Tbool | Tunit | Tint | Tu8 | Tu16 | Tfloat | Ti32 | Tf32 -> acc
+    | Tbool | Tunit | Tint | Tu8 | Tu16 | Tfloat | Ti32 | Tf32 | Ti8 | Ti16
+    | Tu32 ->
+        acc
     | Tfixed_array (i, _) when i < 0 -> true
     | Traw_ptr t | Tarray t | Tfixed_array (_, t) | Trc t -> inner acc t
   in
@@ -61,6 +66,9 @@ let rec string_of_type = function
   | Tfloat -> "float"
   | Ti32 -> "i32"
   | Tf32 -> "f32"
+  | Ti8 -> "i8"
+  | Ti16 -> "i16"
+  | Tu32 -> "u32"
   | Tfun (ts, t, _) ->
       let ps =
         String.concat " "
@@ -87,18 +95,20 @@ let rec string_of_type = function
 
 let is_struct = function
   | Trecord _ | Tvariant _ | Tfun _ | Tpoly _ | Tfixed_array _ -> true
-  | Tint | Tbool | Tunit | Tu8 | Tu16 | Tfloat | Ti32 | Tf32 | Traw_ptr _
-  | Tarray _ | Trc _ ->
+  | Tint | Tbool | Tunit | Tu8 | Tu16 | Tfloat | Ti32 | Tf32 | Ti8 | Ti16 | Tu32
+  | Traw_ptr _ | Tarray _ | Trc _ ->
       false
 
 let is_aggregate = function
   | Trecord _ | Tvariant _ | Tfixed_array _ -> true
-  | Tint | Tbool | Tunit | Tu8 | Tu16 | Tfloat | Ti32 | Tf32 | Traw_ptr _
-  | Tfun _ | Tpoly _ | Tarray _ | Trc _ ->
+  | Tint | Tbool | Tunit | Tu8 | Tu16 | Tfloat | Ti32 | Tf32 | Ti8 | Ti16 | Tu32
+  | Traw_ptr _ | Tfun _ | Tpoly _ | Tarray _ | Trc _ ->
       false
 
 let rec contains_allocation = function
-  | Tint | Tbool | Tunit | Tu8 | Tu16 | Tfloat | Ti32 | Tf32 -> false
+  | Tint | Tbool | Tunit | Tu8 | Tu16 | Tfloat | Ti32 | Tf32 | Ti8 | Ti16 | Tu32
+    ->
+      false
   | Tpoly _ | Tfun _ -> true
   | Trecord (_, Rec_not fs, _) ->
       Array.fold_left (fun ca f -> ca || contains_allocation f.ftyp) false fs

diff --git a/lib/cleaned_types.mli b/lib/cleaned_types.mli
@@ -2,10 +2,13 @@ type typ =
   | Tint
   | Tbool
   | Tunit
+  | Ti8
   | Tu8
+  | Ti16
   | Tu16
   | Tfloat
   | Ti32
+  | Tu32
   | Tf32
   | Tpoly of string
   | Tfun of param list * typ * fun_kind

diff --git a/lib/codegen/helpers.ml b/lib/codegen/helpers.ml
@@ -110,8 +110,8 @@ struct
 
   let default_kind = function
     | t when is_struct t -> Ptr
-    | Tint | Tbool | Tfloat | Tu8 | Tu16 | Ti32 | Tf32 | Tunit | Traw_ptr _
-    | Tarray _ | Trc _ ->
+    | Tint | Tbool | Tfloat | Tu8 | Tu16 | Ti32 | Tf32 | Ti8 | Ti16 | Tu32
+    | Tunit | Traw_ptr _ | Tarray _ | Trc _ ->
         Imm
     | Trecord _ | Tvariant _ | Tfun _ | Tpoly _ | Tfixed_array _ ->
         failwith "unreachable"
@@ -249,8 +249,12 @@ struct
         let v = { value; typ; lltyp; kind = Imm } in
         let ptr = Arr.array_data [ v ] in
         ("%s", ptr.value)
+    | Ti8 -> ("%dhh", v.value)
     | Tu8 -> ("%c", v.value)
+    | Ti16 -> ("%dh", v.value)
+    | Tu16 -> ("%uh", v.value)
     | Ti32 -> ("%i", v.value)
+    | Tu32 -> ("%u", v.value)
     | Tf32 -> ("%.9gf", Llvm.build_fpcast v.value float_t "" builder)
     | _ ->
         print_endline (show_typ value.typ);

diff --git a/lib/codegen/lltypes.ml b/lib/codegen/lltypes.ml
@@ -18,10 +18,10 @@ module Make (A : Abi_intf.S) = struct
   let rec get_lltype_def = function
     | Tint -> int_t
     | Tbool -> bool_t
-    | Tu8 -> u8_t
-    | Tu16 -> u16_t
+    | Ti8 | Tu8 -> u8_t
+    | Ti16 | Tu16 -> u16_t
     | Tfloat -> float_t
-    | Ti32 -> i32_t
+    | Ti32 | Tu32 -> i32_t
     | Tf32 -> f32_t
     | Tunit -> unit_t
     | Tpoly _ -> ptr_t
@@ -33,7 +33,7 @@ module Make (A : Abi_intf.S) = struct
 
   and get_lltype_param mut = function
     | ( Tint | Tbool | Tu8 | Tu16 | Tfloat | Ti32 | Tf32 | Tunit | Tpoly _
-      | Traw_ptr _ | Tarray _ ) as t ->
+      | Traw_ptr _ | Tarray _ | Ti8 | Ti16 | Tu32 ) as t ->
         let t = get_lltype_def t in
         if mut then ptr_t else t
     | Tfun _ -> ptr_t

diff --git a/lib/codegen/size_align.ml b/lib/codegen/size_align.ml
@@ -16,11 +16,11 @@ let add_size_align ~upto ~sz { size; align } =
 let rec size_align_impl size_pr typ =
   match typ with
   | Tint | Tfloat -> add_size_align ~upto:8 ~sz:8 size_pr
-  | Ti32 | Tf32 -> add_size_align ~upto:4 ~sz:4 size_pr
-  | Tbool | Tu8 ->
+  | Ti32 | Tf32 | Tu32 -> add_size_align ~upto:4 ~sz:4 size_pr
+  | Tbool | Tu8 | Ti8 ->
       (* No need to align one byte *)
       { size_pr with size = size_pr.size + 1 }
-  | Tu16 -> add_size_align ~upto:2 ~sz:2 size_pr
+  | Tu16 | Ti16 -> add_size_align ~upto:2 ~sz:2 size_pr
   | Tunit -> add_size_align ~upto:1 ~sz:0 size_pr
   | Tfun _ ->
       (* A closure, 2 ptrs. Assume 64bit *)

diff --git a/lib/monomorph.ml b/lib/monomorph.ml
@@ -117,10 +117,10 @@ module Make (Mtree : Monomorph_tree_intf.S) = struct
       | Tint -> "l"
       | Tbool -> "b"
       | Tunit -> "u"
-      | Tu8 -> "c"
-      | Tu16 -> "s"
+      | Tu8 | Ti8 -> "c"
+      | Tu16 | Ti16 -> "s"
       | Tfloat -> "d"
-      | Ti32 -> "i"
+      | Ti32 | Tu32 -> "i"
       | Tf32 -> "f"
       | Tfun (ps, r, k) ->
           let k =
@@ -184,8 +184,8 @@ module Make (Mtree : Monomorph_tree_intf.S) = struct
   let nominal_name name ~closure ~poly concrete =
     let open Printf in
     let rec aux ~poly = function
-      | (Tint | Tbool | Tunit | Tu8 | Tu16 | Tfloat | Ti32 | Tf32 | Tpoly _) as
-        t ->
+      | ( Tint | Tbool | Tunit | Tu8 | Tu16 | Tfloat | Ti32 | Tf32 | Ti8 | Ti16
+        | Tu32 | Tpoly _ ) as t ->
           structural_name ~closure t
       | Tfun (ps, r, k) -> (
           match poly with

diff --git a/lib/monomorph_tree.ml b/lib/monomorph_tree.ml
@@ -166,9 +166,12 @@ let rec cln ss p = function
   | Tconstr (Pid "bool", _) -> Tbool
   | Tconstr (Pid "unit", _) -> Tunit
   | Tconstr (Pid "float", _) -> Tfloat
+  | Tconstr (Pid "i8", _) -> Ti8
   | Tconstr (Pid "u8", _) -> Tu8
+  | Tconstr (Pid "i16", _) -> Ti16
   | Tconstr (Pid "u16", _) -> Tu16
   | Tconstr (Pid "i32", _) -> Ti32
+  | Tconstr (Pid "u32", _) -> Tu32
   | Tconstr (Pid "f32", _) -> Tf32
   | Qvar id | Tvar { contents = Unbound (id, _) } -> Tpoly id
   | Tfun (params, ret, kind) ->

diff --git a/lib/typing/types.ml b/lib/typing/types.ml
@@ -56,10 +56,13 @@ let tunit = Tconstr (Pid "unit", [])
 and tint = Tconstr (Pid "int", [])
 and tfloat = Tconstr (Pid "float", [])
 and ti32 = Tconstr (Pid "i32", [])
+and tu32 = Tconstr (Pid "u32", [])
 and tf32 = Tconstr (Pid "f32", [])
 and tbool = Tconstr (Pid "bool", [])
 and tu8 = Tconstr (Pid "u8", [])
+and ti8 = Tconstr (Pid "i8", [])
 and tu16 = Tconstr (Pid "u16", [])
+and ti16 = Tconstr (Pid "i16", [])
 and tarray typ = Tconstr (Pid "array", [ typ ])
 and traw_ptr typ = Tconstr (Pid "raw_ptr", [ typ ])
 and trc typ = Tconstr (Pid "rc", [ typ ])
@@ -158,9 +161,12 @@ let fold_builtins f init =
       tbool;
       tunit;
       tfloat;
+      ti8;
       tu8;
+      ti16;
       tu16;
       ti32;
+      tu32;
       tf32;
       tarray (Qvar "0");
       traw_ptr (Qvar "0");
@@ -171,7 +177,7 @@ let is_builtin = function
   | Tconstr
       ( Pid
           ( "int" | "bool" | "unit" | "float" | "u8" | "u16" | "i32" | "f32"
-          | "array" | "raw_ptr" | "rc" ),
+          | "i8" | "i16" | "u32" | "array" | "raw_ptr" | "rc" ),
         _ ) ->
       true
   | _ -> false

diff --git a/lib/typing/types.mli b/lib/typing/types.mli
@@ -46,9 +46,12 @@ val tunit : typ
 val tint : typ
 val tfloat : typ
 val ti32 : typ
+val tu32 : typ
 val tf32 : typ
 val tbool : typ
+val ti8 : typ
 val tu8 : typ
+val ti16 : typ
 val tu16 : typ
 val tarray : typ -> typ
 val traw_ptr : typ -> typ

diff --git a/lib/typing/typing.ml b/lib/typing/typing.ml
@@ -1137,7 +1137,12 @@ end = struct
       | _, Tconstr (p, [])
         when Path.equal p (Path.Pmod ("string", Path.Pid "t")) ->
           Fexpr e
-      | _, Tconstr (Pid ("int" | "bool" | "float" | "u8" | "i32" | "f32"), _) ->
+      | ( _,
+          Tconstr
+            ( Pid
+                ( "int" | "bool" | "float" | "u8" | "i32" | "f32" | "i8" | "i16"
+                | "u16" | "u32" ),
+              _ ) ) ->
           Fexpr e
       | _, Tvar { contents = Unbound _ } ->
           Fexpr e (* Might be the right type later *)
-Original file line number
+Diff line change
@@ Expand Up / @@ -2,10 +2,13 @@ type typ = @@
       | Tint
       | Tbool
       | Tunit
+      | Ti8
       | Tu8
+      | Ti16
       | Tu16
       | Tfloat
       | Ti32
+      | Tu32
       | Tf32
       | Tpoly of string
       | Tfun of param list * typ * fun_kind
@@ Expand Down @@