Merge pull request #899 from rtfeldman/nqueens

Nqueens

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,
-        } => {
+        } => build_foreign_symbol(env, scope, foreign, arguments, ret_layout),
-            let mut arg_vals: Vec<BasicValueEnum> =
-                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."))
-            }
-        }
     }
 }
 
@@ -1696,8 +1632,13 @@ pub fn build_exp_stmt<'a, 'ctx, 'env>(
                     fail,
                 )
             }
-            _ => {
+            CallType::Foreign {
-                todo!()
+                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<BasicValueEnum> = 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>,

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))

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 {