Handle struct types more generally

by using `is_struct` instead of hardcoding for (some) struct types. Also
get rid off `const_param` bool, we don't need it anymore. Instead,
handling of const globals and constexpr things is unified. Constexpr
mutable globals are still missing though

lib/codegen/codegen.ml

@@ -34,7 +34,7 @@ end = struct
 
         let start_index, alloca =
           match ret_t with
-          | (Trecord _ | Tvariant _ | Tfun _) as t -> (
+          | t when is_struct t -> (
               match pkind_of_typ false t with
               | Boxed ->
                   (* Whenever the return type is boxed, we add the prealloc to the environment *)
@@ -63,7 +63,8 @@ end = struct
           (* If we want to return a struct, we copy the struct to
               its ptr (1st parameter) and return void *)
           match ret.typ with
-          | (Trecord _ | Tvariant _ | Tfun _) as t -> (
+          | Tpoly _ -> ()
+          | t when is_struct t -> (
               match pkind_of_typ false t with
               | Boxed ->
                   (* Since we only have POD records, we can safely memcpy here *)
@@ -77,9 +78,7 @@ end = struct
         in
 
         let finalize = Some fun_finalize in
-        let param =
-          { vars = tvars; alloca; finalize; rec_block; const_pass = false }
-        in
+        let param = { vars = tvars; alloca; finalize; rec_block } in
         let ret = gen_expr param abs.body in
 
         (match recursive with
@@ -493,7 +492,7 @@ end = struct
 
     let value, lltyp =
       match ret_t with
-      | (Trecord _ | Tvariant _ | Tfun _) as t -> (
+      | t when is_struct t -> (
           let lltyp = get_lltype_def ret_t in
           match pkind_of_typ false t with
           | Boxed ->
@@ -526,7 +525,7 @@ end = struct
 
     let start_index, ret =
       match func.typ with
-      | Tfun (_, (Trecord _ as r), _) | Tfun (_, (Tvariant _ as r), _) -> (
+      | Tfun (_, r, _) when is_struct r -> (
           match pkind_of_typ false r with
           | Boxed -> (1, r)
           | Unboxed size -> (0, type_unboxed size))
@@ -559,10 +558,7 @@ end = struct
     List.iter store_arg margs;
 
     let lltyp =
-      (* TODO record *)
-      match ret with
-      | Trecord _ | Tvariant _ -> get_lltype_def ret_t
-      | t -> get_lltype_param false t
+      if is_struct ret then get_lltype_def ret_t else get_lltype_param false ret
     in
 
     let value = Llvm.build_br rec_block.rec_ builder in
@@ -879,13 +875,6 @@ end = struct
             ignore (Llvm.build_store value record builder);
             (record, Const_ptr))
           else (value, Const)
-      (* | Const -> *)
-      (*     let values = *)
-      (*       List.map (fun (_, expr) -> (gen_expr param expr).value) labels *)
-      (*       |> Array.of_list *)
-      (*     in *)
-      (*     let ret = Llvm.const_named_struct lltyp values in *)
-      (*     (ret, Const) *)
     in
 
     let v = { value; typ; lltyp; kind } in
@@ -1133,7 +1122,7 @@ and Auto : Autogen_intf.S = Autogen.Make (T) (H) (Ar)
 
 let fill_constants constants =
   let f (name, tree, toplvl) =
-    let init = Core.gen_expr { no_param with const_pass = true } tree in
+    let init = Core.gen_expr no_param tree in
     (* We only add records to the global table, because they are expected as ptrs.
        For ints or floats, we just return the immediate value *)
     let init =

lib/codegen/helpers.ml

@@ -109,10 +109,12 @@ struct
   let bb = Llvm.build_bitcast
 
   let default_kind = function
+    | t when is_struct t -> Ptr
     | Tint | Tbool | Tfloat | Tu8 | Ti32 | Tf32 | Tunit | Traw_ptr _ | Tarray _
       ->
         Imm
-    | Trecord _ | Tvariant _ | Tfun _ | Tpoly _ | Tfixed_array _ -> Ptr
+    | Trecord _ | Tvariant _ | Tfun _ | Tpoly _ | Tfixed_array _ ->
+        failwith "unreachable"
 
   let bring_default value =
     if is_struct value.typ then value.value
@@ -304,7 +306,7 @@ struct
 
   let set_struct_field value ptr =
     match value.typ with
-    | Trecord _ | Tvariant _ | Tfun _ ->
+    | t when is_struct t ->
         if value.value <> ptr then
           let size = sizeof_typ value.typ |> llval_of_size in
           memcpy ~dst:ptr ~src:value ~size
@@ -547,7 +549,7 @@ struct
         if mut then tailrec_store ~src ~dst else store_or_copy ~src ~dst
       in
       match src.typ with
-      | Trecord _ | Tvariant _ | Tfun _ ->
+      | t when is_struct t ->
           let typ = get_lltype_def src.typ |> m in
           let dst = Llvm.build_alloca typ "" builder in
           store dst;
@@ -665,16 +667,16 @@ struct
 
   let fun_return name ret =
     match ret.typ with
-    | (Trecord _ | Tvariant _ | Tfun _) as t -> (
+    | Tpoly id when String.equal id "tail" ->
+        (* This magic id is used to mark a tailrecursive call *)
+        Llvm.build_ret_void builder
+    | Tpoly _ -> failwith "Internal Error: Generic return"
+    | t when is_struct t -> (
         match pkind_of_typ false t with
         | Boxed -> (* Default record case *) Llvm.build_ret_void builder
         | Unboxed kind ->
             let unboxed, _ = unbox_record ~kind ~ret:true ret in
             Llvm.build_ret unboxed builder)
-    | Tpoly id when String.equal id "tail" ->
-        (* This magic id is used to mark a tailrecursive call *)
-        Llvm.build_ret_void builder
-    | Tpoly _ -> failwith "Internal Error: Generic return"
     | Tunit ->
         if String.equal name "main" then
           Llvm.(build_ret (const_int int_t 0)) builder

lib/codegen/llvm_types.ml

@@ -18,17 +18,10 @@ type param = {
   alloca : Llvm.llvalue option;
   finalize : (llvar -> unit) option;
   rec_block : rec_block option;
-  const_pass : bool;
 }
 
 let no_param =
-  {
-    vars = Vars.empty;
-    alloca = None;
-    finalize = None;
-    rec_block = None;
-    const_pass = false;
-  }
+  { vars = Vars.empty; alloca = None; finalize = None; rec_block = None }
 
 let context = Llvm.global_context ()
 let the_module = Llvm.create_module context "context"