diff --git a/compiler/builtins/bitcode/src/list.zig b/compiler/builtins/bitcode/src/list.zig index d012e92e26..e4a994e79b 100644 --- a/compiler/builtins/bitcode/src/list.zig +++ b/compiler/builtins/bitcode/src/list.zig @@ -1109,6 +1109,36 @@ pub fn listAny( return false; } +pub fn listAll( + list: RocList, + caller: Caller1, + data: Opaque, + inc_n_data: IncN, + data_is_owned: bool, + element_width: usize, +) callconv(.C) bool { + if (list.bytes) |source_ptr| { + const size = list.len(); + + if (data_is_owned) { + inc_n_data(data, size); + } + + var i: usize = 0; + while (i < size) : (i += 1) { + var satisfied = false; + const element = source_ptr + i * element_width; + caller(data, element, @ptrCast(?[*]u8, &satisfied)); + + if (!satisfied) { + return false; + } + } + return true; + } + return false; +} + // SWAP ELEMENTS inline fn swapHelp(width: usize, temporary: [*]u8, ptr1: [*]u8, ptr2: [*]u8) void { diff --git a/compiler/builtins/bitcode/src/main.zig b/compiler/builtins/bitcode/src/main.zig index 345b63e48e..8b081cd1cf 100644 --- a/compiler/builtins/bitcode/src/main.zig +++ b/compiler/builtins/bitcode/src/main.zig @@ -51,6 +51,7 @@ comptime { exportListFn(list.listSetInPlace, "set_in_place"); exportListFn(list.listSwap, "swap"); exportListFn(list.listAny, "any"); + exportListFn(list.listAll, "all"); exportListFn(list.listFindUnsafe, "find_unsafe"); } diff --git a/compiler/builtins/docs/List.roc b/compiler/builtins/docs/List.roc index be4f8891c1..e30c0bfe45 100644 --- a/compiler/builtins/docs/List.roc +++ b/compiler/builtins/docs/List.roc @@ -691,6 +691,10 @@ all : List elem, (elem -> Bool) -> Bool ## any of the elements satisfy it. any : List elem, (elem -> Bool) -> Bool +## Run the given predicate on each element of the list, returning `True` if +## all of the elements satisfy it. +all : List elem, (elem -> Bool) -> Bool + ## Returns the first element of the list satisfying a predicate function. ## If no satisfying element is found, an `Err NotFound` is returned. find : List elem, (elem -> Bool) -> Result elem [ NotFound ]* diff --git a/compiler/builtins/src/bitcode.rs b/compiler/builtins/src/bitcode.rs index d00ab60bae..46ee44bf3f 100644 --- a/compiler/builtins/src/bitcode.rs +++ b/compiler/builtins/src/bitcode.rs @@ -196,6 +196,7 @@ pub const LIST_CONCAT: &str = "roc_builtins.list.concat"; pub const LIST_SET: &str = "roc_builtins.list.set"; pub const LIST_SET_IN_PLACE: &str = "roc_builtins.list.set_in_place"; pub const LIST_ANY: &str = "roc_builtins.list.any"; +pub const LIST_ALL: &str = "roc_builtins.list.all"; pub const LIST_FIND_UNSAFE: &str = "roc_builtins.list.find_unsafe"; pub const DEC_FROM_F64: &str = "roc_builtins.dec.from_f64"; diff --git a/compiler/builtins/src/std.rs b/compiler/builtins/src/std.rs index 0f8d1fe154..8e018a6f95 100644 --- a/compiler/builtins/src/std.rs +++ b/compiler/builtins/src/std.rs @@ -1109,6 +1109,16 @@ pub fn types() -> MutMap { Box::new(bool_type()), ); + // all: List elem, (elem -> Bool) -> Bool + add_top_level_function_type!( + Symbol::LIST_ALL, + vec![ + list_type(flex(TVAR1)), + closure(vec![flex(TVAR1)], TVAR2, Box::new(bool_type())), + ], + Box::new(bool_type()), + ); + // sortWith : List a, (a, a -> Ordering) -> List a add_top_level_function_type!( Symbol::LIST_SORT_WITH, diff --git a/compiler/can/src/builtins.rs b/compiler/can/src/builtins.rs index 6e2342ca3e..604374f90f 100644 --- a/compiler/can/src/builtins.rs +++ b/compiler/can/src/builtins.rs @@ -111,6 +111,7 @@ pub fn builtin_defs_map(symbol: Symbol, var_store: &mut VarStore) -> Option LIST_WALK_UNTIL => list_walk_until, LIST_SORT_WITH => list_sort_with, LIST_ANY => list_any, + LIST_ALL => list_all, LIST_FIND => list_find, DICT_LEN => dict_len, DICT_EMPTY => dict_empty, @@ -2855,6 +2856,11 @@ fn list_any(symbol: Symbol, var_store: &mut VarStore) -> Def { lowlevel_2(symbol, LowLevel::ListAny, var_store) } +/// List.all: List elem, (elem -> Bool) -> Bool +fn list_all(symbol: Symbol, var_store: &mut VarStore) -> Def { + lowlevel_2(symbol, LowLevel::ListAll, var_store) +} + /// List.find : List elem, (elem -> Bool) -> Result elem [ NotFound ]* fn list_find(symbol: Symbol, var_store: &mut VarStore) -> Def { let list = Symbol::ARG_1; diff --git a/compiler/gen_llvm/src/llvm/build.rs b/compiler/gen_llvm/src/llvm/build.rs index c0c3401c20..4258b04330 100644 --- a/compiler/gen_llvm/src/llvm/build.rs +++ b/compiler/gen_llvm/src/llvm/build.rs @@ -8,7 +8,7 @@ use crate::llvm::build_dict::{ }; use crate::llvm::build_hash::generic_hash; use crate::llvm::build_list::{ - self, allocate_list, empty_list, empty_polymorphic_list, list_any, list_append, list_concat, + self, allocate_list, empty_list, empty_polymorphic_list, list_any, list_all, list_append, list_concat, list_contains, list_drop_at, list_find_trivial_not_found, list_find_unsafe, list_get_unsafe, list_join, list_keep_errs, list_keep_if, list_keep_oks, list_len, list_map, list_map2, list_map3, list_map4, list_map_with_index, list_prepend, list_range, list_repeat, list_reverse, @@ -5141,6 +5141,31 @@ fn run_higher_order_low_level<'a, 'ctx, 'env>( _ => unreachable!("invalid list layout"), } } + ListAll { xs } => { + let (list, list_layout) = load_symbol_and_layout(scope, xs); + let (function, closure, closure_layout) = function_details!(); + + match list_layout { + Layout::Builtin(Builtin::EmptyList) => env.context.bool_type().const_zero().into(), + Layout::Builtin(Builtin::List(element_layout)) => { + let argument_layouts = &[**element_layout]; + + let roc_function_call = roc_function_call( + env, + layout_ids, + function, + closure, + closure_layout, + function_owns_closure_data, + argument_layouts, + Layout::Builtin(Builtin::Int1), + ); + + list_all(env, roc_function_call, list, element_layout) + } + _ => unreachable!("invalid list layout"), + } + } ListFindUnsafe { xs } => { let (list, list_layout) = load_symbol_and_layout(scope, xs); @@ -6041,7 +6066,7 @@ fn run_low_level<'a, 'ctx, 'env>( ListMap | ListMap2 | ListMap3 | ListMap4 | ListMapWithIndex | ListKeepIf | ListWalk | ListWalkUntil | ListWalkBackwards | ListKeepOks | ListKeepErrs | ListSortWith - | ListAny | ListFindUnsafe | DictWalk => { + | ListAny | ListAll | ListFindUnsafe | DictWalk => { unreachable!("these are higher order, and are handled elsewhere") } } diff --git a/compiler/gen_llvm/src/llvm/build_list.rs b/compiler/gen_llvm/src/llvm/build_list.rs index 3806bc8b72..a62b7a2f47 100644 --- a/compiler/gen_llvm/src/llvm/build_list.rs +++ b/compiler/gen_llvm/src/llvm/build_list.rs @@ -926,6 +926,27 @@ pub fn list_any<'a, 'ctx, 'env>( ) } +/// List.all : List elem, \(elem -> Bool) -> Bool +pub fn list_all<'a, 'ctx, 'env>( + env: &Env<'a, 'ctx, 'env>, + roc_function_call: RocFunctionCall<'ctx>, + list: BasicValueEnum<'ctx>, + element_layout: &Layout<'a>, +) -> BasicValueEnum<'ctx> { + call_bitcode_fn( + env, + &[ + pass_list_cc(env, list), + roc_function_call.caller.into(), + pass_as_opaque(env, roc_function_call.data), + roc_function_call.inc_n_data.into(), + roc_function_call.data_is_owned.into(), + layout_width(env, element_layout), + ], + bitcode::LIST_ALL, + ) +} + /// List.findUnsafe : List elem, (elem -> Bool) -> { value: elem, found: bool } pub fn list_find_unsafe<'a, 'ctx, 'env>( env: &Env<'a, 'ctx, 'env>, diff --git a/compiler/gen_wasm/src/low_level.rs b/compiler/gen_wasm/src/low_level.rs index e5b5da9bbb..07109404d1 100644 --- a/compiler/gen_wasm/src/low_level.rs +++ b/compiler/gen_wasm/src/low_level.rs @@ -34,7 +34,7 @@ pub fn decode_low_level<'a>( | ListConcat | ListContains | ListAppend | ListPrepend | ListJoin | ListRange | ListMap | ListMap2 | ListMap3 | ListMap4 | ListMapWithIndex | ListKeepIf | ListWalk | ListWalkUntil | ListWalkBackwards | ListKeepOks | ListKeepErrs | ListSortWith - | ListSublist | ListDropAt | ListSwap | ListAny | ListFindUnsafe | DictSize | DictEmpty + | ListSublist | ListDropAt | ListSwap | ListAny | ListAll | ListFindUnsafe | DictSize | DictEmpty | DictInsert | DictRemove | DictContains | DictGetUnsafe | DictKeys | DictValues | DictUnion | DictIntersection | DictDifference | DictWalk | SetFromList => { return NotImplemented; diff --git a/compiler/module/src/low_level.rs b/compiler/module/src/low_level.rs index 77f551b980..9405956fc0 100644 --- a/compiler/module/src/low_level.rs +++ b/compiler/module/src/low_level.rs @@ -50,6 +50,7 @@ pub enum LowLevel { ListDropAt, ListSwap, ListAny, + ListAll, ListFindUnsafe, DictSize, DictEmpty, @@ -131,6 +132,7 @@ macro_rules! higher_order { | ListKeepErrs | ListSortWith | ListAny + | ListAll | ListFindUnsafe | DictWalk }; @@ -162,6 +164,7 @@ impl LowLevel { ListKeepErrs => 1, ListSortWith => 1, ListAny => 1, + ListAll => 1, ListFindUnsafe => 1, DictWalk => 2, _ => unreachable!(), @@ -220,6 +223,7 @@ impl LowLevel { Symbol::LIST_DROP_AT => Some(ListDropAt), Symbol::LIST_SWAP => Some(ListSwap), Symbol::LIST_ANY => Some(ListAny), + Symbol::LIST_ALL => Some(ListAll), Symbol::LIST_FIND => None, Symbol::DICT_LEN => Some(DictSize), Symbol::DICT_EMPTY => Some(DictEmpty), diff --git a/compiler/module/src/symbol.rs b/compiler/module/src/symbol.rs index 44bf51012a..499d6d84ee 100644 --- a/compiler/module/src/symbol.rs +++ b/compiler/module/src/symbol.rs @@ -1072,6 +1072,7 @@ define_builtins! { 47 LIST_FIND: "find" 48 LIST_FIND_RESULT: "#find_result" // symbol used in the definition of List.find 49 LIST_SUBLIST: "sublist" + 50 LIST_ALL: "all" } 5 RESULT: "Result" => { 0 RESULT_RESULT: "Result" imported // the Result.Result type alias diff --git a/compiler/mono/src/alias_analysis.rs b/compiler/mono/src/alias_analysis.rs index 6acb90d50d..306b2a52ae 100644 --- a/compiler/mono/src/alias_analysis.rs +++ b/compiler/mono/src/alias_analysis.rs @@ -1093,6 +1093,25 @@ fn call_spec( add_loop(builder, block, state_type, init_state, loop_body) } + ListAll { xs } => { + let list = env.symbols[xs]; + + let loop_body = |builder: &mut FuncDefBuilder, block, _state| { + let bag = builder.add_get_tuple_field(block, list, LIST_BAG_INDEX)?; + let element = builder.add_bag_get(block, bag)?; + + let new_state = call_function!(builder, block, [element]); + + Ok(new_state) + }; + + let state_layout = Layout::Builtin(Builtin::Int1); + let state_type = layout_spec(builder, &state_layout)?; + + let init_state = new_num(builder, block)?; + + add_loop(builder, block, state_type, init_state, loop_body) + } ListFindUnsafe { xs } => { let list = env.symbols[xs]; diff --git a/compiler/mono/src/borrow.rs b/compiler/mono/src/borrow.rs index bef854f20b..bc5492c8bf 100644 --- a/compiler/mono/src/borrow.rs +++ b/compiler/mono/src/borrow.rs @@ -619,6 +619,7 @@ impl<'a> BorrowInfState<'a> { | ListKeepOks { xs } | ListKeepErrs { xs } | ListAny { xs } + | ListAll { xs } | ListFindUnsafe { xs } => { // own the list if the function wants to own the element if !function_ps[0].borrow { @@ -953,7 +954,7 @@ pub fn lowlevel_borrow_signature(arena: &Bump, op: LowLevel) -> &[bool] { ListMap2 => arena.alloc_slice_copy(&[owned, owned, function, closure_data]), ListMap3 => arena.alloc_slice_copy(&[owned, owned, owned, function, closure_data]), ListMap4 => arena.alloc_slice_copy(&[owned, owned, owned, owned, function, closure_data]), - ListKeepIf | ListKeepOks | ListKeepErrs | ListAny => { + ListKeepIf | ListKeepOks | ListKeepErrs | ListAny | ListAll => { arena.alloc_slice_copy(&[owned, function, closure_data]) } ListContains => arena.alloc_slice_copy(&[borrowed, irrelevant]), diff --git a/compiler/mono/src/inc_dec.rs b/compiler/mono/src/inc_dec.rs index 63604bf205..c6dfd67314 100644 --- a/compiler/mono/src/inc_dec.rs +++ b/compiler/mono/src/inc_dec.rs @@ -536,6 +536,7 @@ impl<'a> Context<'a> { | ListKeepOks { xs } | ListKeepErrs { xs } | ListAny { xs } + | ListAll { xs } | ListFindUnsafe { xs } => { let borrows = [function_ps[0].borrow, FUNCTION, CLOSURE_DATA]; diff --git a/compiler/mono/src/ir.rs b/compiler/mono/src/ir.rs index 32be663338..d70ae54b46 100644 --- a/compiler/mono/src/ir.rs +++ b/compiler/mono/src/ir.rs @@ -4086,6 +4086,12 @@ pub fn with_hole<'a>( let xs = arg_symbols[0]; match_on_closure_argument!(ListAny, [xs]) } + ListAll => { + debug_assert_eq!(arg_symbols.len(), 2); + let xs = arg_symbols[0]; + match_on_closure_argument!(ListAll, [xs]) + } + ListKeepOks => { debug_assert_eq!(arg_symbols.len(), 2); let xs = arg_symbols[0]; diff --git a/compiler/mono/src/low_level.rs b/compiler/mono/src/low_level.rs index 058a2958eb..7053ef87ae 100644 --- a/compiler/mono/src/low_level.rs +++ b/compiler/mono/src/low_level.rs @@ -50,6 +50,9 @@ pub enum HigherOrder { ListAny { xs: Symbol, }, + ListAll { + xs: Symbol, + }, ListFindUnsafe { xs: Symbol, }, @@ -77,6 +80,7 @@ impl HigherOrder { HigherOrder::ListFindUnsafe { .. } => 1, HigherOrder::DictWalk { .. } => 2, HigherOrder::ListAny { .. } => 1, + HigherOrder::ListAll { .. } => 1, } } } diff --git a/compiler/test_gen/src/gen_list.rs b/compiler/test_gen/src/gen_list.rs index 5e0f737e72..97840d8ce1 100644 --- a/compiler/test_gen/src/gen_list.rs +++ b/compiler/test_gen/src/gen_list.rs @@ -2352,6 +2352,28 @@ fn list_any_empty_with_unknown_element_type() { assert_evals_to!("List.any [] (\\_ -> True)", false, bool); } +#[test] +#[cfg(any(feature = "gen-llvm"))] +fn list_all() { + assert_evals_to!("List.all [] (\\e -> e > 3)", false, bool); + assert_evals_to!("List.all [ 1, 2, 3 ] (\\e -> e > 3)", false, bool); + assert_evals_to!("List.all [ 1, 2, 4 ] (\\e -> e > 3)", false, bool); + assert_evals_to!("List.all [ 1, 2, 3 ] (\\e -> e >= 1", true, bool); +} + +#[test] +#[cfg(any(feature = "gen-llvm"))] +#[should_panic(expected = r#"Roc failed with message: "UnresolvedTypeVar"#)] +fn list_all_empty_with_unknown_element_type() { + // Segfaults with invalid memory reference. Running this as a stand-alone + // Roc program, generates the following error message: + // + // Application crashed with message + // UnresolvedTypeVar compiler/mono/src/ir.rs line 3775 + // Shutting down + assert_evals_to!("List.all [] (\\_ -> True)", false, bool); +} + #[test] #[cfg(any(feature = "gen-llvm"))] #[should_panic(expected = r#"Roc failed with message: "invalid ret_layout""#)]