remove tag id from data bytes for non-recursive tags

This commit is contained in:
Folkert 2021-06-26 17:01:23 +02:00
parent 98db393587
commit 98a9dc0945
24 changed files with 188 additions and 170 deletions

View file

@ -140,12 +140,9 @@ fn build_has_tag_id_help<'a, 'ctx, 'env>(
let tag_value = env.builder.build_load(argument_cast, "get_value");
let actual_tag_id = {
let tag_id_i64 = crate::llvm::build::extract_tag_discriminant(
env,
function_value,
union_layout,
tag_value,
);
let tag_id_i64 =
crate::llvm::build::get_tag_id(env, function_value, &union_layout, tag_value)
.into_int_value();
env.builder
.build_int_cast(tag_id_i64, env.context.i16_type(), "to_i16")

View file

@ -1479,6 +1479,8 @@ pub fn build_exp_expr<'a, 'ctx, 'env>(
match union_layout {
UnionLayout::NonRecursive(tag_layouts) => {
let index = *index - 1;
debug_assert!(argument.is_struct_value());
let field_layouts = tag_layouts[*tag_id as usize];
let struct_layout = Layout::Struct(field_layouts);
@ -1492,7 +1494,7 @@ pub fn build_exp_expr<'a, 'ctx, 'env>(
);
let result = builder
.build_extract_value(struct_value, *index as u32, "")
.build_extract_value(struct_value, index as u32, "")
.expect("desired field did not decode");
result
@ -3841,6 +3843,7 @@ fn run_higher_order_low_level<'a, 'ctx, 'env>(
env,
layout_ids,
roc_function_call,
result_layout,
list,
element_layout,
default,

View file

@ -417,6 +417,7 @@ pub fn list_walk_generic<'a, 'ctx, 'env>(
env: &Env<'a, 'ctx, 'env>,
layout_ids: &mut LayoutIds<'a>,
roc_function_call: RocFunctionCall<'ctx>,
function_call_return_layout: &Layout<'a>,
list: BasicValueEnum<'ctx>,
element_layout: &Layout<'a>,
default: BasicValueEnum<'ctx>,
@ -457,6 +458,18 @@ pub fn list_walk_generic<'a, 'ctx, 'env>(
);
}
ListWalk::WalkUntil | ListWalk::WalkBackwardsUntil => {
let function = env
.builder
.get_insert_block()
.unwrap()
.get_parent()
.unwrap();
let has_tag_id = match function_call_return_layout {
Layout::Union(union_layout) => build_has_tag_id(env, function, *union_layout),
_ => unreachable!(),
};
let dec_element_fn = build_dec_wrapper(env, layout_ids, element_layout);
call_void_bitcode_fn(
env,
@ -469,7 +482,9 @@ pub fn list_walk_generic<'a, 'ctx, 'env>(
pass_as_opaque(env, default_ptr),
env.alignment_intvalue(&element_layout),
layout_width(env, element_layout),
layout_width(env, function_call_return_layout),
layout_width(env, default_layout),
has_tag_id.as_global_value().as_pointer_value().into(),
dec_element_fn.as_global_value().as_pointer_value().into(),
pass_as_opaque(env, result_ptr),
],

View file

@ -1,5 +1,5 @@
use crate::llvm::build::Env;
use crate::llvm::build::{cast_block_of_memory_to_tag, complex_bitcast, FAST_CALL_CONV};
use crate::llvm::build::{cast_block_of_memory_to_tag, FAST_CALL_CONV};
use crate::llvm::build_list::{list_len, load_list_ptr};
use crate::llvm::build_str::str_equal;
use crate::llvm::convert::basic_type_from_layout;
@ -846,9 +846,10 @@ fn build_tag_eq_help<'a, 'ctx, 'env>(
match union_layout {
NonRecursive(tags) => {
// SAFETY we know that non-recursive tags cannot be NULL
let id1 = nonrec_tag_id(env, tag1.into_struct_value());
let id2 = nonrec_tag_id(env, tag2.into_struct_value());
let id1 =
crate::llvm::build::get_tag_id(env, parent, union_layout, tag1).into_int_value();
let id2 =
crate::llvm::build::get_tag_id(env, parent, union_layout, tag2).into_int_value();
let compare_tag_fields = ctx.append_basic_block(parent, "compare_tag_fields");
@ -1212,19 +1213,6 @@ fn eq_ptr_to_struct<'a, 'ctx, 'env>(
.into_int_value()
}
fn nonrec_tag_id<'a, 'ctx, 'env>(
env: &Env<'a, 'ctx, 'env>,
tag: StructValue<'ctx>,
) -> IntValue<'ctx> {
complex_bitcast(
env.builder,
tag.into(),
env.context.i64_type().into(),
"load_tag_id",
)
.into_int_value()
}
unsafe fn rec_tag_id_unsafe<'a, 'ctx, 'env>(
env: &Env<'a, 'ctx, 'env>,
tag: PointerValue<'ctx>,