diff --git a/compiler/gen/src/llvm/build.rs b/compiler/gen/src/llvm/build.rs index f45b11121f..6b571bff1c 100644 --- a/compiler/gen/src/llvm/build.rs +++ b/compiler/gen/src/llvm/build.rs @@ -730,73 +730,9 @@ pub fn build_exp_call<'a, 'ctx, 'env>( } CallType::Foreign { - foreign_symbol, + foreign_symbol: foreign, ret_layout, - } => { - let mut arg_vals: Vec = - Vec::with_capacity_in(arguments.len(), env.arena); - - let mut arg_types = Vec::with_capacity_in(arguments.len() + 1, env.arena); - - // crude approximation of the C calling convention - let pass_result_by_pointer = ret_layout.stack_size(env.ptr_bytes) > 2 * env.ptr_bytes; - - if pass_result_by_pointer { - // the return value is too big to pass through a register, so the caller must - // allocate space for it on its stack, and provide a pointer to write the result into - let ret_type = - basic_type_from_layout(env.arena, env.context, ret_layout, env.ptr_bytes); - - let ret_ptr_type = get_ptr_type(&ret_type, AddressSpace::Generic); - - let ret_ptr = env.builder.build_alloca(ret_type, "return_value"); - - arg_vals.push(ret_ptr.into()); - arg_types.push(ret_ptr_type.into()); - - for arg in arguments.iter() { - let (value, layout) = load_symbol_and_layout(env, scope, arg); - arg_vals.push(value); - let arg_type = - basic_type_from_layout(env.arena, env.context, layout, env.ptr_bytes); - arg_types.push(arg_type); - } - - let function_type = env.context.void_type().fn_type(&arg_types, false); - let function = get_foreign_symbol(env, foreign_symbol.clone(), function_type); - - let call = env.builder.build_call(function, arg_vals.as_slice(), "tmp"); - - // this is a foreign function, use c calling convention - call.set_call_convention(C_CALL_CONV); - - call.try_as_basic_value(); - - env.builder.build_load(ret_ptr, "read_result") - } else { - for arg in arguments.iter() { - let (value, layout) = load_symbol_and_layout(env, scope, arg); - arg_vals.push(value); - let arg_type = - basic_type_from_layout(env.arena, env.context, layout, env.ptr_bytes); - arg_types.push(arg_type); - } - - let ret_type = - basic_type_from_layout(env.arena, env.context, ret_layout, env.ptr_bytes); - let function_type = get_fn_type(&ret_type, &arg_types); - let function = get_foreign_symbol(env, foreign_symbol.clone(), function_type); - - let call = env.builder.build_call(function, arg_vals.as_slice(), "tmp"); - - // this is a foreign function, use c calling convention - call.set_call_convention(C_CALL_CONV); - - call.try_as_basic_value() - .left() - .unwrap_or_else(|| panic!("LLVM error: Invalid call by pointer.")) - } - } + } => build_foreign_symbol(env, scope, foreign, arguments, ret_layout), } } @@ -1696,8 +1632,13 @@ pub fn build_exp_stmt<'a, 'ctx, 'env>( fail, ) } - _ => { - todo!() + CallType::Foreign { + ref foreign_symbol, + ref ret_layout, + } => build_foreign_symbol(env, scope, foreign_symbol, call.arguments, ret_layout), + + CallType::LowLevel { .. } => { + unreachable!("lowlevel itself never throws exceptions") } }, @@ -3477,6 +3418,73 @@ fn run_low_level<'a, 'ctx, 'env>( } } +fn build_foreign_symbol<'a, 'ctx, 'env>( + env: &Env<'a, 'ctx, 'env>, + scope: &Scope<'a, 'ctx>, + foreign: &roc_module::ident::ForeignSymbol, + arguments: &[Symbol], + ret_layout: &Layout<'a>, +) -> BasicValueEnum<'ctx> { + let mut arg_vals: Vec = Vec::with_capacity_in(arguments.len(), env.arena); + + let mut arg_types = Vec::with_capacity_in(arguments.len() + 1, env.arena); + + // crude approximation of the C calling convention + let pass_result_by_pointer = ret_layout.stack_size(env.ptr_bytes) > 2 * env.ptr_bytes; + + if pass_result_by_pointer { + // the return value is too big to pass through a register, so the caller must + // allocate space for it on its stack, and provide a pointer to write the result into + let ret_type = basic_type_from_layout(env.arena, env.context, ret_layout, env.ptr_bytes); + + let ret_ptr_type = get_ptr_type(&ret_type, AddressSpace::Generic); + + let ret_ptr = env.builder.build_alloca(ret_type, "return_value"); + + arg_vals.push(ret_ptr.into()); + arg_types.push(ret_ptr_type.into()); + + for arg in arguments.iter() { + let (value, layout) = load_symbol_and_layout(env, scope, arg); + arg_vals.push(value); + let arg_type = basic_type_from_layout(env.arena, env.context, layout, env.ptr_bytes); + arg_types.push(arg_type); + } + + let function_type = env.context.void_type().fn_type(&arg_types, false); + let function = get_foreign_symbol(env, foreign.clone(), function_type); + + let call = env.builder.build_call(function, arg_vals.as_slice(), "tmp"); + + // this is a foreign function, use c calling convention + call.set_call_convention(C_CALL_CONV); + + call.try_as_basic_value(); + + env.builder.build_load(ret_ptr, "read_result") + } else { + for arg in arguments.iter() { + let (value, layout) = load_symbol_and_layout(env, scope, arg); + arg_vals.push(value); + let arg_type = basic_type_from_layout(env.arena, env.context, layout, env.ptr_bytes); + arg_types.push(arg_type); + } + + let ret_type = basic_type_from_layout(env.arena, env.context, ret_layout, env.ptr_bytes); + let function_type = get_fn_type(&ret_type, &arg_types); + let function = get_foreign_symbol(env, foreign.clone(), function_type); + + let call = env.builder.build_call(function, arg_vals.as_slice(), "tmp"); + + // this is a foreign function, use c calling convention + call.set_call_convention(C_CALL_CONV); + + call.try_as_basic_value() + .left() + .unwrap_or_else(|| panic!("LLVM error: Invalid call by pointer.")) + } +} + fn maybe_inplace_list<'a, 'ctx, 'env, InPlace, CloneFirst, Empty>( env: &Env<'a, 'ctx, 'env>, parent: FunctionValue<'ctx>, diff --git a/examples/effect/NQueens.roc b/examples/effect/NQueens.roc new file mode 100644 index 0000000000..67c327131a --- /dev/null +++ b/examples/effect/NQueens.roc @@ -0,0 +1,54 @@ +app "effect-example" + packages { base: "thing/platform-dir" } + imports [base.Task] + provides [ main ] to base + +main : Task.Task {} [] +main = + queens 10 + |> Str.fromInt + |> Task.putLine + +ConsList a : [ Nil, Cons a (ConsList a) ] + +queens = \n -> length (findSolutions n n) + + +length : ConsList a -> I64 +length = \xs -> lengthHelp xs 0 + +lengthHelp : ConsList a, I64 -> I64 +lengthHelp = \xs, acc -> + when xs is + Nil -> acc + Cons _ rest -> lengthHelp rest (1 + acc) + +safe : I64, I64, ConsList I64 -> Bool +safe = \queen, diagonal, xs -> + when xs is + Nil -> + True + + Cons q t -> + queen != q && queen != q + diagonal && queen != q - diagonal && safe queen (diagonal + 1) t + +appendSafe : I64, ConsList I64, ConsList (ConsList I64) -> ConsList (ConsList I64) +appendSafe = \k, soln, solns -> + if k <= 0 then + solns + else if safe k 1 soln then + appendSafe (k - 1) soln (Cons (Cons k soln) solns) + else + appendSafe (k - 1) soln solns + +extend = \n, acc, solns -> + when solns is + Nil -> acc + Cons soln rest -> extend n (appendSafe n soln acc) rest + +findSolutions = \n, k -> + if k == 0 then + Cons Nil Nil + + else + extend n Nil (findSolutions n (k - 1)) diff --git a/examples/effect/thing/platform-dir/src/lib.rs b/examples/effect/thing/platform-dir/src/lib.rs index 0f753acdb4..3c3f90a089 100644 --- a/examples/effect/thing/platform-dir/src/lib.rs +++ b/examples/effect/thing/platform-dir/src/lib.rs @@ -52,7 +52,7 @@ pub fn roc_fx_getLine() -> RocStr { let stdin = io::stdin(); let line1 = stdin.lock().lines().next().unwrap().unwrap(); - RocStr::from_slice_with_capacity(line1.as_bytes(), line1.len()) + RocStr::from_slice(line1.as_bytes()) } unsafe fn call_the_closure(function_pointer: *const u8, closure_data_ptr: *const u8) -> i64 {