has_tag_id from zig

compiler/gen_llvm/src/llvm/bitcode.rs

@@ -1,6 +1,8 @@
 /// Helpers for interacting with the zig that generates bitcode
 use crate::debug_info_init;
-use crate::llvm::build::{Env, C_CALL_CONV, FAST_CALL_CONV};
+use crate::llvm::build::{
+    struct_from_fields, Env, C_CALL_CONV, FAST_CALL_CONV, TAG_DATA_INDEX, TAG_ID_INDEX,
+};
 use crate::llvm::convert::basic_type_from_layout;
 use crate::llvm::refcounting::{
     decrement_refcount_layout, increment_n_refcount_layout, increment_refcount_layout,
@@ -10,7 +12,7 @@ use inkwell::types::{BasicType, BasicTypeEnum};
 use inkwell::values::{BasicValue, BasicValueEnum, CallSiteValue, FunctionValue, InstructionValue};
 use inkwell::AddressSpace;
 use roc_module::symbol::Symbol;
-use roc_mono::layout::{Layout, LayoutIds};
+use roc_mono::layout::{Layout, LayoutIds, UnionLayout};
 
 pub fn call_bitcode_fn<'a, 'ctx, 'env>(
     env: &Env<'a, 'ctx, 'env>,
@@ -66,6 +68,120 @@ const ARGUMENT_SYMBOLS: [Symbol; 8] = [
     Symbol::ARG_8,
 ];
 
+pub fn build_has_tag_id<'a, 'ctx, 'env>(
+    env: &Env<'a, 'ctx, 'env>,
+    function: FunctionValue<'ctx>,
+    union_layout: UnionLayout<'a>,
+) -> FunctionValue<'ctx> {
+    let fn_name: &str = &format!("{}_has_tag_id", function.get_name().to_string_lossy());
+
+    match env.module.get_function(fn_name) {
+        Some(function_value) => function_value,
+        None => build_has_tag_id_help(env, union_layout, &fn_name),
+    }
+}
+
+fn build_has_tag_id_help<'a, 'ctx, 'env>(
+    env: &Env<'a, 'ctx, 'env>,
+    union_layout: UnionLayout<'a>,
+    fn_name: &str,
+) -> FunctionValue<'ctx> {
+    let i8_ptr_type = env.context.i8_type().ptr_type(AddressSpace::Generic);
+    let argument_types: &[BasicTypeEnum] = &[env.context.i16_type().into(), i8_ptr_type.into()];
+
+    let block = env.builder.get_insert_block().expect("to be in a function");
+    let di_location = env.builder.get_current_debug_location().unwrap();
+
+    let output_type = crate::llvm::convert::zig_has_tag_id_type(env);
+
+    let function_value = crate::llvm::refcounting::build_header_help(
+        env,
+        &fn_name,
+        output_type.into(),
+        &argument_types,
+    );
+
+    // called from zig, must use C calling convention
+    function_value.set_call_conventions(C_CALL_CONV);
+
+    let kind_id = Attribute::get_named_enum_kind_id("alwaysinline");
+    debug_assert!(kind_id > 0);
+    let attr = env.context.create_enum_attribute(kind_id, 1);
+    function_value.add_attribute(AttributeLoc::Function, attr);
+
+    let entry = env.context.append_basic_block(function_value, "entry");
+    env.builder.position_at_end(entry);
+
+    debug_info_init!(env, function_value);
+
+    let it = function_value.get_param_iter();
+
+    let arguments =
+        bumpalo::collections::Vec::from_iter_in(it.take(argument_types.len()), env.arena);
+
+    for (argument, name) in arguments.iter().zip(ARGUMENT_SYMBOLS.iter()) {
+        argument.set_name(name.ident_string(&env.interns));
+    }
+
+    match arguments.as_slice() {
+        [tag_id, tag_value_ptr] => {
+            let tag_type = basic_type_from_layout(env, &Layout::Union(union_layout));
+
+            let argument_cast = env
+                .builder
+                .build_bitcast(
+                    *tag_value_ptr,
+                    tag_type.ptr_type(AddressSpace::Generic),
+                    "load_opaque",
+                )
+                .into_pointer_value();
+
+            let input = env.builder.build_load(argument_cast, "get_value");
+
+            let tag_value =
+                crate::llvm::build::get_tag_id(env, function_value, &union_layout, input)
+                    .into_int_value();
+
+            let actual_tag_id =
+                env.builder
+                    .build_int_cast(tag_value, env.context.i16_type(), "to_i16");
+
+            let data_ptr = {
+                let index = env
+                    .context
+                    .i64_type()
+                    .const_int(TAG_DATA_INDEX as u64, false);
+                let ptr = unsafe {
+                    env.builder
+                        .build_in_bounds_gep(argument_cast, &[index], "get_tag_id")
+                };
+
+                env.builder.build_bitcast(ptr, i8_ptr_type, "to_opaque")
+            };
+
+            let answer = env.builder.build_int_compare(
+                inkwell::IntPredicate::EQ,
+                tag_id.into_int_value(),
+                actual_tag_id,
+                "compare",
+            );
+
+            let field_vals = [(0, answer.into()), (1, data_ptr)];
+
+            let output = struct_from_fields(env, output_type, field_vals.iter().copied());
+
+            env.builder.build_return(Some(&output));
+
+            env.builder.position_at_end(block);
+            env.builder
+                .set_current_debug_location(env.context, di_location);
+
+            function_value
+        }
+        _ => unreachable!(),
+    }
+}
+
 pub fn build_transform_caller<'a, 'ctx, 'env>(
     env: &Env<'a, 'ctx, 'env>,
     function: FunctionValue<'ctx>,

compiler/gen_llvm/src/llvm/build_list.rs

@@ -1,7 +1,7 @@
 #![allow(clippy::too_many_arguments)]
 use crate::llvm::bitcode::{
-    build_dec_wrapper, build_eq_wrapper, build_inc_n_wrapper, build_inc_wrapper, call_bitcode_fn,
-    call_void_bitcode_fn,
+    build_dec_wrapper, build_eq_wrapper, build_has_tag_id, build_inc_n_wrapper, build_inc_wrapper,
+    call_bitcode_fn, call_void_bitcode_fn,
 };
 use crate::llvm::build::{
     allocate_with_refcount_help, cast_basic_basic, complex_bitcast, Env, RocFunctionCall,
@@ -611,6 +611,18 @@ pub fn list_keep_oks<'a, 'ctx, 'env>(
 ) -> BasicValueEnum<'ctx> {
     let dec_result_fn = build_dec_wrapper(env, layout_ids, result_layout);
 
+    let function = env
+        .builder
+        .get_insert_block()
+        .unwrap()
+        .get_parent()
+        .unwrap();
+
+    let has_tag_id = match result_layout {
+        Layout::Union(union_layout) => build_has_tag_id(env, function, *union_layout),
+        _ => unreachable!(),
+    };
+
     call_bitcode_fn(
         env,
         &[
@@ -623,6 +635,7 @@ pub fn list_keep_oks<'a, 'ctx, 'env>(
             layout_width(env, before_layout),
             layout_width(env, result_layout),
             layout_width(env, after_layout),
+            has_tag_id.as_global_value().as_pointer_value().into(),
             dec_result_fn.as_global_value().as_pointer_value().into(),
         ],
         bitcode::LIST_KEEP_OKS,
@@ -642,6 +655,18 @@ pub fn list_keep_errs<'a, 'ctx, 'env>(
 ) -> BasicValueEnum<'ctx> {
     let dec_result_fn = build_dec_wrapper(env, layout_ids, result_layout);
 
+    let function = env
+        .builder
+        .get_insert_block()
+        .unwrap()
+        .get_parent()
+        .unwrap();
+
+    let has_tag_id = match result_layout {
+        Layout::Union(union_layout) => build_has_tag_id(env, function, *union_layout),
+        _ => unreachable!(),
+    };
+
     call_bitcode_fn(
         env,
         &[
@@ -654,6 +679,7 @@ pub fn list_keep_errs<'a, 'ctx, 'env>(
             layout_width(env, before_layout),
             layout_width(env, result_layout),
             layout_width(env, after_layout),
+            has_tag_id.as_global_value().as_pointer_value().into(),
             dec_result_fn.as_global_value().as_pointer_value().into(),
         ],
         bitcode::LIST_KEEP_ERRS,