From 11ea52731ce9c692a21b729bc53ee597ba866767 Mon Sep 17 00:00:00 2001 From: Folkert Date: Fri, 13 Nov 2020 16:05:14 +0100 Subject: [PATCH 01/18] cleanup --- compiler/mono/src/decision_tree.rs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/compiler/mono/src/decision_tree.rs b/compiler/mono/src/decision_tree.rs index 19de797928..c0f789ef25 100644 --- a/compiler/mono/src/decision_tree.rs +++ b/compiler/mono/src/decision_tree.rs @@ -11,6 +11,7 @@ use roc_module::symbol::Symbol; /// COMPILE CASES type Label = u64; +const RECORD_TAG_NAME: &'static str = "#Record"; /// Users of this module will mainly interact with this function. It takes /// some normal branches and gives out a decision tree that has "labels" at all @@ -189,7 +190,7 @@ fn to_decision_tree(raw_branches: Vec) -> DecisionTree { fn is_complete(tests: &[Test]) -> bool { let length = tests.len(); debug_assert!(length > 0); - match tests.get(length - 1) { + match tests.last() { None => unreachable!("should never happen"), Some(v) => match v { Test::IsCtor { union, .. } => length == union.alternatives.len(), @@ -395,7 +396,7 @@ fn test_at_path<'a>(selected_path: &Path, branch: &Branch<'a>, all_tests: &mut V render_as: RenderAs::Tag, alternatives: vec![Ctor { tag_id: TagId(0), - name: TagName::Global("#Record".into()), + name: TagName::Global(RECORD_TAG_NAME.into()), arity: destructs.len(), }], }; @@ -418,7 +419,7 @@ fn test_at_path<'a>(selected_path: &Path, branch: &Branch<'a>, all_tests: &mut V all_tests.push(IsCtor { tag_id: 0, - tag_name: TagName::Global("#Record".into()), + tag_name: TagName::Global(RECORD_TAG_NAME.into()), union, arguments, }); @@ -538,7 +539,7 @@ fn to_relevant_branch_help<'a>( tag_id, .. } => { - debug_assert!(test_name == &TagName::Global("#Record".into())); + debug_assert!(test_name == &TagName::Global(RECORD_TAG_NAME.into())); let sub_positions = destructs.into_iter().enumerate().map(|(index, destruct)| { let pattern = match destruct.typ { DestructType::Guard(guard) => guard.clone(), From 0c86d09ccfd4918d8da0ab6aaf388a4f9ff3b388 Mon Sep 17 00:00:00 2001 From: Folkert Date: Fri, 13 Nov 2020 17:04:22 +0100 Subject: [PATCH 02/18] refactor Path -> Expr conversion --- compiler/mono/src/decision_tree.rs | 133 +++++++++++++++++------------ 1 file changed, 79 insertions(+), 54 deletions(-) diff --git a/compiler/mono/src/decision_tree.rs b/compiler/mono/src/decision_tree.rs index c0f789ef25..fafb1074c5 100644 --- a/compiler/mono/src/decision_tree.rs +++ b/compiler/mono/src/decision_tree.rs @@ -935,80 +935,105 @@ pub fn optimize_when<'a>( ) } -fn path_to_expr_help<'a>( - env: &mut Env<'a, '_>, - mut symbol: Symbol, - mut path: &Path, - mut layout: Layout<'a>, -) -> (Symbol, StoresVec<'a>, Layout<'a>) { - let mut stores = bumpalo::collections::Vec::new_in(env.arena); +#[derive(Debug)] +struct PathInstruction { + index: u64, + tag_id: u8, +} + +fn reverse_path(mut path: &Path) -> Vec { + let mut result = Vec::new(); loop { match path { - Path::Unbox(unboxed) => { - path = unboxed; + Path::Unbox(nested) => { + path = nested; } Path::Empty => break, - Path::Index { index, tag_id, path: nested, - } => match Wrapped::opt_from_layout(&layout) { - None => { - // this MUST be an index into a single-element (hence unwrapped) record + } => { + result.push(PathInstruction { + index: *index, + tag_id: *tag_id, + }); + path = nested; + } + } + } - debug_assert_eq!(*index, 0); - debug_assert_eq!(*tag_id, 0); - debug_assert_eq!(**nested, Path::Empty); + result.reverse(); - let field_layouts = vec![layout.clone()]; + result +} - debug_assert!(*index < field_layouts.len() as u64); +fn path_to_expr_help<'a>( + env: &mut Env<'a, '_>, + mut symbol: Symbol, + path: &Path, + mut layout: Layout<'a>, +) -> (Symbol, StoresVec<'a>, Layout<'a>) { + let mut stores = bumpalo::collections::Vec::new_in(env.arena); - let inner_layout = field_layouts[*index as usize].clone(); - let inner_expr = Expr::AccessAtIndex { - index: *index, - field_layouts: env.arena.alloc(field_layouts), - structure: symbol, - wrapped: Wrapped::SingleElementRecord, - }; + let instructions = reverse_path(path); + let mut it = instructions.iter().peekable(); - symbol = env.unique_symbol(); - stores.push((symbol, inner_layout.clone(), inner_expr)); + while let Some(PathInstruction { index, tag_id }) = it.next() { + match Wrapped::opt_from_layout(&layout) { + None => { + // this MUST be an index into a single-element (hence unwrapped) record - break; - } - Some(wrapped) => { - let field_layouts = match &layout { - Layout::Union(layouts) | Layout::RecursiveUnion(layouts) => { - layouts[*tag_id as usize].to_vec() - } - Layout::Struct(layouts) => layouts.to_vec(), - other => vec![other.clone()], - }; + debug_assert_eq!(*index, 0); + debug_assert_eq!(*tag_id, 0); + debug_assert!(it.peek().is_none()); - debug_assert!(*index < field_layouts.len() as u64); + let field_layouts = vec![layout.clone()]; - let inner_layout = match &field_layouts[*index as usize] { - Layout::RecursivePointer => layout.clone(), - other => other.clone(), - }; + debug_assert!(*index < field_layouts.len() as u64); - let inner_expr = Expr::AccessAtIndex { - index: *index, - field_layouts: env.arena.alloc(field_layouts), - structure: symbol, - wrapped, - }; + let inner_layout = field_layouts[*index as usize].clone(); + let inner_expr = Expr::AccessAtIndex { + index: *index, + field_layouts: env.arena.alloc(field_layouts), + structure: symbol, + wrapped: Wrapped::SingleElementRecord, + }; - symbol = env.unique_symbol(); - stores.push((symbol, inner_layout.clone(), inner_expr)); + symbol = env.unique_symbol(); + stores.push((symbol, inner_layout.clone(), inner_expr)); - layout = inner_layout; - path = nested; - } - }, + break; + } + Some(wrapped) => { + let field_layouts = match &layout { + Layout::Union(layouts) | Layout::RecursiveUnion(layouts) => { + layouts[*tag_id as usize] + } + Layout::Struct(layouts) => layouts, + other => env.arena.alloc([other.clone()]), + }; + + debug_assert!(*index < field_layouts.len() as u64); + + let inner_layout = match &field_layouts[*index as usize] { + Layout::RecursivePointer => layout.clone(), + other => other.clone(), + }; + + let inner_expr = Expr::AccessAtIndex { + index: *index, + field_layouts, + structure: symbol, + wrapped, + }; + + symbol = env.unique_symbol(); + stores.push((symbol, inner_layout.clone(), inner_expr)); + + layout = inner_layout; + } } } From 490f50deb2f8aad74cc623da90e4977f42d7c152 Mon Sep 17 00:00:00 2001 From: Folkert Date: Fri, 13 Nov 2020 21:37:36 +0100 Subject: [PATCH 03/18] WIP --- compiler/mono/src/decision_tree.rs | 192 ++++++++++++++++------------- 1 file changed, 107 insertions(+), 85 deletions(-) diff --git a/compiler/mono/src/decision_tree.rs b/compiler/mono/src/decision_tree.rs index fafb1074c5..7d9853c523 100644 --- a/compiler/mono/src/decision_tree.rs +++ b/compiler/mono/src/decision_tree.rs @@ -1169,6 +1169,98 @@ fn test_to_equality<'a>( } } +fn stores_and_condition<'a>( + env: &mut Env<'a, '_>, + cond_symbol: Symbol, + cond_layout: &Layout<'a>, + test_chain: Vec<(Path, Test<'a>)>, +) -> ( + std::vec::Vec<( + bumpalo::collections::Vec<'a, (Symbol, Layout<'a>, Expr<'a>)>, + Symbol, + Symbol, + Layout<'a>, + )>, + Option<(Symbol, JoinPointId, Stmt<'a>)>, +) { + let mut tests = Vec::with_capacity(test_chain.len()); + + let mut guard = None; + + // Assumption: there is at most 1 guard, and it is the outer layer. + for (path, test) in test_chain { + match test { + Test::Guarded { + opt_test, + id, + symbol, + stmt, + } => { + if let Some(nested) = opt_test { + tests.push(test_to_equality( + env, + cond_symbol, + &cond_layout, + &path, + *nested, + )); + } + + // let (stores, rhs_symbol) = path_to_expr(env, cond_symbol, &path, &cond_layout); + + guard = Some((symbol, id, stmt)); + } + + _ => tests.push(test_to_equality( + env, + cond_symbol, + &cond_layout, + &path, + test, + )), + } + } + + (tests, guard) +} + +fn compile_guard<'a>( + env: &mut Env<'a, '_>, + ret_layout: Layout<'a>, + id: JoinPointId, + stmt: &'a Stmt<'a>, + fail: &'a Stmt<'a>, + mut cond: Stmt<'a>, +) -> Stmt<'a> { + // the guard is the final thing that we check, so needs to be layered on first! + let test_symbol = env.unique_symbol(); + let arena = env.arena; + + cond = Stmt::Cond { + cond_symbol: test_symbol, + cond_layout: Layout::Builtin(Builtin::Int1), + branching_symbol: test_symbol, + branching_layout: Layout::Builtin(Builtin::Int1), + pass: arena.alloc(cond), + fail, + ret_layout, + }; + + // calculate the guard value + let param = Param { + symbol: test_symbol, + layout: Layout::Builtin(Builtin::Int1), + borrow: false, + }; + + Stmt::Join { + id, + parameters: arena.alloc([param]), + remainder: stmt, + continuation: arena.alloc(cond), + } +} + // TODO procs and layout are currently unused, but potentially required // for defining optional fields? // if not, do remove @@ -1231,55 +1323,11 @@ fn decide_to_branching<'a>( let branching_symbol = env.unique_symbol(); let branching_layout = Layout::Builtin(Builtin::Int1); - let mut cond = Stmt::Cond { - cond_symbol, - cond_layout: cond_layout.clone(), - branching_symbol, - branching_layout, - pass, - fail, - ret_layout, - }; + let mut cond = pass.clone(); let true_symbol = env.unique_symbol(); - let mut tests = Vec::with_capacity(test_chain.len()); - - let mut guard = None; - - // Assumption: there is at most 1 guard, and it is the outer layer. - for (path, test) in test_chain { - match test { - Test::Guarded { - opt_test, - id, - symbol, - stmt, - } => { - if let Some(nested) = opt_test { - tests.push(test_to_equality( - env, - cond_symbol, - &cond_layout, - &path, - *nested, - )); - } - - // let (stores, rhs_symbol) = path_to_expr(env, cond_symbol, &path, &cond_layout); - - guard = Some((symbol, id, stmt)); - } - - _ => tests.push(test_to_equality( - env, - cond_symbol, - &cond_layout, - &path, - test, - )), - } - } + let (tests, guard) = stores_and_condition(env, cond_symbol, &cond_layout, test_chain); let mut current_symbol = branching_symbol; @@ -1297,54 +1345,28 @@ fn decide_to_branching<'a>( // the guard is the final thing that we check, so needs to be layered on first! if let Some((_, id, stmt)) = guard { - let accum = accum_it.next().unwrap(); - let test_symbol = env.unique_symbol(); - - let and_expr = Expr::RunLowLevel(LowLevel::And, arena.alloc([test_symbol, accum])); - - // write to the branching symbol - cond = Stmt::Let( - current_symbol, - and_expr, - Layout::Builtin(Builtin::Int1), - arena.alloc(cond), - ); - - // calculate the guard value - let param = Param { - symbol: test_symbol, - layout: Layout::Builtin(Builtin::Int1), - borrow: false, - }; - cond = Stmt::Join { - id, - parameters: arena.alloc([param]), - remainder: arena.alloc(stmt), - continuation: arena.alloc(cond), - }; - - // load all the variables (the guard might need them); - - current_symbol = accum; + cond = compile_guard(env, ret_layout.clone(), id, arena.alloc(stmt), fail, cond); } for ((new_stores, lhs, rhs, _layout), accum) in tests.into_iter().rev().zip(accum_it) { + // `if test_symbol then cond else false_branch let test_symbol = env.unique_symbol(); + + cond = Stmt::Cond { + cond_symbol: test_symbol, + cond_layout: Layout::Builtin(Builtin::Int1), + branching_symbol: test_symbol, + branching_layout: Layout::Builtin(Builtin::Int1), + pass: env.arena.alloc(cond), + fail, + ret_layout: ret_layout.clone(), + }; + let test = Expr::RunLowLevel( LowLevel::Eq, bumpalo::vec![in arena; lhs, rhs].into_bump_slice(), ); - let and_expr = Expr::RunLowLevel(LowLevel::And, arena.alloc([test_symbol, accum])); - - // write to the branching symbol - cond = Stmt::Let( - current_symbol, - and_expr, - Layout::Builtin(Builtin::Int1), - arena.alloc(cond), - ); - // write to the test symbol cond = Stmt::Let( test_symbol, From 859656f02d422c3f0d89443d455bb1b09d2a3095 Mon Sep 17 00:00:00 2001 From: Folkert Date: Fri, 13 Nov 2020 23:24:13 +0100 Subject: [PATCH 04/18] fix mono tests --- compiler/mono/src/decision_tree.rs | 166 +++---- compiler/mono/tests/test_mono.rs | 666 ++++++++++++++++------------- 2 files changed, 460 insertions(+), 372 deletions(-) diff --git a/compiler/mono/src/decision_tree.rs b/compiler/mono/src/decision_tree.rs index 7d9853c523..8b51abe085 100644 --- a/compiler/mono/src/decision_tree.rs +++ b/compiler/mono/src/decision_tree.rs @@ -1169,20 +1169,19 @@ fn test_to_equality<'a>( } } +type Tests<'a> = std::vec::Vec<( + bumpalo::collections::Vec<'a, (Symbol, Layout<'a>, Expr<'a>)>, + Symbol, + Symbol, + Layout<'a>, +)>; + fn stores_and_condition<'a>( env: &mut Env<'a, '_>, cond_symbol: Symbol, cond_layout: &Layout<'a>, test_chain: Vec<(Path, Test<'a>)>, -) -> ( - std::vec::Vec<( - bumpalo::collections::Vec<'a, (Symbol, Layout<'a>, Expr<'a>)>, - Symbol, - Symbol, - Layout<'a>, - )>, - Option<(Symbol, JoinPointId, Stmt<'a>)>, -) { +) -> (Tests<'a>, Option<(Symbol, JoinPointId, Stmt<'a>)>) { let mut tests = Vec::with_capacity(test_chain.len()); let mut guard = None; @@ -1261,6 +1260,68 @@ fn compile_guard<'a>( } } +fn compile_test<'a>( + env: &mut Env<'a, '_>, + ret_layout: Layout<'a>, + stores: bumpalo::collections::Vec<'a, (Symbol, Layout<'a>, Expr<'a>)>, + lhs: Symbol, + rhs: Symbol, + fail: &'a Stmt<'a>, + mut cond: Stmt<'a>, +) -> Stmt<'a> { + // `if test_symbol then cond else false_branch + let test_symbol = env.unique_symbol(); + let arena = env.arena; + + cond = Stmt::Cond { + cond_symbol: test_symbol, + cond_layout: Layout::Builtin(Builtin::Int1), + branching_symbol: test_symbol, + branching_layout: Layout::Builtin(Builtin::Int1), + pass: arena.alloc(cond), + fail, + ret_layout, + }; + + let test = Expr::RunLowLevel(LowLevel::Eq, arena.alloc([lhs, rhs])); + + // write to the test symbol + cond = Stmt::Let( + test_symbol, + test, + Layout::Builtin(Builtin::Int1), + arena.alloc(cond), + ); + + // stores are in top-to-bottom order, so we have to add them in reverse + for (symbol, layout, expr) in stores.into_iter().rev() { + cond = Stmt::Let(symbol, expr, layout, arena.alloc(cond)); + } + + cond +} + +fn compile_tests<'a>( + env: &mut Env<'a, '_>, + ret_layout: Layout<'a>, + tests: Tests<'a>, + opt_guard: Option<(Symbol, JoinPointId, Stmt<'a>)>, + fail: &'a Stmt<'a>, + mut cond: Stmt<'a>, +) -> Stmt<'a> { + let arena = env.arena; + + // the guard is the final thing that we check, so needs to be layered on first! + if let Some((_, id, stmt)) = opt_guard { + cond = compile_guard(env, ret_layout.clone(), id, arena.alloc(stmt), fail, cond); + } + + for (new_stores, lhs, rhs, _layout) in tests.into_iter().rev() { + cond = compile_test(env, ret_layout.clone(), new_stores, lhs, rhs, fail, cond); + } + cond +} + // TODO procs and layout are currently unused, but potentially required // for defining optional fields? // if not, do remove @@ -1278,6 +1339,8 @@ fn decide_to_branching<'a>( use Choice::*; use Decider::*; + let arena = env.arena; + match decider { Leaf(Jump(label)) => { // we currently inline the jumps: does fewer jumps but produces a larger artifact @@ -1293,7 +1356,7 @@ fn decide_to_branching<'a>( success, failure, } => { - // generate a switch based on the test chain + // generate a (nested) if-then-else let pass_expr = decide_to_branching( env, @@ -1317,80 +1380,35 @@ fn decide_to_branching<'a>( jumps, ); - let fail = &*env.arena.alloc(fail_expr); - let pass = &*env.arena.alloc(pass_expr); - - let branching_symbol = env.unique_symbol(); - let branching_layout = Layout::Builtin(Builtin::Int1); - - let mut cond = pass.clone(); - - let true_symbol = env.unique_symbol(); - let (tests, guard) = stores_and_condition(env, cond_symbol, &cond_layout, test_chain); - let mut current_symbol = branching_symbol; + let number_of_tests = tests.len() as i64 + guard.is_some() as i64; - // TODO There must be some way to remove this iterator/loop - let nr = (tests.len() as i64) - 1 + (guard.is_some() as i64); + debug_assert!(number_of_tests > 0); - let arena = env.arena; + let mut accum = pass_expr; + if number_of_tests == 1 { + // if there is just one test, compile to a simple if-then-else + let fail = &*env.arena.alloc(fail_expr); - let accum_symbols = std::iter::once(true_symbol) - .chain((0..nr).map(|_| env.unique_symbol())) - .rev() - .collect::>(); + accum = compile_tests(env, ret_layout, tests, guard, fail, accum); + } else { + // otherwise, we use a join point so the code for the `else` case + // is only generated once. + let fail_jp_id = JoinPointId(env.unique_symbol()); + let fail = arena.alloc(Stmt::Jump(fail_jp_id, &[])); - let mut accum_it = accum_symbols.into_iter(); + accum = compile_tests(env, ret_layout, tests, guard, fail, accum); - // the guard is the final thing that we check, so needs to be layered on first! - if let Some((_, id, stmt)) = guard { - cond = compile_guard(env, ret_layout.clone(), id, arena.alloc(stmt), fail, cond); - } - - for ((new_stores, lhs, rhs, _layout), accum) in tests.into_iter().rev().zip(accum_it) { - // `if test_symbol then cond else false_branch - let test_symbol = env.unique_symbol(); - - cond = Stmt::Cond { - cond_symbol: test_symbol, - cond_layout: Layout::Builtin(Builtin::Int1), - branching_symbol: test_symbol, - branching_layout: Layout::Builtin(Builtin::Int1), - pass: env.arena.alloc(cond), - fail, - ret_layout: ret_layout.clone(), + accum = Stmt::Join { + id: fail_jp_id, + parameters: &[], + continuation: env.arena.alloc(fail_expr), + remainder: arena.alloc(accum), }; - - let test = Expr::RunLowLevel( - LowLevel::Eq, - bumpalo::vec![in arena; lhs, rhs].into_bump_slice(), - ); - - // write to the test symbol - cond = Stmt::Let( - test_symbol, - test, - Layout::Builtin(Builtin::Int1), - arena.alloc(cond), - ); - - // stores are in top-to-bottom order, so we have to add them in reverse - for (symbol, layout, expr) in new_stores.into_iter().rev() { - cond = Stmt::Let(symbol, expr, layout, arena.alloc(cond)); - } - - current_symbol = accum; } - cond = Stmt::Let( - true_symbol, - Expr::Literal(Literal::Bool(true)), - Layout::Builtin(Builtin::Int1), - arena.alloc(cond), - ); - - cond + accum } FanOut { path, diff --git a/compiler/mono/tests/test_mono.rs b/compiler/mono/tests/test_mono.rs index cf35ba4f6a..006052b4f3 100644 --- a/compiler/mono/tests/test_mono.rs +++ b/compiler/mono/tests/test_mono.rs @@ -116,11 +116,17 @@ mod test_mono { let the_same = result == expected; if !the_same { - println!("{}", result); - let expected_lines = expected.split("\n").collect::>(); let result_lines = result.split("\n").collect::>(); + for line in &result_lines { + if !line.is_empty() { + println!(" {}", line); + } else { + println!(""); + } + } + assert_eq!(expected_lines, result_lines); assert_eq!(0, 1); } @@ -183,15 +189,13 @@ mod test_mono { indoc!( r#" procedure Test.0 (): - let Test.10 = 0i64; - let Test.11 = 3i64; - let Test.2 = Just Test.10 Test.11; - let Test.6 = true; - let Test.7 = 0i64; - let Test.8 = Index 0 Test.2; - let Test.9 = lowlevel Eq Test.7 Test.8; - let Test.5 = lowlevel And Test.9 Test.6; - if Test.5 then + let Test.8 = 0i64; + let Test.9 = 3i64; + let Test.2 = Just Test.8 Test.9; + let Test.5 = 0i64; + let Test.6 = Index 0 Test.2; + let Test.7 = lowlevel Eq Test.5 Test.6; + if Test.7 then let Test.1 = Index 1 Test.2; ret Test.1; else @@ -309,35 +313,33 @@ mod test_mono { "#, indoc!( r#" - procedure Num.32 (#Attr.2, #Attr.3): - let Test.19 = 0i64; - let Test.15 = lowlevel NotEq #Attr.3 Test.19; - if Test.15 then - let Test.17 = 1i64; - let Test.18 = lowlevel NumDivUnchecked #Attr.2 #Attr.3; - let Test.16 = Ok Test.17 Test.18; - ret Test.16; - else - let Test.13 = 0i64; - let Test.14 = Struct {}; - let Test.12 = Err Test.13 Test.14; - ret Test.12; + procedure Num.32 (#Attr.2, #Attr.3): + let Test.17 = 0i64; + let Test.13 = lowlevel NotEq #Attr.3 Test.17; + if Test.13 then + let Test.15 = 1i64; + let Test.16 = lowlevel NumDivUnchecked #Attr.2 #Attr.3; + let Test.14 = Ok Test.15 Test.16; + ret Test.14; + else + let Test.11 = 0i64; + let Test.12 = Struct {}; + let Test.10 = Err Test.11 Test.12; + ret Test.10; - procedure Test.0 (): - let Test.10 = 1000i64; - let Test.11 = 10i64; - let Test.2 = CallByName Num.32 Test.10 Test.11; - let Test.6 = true; - let Test.7 = 1i64; - let Test.8 = Index 0 Test.2; - let Test.9 = lowlevel Eq Test.7 Test.8; - let Test.5 = lowlevel And Test.9 Test.6; - if Test.5 then - let Test.1 = Index 1 Test.2; - ret Test.1; - else - let Test.4 = -1i64; - ret Test.4; + procedure Test.0 (): + let Test.8 = 1000i64; + let Test.9 = 10i64; + let Test.2 = CallByName Num.32 Test.8 Test.9; + let Test.5 = 1i64; + let Test.6 = Index 0 Test.2; + let Test.7 = lowlevel Eq Test.5 Test.6; + if Test.7 then + let Test.1 = Index 1 Test.2; + ret Test.1; + else + let Test.4 = -1i64; + ret Test.4; "# ), ) @@ -386,15 +388,13 @@ mod test_mono { ret Test.5; procedure Test.0 (): - let Test.12 = 0i64; - let Test.13 = 41i64; - let Test.1 = Just Test.12 Test.13; - let Test.8 = true; - let Test.9 = 0i64; - let Test.10 = Index 0 Test.1; - let Test.11 = lowlevel Eq Test.9 Test.10; - let Test.7 = lowlevel And Test.11 Test.8; - if Test.7 then + let Test.10 = 0i64; + let Test.11 = 41i64; + let Test.1 = Just Test.10 Test.11; + let Test.7 = 0i64; + let Test.8 = Index 0 Test.1; + let Test.9 = lowlevel Eq Test.7 Test.8; + if Test.9 then let Test.2 = Index 1 Test.1; let Test.4 = 1i64; let Test.3 = CallByName Num.14 Test.2 Test.4; @@ -442,20 +442,24 @@ mod test_mono { r#" procedure Test.1 (Test.2): let Test.5 = 2i64; - let Test.11 = true; - let Test.12 = 2i64; - let Test.15 = lowlevel Eq Test.12 Test.5; - let Test.13 = lowlevel And Test.15 Test.11; - let Test.8 = false; - jump Test.7 Test.8; - joinpoint Test.7 Test.14: - let Test.10 = lowlevel And Test.14 Test.13; - if Test.10 then - let Test.6 = 42i64; - ret Test.6; - else - let Test.9 = 0i64; - ret Test.9; + joinpoint Test.11: + let Test.9 = 0i64; + ret Test.9; + in + let Test.10 = 2i64; + let Test.13 = lowlevel Eq Test.10 Test.5; + if Test.13 then + joinpoint Test.7 Test.12: + if Test.12 then + let Test.6 = 42i64; + ret Test.6; + else + jump Test.11; + in + let Test.8 = false; + jump Test.7 Test.8; + else + jump Test.11; procedure Test.0 (): let Test.4 = Struct {}; @@ -511,30 +515,33 @@ mod test_mono { ret Test.6; procedure Test.0 (): + let Test.17 = 0i64; let Test.19 = 0i64; - let Test.21 = 0i64; - let Test.22 = 41i64; - let Test.20 = Just Test.21 Test.22; - let Test.2 = Just Test.19 Test.20; - let Test.10 = true; - let Test.12 = 0i64; - let Test.11 = Index 1 Test.2; - let Test.13 = Index 0 Test.11; - let Test.18 = lowlevel Eq Test.12 Test.13; - let Test.16 = lowlevel And Test.18 Test.10; - let Test.14 = 0i64; - let Test.15 = Index 0 Test.2; - let Test.17 = lowlevel Eq Test.14 Test.15; - let Test.9 = lowlevel And Test.17 Test.16; - if Test.9 then - let Test.7 = Index 1 Test.2; - let Test.3 = Index 1 Test.7; - let Test.5 = 1i64; - let Test.4 = CallByName Num.14 Test.3 Test.5; - ret Test.4; - else + let Test.20 = 41i64; + let Test.18 = Just Test.19 Test.20; + let Test.2 = Just Test.17 Test.18; + joinpoint Test.14: let Test.8 = 1i64; ret Test.8; + in + let Test.9 = Index 1 Test.2; + let Test.10 = 0i64; + let Test.11 = Index 0 Test.9; + let Test.16 = lowlevel Eq Test.10 Test.11; + if Test.16 then + let Test.12 = 0i64; + let Test.13 = Index 0 Test.2; + let Test.15 = lowlevel Eq Test.12 Test.13; + if Test.15 then + let Test.7 = Index 1 Test.2; + let Test.3 = Index 1 Test.7; + let Test.5 = 1i64; + let Test.4 = CallByName Num.14 Test.3 Test.5; + ret Test.4; + else + jump Test.14; + else + jump Test.14; "# ), ) @@ -555,26 +562,29 @@ mod test_mono { ret Test.6; procedure Test.0 (): - let Test.16 = 2i64; - let Test.17 = 3i64; - let Test.3 = Struct {Test.16, Test.17}; - let Test.8 = true; - let Test.10 = 4i64; - let Test.9 = Index 0 Test.3; - let Test.15 = lowlevel Eq Test.10 Test.9; - let Test.13 = lowlevel And Test.15 Test.8; - let Test.12 = 3i64; - let Test.11 = Index 1 Test.3; - let Test.14 = lowlevel Eq Test.12 Test.11; - let Test.7 = lowlevel And Test.14 Test.13; - if Test.7 then - let Test.4 = 9i64; - ret Test.4; - else + let Test.14 = 2i64; + let Test.15 = 3i64; + let Test.3 = Struct {Test.14, Test.15}; + joinpoint Test.11: let Test.1 = Index 0 Test.3; let Test.2 = Index 1 Test.3; let Test.5 = CallByName Num.14 Test.1 Test.2; ret Test.5; + in + let Test.7 = Index 0 Test.3; + let Test.8 = 4i64; + let Test.13 = lowlevel Eq Test.8 Test.7; + if Test.13 then + let Test.9 = Index 1 Test.3; + let Test.10 = 3i64; + let Test.12 = lowlevel Eq Test.10 Test.9; + if Test.12 then + let Test.4 = 9i64; + ret Test.4; + else + jump Test.11; + else + jump Test.11; "# ), ) @@ -698,6 +708,9 @@ mod test_mono { r#" procedure Test.1 (Test.4): let Test.2 = 0u8; + joinpoint Test.8 Test.3: + ret Test.3; + in switch Test.2: case 1: let Test.9 = 1i64; @@ -711,8 +724,6 @@ mod test_mono { let Test.11 = 3i64; jump Test.8 Test.11; - joinpoint Test.8 Test.3: - ret Test.3; procedure Test.0 (): let Test.6 = Struct {}; @@ -798,21 +809,20 @@ mod test_mono { indoc!( r#" procedure Test.1 (Test.4): - let Test.22 = 1i64; - let Test.23 = 2i64; - let Test.2 = Ok Test.22 Test.23; - let Test.18 = true; - let Test.19 = 1i64; - let Test.20 = Index 0 Test.2; - let Test.21 = lowlevel Eq Test.19 Test.20; - let Test.17 = lowlevel And Test.21 Test.18; + let Test.18 = 1i64; + let Test.19 = 2i64; + let Test.2 = Ok Test.18 Test.19; + joinpoint Test.8 Test.3: + ret Test.3; + in + let Test.15 = 1i64; + let Test.16 = Index 0 Test.2; + let Test.17 = lowlevel Eq Test.15 Test.16; if Test.17 then - let Test.13 = true; - let Test.15 = 3i64; - let Test.14 = Index 1 Test.2; - let Test.16 = lowlevel Eq Test.15 Test.14; - let Test.12 = lowlevel And Test.16 Test.13; - if Test.12 then + let Test.12 = Index 1 Test.2; + let Test.13 = 3i64; + let Test.14 = lowlevel Eq Test.13 Test.12; + if Test.14 then let Test.9 = 1i64; jump Test.8 Test.9; else @@ -821,8 +831,6 @@ mod test_mono { else let Test.11 = 3i64; jump Test.8 Test.11; - joinpoint Test.8 Test.3: - ret Test.3; procedure Test.0 (): let Test.6 = Struct {}; @@ -901,18 +909,17 @@ mod test_mono { procedure Test.1 (Test.3): let Test.6 = 10i64; - let Test.14 = true; - let Test.10 = 5i64; - let Test.9 = CallByName Bool.5 Test.6 Test.10; - jump Test.8 Test.9; - joinpoint Test.8 Test.15: - let Test.13 = lowlevel And Test.15 Test.14; + joinpoint Test.8 Test.13: if Test.13 then let Test.7 = 0i64; ret Test.7; else let Test.12 = 42i64; ret Test.12; + in + let Test.10 = 5i64; + let Test.9 = CallByName Bool.5 Test.6 Test.10; + jump Test.8 Test.9; procedure Test.0 (): let Test.5 = Struct {}; @@ -977,11 +984,9 @@ mod test_mono { r#" procedure Test.0 (): let Test.2 = 0i64; - let Test.6 = true; - let Test.7 = 1i64; - let Test.8 = lowlevel Eq Test.7 Test.2; - let Test.5 = lowlevel And Test.8 Test.6; - if Test.5 then + let Test.5 = 1i64; + let Test.6 = lowlevel Eq Test.5 Test.2; + if Test.6 then let Test.3 = 12i64; ret Test.3; else @@ -1195,6 +1200,71 @@ mod test_mono { ), indoc!( r#" + procedure List.3 (#Attr.2, #Attr.3): + let Test.38 = lowlevel ListLen #Attr.2; + let Test.34 = lowlevel NumLt #Attr.3 Test.38; + if Test.34 then + let Test.36 = 1i64; + let Test.37 = lowlevel ListGetUnsafe #Attr.2 #Attr.3; + let Test.35 = Ok Test.36 Test.37; + ret Test.35; + else + let Test.32 = 0i64; + let Test.33 = Struct {}; + let Test.31 = Err Test.32 Test.33; + ret Test.31; + + procedure List.4 (#Attr.2, #Attr.3, #Attr.4): + let Test.14 = lowlevel ListLen #Attr.2; + let Test.12 = lowlevel NumLt #Attr.3 Test.14; + if Test.12 then + let Test.13 = lowlevel ListSet #Attr.2 #Attr.3 #Attr.4; + ret Test.13; + else + ret #Attr.2; + + procedure Test.1 (Test.2): + let Test.39 = 0i64; + let Test.28 = CallByName List.3 Test.2 Test.39; + let Test.30 = 0i64; + let Test.29 = CallByName List.3 Test.2 Test.30; + let Test.7 = Struct {Test.28, Test.29}; + joinpoint Test.25: + let Test.18 = Array []; + ret Test.18; + in + let Test.19 = Index 0 Test.7; + let Test.20 = 1i64; + let Test.21 = Index 0 Test.19; + let Test.27 = lowlevel Eq Test.20 Test.21; + if Test.27 then + let Test.22 = Index 1 Test.7; + let Test.23 = 1i64; + let Test.24 = Index 0 Test.22; + let Test.26 = lowlevel Eq Test.23 Test.24; + if Test.26 then + let Test.17 = Index 0 Test.7; + let Test.3 = Index 1 Test.17; + let Test.16 = Index 1 Test.7; + let Test.4 = Index 1 Test.16; + let Test.15 = 0i64; + let Test.9 = CallByName List.4 Test.2 Test.15 Test.4; + let Test.10 = 0i64; + let Test.8 = CallByName List.4 Test.9 Test.10 Test.3; + ret Test.8; + else + dec Test.2; + jump Test.25; + else + dec Test.2; + jump Test.25; + + procedure Test.0 (): + let Test.40 = 1i64; + let Test.41 = 2i64; + let Test.6 = Array [Test.40, Test.41]; + let Test.5 = CallByName Test.1 Test.6; + ret Test.5; "# ), ) @@ -1212,7 +1282,7 @@ mod test_mono { swap = \list -> when Pair (List.get list 0) (List.get list 0) is Pair (Ok atI) (Ok atJ) -> - list + list |> List.set 0 atJ |> List.set 0 atI @@ -1225,47 +1295,49 @@ mod test_mono { ), indoc!( r#" - procedure List.3 (#Attr.2, #Attr.3): - let Test.40 = lowlevel ListLen #Attr.2; - let Test.36 = lowlevel NumLt #Attr.3 Test.40; - if Test.36 then - let Test.38 = 1i64; - let Test.39 = lowlevel ListGetUnsafe #Attr.2 #Attr.3; - let Test.37 = Ok Test.38 Test.39; - ret Test.37; - else - let Test.34 = 0i64; - let Test.35 = Struct {}; - let Test.33 = Err Test.34 Test.35; - ret Test.33; - - procedure List.4 (#Attr.2, #Attr.3, #Attr.4): - let Test.14 = lowlevel ListLen #Attr.2; - let Test.12 = lowlevel NumLt #Attr.3 Test.14; - if Test.12 then - let Test.13 = lowlevel ListSet #Attr.2 #Attr.3 #Attr.4; - ret Test.13; - else - ret #Attr.2; - - procedure Test.1 (Test.2): - let Test.41 = 0i64; - let Test.30 = CallByName List.3 Test.2 Test.41; + procedure List.3 (#Attr.2, #Attr.3): + let Test.38 = lowlevel ListLen #Attr.2; + let Test.34 = lowlevel NumLt #Attr.3 Test.38; + if Test.34 then + let Test.36 = 1i64; + let Test.37 = lowlevel ListGetUnsafe #Attr.2 #Attr.3; + let Test.35 = Ok Test.36 Test.37; + ret Test.35; + else let Test.32 = 0i64; - let Test.31 = CallByName List.3 Test.2 Test.32; - let Test.7 = Struct {Test.30, Test.31}; - let Test.20 = true; - let Test.22 = 1i64; - let Test.21 = Index 0 Test.7; - let Test.23 = Index 0 Test.21; - let Test.29 = lowlevel Eq Test.22 Test.23; - let Test.27 = lowlevel And Test.29 Test.20; - let Test.25 = 1i64; - let Test.24 = Index 1 Test.7; - let Test.26 = Index 0 Test.24; - let Test.28 = lowlevel Eq Test.25 Test.26; - let Test.19 = lowlevel And Test.28 Test.27; - if Test.19 then + let Test.33 = Struct {}; + let Test.31 = Err Test.32 Test.33; + ret Test.31; + + procedure List.4 (#Attr.2, #Attr.3, #Attr.4): + let Test.14 = lowlevel ListLen #Attr.2; + let Test.12 = lowlevel NumLt #Attr.3 Test.14; + if Test.12 then + let Test.13 = lowlevel ListSet #Attr.2 #Attr.3 #Attr.4; + ret Test.13; + else + ret #Attr.2; + + procedure Test.1 (Test.2): + let Test.39 = 0i64; + let Test.28 = CallByName List.3 Test.2 Test.39; + let Test.30 = 0i64; + let Test.29 = CallByName List.3 Test.2 Test.30; + let Test.7 = Struct {Test.28, Test.29}; + joinpoint Test.25: + let Test.18 = Array []; + ret Test.18; + in + let Test.19 = Index 0 Test.7; + let Test.20 = 1i64; + let Test.21 = Index 0 Test.19; + let Test.27 = lowlevel Eq Test.20 Test.21; + if Test.27 then + let Test.22 = Index 1 Test.7; + let Test.23 = 1i64; + let Test.24 = Index 0 Test.22; + let Test.26 = lowlevel Eq Test.23 Test.24; + if Test.26 then let Test.17 = Index 0 Test.7; let Test.3 = Index 1 Test.17; let Test.16 = Index 1 Test.7; @@ -1277,15 +1349,17 @@ mod test_mono { ret Test.8; else dec Test.2; - let Test.18 = Array []; - ret Test.18; + jump Test.25; + else + dec Test.2; + jump Test.25; - procedure Test.0 (): - let Test.42 = 1i64; - let Test.43 = 2i64; - let Test.6 = Array [Test.42, Test.43]; - let Test.5 = CallByName Test.1 Test.6; - ret Test.5; + procedure Test.0 (): + let Test.40 = 1i64; + let Test.41 = 2i64; + let Test.6 = Array [Test.40, Test.41]; + let Test.5 = CallByName Test.1 Test.6; + ret Test.5; "# ), ) @@ -1430,19 +1504,18 @@ mod test_mono { ret Test.12; procedure Test.1 (Test.2, Test.3): - jump Test.7 Test.2 Test.3; joinpoint Test.7 Test.2 Test.3: - let Test.16 = true; - let Test.17 = 0i64; - let Test.18 = lowlevel Eq Test.17 Test.2; - let Test.15 = lowlevel And Test.18 Test.16; - if Test.15 then + let Test.15 = 0i64; + let Test.16 = lowlevel Eq Test.15 Test.2; + if Test.16 then ret Test.3; else let Test.13 = 1i64; let Test.10 = CallByName Num.15 Test.2 Test.13; let Test.11 = CallByName Num.16 Test.2 Test.3; jump Test.7 Test.10 Test.11; + in + jump Test.7 Test.2 Test.3; procedure Test.0 (): let Test.5 = 10i64; @@ -1767,20 +1840,18 @@ mod test_mono { indoc!( r#" procedure Test.0 (): + let Test.8 = 0i64; let Test.10 = 0i64; let Test.12 = 0i64; - let Test.14 = 0i64; - let Test.16 = 1i64; - let Test.15 = Z Test.16; - let Test.13 = S Test.14 Test.15; + let Test.14 = 1i64; + let Test.13 = Z Test.14; let Test.11 = S Test.12 Test.13; - let Test.2 = S Test.10 Test.11; - let Test.6 = true; - let Test.7 = 1i64; - let Test.8 = Index 0 Test.2; - let Test.9 = lowlevel Eq Test.7 Test.8; - let Test.5 = lowlevel And Test.9 Test.6; - if Test.5 then + let Test.9 = S Test.10 Test.11; + let Test.2 = S Test.8 Test.9; + let Test.5 = 1i64; + let Test.6 = Index 0 Test.2; + let Test.7 = lowlevel Eq Test.5 Test.6; + if Test.7 then let Test.3 = 0i64; ret Test.3; else @@ -1810,29 +1881,25 @@ mod test_mono { indoc!( r#" procedure Test.0 (): + let Test.14 = 0i64; + let Test.16 = 0i64; let Test.18 = 0i64; - let Test.20 = 0i64; - let Test.22 = 0i64; - let Test.24 = 1i64; - let Test.23 = Z Test.24; - let Test.21 = S Test.22 Test.23; - let Test.19 = S Test.20 Test.21; - let Test.2 = S Test.18 Test.19; - let Test.14 = true; - let Test.15 = 0i64; - let Test.16 = Index 0 Test.2; - let Test.17 = lowlevel Eq Test.15 Test.16; - let Test.13 = lowlevel And Test.17 Test.14; + let Test.20 = 1i64; + let Test.19 = Z Test.20; + let Test.17 = S Test.18 Test.19; + let Test.15 = S Test.16 Test.17; + let Test.2 = S Test.14 Test.15; + let Test.11 = 0i64; + let Test.12 = Index 0 Test.2; + let Test.13 = lowlevel Eq Test.11 Test.12; if Test.13 then - let Test.8 = true; - let Test.10 = 0i64; - let Test.9 = Index 1 Test.2; - inc Test.9; - let Test.11 = Index 0 Test.9; - dec Test.9; - let Test.12 = lowlevel Eq Test.10 Test.11; - let Test.7 = lowlevel And Test.12 Test.8; - if Test.7 then + let Test.7 = Index 1 Test.2; + inc Test.7; + let Test.8 = 0i64; + let Test.9 = Index 0 Test.7; + dec Test.7; + let Test.10 = lowlevel Eq Test.8 Test.9; + if Test.10 then let Test.4 = Index 1 Test.2; let Test.3 = 1i64; ret Test.3; @@ -1872,12 +1939,10 @@ mod test_mono { ret Test.13; procedure Test.1 (Test.6): - let Test.19 = true; - let Test.21 = false; - let Test.20 = Index 0 Test.6; - let Test.22 = lowlevel Eq Test.21 Test.20; - let Test.18 = lowlevel And Test.22 Test.19; - if Test.18 then + let Test.18 = Index 0 Test.6; + let Test.19 = false; + let Test.20 = lowlevel Eq Test.19 Test.18; + if Test.20 then let Test.8 = Index 1 Test.6; ret Test.8; else @@ -1885,11 +1950,9 @@ mod test_mono { ret Test.10; procedure Test.1 (Test.6): - let Test.32 = true; - let Test.34 = false; - let Test.33 = Index 0 Test.6; - let Test.35 = lowlevel Eq Test.34 Test.33; - let Test.31 = lowlevel And Test.35 Test.32; + let Test.29 = Index 0 Test.6; + let Test.30 = false; + let Test.31 = lowlevel Eq Test.30 Test.29; if Test.31 then let Test.8 = 3i64; ret Test.8; @@ -1898,19 +1961,19 @@ mod test_mono { ret Test.10; procedure Test.0 (): - let Test.38 = true; - let Test.37 = Struct {Test.38}; - let Test.5 = CallByName Test.1 Test.37; - let Test.36 = false; - let Test.28 = Struct {Test.36}; - let Test.3 = CallByName Test.1 Test.28; - let Test.26 = true; - let Test.27 = 11i64; - let Test.25 = Struct {Test.26, Test.27}; - let Test.4 = CallByName Test.1 Test.25; - let Test.23 = false; - let Test.24 = 7i64; - let Test.15 = Struct {Test.23, Test.24}; + let Test.34 = true; + let Test.33 = Struct {Test.34}; + let Test.5 = CallByName Test.1 Test.33; + let Test.32 = false; + let Test.26 = Struct {Test.32}; + let Test.3 = CallByName Test.1 Test.26; + let Test.24 = true; + let Test.25 = 11i64; + let Test.23 = Struct {Test.24, Test.25}; + let Test.4 = CallByName Test.1 Test.23; + let Test.21 = false; + let Test.22 = 7i64; + let Test.15 = Struct {Test.21, Test.22}; let Test.2 = CallByName Test.1 Test.15; let Test.14 = CallByName Num.16 Test.2 Test.3; let Test.12 = CallByName Num.16 Test.14 Test.4; @@ -1943,30 +2006,33 @@ mod test_mono { ret Test.6; procedure Test.0 (): + let Test.17 = 0i64; let Test.19 = 0i64; - let Test.21 = 0i64; - let Test.22 = 41i64; - let Test.20 = Just Test.21 Test.22; - let Test.2 = Just Test.19 Test.20; - let Test.10 = true; - let Test.12 = 0i64; - let Test.11 = Index 1 Test.2; - let Test.13 = Index 0 Test.11; - let Test.18 = lowlevel Eq Test.12 Test.13; - let Test.16 = lowlevel And Test.18 Test.10; - let Test.14 = 0i64; - let Test.15 = Index 0 Test.2; - let Test.17 = lowlevel Eq Test.14 Test.15; - let Test.9 = lowlevel And Test.17 Test.16; - if Test.9 then - let Test.7 = Index 1 Test.2; - let Test.3 = Index 1 Test.7; - let Test.5 = 1i64; - let Test.4 = CallByName Num.14 Test.3 Test.5; - ret Test.4; - else + let Test.20 = 41i64; + let Test.18 = Just Test.19 Test.20; + let Test.2 = Just Test.17 Test.18; + joinpoint Test.14: let Test.8 = 1i64; ret Test.8; + in + let Test.9 = Index 1 Test.2; + let Test.10 = 0i64; + let Test.11 = Index 0 Test.9; + let Test.16 = lowlevel Eq Test.10 Test.11; + if Test.16 then + let Test.12 = 0i64; + let Test.13 = Index 0 Test.2; + let Test.15 = lowlevel Eq Test.12 Test.13; + if Test.15 then + let Test.7 = Index 1 Test.2; + let Test.3 = Index 1 Test.7; + let Test.5 = 1i64; + let Test.4 = CallByName Num.14 Test.3 Test.5; + ret Test.4; + else + jump Test.14; + else + jump Test.14; "# ), ) @@ -2055,18 +2121,18 @@ mod test_mono { indoc!( r#" procedure List.3 (#Attr.2, #Attr.3): - let Test.42 = lowlevel ListLen #Attr.2; - let Test.38 = lowlevel NumLt #Attr.3 Test.42; - if Test.38 then - let Test.40 = 1i64; - let Test.41 = lowlevel ListGetUnsafe #Attr.2 #Attr.3; - let Test.39 = Ok Test.40 Test.41; - ret Test.39; + let Test.40 = lowlevel ListLen #Attr.2; + let Test.36 = lowlevel NumLt #Attr.3 Test.40; + if Test.36 then + let Test.38 = 1i64; + let Test.39 = lowlevel ListGetUnsafe #Attr.2 #Attr.3; + let Test.37 = Ok Test.38 Test.39; + ret Test.37; else - let Test.36 = 0i64; - let Test.37 = Struct {}; - let Test.35 = Err Test.36 Test.37; - ret Test.35; + let Test.34 = 0i64; + let Test.35 = Struct {}; + let Test.33 = Err Test.34 Test.35; + ret Test.33; procedure List.4 (#Attr.2, #Attr.3, #Attr.4): let Test.18 = lowlevel ListLen #Attr.2; @@ -2078,38 +2144,42 @@ mod test_mono { ret #Attr.2; procedure Test.1 (Test.2, Test.3, Test.4): - let Test.33 = CallByName List.3 Test.4 Test.2; - let Test.34 = CallByName List.3 Test.4 Test.3; - let Test.12 = Struct {Test.33, Test.34}; - let Test.23 = true; - let Test.25 = 1i64; - let Test.24 = Index 0 Test.12; - let Test.26 = Index 0 Test.24; - let Test.32 = lowlevel Eq Test.25 Test.26; - let Test.30 = lowlevel And Test.32 Test.23; - let Test.28 = 1i64; - let Test.27 = Index 1 Test.12; - let Test.29 = Index 0 Test.27; - let Test.31 = lowlevel Eq Test.28 Test.29; - let Test.22 = lowlevel And Test.31 Test.30; - if Test.22 then - let Test.20 = Index 0 Test.12; - let Test.5 = Index 1 Test.20; - let Test.19 = Index 1 Test.12; - let Test.6 = Index 1 Test.19; - let Test.14 = CallByName List.4 Test.4 Test.2 Test.6; - let Test.13 = CallByName List.4 Test.14 Test.3 Test.5; - ret Test.13; - else - dec Test.4; + let Test.31 = CallByName List.3 Test.4 Test.2; + let Test.32 = CallByName List.3 Test.4 Test.3; + let Test.12 = Struct {Test.31, Test.32}; + joinpoint Test.28: let Test.21 = Array []; ret Test.21; + in + let Test.22 = Index 0 Test.12; + let Test.23 = 1i64; + let Test.24 = Index 0 Test.22; + let Test.30 = lowlevel Eq Test.23 Test.24; + if Test.30 then + let Test.25 = Index 1 Test.12; + let Test.26 = 1i64; + let Test.27 = Index 0 Test.25; + let Test.29 = lowlevel Eq Test.26 Test.27; + if Test.29 then + let Test.20 = Index 0 Test.12; + let Test.5 = Index 1 Test.20; + let Test.19 = Index 1 Test.12; + let Test.6 = Index 1 Test.19; + let Test.14 = CallByName List.4 Test.4 Test.2 Test.6; + let Test.13 = CallByName List.4 Test.14 Test.3 Test.5; + ret Test.13; + else + dec Test.4; + jump Test.28; + else + dec Test.4; + jump Test.28; procedure Test.0 (): let Test.9 = 0i64; let Test.10 = 0i64; - let Test.43 = 1i64; - let Test.11 = Array [Test.43]; + let Test.41 = 1i64; + let Test.11 = Array [Test.41]; let Test.8 = CallByName Test.1 Test.9 Test.10 Test.11; ret Test.8; "# @@ -2193,7 +2263,7 @@ mod test_mono { f = \{} -> x f - main = + main = f = foo {} f {} "# From b7f7de8afb72ace9b91ecafa098fd198008e2a76 Mon Sep 17 00:00:00 2001 From: Folkert Date: Fri, 13 Nov 2020 23:27:42 +0100 Subject: [PATCH 05/18] fix issue in refcounting --- compiler/gen/src/llvm/build.rs | 3 +-- compiler/gen/src/llvm/refcounting.rs | 34 ++++++++++++++++++---------- 2 files changed, 23 insertions(+), 14 deletions(-) diff --git a/compiler/gen/src/llvm/build.rs b/compiler/gen/src/llvm/build.rs index 444e085ca6..209dc6e02b 100644 --- a/compiler/gen/src/llvm/build.rs +++ b/compiler/gen/src/llvm/build.rs @@ -993,8 +993,7 @@ pub fn allocate_with_refcount<'a, 'ctx, 'env>( // bytes per element let bytes_len = len_type.const_int(value_bytes, false); - // TODO fix offset - let offset = (env.ptr_bytes as u64).max(value_bytes); + let offset = crate::llvm::refcounting::refcount_offset(env, layout); let ptr = { let len = bytes_len; diff --git a/compiler/gen/src/llvm/refcounting.rs b/compiler/gen/src/llvm/refcounting.rs index 548370168e..fa5c877303 100644 --- a/compiler/gen/src/llvm/refcounting.rs +++ b/compiler/gen/src/llvm/refcounting.rs @@ -749,6 +749,7 @@ fn decrement_refcount_help<'a, 'ctx, 'env>( ], ) .into_struct_value(); + let has_overflowed = builder .build_extract_value(add_with_overflow, 1, "has_overflowed") .unwrap(); @@ -759,6 +760,7 @@ fn decrement_refcount_help<'a, 'ctx, 'env>( ctx.bool_type().const_int(1 as u64, false), "has_overflowed", ); + // build blocks let then_block = ctx.append_basic_block(parent, "then"); let else_block = ctx.append_basic_block(parent, "else"); @@ -780,6 +782,7 @@ fn decrement_refcount_help<'a, 'ctx, 'env>( // build else block { builder.position_at_end(else_block); + let max = builder.build_int_compare( IntPredicate::EQ, refcount, @@ -926,18 +929,19 @@ pub fn build_dec_union_help<'a, 'ctx, 'env>( for (i, field_layout) in field_layouts.iter().enumerate() { if let Layout::RecursivePointer = field_layout { - // a *i64 pointer to the recursive data - // we need to cast this pointer to the appropriate type - let field_ptr = env + // this field has type `*i64`, but is really a pointer to the data we want + let ptr_as_i64_ptr = env .builder .build_extract_value(wrapper_struct, i as u32, "decrement_struct_field") .unwrap(); - // recursively decrement + debug_assert!(ptr_as_i64_ptr.is_pointer_value()); + + // therefore we must cast it to our desired type let union_type = block_of_memory(env.context, &layout, env.ptr_bytes); let recursive_field_ptr = cast_basic_basic( env.builder, - field_ptr, + ptr_as_i64_ptr, union_type.ptr_type(AddressSpace::Generic).into(), ) .into_pointer_value(); @@ -956,7 +960,7 @@ pub fn build_dec_union_help<'a, 'ctx, 'env>( // TODO do this decrement before the recursive call? // Then the recursive call is potentially TCE'd - decrement_refcount_ptr(env, parent, &layout, field_ptr.into_pointer_value()); + decrement_refcount_ptr(env, parent, &layout, recursive_field_ptr); } else if field_layout.contains_refcounted() { let field_ptr = env .builder @@ -1221,6 +1225,17 @@ fn get_refcount_ptr<'a, 'ctx, 'env>( get_refcount_ptr_help(env, layout, ptr_as_int) } +pub fn refcount_offset<'a, 'ctx, 'env>(env: &Env<'a, 'ctx, 'env>, layout: &Layout<'a>) -> u64 { + let value_bytes = layout.stack_size(env.ptr_bytes) as u64; + + match layout { + Layout::Builtin(Builtin::List(_, _)) => env.ptr_bytes as u64, + Layout::Builtin(Builtin::Str) => env.ptr_bytes as u64, + Layout::RecursivePointer | Layout::RecursiveUnion(_) => env.ptr_bytes as u64, + _ => (env.ptr_bytes as u64).max(value_bytes), + } +} + fn get_refcount_ptr_help<'a, 'ctx, 'env>( env: &Env<'a, 'ctx, 'env>, layout: &Layout<'a>, @@ -1229,12 +1244,7 @@ fn get_refcount_ptr_help<'a, 'ctx, 'env>( let builder = env.builder; let ctx = env.context; - let value_bytes = layout.stack_size(env.ptr_bytes) as u64; - let offset = match layout { - Layout::Builtin(Builtin::List(_, _)) => env.ptr_bytes as u64, - Layout::Builtin(Builtin::Str) => env.ptr_bytes as u64, - _ => (env.ptr_bytes as u64).max(value_bytes), - }; + let offset = refcount_offset(env, layout); // pointer to usize let refcount_type = ptr_int(ctx, env.ptr_bytes); From 9af83bb490759b404abe5486d77ab4eb6b5cbc49 Mon Sep 17 00:00:00 2001 From: Folkert Date: Fri, 13 Nov 2020 23:29:13 +0100 Subject: [PATCH 06/18] display join points like a `let ... in ...` --- compiler/mono/src/ir.rs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/mono/src/ir.rs b/compiler/mono/src/ir.rs index 02441a6944..e52641762b 100644 --- a/compiler/mono/src/ir.rs +++ b/compiler/mono/src/ir.rs @@ -1134,7 +1134,6 @@ impl<'a> Stmt<'a> { alloc.intersperse( vec![ - remainder.to_doc(alloc), alloc .text("joinpoint ") .append(join_point_to_doc(alloc, *id)) @@ -1142,6 +1141,8 @@ impl<'a> Stmt<'a> { .append(alloc.intersperse(it, alloc.space())) .append(":"), continuation.to_doc(alloc).indent(4), + alloc.text("in"), + remainder.to_doc(alloc), ], alloc.hardline(), ) From b2f3dd18fd3d5a9aa026352e16b713d9d4c6452c Mon Sep 17 00:00:00 2001 From: Folkert Date: Fri, 13 Nov 2020 23:29:40 +0100 Subject: [PATCH 07/18] cleanup --- compiler/mono/src/decision_tree.rs | 24 ++++++++++-------------- 1 file changed, 10 insertions(+), 14 deletions(-) diff --git a/compiler/mono/src/decision_tree.rs b/compiler/mono/src/decision_tree.rs index 8b51abe085..65ed5c3f0c 100644 --- a/compiler/mono/src/decision_tree.rs +++ b/compiler/mono/src/decision_tree.rs @@ -11,7 +11,7 @@ use roc_module::symbol::Symbol; /// COMPILE CASES type Label = u64; -const RECORD_TAG_NAME: &'static str = "#Record"; +const RECORD_TAG_NAME: &str = "#Record"; /// Users of this module will mainly interact with this function. It takes /// some normal branches and gives out a decision tree that has "labels" at all @@ -1269,7 +1269,7 @@ fn compile_test<'a>( fail: &'a Stmt<'a>, mut cond: Stmt<'a>, ) -> Stmt<'a> { - // `if test_symbol then cond else false_branch + // if test_symbol then cond else fail let test_symbol = env.unique_symbol(); let arena = env.arena; @@ -1386,29 +1386,25 @@ fn decide_to_branching<'a>( debug_assert!(number_of_tests > 0); - let mut accum = pass_expr; + let fail = env.arena.alloc(fail_expr); if number_of_tests == 1 { // if there is just one test, compile to a simple if-then-else - let fail = &*env.arena.alloc(fail_expr); - - accum = compile_tests(env, ret_layout, tests, guard, fail, accum); + compile_tests(env, ret_layout, tests, guard, fail, pass_expr) } else { // otherwise, we use a join point so the code for the `else` case // is only generated once. let fail_jp_id = JoinPointId(env.unique_symbol()); - let fail = arena.alloc(Stmt::Jump(fail_jp_id, &[])); + let jump = arena.alloc(Stmt::Jump(fail_jp_id, &[])); - accum = compile_tests(env, ret_layout, tests, guard, fail, accum); + let test_stmt = compile_tests(env, ret_layout, tests, guard, jump, pass_expr); - accum = Stmt::Join { + Stmt::Join { id: fail_jp_id, parameters: &[], - continuation: env.arena.alloc(fail_expr), - remainder: arena.alloc(accum), - }; + continuation: fail, + remainder: arena.alloc(test_stmt), + } } - - accum } FanOut { path, From ec3868ed7e32308086a9b892c629c7c0caf3e24c Mon Sep 17 00:00:00 2001 From: Folkert Date: Sat, 14 Nov 2020 02:45:05 +0100 Subject: [PATCH 08/18] small rigid fix --- compiler/constrain/src/expr.rs | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/compiler/constrain/src/expr.rs b/compiler/constrain/src/expr.rs index 3e24eda551..f548ebe359 100644 --- a/compiler/constrain/src/expr.rs +++ b/compiler/constrain/src/expr.rs @@ -1229,12 +1229,24 @@ fn constrain_def(env: &Env, def: &Def, body_con: Constraint) -> Constraint { ) } - _ => constrain_expr( - &env, - def.loc_expr.region, - &def.loc_expr.value, - annotation_expected, - ), + _ => { + let expected = annotation_expected; + + let ret_constraint = + constrain_expr(env, def.loc_expr.region, &def.loc_expr.value, expected); + + And(vec![ + Let(Box::new(LetConstraint { + rigid_vars: Vec::new(), + flex_vars: vec![], + def_types: SendMap::default(), + defs_constraint: True, + ret_constraint, + })), + // Store type into AST vars. We use Store so errors aren't reported twice + Store(signature, expr_var, std::file!(), std::line!()), + ]) + } } } None => { From 154b5cc29f7f2da24e5f7d51dda37f272e04d0b0 Mon Sep 17 00:00:00 2001 From: Folkert Date: Sat, 14 Nov 2020 02:49:28 +0100 Subject: [PATCH 09/18] get RBTree.balance to compile --- compiler/gen/src/llvm/build.rs | 36 ++++++------ compiler/gen/src/llvm/refcounting.rs | 88 ++++++++++------------------ compiler/gen/tests/gen_primitives.rs | 61 ++++++++++++++++--- compiler/mono/src/ir.rs | 1 + compiler/mono/src/layout.rs | 1 + 5 files changed, 104 insertions(+), 83 deletions(-) diff --git a/compiler/gen/src/llvm/build.rs b/compiler/gen/src/llvm/build.rs index 209dc6e02b..c644a75ca5 100644 --- a/compiler/gen/src/llvm/build.rs +++ b/compiler/gen/src/llvm/build.rs @@ -752,31 +752,33 @@ pub fn build_exp_expr<'a, 'ctx, 'env>( let mut field_types = Vec::with_capacity_in(num_fields, env.arena); let mut field_vals = Vec::with_capacity_in(num_fields, env.arena); - for (field_symbol, tag_field_layout) in - arguments.iter().zip(fields[*tag_id as usize].iter()) - { - // note field_layout is the layout of the argument. - // tag_field_layout is the layout that the tag will store - // these are different for recursive tag unions - let (val, field_layout) = load_symbol_and_layout(env, scope, field_symbol); - let field_size = tag_field_layout.stack_size(ptr_size); + let tag_field_layouts = fields[*tag_id as usize]; + for (field_symbol, tag_field_layout) in arguments.iter().zip(tag_field_layouts.iter()) { + let val = load_symbol(env, scope, field_symbol); // Zero-sized fields have no runtime representation. // The layout of the struct expects them to be dropped! - if field_size != 0 { + if !tag_field_layout.is_dropped_because_empty() { let field_type = basic_type_from_layout(env.arena, env.context, tag_field_layout, ptr_size); field_types.push(field_type); if let Layout::RecursivePointer = tag_field_layout { - let ptr = allocate_with_refcount(env, field_layout, val).into(); - let ptr = cast_basic_basic( - builder, - ptr, - ctx.i64_type().ptr_type(AddressSpace::Generic).into(), + let ptr = allocate_with_refcount(env, &tag_layout, val).into(); + + builder.build_store(ptr, val); + + let as_i64_ptr = cast_basic_basic( + env.builder, + ptr.into(), + env.context + .i64_type() + .ptr_type(AddressSpace::Generic) + .into(), ); - field_vals.push(ptr); + + field_vals.push(as_i64_ptr); } else { field_vals.push(val); } @@ -1010,7 +1012,7 @@ pub fn allocate_with_refcount<'a, 'ctx, 'env>( // We must return a pointer to the first element: let ptr_bytes = env.ptr_bytes; let int_type = ptr_int(ctx, ptr_bytes); - let ptr_as_int = builder.build_ptr_to_int(ptr, int_type, "list_cast_ptr"); + let ptr_as_int = builder.build_ptr_to_int(ptr, int_type, "allocate_refcount_pti"); let incremented = builder.build_int_add( ptr_as_int, ctx.i64_type().const_int(offset, false), @@ -1018,7 +1020,7 @@ pub fn allocate_with_refcount<'a, 'ctx, 'env>( ); let ptr_type = get_ptr_type(&value_type, AddressSpace::Generic); - let list_element_ptr = builder.build_int_to_ptr(incremented, ptr_type, "list_cast_ptr"); + let list_element_ptr = builder.build_int_to_ptr(incremented, ptr_type, "allocate_refcount_itp"); // subtract ptr_size, to access the refcount let refcount_ptr = builder.build_int_sub( diff --git a/compiler/gen/src/llvm/refcounting.rs b/compiler/gen/src/llvm/refcounting.rs index fa5c877303..9ae829bc0c 100644 --- a/compiler/gen/src/llvm/refcounting.rs +++ b/compiler/gen/src/llvm/refcounting.rs @@ -89,46 +89,7 @@ pub fn decrement_refcount_layout<'a, 'ctx, 'env>( RecursivePointer => todo!("TODO implement decrement layout of recursive tag union"), Union(tags) => { - debug_assert!(!tags.is_empty()); - let wrapper_struct = value.into_struct_value(); - - // read the tag_id - let tag_id = env - .builder - .build_extract_value(wrapper_struct, 0, "read_tag_id") - .unwrap() - .into_int_value(); - - // next, make a jump table for all possible values of the tag_id - let mut cases = Vec::with_capacity_in(tags.len(), env.arena); - - let merge_block = env.context.append_basic_block(parent, "decrement_merge"); - - for (tag_id, field_layouts) in tags.iter().enumerate() { - let block = env.context.append_basic_block(parent, "tag_id_decrement"); - env.builder.position_at_end(block); - - for (i, field_layout) in field_layouts.iter().enumerate() { - if field_layout.contains_refcounted() { - let field_ptr = env - .builder - .build_extract_value(wrapper_struct, i as u32, "decrement_struct_field") - .unwrap(); - - decrement_refcount_layout(env, parent, layout_ids, field_ptr, field_layout) - } - } - - env.builder.build_unconditional_branch(merge_block); - - cases.push((env.context.i8_type().const_int(tag_id as u64, false), block)); - } - - let (_, default_block) = cases.pop().unwrap(); - - env.builder.build_switch(tag_id, default_block, &cases); - - env.builder.position_at_end(merge_block); + build_dec_union(env, layout_ids, tags, value); } RecursiveUnion(tags) => { @@ -906,14 +867,20 @@ pub fn build_dec_union_help<'a, 'ctx, 'env>( let wrapper_struct = arg_val.into_struct_value(); - // let tag_id_u8 = cast_basic_basic(env.builder, tag_id.into(), env.context.i8_type().into()); - // next, make a jump table for all possible values of the tag_id let mut cases = Vec::with_capacity_in(tags.len(), env.arena); let merge_block = env.context.append_basic_block(parent, "decrement_merge"); for (tag_id, field_layouts) in tags.iter().enumerate() { + // if none of the fields are or contain anything refcounted, just move on + if !field_layouts + .iter() + .any(|x| x.is_refcounted() || x.contains_refcounted()) + { + continue; + } + let block = env.context.append_basic_block(parent, "tag_id_decrement"); env.builder.position_at_end(block); @@ -981,8 +948,6 @@ pub fn build_dec_union_help<'a, 'ctx, 'env>( cases.reverse(); - let (_, default_block) = cases.pop().unwrap(); - env.builder.position_at_end(before_block); // read the tag_id @@ -1002,7 +967,7 @@ pub fn build_dec_union_help<'a, 'ctx, 'env>( // switch on it env.builder - .build_switch(current_tag_id, default_block, &cases); + .build_switch(current_tag_id, merge_block, &cases); env.builder.position_at_end(merge_block); @@ -1109,10 +1074,18 @@ pub fn build_inc_union_help<'a, 'ctx, 'env>( // next, make a jump table for all possible values of the tag_id let mut cases = Vec::with_capacity_in(tags.len(), env.arena); - let merge_block = env.context.append_basic_block(parent, "decrement_merge"); + let merge_block = env.context.append_basic_block(parent, "increment_merge"); for (tag_id, field_layouts) in tags.iter().enumerate() { - let block = env.context.append_basic_block(parent, "tag_id_decrement"); + // if none of the fields are or contain anything refcounted, just move on + if !field_layouts + .iter() + .any(|x| x.is_refcounted() || x.contains_refcounted()) + { + continue; + } + + let block = env.context.append_basic_block(parent, "tag_id_increment"); env.builder.position_at_end(block); let wrapper_type = basic_type_from_layout( @@ -1127,18 +1100,19 @@ pub fn build_inc_union_help<'a, 'ctx, 'env>( for (i, field_layout) in field_layouts.iter().enumerate() { if let Layout::RecursivePointer = field_layout { - // a *i64 pointer to the recursive data - // we need to cast this pointer to the appropriate type - let field_ptr = env + // this field has type `*i64`, but is really a pointer to the data we want + let ptr_as_i64_ptr = env .builder - .build_extract_value(wrapper_struct, i as u32, "decrement_struct_field") + .build_extract_value(wrapper_struct, i as u32, "increment_struct_field") .unwrap(); - // recursively increment + debug_assert!(ptr_as_i64_ptr.is_pointer_value()); + + // therefore we must cast it to our desired type let union_type = block_of_memory(env.context, &layout, env.ptr_bytes); let recursive_field_ptr = cast_basic_basic( env.builder, - field_ptr, + ptr_as_i64_ptr, union_type.ptr_type(AddressSpace::Generic).into(), ) .into_pointer_value(); @@ -1155,9 +1129,9 @@ pub fn build_inc_union_help<'a, 'ctx, 'env>( // Because it's an internal-only function, use the fast calling convention. call.set_call_convention(FAST_CALL_CONV); - // TODO do this increment before the recursive call? + // TODO do this decrement before the recursive call? // Then the recursive call is potentially TCE'd - increment_refcount_ptr(env, &layout, field_ptr.into_pointer_value()); + increment_refcount_ptr(env, &layout, recursive_field_ptr); } else if field_layout.contains_refcounted() { let field_ptr = env .builder @@ -1173,12 +1147,10 @@ pub fn build_inc_union_help<'a, 'ctx, 'env>( cases.push((env.context.i8_type().const_int(tag_id as u64, false), block)); } - let (_, default_block) = cases.pop().unwrap(); - env.builder.position_at_end(before_block); env.builder - .build_switch(tag_id_u8.into_int_value(), default_block, &cases); + .build_switch(tag_id_u8.into_int_value(), merge_block, &cases); env.builder.position_at_end(merge_block); diff --git a/compiler/gen/tests/gen_primitives.rs b/compiler/gen/tests/gen_primitives.rs index 0a693b818d..58bec5323e 100644 --- a/compiler/gen/tests/gen_primitives.rs +++ b/compiler/gen/tests/gen_primitives.rs @@ -1278,7 +1278,6 @@ mod gen_primitives { } #[test] - #[ignore] fn rbtree_balance() { assert_non_opt_evals_to!( indoc!( @@ -1289,18 +1288,38 @@ mod gen_primitives { Dict k v : [ Node NodeColor k v (Dict k v) (Dict k v), Empty ] - Key k : Num k - balance : NodeColor, k, v, Dict k v, Dict k v -> Dict k v balance = \color, key, value, left, right -> when right is - Node Red lK lV (Node Red llK llV llLeft llRight) lRight -> Empty - Empty -> Empty + Node Red rK rV rLeft rRight -> + when left is + Node Red lK lV lLeft lRight -> + Node + Red + key + value + (Node Black lK lV lLeft lRight) + (Node Black rK rV rLeft rRight) + _ -> + Node color rK rV (Node Red key value left rLeft) rRight - main : Dict Int {} + _ -> + when left is + Node Red lK lV (Node Red llK llV llLeft llRight) lRight -> + Node + Red + lK + lV + (Node Black llK llV llLeft llRight) + (Node Black key value lRight right) + + _ -> + Node color key value left right + + main : Dict Int Int main = - balance Red 0 {} Empty Empty + balance Red 0 0 Empty Empty "# ), 1, @@ -1309,7 +1328,33 @@ mod gen_primitives { } #[test] - #[ignore] + fn linked_list_guarded_double_pattern_match() { + // the important part here is that the first case (with the nested Cons) does not match + assert_non_opt_evals_to!( + indoc!( + r#" + app Test provides [ main ] imports [] + + ConsList a : [ Cons a (ConsList a), Nil ] + + balance : ConsList Int -> Int + balance = \right -> + when right is + Cons 1 (Cons 1 _) -> 3 + _ -> 3 + + main : Int + main = + when balance Nil is + _ -> 3 + "# + ), + 3, + i64 + ); + } + + #[test] fn linked_list_double_pattern_match() { assert_non_opt_evals_to!( indoc!( diff --git a/compiler/mono/src/ir.rs b/compiler/mono/src/ir.rs index e52641762b..edbae1195b 100644 --- a/compiler/mono/src/ir.rs +++ b/compiler/mono/src/ir.rs @@ -4398,6 +4398,7 @@ fn store_pattern<'a>( field_layouts: arg_layouts.clone().into_bump_slice(), structure: outer_symbol, }; + match argument { Identifier(symbol) => { // store immediately in the given symbol diff --git a/compiler/mono/src/layout.rs b/compiler/mono/src/layout.rs index ea55789a6e..50b572c76c 100644 --- a/compiler/mono/src/layout.rs +++ b/compiler/mono/src/layout.rs @@ -435,6 +435,7 @@ impl<'a> Layout<'a> { match self { Layout::Builtin(Builtin::List(_, _)) => true, Layout::RecursiveUnion(_) => true, + Layout::RecursivePointer => true, _ => false, } } From 0dde6da77dbe5b03bfdbdbed6cdd7d85f89d1a8f Mon Sep 17 00:00:00 2001 From: Folkert Date: Sat, 14 Nov 2020 02:58:12 +0100 Subject: [PATCH 10/18] fix mono test --- compiler/gen/src/llvm/build.rs | 2 +- compiler/mono/tests/test_mono.rs | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/compiler/gen/src/llvm/build.rs b/compiler/gen/src/llvm/build.rs index c644a75ca5..05dbaa91a3 100644 --- a/compiler/gen/src/llvm/build.rs +++ b/compiler/gen/src/llvm/build.rs @@ -765,7 +765,7 @@ pub fn build_exp_expr<'a, 'ctx, 'env>( field_types.push(field_type); if let Layout::RecursivePointer = tag_field_layout { - let ptr = allocate_with_refcount(env, &tag_layout, val).into(); + let ptr = allocate_with_refcount(env, &tag_layout, val); builder.build_store(ptr, val); diff --git a/compiler/mono/tests/test_mono.rs b/compiler/mono/tests/test_mono.rs index 006052b4f3..e010927233 100644 --- a/compiler/mono/tests/test_mono.rs +++ b/compiler/mono/tests/test_mono.rs @@ -1850,6 +1850,7 @@ mod test_mono { let Test.2 = S Test.8 Test.9; let Test.5 = 1i64; let Test.6 = Index 0 Test.2; + dec Test.2; let Test.7 = lowlevel Eq Test.5 Test.6; if Test.7 then let Test.3 = 0i64; @@ -1901,12 +1902,15 @@ mod test_mono { let Test.10 = lowlevel Eq Test.8 Test.9; if Test.10 then let Test.4 = Index 1 Test.2; + dec Test.2; let Test.3 = 1i64; ret Test.3; else + dec Test.2; let Test.5 = 0i64; ret Test.5; else + dec Test.2; let Test.6 = 0i64; ret Test.6; "# From 4b6eaca284cff04898313478b5a85da558fc6658 Mon Sep 17 00:00:00 2001 From: Folkert Date: Sat, 14 Nov 2020 03:07:18 +0100 Subject: [PATCH 11/18] fix oversight --- compiler/gen/src/llvm/build.rs | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/compiler/gen/src/llvm/build.rs b/compiler/gen/src/llvm/build.rs index 05dbaa91a3..e27a061169 100644 --- a/compiler/gen/src/llvm/build.rs +++ b/compiler/gen/src/llvm/build.rs @@ -767,18 +767,13 @@ pub fn build_exp_expr<'a, 'ctx, 'env>( if let Layout::RecursivePointer = tag_field_layout { let ptr = allocate_with_refcount(env, &tag_layout, val); - builder.build_store(ptr, val); - - let as_i64_ptr = cast_basic_basic( - env.builder, + let ptr = cast_basic_basic( + builder, ptr.into(), - env.context - .i64_type() - .ptr_type(AddressSpace::Generic) - .into(), + ctx.i64_type().ptr_type(AddressSpace::Generic).into(), ); - field_vals.push(as_i64_ptr); + field_vals.push(ptr); } else { field_vals.push(val); } From 342059ab6c0ef6c895c932bbc4b3e261e4322e4d Mon Sep 17 00:00:00 2001 From: Folkert Date: Sat, 14 Nov 2020 23:54:22 +0100 Subject: [PATCH 12/18] fix bug in Recursion ~ Flex unification --- compiler/unify/src/unify.rs | 43 ++++++++++++++++++++++++++----------- 1 file changed, 30 insertions(+), 13 deletions(-) diff --git a/compiler/unify/src/unify.rs b/compiler/unify/src/unify.rs index 4b3777d68b..b63343663a 100644 --- a/compiler/unify/src/unify.rs +++ b/compiler/unify/src/unify.rs @@ -180,7 +180,8 @@ fn unify_alias( // Alias wins merge(subs, &ctx, Alias(symbol, args.to_owned(), real_var)) } - RecursionVar { .. } | RigidVar(_) => unify_pool(subs, pool, real_var, ctx.second), + RecursionVar { structure, .. } => unify_pool(subs, pool, real_var, *structure), + RigidVar(_) => unify_pool(subs, pool, real_var, ctx.second), Alias(other_symbol, other_args, other_real_var) => { if symbol == *other_symbol { if args.len() == other_args.len() { @@ -240,7 +241,8 @@ fn unify_structure( problems } - FlatType::RecursiveTagUnion(_, _, _) => { + FlatType::RecursiveTagUnion(rec, _, _) => { + debug_assert!(is_recursion_var(subs, *rec)); let structure_rank = subs.get(*structure).rank; let self_rank = subs.get(ctx.first).rank; let other_rank = subs.get(ctx.second).rank; @@ -436,7 +438,7 @@ fn unify_tag_union( let recursion_var = match recursion { (None, None) => None, (Some(v), None) | (None, Some(v)) => Some(v), - (Some(v1), Some(_v2)) => Some(v1), + (Some(v1), Some(v2)) => Some(v1), }; if unique_tags1.is_empty() { @@ -593,7 +595,7 @@ fn unify_tag_union_not_recursive_recursive( tag_problems } else { - let flat_type = FlatType::RecursiveTagUnion(recursion_var, unique_tags2, rec2.ext); + let flat_type = FlatType::TagUnion(unique_tags2, rec2.ext); let sub_record = fresh(subs, pool, ctx, Structure(flat_type)); let ext_problems = unify_pool(subs, pool, rec1.ext, sub_record); @@ -616,7 +618,7 @@ fn unify_tag_union_not_recursive_recursive( tag_problems } } else if unique_tags2.is_empty() { - let flat_type = FlatType::RecursiveTagUnion(recursion_var, unique_tags1, rec1.ext); + let flat_type = FlatType::TagUnion(unique_tags1, rec1.ext); let sub_record = fresh(subs, pool, ctx, Structure(flat_type)); let ext_problems = unify_pool(subs, pool, sub_record, rec2.ext); @@ -641,8 +643,8 @@ fn unify_tag_union_not_recursive_recursive( let other_tags = union(unique_tags1.clone(), &unique_tags2); let ext = fresh(subs, pool, ctx, Content::FlexVar(None)); - let flat_type1 = FlatType::RecursiveTagUnion(recursion_var, unique_tags1, ext); - let flat_type2 = FlatType::RecursiveTagUnion(recursion_var, unique_tags2, ext); + let flat_type1 = FlatType::TagUnion(unique_tags1, ext); + let flat_type2 = FlatType::TagUnion(unique_tags2, ext); let sub1 = fresh(subs, pool, ctx, Structure(flat_type1)); let sub2 = fresh(subs, pool, ctx, Structure(flat_type2)); @@ -855,6 +857,7 @@ fn unify_shared_tags( new_tags.extend(fields.into_iter()); let flat_type = if let Some(rec) = recursion_var { + debug_assert!(is_recursion_var(subs, rec)); FlatType::RecursiveTagUnion(rec, new_tags, new_ext_var) } else { FlatType::TagUnion(new_tags, new_ext_var) @@ -924,6 +927,7 @@ fn unify_flat_type( } (RecursiveTagUnion(recursion_var, tags1, ext1), TagUnion(tags2, ext2)) => { + debug_assert!(is_recursion_var(subs, *recursion_var)); // this never happens in type-correct programs, but may happen if there is a type error let union1 = gather_tags(subs, tags1.clone(), *ext1); let union2 = gather_tags(subs, tags2.clone(), *ext2); @@ -939,6 +943,7 @@ fn unify_flat_type( } (TagUnion(tags1, ext1), RecursiveTagUnion(recursion_var, tags2, ext2)) => { + debug_assert!(is_recursion_var(subs, *recursion_var)); let union1 = gather_tags(subs, tags1.clone(), *ext1); let union2 = gather_tags(subs, tags2.clone(), *ext2); @@ -946,6 +951,8 @@ fn unify_flat_type( } (RecursiveTagUnion(rec1, tags1, ext1), RecursiveTagUnion(rec2, tags2, ext2)) => { + debug_assert!(is_recursion_var(subs, *rec1)); + debug_assert!(is_recursion_var(subs, *rec2)); let union1 = gather_tags(subs, tags1.clone(), *ext1); let union2 = gather_tags(subs, tags2.clone(), *ext2); @@ -1153,13 +1160,16 @@ fn unify_recursion( // unify the structure variable with this Structure unify_pool(subs, pool, structure, ctx.second) } + RigidVar(_) => mismatch!("RecursionVar {:?} with rigid {:?}", ctx.first, &other), - FlexVar(_) | RigidVar(_) => { - // TODO special-case boolean here - // In all other cases, if left is flex, defer to right. - // (This includes using right's name if both are flex and named.) - merge(subs, ctx, other.clone()) - } + FlexVar(_) => merge( + subs, + ctx, + RecursionVar { + structure, + opt_name: opt_name.clone(), + }, + ), Alias(_, _, actual) => { // look at the type the alias stands for @@ -1227,3 +1237,10 @@ fn gather_tags( _ => TagUnionStructure { tags, ext: var }, } } + +fn is_recursion_var(subs: &Subs, var: Variable) -> bool { + match subs.get_without_compacting(var).content { + Content::RecursionVar { .. } => true, + _ => false, + } +} From 23fe8e5c07b5af3580e650d1bf21e885b71f5cb7 Mon Sep 17 00:00:00 2001 From: Folkert Date: Sun, 15 Nov 2020 00:23:32 +0100 Subject: [PATCH 13/18] fix another nasty rigid problem --- compiler/constrain/src/expr.rs | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/compiler/constrain/src/expr.rs b/compiler/constrain/src/expr.rs index f548ebe359..3b4465b2bf 100644 --- a/compiler/constrain/src/expr.rs +++ b/compiler/constrain/src/expr.rs @@ -1119,8 +1119,11 @@ fn constrain_def(env: &Env, def: &Def, body_con: Constraint) -> Constraint { name, .. }, - Type::Function(arg_types, _, _), + Type::Function(arg_types, _closure_type, ret_type), ) => { + // NOTE if we ever have problems with the closure, the ignored `_closure_type` + // is probably a good place to start the investigation! + let expected = annotation_expected; let region = def.loc_expr.region; @@ -1135,7 +1138,7 @@ fn constrain_def(env: &Env, def: &Def, body_con: Constraint) -> Constraint { let ret_var = *ret_var; let closure_var = *closure_var; let closure_ext_var = *closure_ext_var; - let ret_type = Type::Variable(ret_var); + let ret_type = *ret_type.clone(); vars.push(ret_var); vars.push(closure_var); @@ -1202,7 +1205,7 @@ fn constrain_def(env: &Env, def: &Def, body_con: Constraint) -> Constraint { Box::new(Type::Variable(closure_var)), Box::new(ret_type.clone()), ); - let body_type = NoExpectation(ret_type); + let body_type = NoExpectation(ret_type.clone()); let ret_constraint = constrain_expr(env, loc_body_expr.region, &loc_body_expr.value, body_type); @@ -1224,6 +1227,7 @@ fn constrain_def(env: &Env, def: &Def, body_con: Constraint) -> Constraint { // Store type into AST vars. We use Store so errors aren't reported twice Store(signature.clone(), *fn_var, std::file!(), std::line!()), Store(signature, expr_var, std::file!(), std::line!()), + Store(ret_type, ret_var, std::file!(), std::line!()), closure_constraint, ]), ) @@ -1452,8 +1456,11 @@ pub fn rec_defs_help( name, .. }, - Type::Function(arg_types, _, _), + Type::Function(arg_types, _closure_type, ret_type), ) => { + // NOTE if we ever have trouble with closure type unification, the ignored + // `_closure_type` here is a good place to start investigating + let expected = annotation_expected; let region = def.loc_expr.region; @@ -1468,7 +1475,7 @@ pub fn rec_defs_help( let ret_var = *ret_var; let closure_var = *closure_var; let closure_ext_var = *closure_ext_var; - let ret_type = Type::Variable(ret_var); + let ret_type = *ret_type.clone(); vars.push(ret_var); vars.push(closure_var); @@ -1535,7 +1542,7 @@ pub fn rec_defs_help( Box::new(Type::Variable(closure_var)), Box::new(ret_type.clone()), ); - let body_type = NoExpectation(ret_type); + let body_type = NoExpectation(ret_type.clone()); let expr_con = constrain_expr( env, loc_body_expr.region, @@ -1560,6 +1567,7 @@ pub fn rec_defs_help( // Store type into AST vars. We use Store so errors aren't reported twice Store(signature.clone(), *fn_var, std::file!(), std::line!()), Store(signature, expr_var, std::file!(), std::line!()), + Store(ret_type, ret_var, std::file!(), std::line!()), closure_constraint, ]), ); From 00978994bfdda7b334192442c2966e24b5556126 Mon Sep 17 00:00:00 2001 From: Folkert Date: Sun, 15 Nov 2020 01:46:56 +0100 Subject: [PATCH 14/18] improve a bunch of reported errors --- compiler/reporting/tests/test_reporting.rs | 67 +++++++++++----------- 1 file changed, 34 insertions(+), 33 deletions(-) diff --git a/compiler/reporting/tests/test_reporting.rs b/compiler/reporting/tests/test_reporting.rs index 10fa903e8b..00fcc29f79 100644 --- a/compiler/reporting/tests/test_reporting.rs +++ b/compiler/reporting/tests/test_reporting.rs @@ -1047,7 +1047,7 @@ mod test_reporting { r#" ── TYPE MISMATCH ─────────────────────────────────────────────────────────────── - Something is off with the 1st branch of this `if` expression: + Something is off with the `then` branch of this `if` expression: 2│ x = if True then 3.14 else 4 ^^^^ @@ -1084,12 +1084,14 @@ mod test_reporting { r#" ── TYPE MISMATCH ─────────────────────────────────────────────────────────────── - Something is off with the 1st branch of this `when` expression: + Something is off with the body of the `x` definition: - 4│ _ -> 3.14 - ^^^^ + 1│ x : Int + 2│ x = + 3│> when True is + 4│> _ -> 3.14 - The 1st branch is a float of type: + This `when`expression produces: Float @@ -1123,15 +1125,15 @@ mod test_reporting { 1│ x : Int -> Int 2│ x = \_ -> 3.14 - ^^^^^^^^^^ + ^^^^ - The body is an anonymous function of type: + The body is a float of type: - Int -> Float + Float But the type annotation on `x` says it should be: - Int -> Int + Int Tip: You can convert between Int and Float using functions like `Num.toFloat` and `Num.round`. @@ -1664,7 +1666,7 @@ mod test_reporting { r#" ── TYPE MISMATCH ─────────────────────────────────────────────────────────────── - This `if` has an `else` branch with a different type from its `then` branch: + Something is off with the `else` branch of this `if` expression: 2│ f = \x, y -> if True then x else y ^ @@ -1673,12 +1675,10 @@ mod test_reporting { b - but the `then` branch has the type: + But the type annotation on `f` says it should be: a - I need all branches in an `if` to have the same type! - Tip: Your type annotation uses `b` and `a` as separate type variables. Your code seems to be saying they are the same though. Maybe they should be the same your type annotation? Maybe your code uses them in @@ -1707,15 +1707,15 @@ mod test_reporting { 1│ f : Bool -> msg 2│ f = \_ -> Foo - ^^^^^^^^^ + ^^^ - The body is an anonymous function of type: + This `Foo` global tag has the type: - Bool -> [ Foo ]a + [ Foo ]a But the type annotation on `f` says it should be: - Bool -> msg + msg Tip: The type annotation uses the type variable `msg` to say that this definition can produce any type of value. But in the body I see that @@ -1829,19 +1829,20 @@ mod test_reporting { Something is off with the body of the `f` definition: - 1│ f : Bool -> Int - 2│> f = \_ -> - 3│> ok = 3 - 4│> - 5│> Ok + 1│ f : Bool -> Int + 2│ f = \_ -> + 3│ ok = 3 + 4│ + 5│ Ok + ^^ - The body is an anonymous function of type: + This `Ok` global tag has the type: - Bool -> [ Ok ]a + [ Ok ]a But the type annotation on `f` says it should be: - Bool -> Int + Int "# ), ) @@ -2141,15 +2142,15 @@ mod test_reporting { 1│ f : [ A ] -> [ A, B ] 2│ f = \a -> a - ^^^^^^^ + ^ - The body is an anonymous function of type: + This `a` value is a: - [ A ] -> [ A ] + [ A ] But the type annotation on `f` says it should be: - [ A ] -> [ A, B ] + [ A, B ] Tip: Looks like a closed tag union does not have the `B` tag. @@ -2179,15 +2180,15 @@ mod test_reporting { 1│ f : [ A ] -> [ A, B, C ] 2│ f = \a -> a - ^^^^^^^ + ^ - The body is an anonymous function of type: + This `a` value is a: - [ A ] -> [ A ] + [ A ] But the type annotation on `f` says it should be: - [ A ] -> [ A, B, C ] + [ A, B, C ] Tip: Looks like a closed tag union does not have the `C` and `B` tags. From 197abd8553751f2bd3fb74f477bccb734408ba3f Mon Sep 17 00:00:00 2001 From: Folkert Date: Sun, 15 Nov 2020 02:06:34 +0100 Subject: [PATCH 15/18] change constraints gen to give better errors --- compiler/constrain/src/expr.rs | 41 +++++++++++++++++----------------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/compiler/constrain/src/expr.rs b/compiler/constrain/src/expr.rs index 3b4465b2bf..f6af20974b 100644 --- a/compiler/constrain/src/expr.rs +++ b/compiler/constrain/src/expr.rs @@ -431,6 +431,7 @@ pub fn constrain_expr( match expected { FromAnnotation(name, arity, _, tipe) => { + let num_branches = branches.len() + 1; for (index, (loc_cond, loc_body)) in branches.iter().enumerate() { let cond_con = constrain_expr( env, @@ -448,7 +449,7 @@ pub fn constrain_expr( arity, AnnotationSource::TypedIfBranch { index: Index::zero_based(index), - num_branches: branches.len(), + num_branches, }, tipe.clone(), ), @@ -467,7 +468,7 @@ pub fn constrain_expr( arity, AnnotationSource::TypedIfBranch { index: Index::zero_based(branches.len()), - num_branches: branches.len(), + num_branches, }, tipe.clone(), ), @@ -558,15 +559,12 @@ pub fn constrain_expr( constraints.push(expr_con); match &expected { - FromAnnotation(name, arity, _, typ) => { - // record the type of the whole expression in the AST - let ast_con = Eq( - Type::Variable(*expr_var), - expected.clone(), - Category::Storage(std::file!(), std::line!()), - region, - ); - constraints.push(ast_con); + FromAnnotation(name, arity, _, _typ) => { + // NOTE deviation from elm. + // + // in elm, `_typ` is used, but because we have this `expr_var` too + // and need to constrain it, this is what works and gives better error messages + let typ = Type::Variable(*expr_var); for (index, when_branch) in branches.iter().enumerate() { let pattern_region = @@ -595,6 +593,10 @@ pub fn constrain_expr( constraints.push(branch_con); } + + constraints.push(Eq(typ, expected, Category::When, region)); + + return exists(vec![cond_var, *expr_var], And(constraints)); } _ => { @@ -1124,7 +1126,6 @@ fn constrain_def(env: &Env, def: &Def, body_con: Constraint) -> Constraint { // NOTE if we ever have problems with the closure, the ignored `_closure_type` // is probably a good place to start the investigation! - let expected = annotation_expected; let region = def.loc_expr.region; let loc_body_expr = &**loc_body; @@ -1200,12 +1201,15 @@ fn constrain_def(env: &Env, def: &Def, body_con: Constraint) -> Constraint { &mut vars, ); - let fn_type = Type::Function( - pattern_types, - Box::new(Type::Variable(closure_var)), - Box::new(ret_type.clone()), + let body_type = FromAnnotation( + def.loc_pattern.clone(), + arguments.len(), + AnnotationSource::TypedBody { + region: annotation.region, + }, + ret_type.clone(), ); - let body_type = NoExpectation(ret_type.clone()); + let ret_constraint = constrain_expr(env, loc_body_expr.region, &loc_body_expr.value, body_type); @@ -1222,9 +1226,6 @@ fn constrain_def(env: &Env, def: &Def, body_con: Constraint) -> Constraint { defs_constraint, ret_constraint, })), - // "the closure's type is equal to expected type" - Eq(fn_type, expected, Category::Lambda, region), - // Store type into AST vars. We use Store so errors aren't reported twice Store(signature.clone(), *fn_var, std::file!(), std::line!()), Store(signature, expr_var, std::file!(), std::line!()), Store(ret_type, ret_var, std::file!(), std::line!()), From d55b1a2e8781b39d5ad60f81f142d95f07ad160f Mon Sep 17 00:00:00 2001 From: Folkert Date: Sun, 15 Nov 2020 02:14:12 +0100 Subject: [PATCH 16/18] add tests --- compiler/gen/tests/gen_primitives.rs | 103 +++++++++++++++++++++++++++ compiler/solve/tests/solve_expr.rs | 95 ++++++++++++++++++++++++ 2 files changed, 198 insertions(+) diff --git a/compiler/gen/tests/gen_primitives.rs b/compiler/gen/tests/gen_primitives.rs index 58bec5323e..53c276484e 100644 --- a/compiler/gen/tests/gen_primitives.rs +++ b/compiler/gen/tests/gen_primitives.rs @@ -1278,6 +1278,109 @@ mod gen_primitives { } #[test] + #[ignore] + fn rbtree_balance_inc_dec() { + // TODO does not define a variable correctly, but all is well with the type signature + assert_non_opt_evals_to!( + indoc!( + r#" + app Test provides [ main ] imports [] + + NodeColor : [ Red, Black ] + + Dict k : [ Node NodeColor k (Dict k) (Dict k), Empty ] + + # balance : NodeColor, k, Dict k, Dict k -> Dict k + balance = \color, key, left, right -> + when right is + Node Red rK rLeft rRight -> + when left is + Node Red _ _ _ -> + Node + Red + key + Empty + Empty + + _ -> + Node color rK (Node Red key left rLeft) rRight + + _ -> + Empty + + main : Dict Int + main = + balance Red 0 Empty Empty + "# + ), + 0, + i64 + ); + } + + #[test] + fn rbtree_balance_3() { + assert_non_opt_evals_to!( + indoc!( + r#" + app Test provides [ main ] imports [] + + Dict k : [ Node k (Dict k) (Dict k), Empty ] + + balance : k, Dict k -> Dict k + balance = \key, left -> + Node key left Empty + + main : Dict Int + main = + balance 0 Empty + "# + ), + 1, + i64 + ); + } + + #[test] + fn rbtree_balance_2() { + assert_non_opt_evals_to!( + indoc!( + r#" + app Test provides [ main ] imports [] + + NodeColor : [ Red, Black ] + + Dict k : [ Node NodeColor k (Dict k), Empty ] + + balance : NodeColor, k, Dict k, Dict k -> Dict k + balance = \color, key, left, right -> + when right is + Node Red rK _ -> + when left is + Node Red _ _ -> + Node + Red + key + Empty + + _ -> + Node color rK (Node Red key left ) + + _ -> + Empty + + main : Dict Int + main = + balance Red 0 Empty Empty + "# + ), + 0, + i64 + ); + } + + #[test] + #[ignore] fn rbtree_balance() { assert_non_opt_evals_to!( indoc!( diff --git a/compiler/solve/tests/solve_expr.rs b/compiler/solve/tests/solve_expr.rs index 2a33175150..27d58428b5 100644 --- a/compiler/solve/tests/solve_expr.rs +++ b/compiler/solve/tests/solve_expr.rs @@ -3519,4 +3519,99 @@ mod solve_expr { "Int, Int, List (Num a), Int, Num a -> [ Pair Int (List (Num a)) ]", ); } + + #[test] + fn rbtree_old_balance_simplified() { + infer_eq_without_problem( + indoc!( + r#" + app Test provides [ main ] imports [] + + Dict k : [ Node k (Dict k) (Dict k), Empty ] + + balance : k, Dict k -> Dict k + balance = \key, left -> + Node key left Empty + + main : Dict Int + main = + balance 0 Empty + "# + ), + "Dict Int", + ); + } + + #[test] + fn rbtree_balance_simplified() { + infer_eq_without_problem( + indoc!( + r#" + app Test provides [ main ] imports [] + + Dict k : [ Node k (Dict k) (Dict k), Empty ] + + node = \x,y,z -> Node x y z + + balance : k, Dict k -> Dict k + balance = \key, left -> + node key left Empty + + main : Dict Int + main = + balance 0 Empty + "# + ), + "Dict Int", + ); + } + + #[test] + fn rbtree_balance() { + infer_eq_without_problem( + indoc!( + r#" + app Test provides [ main ] imports [] + + NodeColor : [ Red, Black ] + + Dict k v : [ Node NodeColor k v (Dict k v) (Dict k v), Empty ] + + balance : NodeColor, k, v, Dict k v, Dict k v -> Dict k v + balance = \color, key, value, left, right -> + when right is + Node Red rK rV rLeft rRight -> + when left is + Node Red lK lV lLeft lRight -> + Node + Red + key + value + (Node Black lK lV lLeft lRight) + (Node Black rK rV rLeft rRight) + + _ -> + Node color rK rV (Node Red key value left rLeft) rRight + + _ -> + when left is + Node Red lK lV (Node Red llK llV llLeft llRight) lRight -> + Node + Red + lK + lV + (Node Black llK llV llLeft llRight) + (Node Black key value lRight right) + + _ -> + Node color key value left right + + main : Dict Int Int + main = + balance Red 0 0 Empty Empty + "# + ), + "Dict Int Int", + ); + } } From f8bfd9a9f4dc6f22a6f905a170256b4620842e8b Mon Sep 17 00:00:00 2001 From: Folkert Date: Sun, 15 Nov 2020 02:15:48 +0100 Subject: [PATCH 17/18] clippy --- compiler/unify/src/unify.rs | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/compiler/unify/src/unify.rs b/compiler/unify/src/unify.rs index b63343663a..89fe4b44e9 100644 --- a/compiler/unify/src/unify.rs +++ b/compiler/unify/src/unify.rs @@ -438,7 +438,7 @@ fn unify_tag_union( let recursion_var = match recursion { (None, None) => None, (Some(v), None) | (None, Some(v)) => Some(v), - (Some(v1), Some(v2)) => Some(v1), + (Some(v1), Some(_v2)) => Some(v1), }; if unique_tags1.is_empty() { @@ -1239,8 +1239,5 @@ fn gather_tags( } fn is_recursion_var(subs: &Subs, var: Variable) -> bool { - match subs.get_without_compacting(var).content { - Content::RecursionVar { .. } => true, - _ => false, - } + matches!(subs.get_without_compacting(var).content, Content::RecursionVar { .. }) } From a952d24370d9e434557c6dae8a2e524c9c32b41f Mon Sep 17 00:00:00 2001 From: Folkert Date: Sun, 15 Nov 2020 03:03:52 +0100 Subject: [PATCH 18/18] comment another test --- compiler/gen/tests/gen_primitives.rs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/gen/tests/gen_primitives.rs b/compiler/gen/tests/gen_primitives.rs index 53c276484e..fc9ddc7ac2 100644 --- a/compiler/gen/tests/gen_primitives.rs +++ b/compiler/gen/tests/gen_primitives.rs @@ -1431,8 +1431,10 @@ mod gen_primitives { } #[test] + #[ignore] fn linked_list_guarded_double_pattern_match() { // the important part here is that the first case (with the nested Cons) does not match + // TODO this also has undefined behavior assert_non_opt_evals_to!( indoc!( r#"