diff --git a/lib/cleaned_types.ml b/lib/cleaned_types.ml index 92ae2c4..15a2b41 100644 --- 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 index e69865c..6817d02 100644 --- 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 index 3f548d4..e72f963 100644 --- 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 index 1cf44aa..6eac6fd 100644 --- 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 index 4d1f43e..743c5e1 100644 --- 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 index c55db99..88d29d1 100644 --- 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 index 05c15b2..5143411 100644 --- 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 index 043ac55..bc10fe6 100644 --- 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 index 6d3c68c..87cd7f7 100644 --- 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 index 5799e81..c7dcf08 100644 --- 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 *)