From 345ecd434b03d4df2f5655d91c12d33924ec69b3 Mon Sep 17 00:00:00 2001 From: Folkert Date: Fri, 15 Jan 2021 15:05:39 +0100 Subject: [PATCH] working is_empty (without RC) --- compiler/gen/src/llvm/build.rs | 203 ++++++++++++++++++++++++++++----- examples/hello-world/Hello.roc | 23 +++- 2 files changed, 198 insertions(+), 28 deletions(-) diff --git a/compiler/gen/src/llvm/build.rs b/compiler/gen/src/llvm/build.rs index 3b858beed9..5d51ed0621 100644 --- a/compiler/gen/src/llvm/build.rs +++ b/compiler/gen/src/llvm/build.rs @@ -966,8 +966,6 @@ pub fn build_exp_expr<'a, 'ctx, 'env>( tag_name, .. } => { - dbg!(&arguments, &fields); - panic!(); let tag_layout = Layout::Union(fields); debug_assert!(*union_size > 1); @@ -1041,6 +1039,99 @@ pub fn build_exp_expr<'a, 'ctx, 'env>( data_ptr.into() } + Tag { + arguments, + tag_layout: + Layout::NullableUnion { + nullable_id, + nullable_layout: _, + foo: fields, + }, + union_size, + tag_id, + tag_name, + .. + } => { + let tag_layout = Layout::Union(fields); + if *tag_id == *nullable_id as u8 { + let output_type = + basic_type_from_layout(env.arena, env.context, &tag_layout, env.ptr_bytes) + .ptr_type(AddressSpace::Generic); + + return output_type.const_null().into(); + } + + debug_assert!(*union_size > 1); + let ptr_size = env.ptr_bytes; + + let ctx = env.context; + let builder = env.builder; + + // Determine types + let num_fields = arguments.len() + 1; + let mut field_types = Vec::with_capacity_in(num_fields, env.arena); + let mut field_vals = Vec::with_capacity_in(num_fields, env.arena); + + let tag_field_layouts = if let TagName::Closure(_) = tag_name { + // closures ignore (and do not store) the discriminant + &fields[*tag_id as usize][1..] + } else { + &fields[*tag_id as usize] + }; + + for (field_symbol, tag_field_layout) in arguments.iter().zip(tag_field_layouts.iter()) { + let (val, val_layout) = load_symbol_and_layout(env, scope, field_symbol); + + // Zero-sized fields have no runtime representation. + // The layout of the struct expects them to be dropped! + if !tag_field_layout.is_dropped_because_empty() { + let field_type = + basic_type_from_layout(env.arena, env.context, tag_field_layout, ptr_size); + + field_types.push(field_type); + + if let Layout::RecursivePointer = tag_field_layout { + debug_assert!(val.is_pointer_value()); + + // we store recursive pointers as `i64*` + let ptr = cast_basic_basic( + builder, + val, + ctx.i64_type().ptr_type(AddressSpace::Generic).into(), + ); + + field_vals.push(ptr); + } else { + // this check fails for recursive tag unions, but can be helpful while debugging + debug_assert_eq!(tag_field_layout, val_layout); + + field_vals.push(val); + } + } + } + + // Create the struct_type + let data_ptr = reserve_with_refcount(env, &tag_layout); + let struct_type = ctx.struct_type(field_types.into_bump_slice(), false); + let struct_ptr = cast_basic_basic( + builder, + data_ptr.into(), + struct_type.ptr_type(AddressSpace::Generic).into(), + ) + .into_pointer_value(); + + // Insert field exprs into struct_val + for (index, field_val) in field_vals.into_iter().enumerate() { + let field_ptr = builder + .build_struct_gep(struct_ptr, index as u32, "struct_gep") + .unwrap(); + + builder.build_store(field_ptr, field_val); + } + + data_ptr.into() + } + Tag { .. } => unreachable!("tags should have a Union or RecursiveUnion layout"), Reset(_) => todo!(), @@ -1127,7 +1218,7 @@ pub fn build_exp_expr<'a, 'ctx, 'env>( .struct_type(field_types.into_bump_slice(), false); // cast the argument bytes into the desired shape for this tag - let argument = load_symbol(env, scope, structure); + let (argument, structure_layout) = load_symbol_and_layout(env, scope, structure); let struct_layout = Layout::Struct(field_layouts); match argument { @@ -1154,31 +1245,72 @@ pub fn build_exp_expr<'a, 'ctx, 'env>( } } PointerValue(value) => { - let ptr = cast_basic_basic( - builder, - value.into(), - struct_type.ptr_type(AddressSpace::Generic).into(), - ) - .into_pointer_value(); + match structure_layout { + Layout::NullableUnion { nullable_id, .. } if *index == 0 => { + let ptr = value; + let is_null = env.builder.build_is_null(ptr, "is_null"); - let elem_ptr = builder - .build_struct_gep(ptr, *index as u32, "at_index_struct_gep") - .unwrap(); + let ctx = env.context; + let then_block = ctx.append_basic_block(parent, "then"); + let else_block = ctx.append_basic_block(parent, "else"); + let cont_block = ctx.append_basic_block(parent, "cont"); - let result = builder.build_load(elem_ptr, "load_at_index_ptr"); + let result = builder.build_alloca(ctx.i64_type(), "result"); - if let Some(Layout::RecursivePointer) = field_layouts.get(*index as usize) { - // a recursive field is stored as a `i64*`, to use it we must cast it to - // a pointer to the block of memory representation - cast_basic_basic( - builder, - result, - block_of_memory(env.context, &struct_layout, env.ptr_bytes) - .ptr_type(AddressSpace::Generic) - .into(), - ) - } else { - result + env.builder.build_switch( + is_null, + else_block, + &[(ctx.bool_type().const_int(1, false), then_block)], + ); + + { + env.builder.position_at_end(then_block); + let tag_id = ctx.i64_type().const_int(*nullable_id as u64, false); + env.builder.build_store(result, tag_id); + env.builder.build_unconditional_branch(cont_block); + } + + { + env.builder.position_at_end(else_block); + let tag_id = extract_tag_discriminant_ptr(env, ptr); + env.builder.build_store(result, tag_id); + env.builder.build_unconditional_branch(cont_block); + } + + env.builder.position_at_end(cont_block); + + env.builder.build_load(result, "load_result") + } + _ => { + let ptr = cast_basic_basic( + builder, + value.into(), + struct_type.ptr_type(AddressSpace::Generic).into(), + ) + .into_pointer_value(); + + let elem_ptr = builder + .build_struct_gep(ptr, *index as u32, "at_index_struct_gep") + .unwrap(); + + let result = builder.build_load(elem_ptr, "load_at_index_ptr"); + + if let Some(Layout::RecursivePointer) = + field_layouts.get(*index as usize) + { + // a recursive field is stored as a `i64*`, to use it we must cast it to + // a pointer to the block of memory representation + cast_basic_basic( + builder, + result, + block_of_memory(env.context, &struct_layout, env.ptr_bytes) + .ptr_type(AddressSpace::Generic) + .into(), + ) + } else { + result + } + } } } _ => panic!("cannot look up index in {:?}", argument), @@ -1842,7 +1974,7 @@ pub fn cast_basic_basic<'ctx>( builder.build_load(to_type_pointer, "") } -fn extract_tag_discriminant<'a, 'ctx, 'env>( +fn extract_tag_discriminant_struct<'a, 'ctx, 'env>( env: &Env<'a, 'ctx, 'env>, from_value: StructValue<'ctx>, ) -> IntValue<'ctx> { @@ -1858,6 +1990,23 @@ fn extract_tag_discriminant<'a, 'ctx, 'env>( .into_int_value() } +fn extract_tag_discriminant_ptr<'a, 'ctx, 'env>( + env: &Env<'a, 'ctx, 'env>, + from_value: PointerValue<'ctx>, +) -> IntValue<'ctx> { + let ptr = cast_basic_basic( + env.builder, + from_value.into(), + env.context + .i64_type() + .ptr_type(AddressSpace::Generic) + .into(), + ) + .into_pointer_value(); + + env.builder.build_load(ptr, "load_tag_id").into_int_value() +} + struct SwitchArgsIr<'a, 'ctx> { pub cond_symbol: Symbol, pub cond_layout: Layout<'a>, @@ -1933,7 +2082,7 @@ fn build_switch_ir<'a, 'ctx, 'env>( cond_layout = Layout::Builtin(Builtin::Int64); let full_cond = load_symbol(env, scope, cond_symbol).into_struct_value(); - extract_tag_discriminant(env, full_cond) + extract_tag_discriminant_struct(env, full_cond) } Layout::Builtin(_) => load_symbol(env, scope, cond_symbol).into_int_value(), other => todo!("Build switch value from layout: {:?}", other), diff --git a/examples/hello-world/Hello.roc b/examples/hello-world/Hello.roc index 24a02e7823..24d38726a3 100644 --- a/examples/hello-world/Hello.roc +++ b/examples/hello-world/Hello.roc @@ -3,10 +3,31 @@ app "hello-world" imports [] provides [ main ] to base + +ConsList a : [ Cons a (ConsList a), Nil ] + +empty : ConsList a +empty = Nil + +isEmpty : ConsList a -> Bool +isEmpty = \list -> + when list is + Cons _ _ -> + False + + Nil -> + True + + greeting = hi = "Hello" name = "World" "\(hi), \(name)!!!!!!!!!!!!!" -main = greeting +main = + myList : ConsList (Int *) + myList = empty + + + if isEmpty myList then greeting else greeting