diff --git a/compiler/can/src/expr.rs b/compiler/can/src/expr.rs index c69eff20f0..81a9e4d747 100644 --- a/compiler/can/src/expr.rs +++ b/compiler/can/src/expr.rs @@ -688,7 +688,7 @@ fn canonicalize_when_branch<'a>( env: &mut Env<'a>, var_store: &VarStore, scope: &mut Scope, - region: Region, + _region: Region, branch: &'a ast::WhenBranch<'a>, output: &mut Output, ) -> (WhenBranch, References) { @@ -721,7 +721,7 @@ fn canonicalize_when_branch<'a>( None => None, Some(loc_expr) => { let (can_guard, guard_branch_output) = - canonicalize_expr(env, var_store, &mut scope, region, &loc_expr.value); + canonicalize_expr(env, var_store, &mut scope, loc_expr.region, &loc_expr.value); branch_output.union(guard_branch_output); Some(can_guard) diff --git a/compiler/constrain/src/expr.rs b/compiler/constrain/src/expr.rs index cbce2021ce..79a8e6c3be 100644 --- a/compiler/constrain/src/expr.rs +++ b/compiler/constrain/src/expr.rs @@ -181,9 +181,10 @@ pub fn constrain_expr( region, ); - cons.push(con); - cons.push(fields_con); - cons.push(record_con); + // ensure constraints are solved in this order, gives better errors + cons.insert(0, fields_con); + cons.insert(1, con); + cons.insert(2, record_con); exists(vars, And(cons)) } @@ -202,9 +203,12 @@ pub fn constrain_expr( let list_elem_type = Type::Variable(*elem_var); let mut constraints = Vec::with_capacity(1 + loc_elems.len()); - for loc_elem in loc_elems { - let elem_expected = - ForReason(Reason::ElemInList, list_elem_type.clone(), region); + for (index, loc_elem) in loc_elems.iter().enumerate() { + let elem_expected = ForReason( + Reason::ElemInList { index }, + list_elem_type.clone(), + loc_elem.region, + ); let constraint = constrain_expr(env, loc_elem.region, &loc_elem.value, elem_expected); @@ -539,7 +543,11 @@ pub fn constrain_expr( cond_type.clone(), region, ), - ForReason(Reason::WhenBranch { index }, branch_type.clone(), region), + ForReason( + Reason::WhenBranch { index }, + branch_type.clone(), + when_branch.value.region, + ), ); branch_cons.push(branch_con); diff --git a/compiler/constrain/src/uniq.rs b/compiler/constrain/src/uniq.rs index 38bdf328ab..c91d9e8673 100644 --- a/compiler/constrain/src/uniq.rs +++ b/compiler/constrain/src/uniq.rs @@ -596,9 +596,12 @@ pub fn constrain_expr( let entry_type = Type::Variable(*elem_var); let mut constraints = Vec::with_capacity(1 + loc_elems.len()); - for loc_elem in loc_elems.iter() { - let elem_expected = - Expected::ForReason(Reason::ElemInList, entry_type.clone(), region); + for (index, loc_elem) in loc_elems.iter().enumerate() { + let elem_expected = Expected::ForReason( + Reason::ElemInList { index }, + entry_type.clone(), + region, + ); let constraint = constrain_expr( env, var_store, diff --git a/compiler/reporting/src/report.rs b/compiler/reporting/src/report.rs index dcb9df97b4..493f6d3651 100644 --- a/compiler/reporting/src/report.rs +++ b/compiler/reporting/src/report.rs @@ -14,6 +14,7 @@ use ven_pretty::{BoxAllocator, DocAllocator, DocBuilder, Render, RenderAnnotated /// A textual report. pub struct Report { + pub title: String, pub filename: PathBuf, pub text: ReportText, } @@ -128,6 +129,7 @@ pub fn can_problem(filename: PathBuf, problem: Problem) -> Report { }; Report { + title: "SYNTAX PROBLEM".to_string(), filename, text: Concat(texts), } @@ -327,11 +329,11 @@ where Url => { self.write_str("<")?; } - GlobalTag | PrivateTag | RecordField | Keyword => { + GlobalTag | PrivateTag | Keyword => { self.write_str("`")?; } CodeBlock | PlainText | LineNumber | Error | GutterBar | TypeVariable | Alias - | Module | Structure | Symbol | BinOp => {} + | RecordField | Module | Structure | Symbol | BinOp => {} } self.style_stack.push(*annotation); Ok(()) @@ -349,11 +351,11 @@ where Url => { self.write_str(">")?; } - GlobalTag | PrivateTag | RecordField | Keyword => { + GlobalTag | PrivateTag | Keyword => { self.write_str("`")?; } CodeBlock | PlainText | LineNumber | Error | GutterBar | TypeVariable | Alias - | Module | Structure | Symbol | BinOp => {} + | RecordField | Module | Structure | Symbol | BinOp => {} }, } Ok(()) diff --git a/compiler/reporting/src/type_error.rs b/compiler/reporting/src/type_error.rs index 8675e6e9a5..fc1e30fa87 100644 --- a/compiler/reporting/src/type_error.rs +++ b/compiler/reporting/src/type_error.rs @@ -74,6 +74,7 @@ fn report_mismatch( ]; Report { + title: "TYPE MISMATCH".to_string(), filename, text: Concat(lines), } @@ -104,6 +105,7 @@ fn report_bad_type( ]; Report { + title: "TYPE MISMATCH".to_string(), filename, text: Concat(lines), } @@ -119,8 +121,8 @@ fn to_expr_report( use ReportText::*; match expected { - Expected::NoExpectation(_expected_type) => todo!(), - Expected::FromAnnotation(_name, _arity, _sub_context, _expected_type) => todo!(), + Expected::NoExpectation(expected_type) => todo!("hit no expectation with type {:?}", expected_type), + Expected::FromAnnotation(_name, _arity, _sub_context, _expected_type) => todo!("hit from annotation {:?} {:?}",_sub_context, _expected_type ), Expected::ForReason(reason, expected_type, region) => match reason { Reason::IfCondition => { let problem = Concat(vec![ @@ -159,6 +161,36 @@ fn to_expr_report( // they don't know. ("Wait, what's truthiness?") ) } + Reason::WhenGuard => { + let problem = Concat(vec![ + plain_text("This "), + keyword_text("if"), + plain_text(" guard condition needs to be a "), + ReportText::Type(Content::Alias(Symbol::BOOL_BOOL, vec![], Variable::BOOL)), + plain_text("."), + ]); + report_bad_type( + filename, + &category, + found, + expected_type, + region, + Some(expr_region), + problem, + plain_text("Right now it’s"), + Concat(vec![ + plain_text("but I need every "), + keyword_text("if"), + plain_text(" guard condition to evaluate to a "), + ReportText::Type(Content::Alias(Symbol::BOOL_BOOL, vec![], Variable::BOOL)), + plain_text("—either "), + global_tag_text("True"), + plain_text(" or "), + global_tag_text("False"), + plain_text("."), + ]), + ) + } Reason::IfBranch { index, total_branches, @@ -211,11 +243,96 @@ fn to_expr_report( )), plain_text(&format!("The {} branch is", ith)), plain_text("but all the previous branches have the type"), - plain_text("instead."), + Concat(vec![ + plain_text("instead. I need all branches in an "), + keyword_text("if"), + plain_text(" to have the same type!"), + ]), ) } }, - _ => todo!(), + Reason::WhenBranch { index } => { + // NOTE: is 0-based + + let ith = int_to_ordinal(index + 1); + + report_mismatch( + filename, + &category, + found, + expected_type, + region, + Some(expr_region), + Concat(vec![ + plain_text(&format!("The {} branch of this ", ith)), + keyword_text("when"), + plain_text(" does not match all the previous branches"), + ]), + plain_text(&format!("The {} branch is", ith)), + plain_text("but all the previous branches have type"), + Concat(vec![ + plain_text("instead. I need all branches of a "), + keyword_text("when"), + plain_text(" to have the same type!"), + ]), + ) + } + Reason::ElemInList { index } => { + // NOTE: is 0-based + + let ith = int_to_ordinal(index + 1); + + report_mismatch( + filename, + &category, + found, + expected_type, + region, + Some(expr_region), + plain_text(&format!( + "The {} element of this list does not match all the previous elements", + ith + )), + plain_text(&format!("The {} element is", ith)), + plain_text("but all the previous elements in the list have type"), + plain_text("instead. I need all elements of a list to have the same type!"), + ) + } + Reason::RecordUpdateValue(field) => report_mismatch( + filename, + &category, + found, + expected_type, + region, + Some(expr_region), + Concat(vec![ + plain_text("I cannot update the "), + record_field_text(field.as_str()), + plain_text(" field like this"), + ]), + Concat(vec![ + plain_text("You are trying to update "), + record_field_text(field.as_str()), + plain_text(" to be"), + ]), + plain_text("But it should be"), + plain_text("instead. Record update syntax does not allow you to change the type of fields. You can achieve that with record literal syntax."), + ), + other => { + // AnonymousFnArg { arg_index: u8 }, + // NamedFnArg(String /* function name */, u8 /* arg index */), + // AnonymousFnCall { arity: u8 }, + // NamedFnCall(String /* function name */, u8 /* arity */), + // BinOpArg(BinOp, ArgSide), + // BinOpRet(BinOp), + // FloatLiteral, + // IntLiteral, + // NumLiteral, + // InterpolatedStringVar, + // RecordUpdateValue(Lowercase), + // RecordUpdateKeys(Symbol, SendMap), + todo!("I don't have a message yet for reason {:?}", other) + } }, } } @@ -300,10 +417,10 @@ fn add_category(this_is: ReportText, category: &Category) -> ReportText { plain_text("expression produces"), ]), - List => Concat(vec![this_is, plain_text("a list of type")]), - Num => Concat(vec![this_is, plain_text("a number of type")]), - Int => Concat(vec![this_is, plain_text("an integer of type")]), - Float => Concat(vec![this_is, plain_text("a float of type")]), + List => Concat(vec![this_is, plain_text(" a list of type")]), + Num => Concat(vec![this_is, plain_text(" a number of type")]), + Int => Concat(vec![this_is, plain_text(" an integer of type")]), + Float => Concat(vec![this_is, plain_text(" a float of type")]), Str => Concat(vec![this_is, plain_text(" a string of type")]), Lambda => Concat(vec![this_is, plain_text("an anonymous function of type")]), @@ -319,7 +436,7 @@ fn add_category(this_is: ReportText, category: &Category) -> ReportText { plain_text(" private tag application produces"), ]), - Record => Concat(vec![this_is, plain_text("a record of type")]), + Record => Concat(vec![this_is, plain_text(" a record of type")]), Accessor(field) => Concat(vec![ plain_text("This "), @@ -378,6 +495,7 @@ fn to_circular_report( ]; Report { + title: "TYPE MISMATCH".to_string(), filename, text: Concat(lines), } diff --git a/compiler/reporting/tests/test_reporting.rs b/compiler/reporting/tests/test_reporting.rs index d8147653c2..00926c1381 100644 --- a/compiler/reporting/tests/test_reporting.rs +++ b/compiler/reporting/tests/test_reporting.rs @@ -37,6 +37,7 @@ mod test_reporting { // use roc_problem::can; fn to_simple_report(text: ReportText) -> Report { Report { + title: "SYNTAX PROBLEM".to_string(), text: text, filename: filename_from_string(r"\code\proj\Main.roc"), } @@ -826,6 +827,33 @@ mod test_reporting { ) } + #[test] + fn when_if_guard() { + report_problem_as( + indoc!( + r#" + when 1 is + 2 if 1 -> 0x0 + _ -> 0x1 + "# + ), + indoc!( + r#" + This `if` guard condition needs to be a Bool. + + 2 ┆ 2 if 1 -> 0x0 + ┆ ^ + + Right now it’s a number of type + + Num a + + but I need every `if` guard condition to evaluate to a Bool—either `True` or `False`. + "# + ), + ) + } + #[test] fn if_2_branch_mismatch() { report_problem_as( @@ -885,6 +913,160 @@ mod test_reporting { // ) // } + #[test] + fn when_branch_mismatch() { + report_problem_as( + indoc!( + r#" + when 1 is + 2 -> "foo" + 3 -> {} + "# + ), + indoc!( + r#" + The 2nd branch of this `when` does not match all the previous branches + + 3 ┆ 3 -> {} + ┆ ^^ + + The 2nd branch is a record of type + + {} + + but all the previous branches have type + + Str + + instead. I need all branches of a `when` to have the same type! + "# + ), + ) + } + + #[test] + fn elem_in_list() { + report_problem_as( + indoc!( + r#" + [ 1, 3, "foo" ] + "# + ), + indoc!( + r#" + The 3rd element of this list does not match all the previous elements + + 1 ┆ [ 1, 3, "foo" ] + ┆ ^^^^^ + + The 3rd element is a string of type + + Str + + but all the previous elements in the list have type + + Num a + + instead. I need all elements of a list to have the same type! + "# + ), + ) + } + + #[test] + fn record_update_value() { + report_problem_as( + indoc!( + r#" + x : { foo : {} } + x = { foo: {} } + + { x & foo: "bar" } + "# + ), + indoc!( + r#" + I cannot update the .foo field like this + + 4 ┆ { x & foo: "bar" } + ┆ ^^^^^^^^^^^^^^^^^^ + + You are trying to update .foo to be a string of type + + Str + + But it should be + + {} + + instead. Record update syntax does not allow you to change the type of fields. You can achieve that with record literal syntax. + "# + ), + ) + } + + // needs a bit more infrastructure re. diffing records + // #[test] + // fn record_update_keys() { + // report_problem_as( + // indoc!( + // r#" + // x : { foo : {} } + // x = { foo: {} } + // + // { x & baz: "bar" } + // "# + // ), + // indoc!( + // r#" + // The `x` record does not have a `baz` field + // + // 4 ┆ { x & baz: "bar" } + // ┆ ^^^ + // + // This is usually a typo. Here are the `x` fields that are most similar + // + // { foo : {} + // } + // + // So maybe `baz` should be `foo`? + // "# + // ), + // ) + // } + + // #[test] + // fn num_literal() { + // report_problem_as( + // indoc!( + // r#" + // x : Str + // x = 4 + // + // x + // "# + // ), + // indoc!( + // r#" + // Something is off with the body of the `x` definition + // + // 4 ┆ x = 4 + // ┆ ^ + // + // The body is a number of type + // + // Num a + // + // But the type annotation on `x` says that it should be + // + // Str + // + // instead. + // "# + // ), + // ) + // } + #[test] fn circular_type() { report_problem_as( diff --git a/compiler/types/src/types.rs b/compiler/types/src/types.rs index 3ee5bad08c..3c6a892d94 100644 --- a/compiler/types/src/types.rs +++ b/compiler/types/src/types.rs @@ -628,7 +628,7 @@ pub enum Reason { WhenGuard, IfCondition, IfBranch { index: usize, total_branches: usize }, - ElemInList, + ElemInList { index: usize }, RecordUpdateValue(Lowercase), RecordUpdateKeys(Symbol, SendMap), } diff --git a/examples/hello-world/host b/examples/hello-world/host deleted file mode 100755 index 16cb34082a..0000000000 Binary files a/examples/hello-world/host and /dev/null differ diff --git a/examples/hello-world/host.rs b/examples/hello-world/host.rs index ce620637d0..3a63194779 100644 --- a/examples/hello-world/host.rs +++ b/examples/hello-world/host.rs @@ -1,7 +1,7 @@ use std::ffi::CStr; use std::os::raw::c_char; -#[link(name = "hello_from_roc")] +#[link(name = "app_main")] extern "C" { #[link_name = "$Test.main"] fn str_from_roc() -> *const c_char; diff --git a/examples/quicksort/.gitignore b/examples/quicksort/.gitignore new file mode 100644 index 0000000000..54f8a7bb8e --- /dev/null +++ b/examples/quicksort/.gitignore @@ -0,0 +1,3 @@ +qs +*.o +*.so diff --git a/examples/quicksort/README.md b/examples/quicksort/README.md new file mode 100644 index 0000000000..748032c9fe --- /dev/null +++ b/examples/quicksort/README.md @@ -0,0 +1,234 @@ +# Quicksort + +Right now, there is only one way to build Roc programs: the Rube Goldberg Build Process. +(In the future, it will be nicer. At the moment, the nicer build system exists only +in our imaginations...so Rube Goldberg it is!) + +*NOTE:* On macOS or Linux, you can run `sudo ./build.sh` from this directory instead of following these instructions. + +## Ingredients + +1. A host. For this example, our host is implemented in the file `host.rs`. +2. A Roc function. For this example, we'll use a function which returns a list of integers. +3. Having `gcc` installed. This will not be necessary in the future, but the Rube Goldberg build process needs it. + +## Steps + +1. `cd` into `examples/hello-world/` +2. Run `cargo run hello.roc` to compile the Roc source code into a `hello.o` file. +3. Run `gcc -shared hello.o -o libroc_qs_main.so` to generate `libroc_qs_main.so`. (This filename must begin with `lib` and end in `.so` or else `host.rs` won't be able to find it!) +4. Move `libroc_qs_main.so` onto the system library path, e.g. with `sudo mv libroc_qs_main.so /usr/local/lib/` on macOS, or `sudo mv libroc_qs_main.so /usr/local/lib /usr/lib` on Linux. +5. Run `rustc host.rs -o qs` to generate the `qs` executable. +6. Run `./qs` to see the output! + +To run in release mode instead, do: + +```bash +cargo run --release hello.roc +``` + +## Design Notes + +This demonstrates the basic design of hosts: Roc code gets compiled into a pure +function (in this case, a thunk that always returns `"Hello, World!"`) and +then the host calls that function. Fundamentally, that's the whole idea! The host +might not even have a `main` - it could be a library, a plugin, anything. +Everything else is built on this basic "hosts calling linked pure functions" design. + +For example, things get more interesting when the compiled Roc function returns +a `Task` - that is, a tagged union data structure containing function pointers +to callback closures. This lets the Roc pure function describe arbitrary +chainable effects, which the host can interpret to perform I/O as requested by +the Roc program. (The tagged union `Task` would have a variant for each supported +I/O operation.) + +In this trivial example, it's very easy to line up the API between the host and +the Roc program. In a more involved host, this would be much trickier - especially +if the API were changing frequently during development. + +The idea there is to have a first-class concept of "glue code" which host authors +can write (it would be plain Roc code, but with some extra keywords that aren't +available in normal modules - kinda like `port module` in Elm), and which +describe both the Roc-host/C boundary as well as the Roc-host/Roc-app boundary. +Roc application authors only care about the Roc-host/Roc-app portion, and the +host author only cares about the Roc-host/C bounary when implementing the host. + +Using this glue code, the Roc compiler can generate C header files describing the +boundary. This not only gets us host compatibility with C compilers, but also +Rust FFI for free, because [`rust-bindgen`](https://github.com/rust-lang/rust-bindgen) +generates correct Rust FFI bindings from C headers. + +The whole "calling gcc and rustc" part of the current build process is obviously +not something Roc application authors should ever need to do. Rather, the idea +would be to have the host precompiled into an object file (eliminating the +need for Roc authors to run `rustc` in this example) and for the Roc compiler +to not only generate the object file for the Roc file, but also to link it with +the host object file to produce an executable (eliminating the need for `gcc`) +such that Roc application authors can concern themselves exclusively with Roc code +and need only the Roc compiler to build and to execute it. + +Of course, none of those niceties exist yet. But we'll get there! + +## The test that builds things + +```rust +let src = indoc!( + r#" + "Hello, World!" + "# +); + +// Build the expr +let arena = Bump::new(); +let (loc_expr, _output, _problems, subs, var, constraint, home, interns) = uniq_expr(src); + +let mut unify_problems = Vec::new(); +let (content, mut subs) = infer_expr(subs, &mut unify_problems, &constraint, var); + +let context = Context::create(); +let module = context.create_module("app"); +let builder = context.create_builder(); +let fpm = PassManager::create(&module); + +roc_gen::llvm::build::add_passes(&fpm); + +fpm.initialize(); + +// Compute main_fn_type before moving subs to Env +let layout = Layout::from_content(&arena, content, &subs, crate::helpers::eval::POINTER_SIZE) +.unwrap_or_else(|err| panic!("Code gen error in test: could not convert to layout. Err was {:?} and Subs were {:?}", err, subs)); + +let execution_engine = module + .create_jit_execution_engine(OptimizationLevel::None) + .expect("Error creating JIT execution engine for test"); + +let ptr_bytes = execution_engine + .get_target_data() + .get_pointer_byte_size(None); +let main_fn_type = + basic_type_from_layout(&arena, &context, &layout, ptr_bytes).fn_type(&[], false); +let main_fn_name = "$Test.main"; + +// Compile and add all the Procs before adding main +let mut env = roc_gen::llvm::build::Env { + arena: &arena, + builder: &builder, + context: &context, + interns, + module: arena.alloc(module), + ptr_bytes, +}; +let mut procs = Procs::default(); +let mut ident_ids = env.interns.all_ident_ids.remove(&home).unwrap(); + +// Populate Procs and get the low-level Expr from the canonical Expr +let main_body = Expr::new( + &arena, + &mut subs, + loc_expr.value, + &mut procs, + home, + &mut ident_ids, + crate::helpers::eval::POINTER_SIZE, +); + +// Put this module's ident_ids back in the interns, so we can use them in env. +env.interns.all_ident_ids.insert(home, ident_ids); + +let mut headers = Vec::with_capacity(procs.len()); + +// 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, opt_proc) in procs.as_map().into_iter() { + if let Some(proc) = opt_proc { + let (fn_val, arg_basic_types) = build_proc_header(&env, symbol, &proc); + + headers.push((proc, fn_val, arg_basic_types)); + } +} + +// Build each proc using its header info. +for (proc, fn_val, arg_basic_types) in headers { + // NOTE: This is here to be uncommented in case verification fails. + // (This approach means we don't have to defensively clone name here.) + // + // println!("\n\nBuilding and then verifying function {}\n\n", name); + build_proc(&env, proc, &procs, fn_val, arg_basic_types); + + if fn_val.verify(true) { + fpm.run_on(&fn_val); + } else { + // NOTE: If this fails, uncomment the above println to debug. + panic!("Non-main function failed LLVM verification. Uncomment the above println to debug!"); + } +} + +// Add main to the module. +let main_fn = env.module.add_function(main_fn_name, main_fn_type, None); + +main_fn.set_call_conventions(crate::helpers::eval::MAIN_CALLING_CONVENTION); +main_fn.set_linkage(Linkage::External); + +// Add main's body +let basic_block = context.append_basic_block(main_fn, "entry"); + +builder.position_at_end(basic_block); + +let ret = roc_gen::llvm::build::build_expr( + &env, + &ImMap::default(), + main_fn, + &main_body, + &mut Procs::default(), +); + +builder.build_return(Some(&ret)); + +// Uncomment this to see the module's un-optimized LLVM instruction output: +// env.module.print_to_stderr(); + +if main_fn.verify(true) { + fpm.run_on(&main_fn); +} else { + panic!("Function {} failed LLVM verification.", main_fn_name); +} + +// Verify the module +if let Err(errors) = env.module.verify() { + panic!("Errors defining module: {:?}", errors); +} + +// Uncomment this to see the module's optimized LLVM instruction output: +// env.module.print_to_stderr(); + +// Emit +Target::initialize_x86(&InitializationConfig::default()); + +let opt = OptimizationLevel::Default; +let reloc = RelocMode::Default; +let model = CodeModel::Default; +let target = Target::from_name("x86-64").unwrap(); +let target_machine = target + .create_target_machine( + &TargetTriple::create("x86_64-pc-linux-gnu"), + "x86-64", + "+avx2", + opt, + reloc, + model, + ) + .unwrap(); + +let path = Path::new("../../hello.o"); + +assert!(target_machine + .write_to_file(&env.module, FileType::Object, &path) + .is_ok()); + +let path = Path::new("../../hello.asm"); + +assert!(target_machine + .write_to_file(&env.module, FileType::Assembly, &path) + .is_ok()); +``` diff --git a/examples/quicksort/build.sh b/examples/quicksort/build.sh new file mode 100755 index 0000000000..3d895afe33 --- /dev/null +++ b/examples/quicksort/build.sh @@ -0,0 +1,18 @@ +#!/bin/bash +set -Eeuo pipefail + +cargo run qs.roc +gcc -shared qs.o -o libroc_qs_main.so + +# Move it to a different place depending on Linux vs macOS +unameVal="$(uname -s)" + +case "${unameVal}" in + Linux*) sudo mv libroc_qs_main.so /usr/lib/;; + Darwin*) sudo mv libroc_qs_main.so /usr/local/lib/;; + *) echo "build.sh does not support this operating system!" exit 1; +esac + +rustc host.rs -o qs + +./qs diff --git a/examples/quicksort/host.rs b/examples/quicksort/host.rs new file mode 100644 index 0000000000..1f7f5886db --- /dev/null +++ b/examples/quicksort/host.rs @@ -0,0 +1,12 @@ +#[link(name = "roc_qs_main")] +extern "C" { + #[allow(improper_ctypes)] + #[link_name = "$Test.main"] + fn list_from_roc() -> Box<[i64]>; +} + +pub fn main() { + let list = unsafe { list_from_roc() }; + + println!("Roc quicksort says: {:?}", list); +} diff --git a/examples/quicksort/qs.roc b/examples/quicksort/qs.roc new file mode 100644 index 0000000000..96798ecdbd --- /dev/null +++ b/examples/quicksort/qs.roc @@ -0,0 +1,47 @@ +quicksort : List (Num a), Int, Int -> List (Num a) +quicksort = \list, low, high -> + when partition low high list is + Pair partitionIndex partitioned -> + partitioned + |> quicksort low (partitionIndex - 1) + |> quicksort (partitionIndex + 1) high + + +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 -> + go = \i, j, list -> + if j < high then + when List.get list j is + Ok value -> + if value <= pivot then + go (i + 1) (j + 1) (swap (i + 1) j list) + else + go i (j + 1) list + + Err _ -> + Pair i list + else + Pair i list + + when go (low - 1) low initialList is + Pair newI newList -> + Pair (newI + 1) (swap (newI + 1) high newList) + + Err _ -> + Pair (low - 1) initialList + +quicksort [ 7, 4, 9 ]