diff --git a/compiler/can/src/builtins.rs b/compiler/can/src/builtins.rs index 8e94860706..e2d7b7cea4 100644 --- a/compiler/can/src/builtins.rs +++ b/compiler/can/src/builtins.rs @@ -960,7 +960,7 @@ fn list_walk_right(symbol: Symbol, var_store: &mut VarStore) -> Def { (func_var, Var(Symbol::ARG_2)), (accum_var, Var(Symbol::ARG_3)), ], - ret_var: list_var, + ret_var: accum_var, }; defn( @@ -972,7 +972,7 @@ fn list_walk_right(symbol: Symbol, var_store: &mut VarStore) -> Def { ], var_store, body, - list_var, + accum_var, ) } diff --git a/compiler/gen/src/llvm/build.rs b/compiler/gen/src/llvm/build.rs index b1fc1f23a9..e95e2e562a 100644 --- a/compiler/gen/src/llvm/build.rs +++ b/compiler/gen/src/llvm/build.rs @@ -1711,7 +1711,22 @@ fn run_low_level<'a, 'ctx, 'env>( // List.walkRight : List elem, (elem -> accum -> accum), accum -> accum debug_assert_eq!(args.len(), 3); - list_walk_right(env) + let (list, list_layout) = load_symbol_and_layout(env, scope, &args[0]); + + let (func, func_layout) = load_symbol_and_layout(env, scope, &args[1]); + + let (default, default_layout) = load_symbol_and_layout(env, scope, &args[2]); + + list_walk_right( + env, + parent, + list, + list_layout, + func, + func_layout, + default, + default_layout, + ) } ListAppend => { // List.append : List elem, elem -> List elem diff --git a/compiler/gen/src/llvm/build_list.rs b/compiler/gen/src/llvm/build_list.rs index bd53ad0e04..deb55373dd 100644 --- a/compiler/gen/src/llvm/build_list.rs +++ b/compiler/gen/src/llvm/build_list.rs @@ -642,10 +642,96 @@ pub fn list_len<'ctx>( } /// List.walkRight : List elem, (elem -> accum -> accum), accum -> accum -pub fn list_walk_right<'a, 'ctx, 'env>(env: &Env<'a, 'ctx, 'env>) -> BasicValueEnum<'ctx> { +#[allow(clippy::too_many_arguments)] +pub fn list_walk_right<'a, 'ctx, 'env>( + env: &Env<'a, 'ctx, 'env>, + parent: FunctionValue<'ctx>, + list: BasicValueEnum<'ctx>, + list_layout: &Layout<'a>, + func: BasicValueEnum<'ctx>, + func_layout: &Layout<'a>, + default: BasicValueEnum<'ctx>, + default_layout: &Layout<'a>, +) -> BasicValueEnum<'ctx> { let ctx = env.context; + let builder = env.builder; - BasicValueEnum::IntValue(ctx.i64_type().const_int(0 as u64, false)) + let list_wrapper = list.into_struct_value(); + let len = list_len(env.builder, list_wrapper); + + let accum_type = basic_type_from_layout(env.arena, ctx, default_layout, env.ptr_bytes); + let accum_alloca = builder.build_alloca(accum_type, "alloca_walk_right_accum"); + builder.build_store(accum_alloca, default); + + let then_block = ctx.append_basic_block(parent, "then"); + let cont_block = ctx.append_basic_block(parent, "branchcont"); + + let condition = builder.build_int_compare( + IntPredicate::UGT, + len, + ctx.i64_type().const_zero(), + "list_non_empty", + ); + + builder.build_conditional_branch(condition, then_block, cont_block); + + builder.position_at_end(then_block); + + match (func, func_layout) { + (BasicValueEnum::PointerValue(func_ptr), Layout::FunctionPointer(_, _)) => { + let elem_layout = match list_layout { + Layout::Builtin(Builtin::List(_, layout)) => layout, + _ => unreachable!("can only fold over a list"), + }; + + let elem_type = basic_type_from_layout(env.arena, ctx, elem_layout, env.ptr_bytes); + let elem_ptr_type = get_ptr_type(&elem_type, AddressSpace::Generic); + + let list_ptr = load_list_ptr(builder, list_wrapper, elem_ptr_type); + + let walk_right_loop = |_, elem: BasicValueEnum<'ctx>| { + // load current accumulator + let current = builder.build_load(accum_alloca, "retrieve_accum"); + + let call_site_value = + builder.build_call(func_ptr, &[elem, current], "#walk_right_func"); + + // set the calling convention explicitly for this call + call_site_value.set_call_convention(crate::llvm::build::FAST_CALL_CONV); + + let new_current = call_site_value + .try_as_basic_value() + .left() + .unwrap_or_else(|| panic!("LLVM error: Invalid call by pointer.")) + .into_int_value(); + + builder.build_store(accum_alloca, new_current); + }; + + incrementing_elem_loop( + builder, + parent, + ctx, + LoopListArg { ptr: list_ptr, len }, + "#index", + None, + walk_right_loop, + ); + } + + _ => { + unreachable!( + "Invalid function basic value enum or layout for List.keepIf : {:?}", + (func, func_layout) + ); + } + } + + builder.build_unconditional_branch(cont_block); + + builder.position_at_end(cont_block); + + builder.build_load(accum_alloca, "load_final_acum") } /// List.keepIf : List elem, (elem -> Bool) -> List elem diff --git a/compiler/gen/tests/gen_list.rs b/compiler/gen/tests/gen_list.rs index bf2d59f020..053b2fa8a7 100644 --- a/compiler/gen/tests/gen_list.rs +++ b/compiler/gen/tests/gen_list.rs @@ -119,7 +119,21 @@ mod gen_list { assert_evals_to!( indoc!( r#" - List.walkRight [] (\a, b -> b) 0 + List.walkRight [0x1] (\a, b -> a + b) 0 + "# + ), + 1, + i64 + ); + + assert_evals_to!( + indoc!( + r#" + empty : List Int + empty = + [] + + List.walkRight empty (\a, b -> a + b) 0 "# ), 0, diff --git a/compiler/mono/src/ir.rs b/compiler/mono/src/ir.rs index 6afce9d633..803aac3269 100644 --- a/compiler/mono/src/ir.rs +++ b/compiler/mono/src/ir.rs @@ -3196,7 +3196,9 @@ fn call_by_name<'a>( None => { // This must have been a runtime error. match procs.runtime_errors.get(&proc_name) { - Some(error) => Stmt::RuntimeError(error), + Some(error) => { + Stmt::RuntimeError(env.arena.alloc(format!("{:?}", error))) + } None => unreachable!("Proc name {:?} is invalid", proc_name), } } @@ -3205,10 +3207,10 @@ fn call_by_name<'a>( } } } - Err(_) => { + Err(e) => { // This function code gens to a runtime error, // so attempting to call it will immediately crash. - Stmt::RuntimeError("") + Stmt::RuntimeError(env.arena.alloc(format!("{:?}", e))) } } } diff --git a/compiler/solve/tests/solve_expr.rs b/compiler/solve/tests/solve_expr.rs index 4a94d6e27f..6e70f7b09f 100644 --- a/compiler/solve/tests/solve_expr.rs +++ b/compiler/solve/tests/solve_expr.rs @@ -2717,4 +2717,32 @@ mod solve_expr { "{ x : Int, y ? Bool }* -> { x : Int, y : Bool }", ); } + + #[test] + fn list_walk_right() { + infer_eq_without_problem( + indoc!( + r#" + List.walkRight + "# + ), + "List a, (a, b -> b), b -> b", + ); + } + + #[test] + fn list_walk_right_example() { + infer_eq_without_problem( + indoc!( + r#" + empty : List Int + empty = + [] + + List.walkRight empty (\a, b -> a + b) 0 + "# + ), + "Int", + ); + } } diff --git a/compiler/solve/tests/solve_uniq_expr.rs b/compiler/solve/tests/solve_uniq_expr.rs index 8539fca251..e0aba0ad85 100644 --- a/compiler/solve/tests/solve_uniq_expr.rs +++ b/compiler/solve/tests/solve_uniq_expr.rs @@ -2220,11 +2220,11 @@ mod solve_uniq_expr { } #[test] - fn list_foldr_sum() { + fn list_walkRight_sum() { infer_eq( indoc!( r#" - sum = \list -> List.foldr list Num.add 0 + sum = \list -> List.walkRight list Num.add 0 sum "# @@ -2291,9 +2291,9 @@ mod solve_uniq_expr { } #[test] - fn list_foldr() { + fn list_walkRight() { infer_eq( - "List.foldr", + "List.walkRight", "Attr * (Attr (* | b) (List (Attr b a)), Attr Shared (Attr b a, c -> c), c -> c)", ); } @@ -2313,11 +2313,11 @@ mod solve_uniq_expr { } #[test] - fn list_foldr_reverse() { + fn list_walkRight_reverse() { infer_eq( indoc!( r#" - reverse = \list -> List.foldr list (\e, l -> List.append l e) [] + reverse = \list -> List.walkRight list (\e, l -> List.append l e) [] reverse "# @@ -3115,4 +3115,32 @@ mod solve_uniq_expr { "Attr * (Attr (* | b | c) { x : Attr b (Num (Attr b a)), y ? Attr c (Num (Attr c a)) }* -> Attr d (Num (Attr d a)))" ); } + + #[test] + fn list_walk_right() { + infer_eq( + indoc!( + r#" + List.walkRight + "# + ), + "Attr * (Attr (* | b) (List (Attr b a)), Attr Shared (Attr b a, c -> c), c -> c)", + ); + } + + #[test] + fn list_walk_right_example() { + infer_eq( + indoc!( + r#" + empty : List Int + empty = + [] + + List.walkRight empty (\a, b -> a + b) 0 + "# + ), + "Attr a Int", + ); + } }