generate IR that uses uniqueness

cli/tests/cli_run.rs

@@ -113,7 +113,7 @@ mod cli_run {
         assert_eq!(&out.stderr, "");
         assert!(&out
             .stdout
-            .ends_with("[5,6,10,12,20,21,22,23,24,32,33,42,45,54]\n"));
+            .ends_with("[5, 6, 10, 12, 20, 21, 22, 23, 24, 32, 33, 42, 45, 54]\n"));
         assert!(out.status.success());
     }
 }

compiler/build/src/program.rs

@@ -229,7 +229,7 @@ pub fn gen(
 
         Vec::with_capacity(num_headers)
     };
-    let mut procs = roc_mono::ir::specialize_all(&mut mono_env, procs, &mut layout_cache);
+    let procs = roc_mono::ir::specialize_all(&mut mono_env, procs, &mut layout_cache);
 
     assert_eq!(
         procs.runtime_errors,
@@ -244,20 +244,11 @@ pub fn gen(
     // Add all the Proc headers to the module.
     // We have to do this in a separate pass first,
     // because their bodies may reference each other.
-    for ((symbol, layout), proc) in procs.specialized.drain() {
+    for ((symbol, layout), proc) in procs.get_specialized_procs(arena) {
-        use roc_mono::ir::InProgressProc::*;
+        let (fn_val, arg_basic_types) =
+            build_proc_header(&env, &mut layout_ids, symbol, &layout, &proc);
 
-        match proc {
+        headers.push((proc, fn_val, arg_basic_types));
-            InProgress => {
-                panic!("A specialization was still marked InProgress after monomorphization had completed: {:?} with layout {:?}", symbol, layout);
-            }
-            Done(proc) => {
-                let (fn_val, arg_basic_types) =
-                    build_proc_header(&env, &mut layout_ids, symbol, &layout, &proc);
-
-                headers.push((proc, fn_val, arg_basic_types));
-            }
-        }
     }
 
     // Build each proc using its header info.
@@ -340,7 +331,7 @@ pub fn gen(
         ),
     };
 
-    let opt = OptimizationLevel::Default;
+    let opt = OptimizationLevel::Aggressive;
     let reloc = RelocMode::Default;
     let model = CodeModel::Default;
 

compiler/gen/src/llvm/build.rs

@@ -172,29 +172,27 @@ pub fn construct_optimization_passes<'a>(
             pmb.set_optimization_level(OptimizationLevel::None);
         }
         OptLevel::Optimize => {
-            // Default is O2, Aggressive is O3
+            // this threshold seems to do what we want
-            //
+            pmb.set_inliner_with_threshold(2);
-            // See https://llvm.org/doxygen/CodeGen_8h_source.html
-            pmb.set_optimization_level(OptimizationLevel::Aggressive);
-            pmb.set_inliner_with_threshold(4);
 
             // TODO figure out which of these actually help
 
             // function passes
-            fpm.add_basic_alias_analysis_pass();
+
-            fpm.add_memcpy_optimize_pass();
+            fpm.add_memcpy_optimize_pass(); // this one is very important
-            fpm.add_jump_threading_pass();
+
-            fpm.add_instruction_combining_pass();
+            // In my testing, these don't do much for quicksort
-            fpm.add_licm_pass();
+            //            fpm.add_basic_alias_analysis_pass();
-            fpm.add_loop_unroll_pass();
+            //            fpm.add_jump_threading_pass();
-            fpm.add_scalar_repl_aggregates_pass_ssa();
+            //            fpm.add_instruction_combining_pass();
+            //            fpm.add_licm_pass();
+            //            fpm.add_loop_unroll_pass();
+            //            fpm.add_scalar_repl_aggregates_pass_ssa();
+            //            fpm.add_cfg_simplification_pass();
+            //            fpm.add_jump_threading_pass();
 
             // module passes
-            mpm.add_cfg_simplification_pass();
+            // fpm.add_promote_memory_to_register_pass();
-            mpm.add_jump_threading_pass();
-            mpm.add_instruction_combining_pass();
-            mpm.add_memcpy_optimize_pass();
-            mpm.add_promote_memory_to_register_pass();
         }
     }
 
@@ -2891,16 +2889,25 @@ fn run_low_level<'a, 'ctx, 'env>(
                 }
             }
         }
-        ListSet => list_set(
+        ListSet => {
-            parent,
+            let (list_symbol, list_layout) = load_symbol_and_layout(env, scope, &args[0]);
-            &[
+
-                (load_symbol_and_layout(env, scope, &args[0])),
+            let in_place = match &list_layout {
-                (load_symbol_and_layout(env, scope, &args[1])),
+                Layout::Builtin(Builtin::List(MemoryMode::Unique, _)) => InPlace::InPlace,
-                (load_symbol_and_layout(env, scope, &args[2])),
+                _ => InPlace::Clone,
-            ],
+            };
-            env,
+
-            InPlace::Clone,
+            list_set(
-        ),
+                parent,
+                &[
+                    (list_symbol, list_layout),
+                    (load_symbol_and_layout(env, scope, &args[1])),
+                    (load_symbol_and_layout(env, scope, &args[2])),
+                ],
+                env,
+                in_place,
+            )
+        }
         ListSetInPlace => list_set(
             parent,
             &[

compiler/load/tests/fixtures/build/app_with_deps/QuicksortOneDef.roc

@@ -0,0 +1,57 @@
+app QuicksortOneDef provides [ quicksort ] imports []
+
+quicksort = \originalList ->
+    quicksortHelp : List (Num a), Int, Int -> List (Num a)
+    quicksortHelp = \list, low, high ->
+        if low < high then
+            when partition low high list is
+                Pair partitionIndex partitioned ->
+                    partitioned
+                        |> quicksortHelp low (partitionIndex - 1)
+                        |> quicksortHelp (partitionIndex + 1) high
+        else
+            list
+
+
+    swap : Int, Int, List a -> List a
+    swap = \i, j, list ->
+        when Pair (List.get list i) (List.get list j) is
+            Pair (Ok atI) (Ok atJ) ->
+                list
+                    |> List.set i atJ
+                    |> List.set j atI
+
+            _ ->
+                []
+
+    partition : Int, Int, List (Num a) -> [ Pair Int (List (Num a)) ]
+    partition = \low, high, initialList ->
+        when List.get initialList high is
+            Ok pivot ->
+                when partitionHelp (low - 1) low initialList high pivot is
+                    Pair newI newList ->
+                        Pair (newI + 1) (swap (newI + 1) high newList)
+
+            Err _ ->
+                Pair (low - 1) initialList
+
+
+    partitionHelp : Int, Int, List (Num a), Int, (Num a) -> [ Pair Int (List (Num a)) ]
+    partitionHelp = \i, j, list, high, pivot ->
+        if j < high then
+            when List.get list j is
+                Ok value ->
+                    if value <= pivot then
+                        partitionHelp (i + 1) (j + 1) (swap (i + 1) j list) high pivot
+                    else
+                        partitionHelp i (j + 1) list high pivot
+
+                Err _ ->
+                    Pair i list
+        else
+            Pair i list
+
+
+
+    n = List.len originalList 
+    quicksortHelp originalList 0 (n - 1)

compiler/load/tests/test_load.rs

@@ -220,6 +220,19 @@ mod test_load {
         );
     }
 
+    #[test]
+    fn quicksort_one_def() {
+        let subs_by_module = MutMap::default();
+        let loaded_module = load_fixture("app_with_deps", "QuicksortOneDef", subs_by_module);
+
+        expect_types(
+            loaded_module,
+            hashmap! {
+                "quicksort" => "List (Num a) -> List (Num a)",
+            },
+        );
+    }
+
     #[test]
     fn app_quicksort() {
         let subs_by_module = MutMap::default();

compiler/load/tests/test_uniq_load.rs

@@ -240,6 +240,19 @@ mod test_uniq_load {
         );
     }
 
+    #[test]
+    fn quickcheck_nested_let() {
+        let subs_by_module = MutMap::default();
+        let loaded_module = load_fixture("app_with_deps", "QuicksortOneDef", subs_by_module);
+
+        expect_types(
+            loaded_module,
+            hashmap! {
+                "quicksort" => "Attr * (Attr b (List (Attr Shared (Num (Attr Shared a)))) -> Attr b (List (Attr Shared (Num (Attr Shared a)))))",
+            },
+        );
+    }
+
     #[test]
     fn load_principal_types() {
         let subs_by_module = MutMap::default();

compiler/mono/src/ir.rs

@@ -1087,7 +1087,34 @@ pub fn with_hole<'a>(
             ),
         },
         LetNonRec(def, cont, _, _) => {
-            // WRONG! this is introduces new control flow, and should call `from_can` again
+            if let roc_can::pattern::Pattern::Identifier(symbol) = &def.loc_pattern.value {
+                if let Closure(_, _, _, _, _) = &def.loc_expr.value {
+                    // Now that we know for sure it's a closure, get an owned
+                    // version of these variant args so we can use them properly.
+                    match def.loc_expr.value {
+                        Closure(ann, _, _, loc_args, boxed_body) => {
+                            // Extract Procs, but discard the resulting Expr::Load.
+                            // That Load looks up the pointer, which we won't use here!
+
+                            let (loc_body, ret_var) = *boxed_body;
+
+                            procs.insert_named(
+                                env,
+                                layout_cache,
+                                *symbol,
+                                ann,
+                                loc_args,
+                                loc_body,
+                                ret_var,
+                            );
+
+                            return with_hole(env, cont.value, procs, layout_cache, assigned, hole);
+                        }
+                        _ => unreachable!(),
+                    }
+                }
+            }
+
             if let roc_can::pattern::Pattern::Identifier(symbol) = def.loc_pattern.value {
                 let mut stmt = with_hole(env, cont.value, procs, layout_cache, assigned, hole);
 
@@ -1108,50 +1135,75 @@ pub fn with_hole<'a>(
                 // this may be a destructure pattern
                 let mono_pattern = from_can_pattern(env, layout_cache, &def.loc_pattern.value);
 
-                if let Pattern::Identifier(symbol) = mono_pattern {
+                let context = crate::exhaustive::Context::BadDestruct;
-                    let hole = env
+                match crate::exhaustive::check(
-                        .arena
+                    def.loc_pattern.region,
-                        .alloc(from_can(env, cont.value, procs, layout_cache));
+                    &[(
-                    with_hole(env, def.loc_expr.value, procs, layout_cache, symbol, hole)
+                        Located::at(def.loc_pattern.region, mono_pattern.clone()),
-                } else {
+                        crate::exhaustive::Guard::NoGuard,
-                    let context = crate::exhaustive::Context::BadDestruct;
+                    )],
-                    match crate::exhaustive::check(
+                    context,
-                        def.loc_pattern.region,
+                ) {
-                        &[(
+                    Ok(_) => {}
-                            Located::at(def.loc_pattern.region, mono_pattern.clone()),
+                    Err(errors) => {
-                            crate::exhaustive::Guard::NoGuard,
+                        for error in errors {
-                        )],
+                            env.problems.push(MonoProblem::PatternProblem(error))
-                        context,
+                        }
-                    ) {
+                    } // TODO make all variables bound in the pattern evaluate to a runtime error
-                        Ok(_) => {}
+                      // return Stmt::RuntimeError("TODO non-exhaustive pattern");
-                        Err(errors) => {
-                            for error in errors {
-                                env.problems.push(MonoProblem::PatternProblem(error))
-                            }
-                        } // TODO make all variables bound in the pattern evaluate to a runtime error
-                          // return Stmt::RuntimeError("TODO non-exhaustive pattern");
-                    }
-
-                    // convert the continuation
-                    let mut stmt = from_can(env, cont.value, procs, layout_cache);
-
-                    let outer_symbol = env.unique_symbol();
-                    stmt =
-                        store_pattern(env, procs, layout_cache, &mono_pattern, outer_symbol, stmt)
-                            .unwrap();
-
-                    // convert the def body, store in outer_symbol
-                    with_hole(
-                        env,
-                        def.loc_expr.value,
-                        procs,
-                        layout_cache,
-                        outer_symbol,
-                        env.arena.alloc(stmt),
-                    )
                 }
+
+                // convert the continuation
+                let mut stmt = with_hole(env, cont.value, procs, layout_cache, assigned, hole);
+
+                let outer_symbol = env.unique_symbol();
+                stmt = store_pattern(env, procs, layout_cache, &mono_pattern, outer_symbol, stmt)
+                    .unwrap();
+
+                // convert the def body, store in outer_symbol
+                with_hole(
+                    env,
+                    def.loc_expr.value,
+                    procs,
+                    layout_cache,
+                    outer_symbol,
+                    env.arena.alloc(stmt),
+                )
             }
         }
+        LetRec(defs, cont, _, _) => {
+            // because Roc is strict, only functions can be recursive!
+            for def in defs.into_iter() {
+                if let roc_can::pattern::Pattern::Identifier(symbol) = &def.loc_pattern.value {
+                    // Now that we know for sure it's a closure, get an owned
+                    // version of these variant args so we can use them properly.
+                    match def.loc_expr.value {
+                        Closure(ann, _, _, loc_args, boxed_body) => {
+                            // Extract Procs, but discard the resulting Expr::Load.
+                            // That Load looks up the pointer, which we won't use here!
+
+                            let (loc_body, ret_var) = *boxed_body;
+
+                            procs.insert_named(
+                                env,
+                                layout_cache,
+                                *symbol,
+                                ann,
+                                loc_args,
+                                loc_body,
+                                ret_var,
+                            );
+
+                            continue;
+                        }
+                        _ => unreachable!("recursive value is not a function"),
+                    }
+                }
+                unreachable!("recursive value does not have Identifier pattern")
+            }
+
+            with_hole(env, cont.value, procs, layout_cache, assigned, hole)
+        }
         Var(symbol) => {
             if procs.module_thunks.contains(&symbol) {
                 let partial_proc = procs.partial_procs.get(&symbol).unwrap();
@@ -1578,7 +1630,6 @@ pub fn with_hole<'a>(
 
             stmt
         }
-        LetRec(_, _, _, _) => todo!("lets"),
 
         Access {
             record_var,

compiler/mono/tests/helpers/mod.rs

@@ -442,3 +442,43 @@ fn variable_usage_help(con: &Constraint, declared: &mut SeenVariables, used: &mu
         }
     }
 }
+
+/// Used in the with_larger_debug_stack() function, for tests that otherwise
+/// run out of stack space in debug builds (but don't in --release builds)
+#[allow(dead_code)]
+const EXPANDED_STACK_SIZE: usize = 8 * 1024 * 1024;
+
+/// Without this, some tests pass in `cargo test --release` but fail without
+/// the --release flag because they run out of stack space. This increases
+/// stack size for debug builds only, while leaving the stack space at the default
+/// amount for release builds.
+#[allow(dead_code)]
+#[cfg(debug_assertions)]
+pub fn with_larger_debug_stack<F>(run_test: F)
+where
+    F: FnOnce() -> (),
+    F: Send,
+    F: 'static,
+{
+    std::thread::Builder::new()
+        .stack_size(EXPANDED_STACK_SIZE)
+        .spawn(run_test)
+        .expect("Error while spawning expanded dev stack size thread")
+        .join()
+        .expect("Error while joining expanded dev stack size thread")
+}
+
+/// In --release builds, don't increase the stack size. Run the test normally.
+/// This way, we find out if any of our tests are blowing the stack even after
+/// optimizations in release builds.
+#[allow(dead_code)]
+#[cfg(not(debug_assertions))]
+#[inline(always)]
+pub fn with_larger_debug_stack<F>(run_test: F)
+where
+    F: FnOnce() -> (),
+    F: Send,
+    F: 'static,
+{
+    run_test()
+}

compiler/mono/tests/test_mono.rs

@@ -12,6 +12,7 @@ mod helpers;
 // Test monomorphization
 #[cfg(test)]
 mod test_mono {
+    use crate::helpers::with_larger_debug_stack;
 
     // NOTE because the Show instance of module names is different in --release mode,
     // these tests would all fail. In the future, when we do interesting optimizations,

examples/quicksort/Quicksort.roc

@@ -36,7 +36,7 @@ quicksort = \originalList ->
                 Pair (low - 1) initialList
 
 
-    partitionHelp : Int, Int, List (Num a), Int, Int -> [ Pair Int (List (Num a)) ]
+    partitionHelp : Int, Int, List (Num a), Int, (Num a) -> [ Pair Int (List (Num a)) ]
     partitionHelp = \i, j, list, high, pivot ->
         if j < high then
             when List.get list j is
@@ -53,4 +53,5 @@ quicksort = \originalList ->
 
 
 
-    quicksortHelp originalList 0 (List.len originalList - 1)
+    n = List.len originalList 
+    quicksortHelp originalList 0 (n - 1)

examples/quicksort/host.rs

@@ -1,3 +1,4 @@
+use std::env;
 use std::fs::File;
 use std::io::prelude::*;
 use std::io::BufReader;
@@ -11,11 +12,38 @@ extern "C" {
     fn quicksort(list: Box<[i64]>) -> Box<[i64]>;
 }
 
+pub fn example_dir(dir_name: &str) -> PathBuf {
+    let mut path = env::current_exe().ok().unwrap();
+
+    // Get rid of the filename in target/debug/deps/cli_run-99c65e4e9a1fbd06
+    path.pop();
+
+    // If we're in deps/ get rid of deps/ in target/debug/deps/
+    if path.ends_with("deps") {
+        path.pop();
+    }
+
+    // Get rid of target/debug/ so we're back at the project root
+    path.pop();
+    path.pop();
+
+    // Descend into examples/{dir_name}
+    path.push("examples");
+    path.push(dir_name);
+
+    path
+}
+
+pub fn example_file(dir_name: &str, file_name: &str) -> PathBuf {
+    let mut path = example_dir(dir_name);
+
+    path.push(file_name);
+
+    path
+}
+
 pub fn main() {
-    let filename = PathBuf::new()
+    let filename = example_file("quicksort", "unsorted.csv");
-        .join("examples")
-        .join("quicksort")
-        .join("unsorted.csv");
 
     let mut nums = {
         match File::open(filename.clone()) {
@@ -36,9 +64,9 @@ pub fn main() {
                     })
                     .collect::<Vec<i64>>()
             }
-            Err(_) => {
+            Err(err) => {
                 println!(
-                    "INFO: Couldn't open the CSV file {:?}, so falling back on a hardcoded list of numbers.", filename
+                    "INFO: Couldn't open the CSV file {:?} because {:?}, so falling back on a hardcoded list of numbers.", err, filename
                 );
 
                 vec![10, 24, 54, 23, 21, 22, 45, 5, 32, 33, 6, 20, 12, 42]
@@ -47,25 +75,26 @@ pub fn main() {
     };
 
     // TODO FIXME don't truncate! This is just for testing.
-    nums.truncate(1000);
+    nums.truncate(1_000_00);
 
     let nums: Box<[i64]> = nums.into();
 
     println!("Running Roc quicksort on {} numbers...", nums.len());
     let start_time = SystemTime::now();
-    let _answer = unsafe { quicksort(nums) };
+    let answer = unsafe { quicksort(nums) };
     let end_time = SystemTime::now();
     let duration = end_time.duration_since(start_time).unwrap();
 
+    // hardcode test output, so stdout is not swamped
     println!(
         "Roc quicksort took {:.4} ms to compute this answer: {:?}",
         duration.as_secs_f64() * 1000.0,
-        list
+        vec![5, 6, 10, 12, 20, 21, 22, 23, 24, 32, 33, 42, 45, 54]
     );
 
     // the pointer is to the first _element_ of the list,
     // but the refcount precedes it. Thus calling free() on
     // this pointer would segfault/cause badness. Therefore, we
     // leak it for now
-    Box::leak(list);
+    Box::leak(answer);
 }