Merge remote-tracking branch 'origin/trunk' into partialproc-by-reference

compiler/mono/src/alias_analysis.rs

@@ -561,6 +561,84 @@ fn build_tuple_type(builder: &mut impl TypeContext, layouts: &[Layout]) -> Resul
     builder.add_tuple_type(&field_types)
 }
 
+#[repr(u32)]
+#[derive(Clone, Copy)]
+enum KeepResult {
+    Errs = ERR_TAG_ID,
+    Oks = OK_TAG_ID,
+}
+
+impl KeepResult {
+    fn invert(&self) -> Self {
+        match self {
+            KeepResult::Errs => KeepResult::Oks,
+            KeepResult::Oks => KeepResult::Errs,
+        }
+    }
+}
+
+#[derive(Clone, Copy)]
+enum ResultRepr<'a> {
+    Int1,
+    NonRecursive { err: Layout<'a>, ok: Layout<'a> },
+}
+
+impl<'a> ResultRepr<'a> {
+    fn from_layout(layout: &Layout<'a>) -> Self {
+        match layout {
+            Layout::Union(UnionLayout::NonRecursive(tags)) => ResultRepr::NonRecursive {
+                err: tags[ERR_TAG_ID as usize][0],
+                ok: tags[OK_TAG_ID as usize][0],
+            },
+            Layout::Builtin(Builtin::Int1) => ResultRepr::Int1,
+            other => unreachable!("unexpected layout: {:?}", other),
+        }
+    }
+
+    fn unwrap(
+        &self,
+        builder: &mut FuncDefBuilder,
+        block: BlockId,
+        err_or_ok: ValueId,
+        keep_tag_id: u32,
+    ) -> Result<ValueId> {
+        match self {
+            ResultRepr::NonRecursive { .. } => {
+                let unwrapped = builder.add_unwrap_union(block, err_or_ok, keep_tag_id)?;
+
+                builder.add_get_tuple_field(block, unwrapped, 0)
+            }
+            ResultRepr::Int1 => builder.add_make_tuple(block, &[]),
+        }
+    }
+}
+
+fn add_loop(
+    builder: &mut FuncDefBuilder,
+    block: BlockId,
+    state_type: TypeId,
+    init_state: ValueId,
+    make_body: impl for<'a> FnOnce(&'a mut FuncDefBuilder, BlockId, ValueId) -> Result<ValueId>,
+) -> Result<ValueId> {
+    let sub_block = builder.add_block();
+    let (loop_cont, loop_arg) = builder.declare_continuation(sub_block, state_type, state_type)?;
+    let body = builder.add_block();
+    let ret_branch = builder.add_block();
+    let loop_branch = builder.add_block();
+    let new_state = make_body(builder, loop_branch, loop_arg)?;
+    let unreachable = builder.add_jump(loop_branch, loop_cont, new_state, state_type)?;
+    let result = builder.add_choice(
+        body,
+        &[
+            BlockExpr(ret_branch, loop_arg),
+            BlockExpr(loop_branch, unreachable),
+        ],
+    )?;
+    builder.define_continuation(loop_cont, BlockExpr(body, result))?;
+    let unreachable = builder.add_jump(sub_block, loop_cont, init_state, state_type)?;
+    builder.add_sub_block(block, BlockExpr(sub_block, unreachable))
+}
+
 fn call_spec(
     builder: &mut FuncDefBuilder,
     env: &Env,
@@ -613,6 +691,7 @@ fn call_spec(
         HigherOrderLowLevel {
             specialization_id,
             closure_env_layout,
+            update_mode,
             op,
             arg_layouts,
             ret_layout,
@@ -620,194 +699,405 @@ fn call_spec(
             function_env,
             ..
         } => {
+            use crate::low_level::HigherOrder::*;
+
             let array = specialization_id.to_bytes();
             let spec_var = CalleeSpecVar(&array);
 
+            let mode = update_mode.to_bytes();
+            let update_mode_var = UpdateModeVar(&mode);
+
             let it = arg_layouts.iter().copied();
             let bytes = func_name_bytes_help(*function_name, it, *ret_layout);
             let name = FuncName(&bytes);
             let module = MOD_APP;
 
-            use crate::low_level::HigherOrder::*;
+            let closure_env = env.symbols[function_env];
+
+            macro_rules! call_function {
+                ($builder: expr, $block:expr, [$($arg:expr),+ $(,)?]) => {{
+                    let argument = if closure_env_layout.is_none() {
+                        $builder.add_make_tuple($block, &[$($arg),+])?
+                    } else {
+                        $builder.add_make_tuple($block, &[$($arg),+, closure_env])?
+                    };
+
+                    $builder.add_call($block, spec_var, module, name, argument)?
+                }};
+            }
 
             match op {
                 DictWalk { xs, state } => {
                     let dict = env.symbols[xs];
                     let state = env.symbols[state];
-                    let closure_env = env.symbols[function_env];
 
-                    let bag = builder.add_get_tuple_field(block, dict, DICT_BAG_INDEX)?;
-                    let _cell = builder.add_get_tuple_field(block, dict, DICT_CELL_INDEX)?;
+                    let loop_body = |builder: &mut FuncDefBuilder, block, state| {
+                        let bag = builder.add_get_tuple_field(block, dict, DICT_BAG_INDEX)?;
 
-                    let first = builder.add_bag_get(block, bag)?;
+                        let element = builder.add_bag_get(block, bag)?;
 
-                    let key = builder.add_get_tuple_field(block, first, 0)?;
-                    let val = builder.add_get_tuple_field(block, first, 1)?;
+                        let key = builder.add_get_tuple_field(block, element, 0)?;
+                        let val = builder.add_get_tuple_field(block, element, 1)?;
 
-                    let argument = if closure_env_layout.is_none() {
-                        builder.add_make_tuple(block, &[state, key, val])?
-                    } else {
-                        builder.add_make_tuple(block, &[state, key, val, closure_env])?
+                        let new_state = call_function!(builder, block, [state, key, val]);
+
+                        Ok(new_state)
                     };
-                    builder.add_call(block, spec_var, module, name, argument)?;
+
+                    let state_layout = arg_layouts[0];
+                    let state_type = layout_spec(builder, &state_layout)?;
+                    let init_state = state;
+
+                    add_loop(builder, block, state_type, init_state, loop_body)
                 }
 
-                ListWalk { xs, state }
-                | ListWalkBackwards { xs, state }
-                | ListWalkUntil { xs, state } => {
+                ListWalk { xs, state } | ListWalkBackwards { xs, state } => {
                     let list = env.symbols[xs];
                     let state = env.symbols[state];
-                    let closure_env = env.symbols[function_env];
 
-                    let bag = builder.add_get_tuple_field(block, list, LIST_BAG_INDEX)?;
-                    let _cell = builder.add_get_tuple_field(block, list, LIST_CELL_INDEX)?;
+                    let loop_body = |builder: &mut FuncDefBuilder, block, state| {
+                        let bag = builder.add_get_tuple_field(block, list, LIST_BAG_INDEX)?;
 
-                    let first = builder.add_bag_get(block, bag)?;
+                        let element = builder.add_bag_get(block, bag)?;
 
-                    let argument = if closure_env_layout.is_none() {
-                        builder.add_make_tuple(block, &[state, first])?
-                    } else {
-                        builder.add_make_tuple(block, &[state, first, closure_env])?
+                        let new_state = call_function!(builder, block, [state, element]);
+
+                        Ok(new_state)
                     };
-                    builder.add_call(block, spec_var, module, name, argument)?;
+
+                    let state_layout = arg_layouts[0];
+                    let state_type = layout_spec(builder, &state_layout)?;
+                    let init_state = state;
+
+                    add_loop(builder, block, state_type, init_state, loop_body)
+                }
+                ListWalkUntil { xs, state } => {
+                    let list = env.symbols[xs];
+                    let state = env.symbols[state];
+
+                    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 continue_or_stop = call_function!(builder, block, [state, element]);
+
+                        // just assume it is a continue
+                        let unwrapped = builder.add_unwrap_union(block, continue_or_stop, 0)?;
+                        let new_state = builder.add_get_tuple_field(block, unwrapped, 0)?;
+
+                        Ok(new_state)
+                    };
+
+                    let state_layout = arg_layouts[0];
+                    let state_type = layout_spec(builder, &state_layout)?;
+                    let init_state = state;
+
+                    add_loop(builder, block, state_type, init_state, loop_body)
                 }
 
                 ListMapWithIndex { xs } => {
                     let list = env.symbols[xs];
-                    let closure_env = env.symbols[function_env];
 
-                    let bag = builder.add_get_tuple_field(block, list, LIST_BAG_INDEX)?;
-                    let _cell = builder.add_get_tuple_field(block, list, LIST_CELL_INDEX)?;
+                    let loop_body = |builder: &mut FuncDefBuilder, block, state| {
+                        let input_bag = builder.add_get_tuple_field(block, list, LIST_BAG_INDEX)?;
 
-                    let first = builder.add_bag_get(block, bag)?;
-                    let index = builder.add_make_tuple(block, &[])?;
+                        let element = builder.add_bag_get(block, input_bag)?;
+                        let index = builder.add_make_tuple(block, &[])?;
 
-                    let argument = if closure_env_layout.is_none() {
-                        builder.add_make_tuple(block, &[index, first])?
-                    } else {
-                        builder.add_make_tuple(block, &[index, first, closure_env])?
+                        let new_element = call_function!(builder, block, [index, element]);
+
+                        list_append(builder, block, update_mode_var, state, new_element)
                     };
-                    builder.add_call(block, spec_var, module, name, argument)?;
+
+                    let output_element_type = layout_spec(builder, ret_layout)?;
+
+                    let state_layout = Layout::Builtin(Builtin::List(ret_layout));
+                    let state_type = layout_spec(builder, &state_layout)?;
+
+                    let init_state = new_list(builder, block, output_element_type)?;
+
+                    add_loop(builder, block, state_type, init_state, loop_body)
                 }
 
                 ListMap { xs } => {
                     let list = env.symbols[xs];
-                    let closure_env = env.symbols[function_env];
 
-                    let bag1 = builder.add_get_tuple_field(block, list, LIST_BAG_INDEX)?;
-                    let _cell1 = builder.add_get_tuple_field(block, list, LIST_CELL_INDEX)?;
+                    let loop_body = |builder: &mut FuncDefBuilder, block, state| {
+                        let input_bag = builder.add_get_tuple_field(block, list, LIST_BAG_INDEX)?;
 
-                    let elem1 = builder.add_bag_get(block, bag1)?;
+                        let element = builder.add_bag_get(block, input_bag)?;
 
-                    let argument = if closure_env_layout.is_none() {
-                        builder.add_make_tuple(block, &[elem1])?
-                    } else {
-                        builder.add_make_tuple(block, &[elem1, closure_env])?
+                        let new_element = call_function!(builder, block, [element]);
+
+                        list_append(builder, block, update_mode_var, state, new_element)
                     };
-                    builder.add_call(block, spec_var, module, name, argument)?;
+
+                    let output_element_type = layout_spec(builder, ret_layout)?;
+
+                    let state_layout = Layout::Builtin(Builtin::List(ret_layout));
+                    let state_type = layout_spec(builder, &state_layout)?;
+
+                    let init_state = new_list(builder, block, output_element_type)?;
+
+                    add_loop(builder, block, state_type, init_state, loop_body)
                 }
 
                 ListSortWith { xs } => {
                     let list = env.symbols[xs];
-                    let closure_env = env.symbols[function_env];
 
-                    let bag1 = builder.add_get_tuple_field(block, list, LIST_BAG_INDEX)?;
-                    let _cell1 = builder.add_get_tuple_field(block, list, LIST_CELL_INDEX)?;
+                    let loop_body = |builder: &mut FuncDefBuilder, block, state| {
+                        let bag = builder.add_get_tuple_field(block, state, LIST_BAG_INDEX)?;
+                        let cell = builder.add_get_tuple_field(block, state, LIST_CELL_INDEX)?;
 
-                    let elem1 = builder.add_bag_get(block, bag1)?;
+                        let element_1 = builder.add_bag_get(block, bag)?;
+                        let element_2 = builder.add_bag_get(block, bag)?;
 
-                    let argument = if closure_env_layout.is_none() {
-                        builder.add_make_tuple(block, &[elem1, elem1])?
-                    } else {
-                        builder.add_make_tuple(block, &[elem1, elem1, closure_env])?
+                        let _ = call_function!(builder, block, [element_1, element_2]);
+
+                        builder.add_update(block, update_mode_var, cell)?;
+
+                        let new_cell = builder.add_new_heap_cell(block)?;
+                        builder.add_make_tuple(block, &[new_cell, bag])
                     };
-                    builder.add_call(block, spec_var, module, name, argument)?;
+
+                    let state_layout = Layout::Builtin(Builtin::List(&arg_layouts[0]));
+                    let state_type = layout_spec(builder, &state_layout)?;
+                    let init_state = list;
+
+                    add_loop(builder, block, state_type, init_state, loop_body)
                 }
 
                 ListMap2 { xs, ys } => {
                     let list1 = env.symbols[xs];
                     let list2 = env.symbols[ys];
-                    let closure_env = env.symbols[function_env];
 
-                    let bag1 = builder.add_get_tuple_field(block, list1, LIST_BAG_INDEX)?;
-                    let _cell1 = builder.add_get_tuple_field(block, list1, LIST_CELL_INDEX)?;
-                    let elem1 = builder.add_bag_get(block, bag1)?;
+                    let loop_body = |builder: &mut FuncDefBuilder, block, state| {
+                        let input_bag_1 =
+                            builder.add_get_tuple_field(block, list1, LIST_BAG_INDEX)?;
+                        let input_bag_2 =
+                            builder.add_get_tuple_field(block, list2, LIST_BAG_INDEX)?;
 
-                    let bag2 = builder.add_get_tuple_field(block, list2, LIST_BAG_INDEX)?;
-                    let _cell2 = builder.add_get_tuple_field(block, list2, LIST_CELL_INDEX)?;
-                    let elem2 = builder.add_bag_get(block, bag2)?;
+                        let element_1 = builder.add_bag_get(block, input_bag_1)?;
+                        let element_2 = builder.add_bag_get(block, input_bag_2)?;
 
-                    let argument = if closure_env_layout.is_none() {
-                        builder.add_make_tuple(block, &[elem1, elem2])?
-                    } else {
-                        builder.add_make_tuple(block, &[elem1, elem2, closure_env])?
+                        let new_element = call_function!(builder, block, [element_1, element_2]);
+
+                        list_append(builder, block, update_mode_var, state, new_element)
                     };
-                    builder.add_call(block, spec_var, module, name, argument)?;
+
+                    let output_element_type = layout_spec(builder, ret_layout)?;
+
+                    let state_layout = Layout::Builtin(Builtin::List(ret_layout));
+                    let state_type = layout_spec(builder, &state_layout)?;
+
+                    let init_state = new_list(builder, block, output_element_type)?;
+
+                    add_loop(builder, block, state_type, init_state, loop_body)
                 }
 
                 ListMap3 { xs, ys, zs } => {
                     let list1 = env.symbols[xs];
                     let list2 = env.symbols[ys];
                     let list3 = env.symbols[zs];
-                    let closure_env = env.symbols[function_env];
 
-                    let bag1 = builder.add_get_tuple_field(block, list1, LIST_BAG_INDEX)?;
-                    let _cell1 = builder.add_get_tuple_field(block, list1, LIST_CELL_INDEX)?;
-                    let elem1 = builder.add_bag_get(block, bag1)?;
+                    let loop_body = |builder: &mut FuncDefBuilder, block, state| {
+                        let input_bag_1 =
+                            builder.add_get_tuple_field(block, list1, LIST_BAG_INDEX)?;
+                        let input_bag_2 =
+                            builder.add_get_tuple_field(block, list2, LIST_BAG_INDEX)?;
+                        let input_bag_3 =
+                            builder.add_get_tuple_field(block, list3, LIST_BAG_INDEX)?;
 
-                    let bag2 = builder.add_get_tuple_field(block, list2, LIST_BAG_INDEX)?;
-                    let _cell2 = builder.add_get_tuple_field(block, list2, LIST_CELL_INDEX)?;
-                    let elem2 = builder.add_bag_get(block, bag2)?;
+                        let element_1 = builder.add_bag_get(block, input_bag_1)?;
+                        let element_2 = builder.add_bag_get(block, input_bag_2)?;
+                        let element_3 = builder.add_bag_get(block, input_bag_3)?;
 
-                    let bag3 = builder.add_get_tuple_field(block, list3, LIST_BAG_INDEX)?;
-                    let _cell3 = builder.add_get_tuple_field(block, list3, LIST_CELL_INDEX)?;
-                    let elem3 = builder.add_bag_get(block, bag3)?;
+                        let new_element =
+                            call_function!(builder, block, [element_1, element_2, element_3]);
 
-                    let argument = if closure_env_layout.is_none() {
-                        builder.add_make_tuple(block, &[elem1, elem2, elem3])?
-                    } else {
-                        builder.add_make_tuple(block, &[elem1, elem2, elem3, closure_env])?
+                        list_append(builder, block, update_mode_var, state, new_element)
                     };
-                    builder.add_call(block, spec_var, module, name, argument)?;
+
+                    let output_element_type = layout_spec(builder, ret_layout)?;
+
+                    let state_layout = Layout::Builtin(Builtin::List(ret_layout));
+                    let state_type = layout_spec(builder, &state_layout)?;
+
+                    let init_state = new_list(builder, block, output_element_type)?;
+
+                    add_loop(builder, block, state_type, init_state, loop_body)
+                }
+                ListMap4 { xs, ys, zs, ws } => {
+                    let list1 = env.symbols[xs];
+                    let list2 = env.symbols[ys];
+                    let list3 = env.symbols[zs];
+                    let list4 = env.symbols[ws];
+
+                    let loop_body = |builder: &mut FuncDefBuilder, block, state| {
+                        let input_bag_1 =
+                            builder.add_get_tuple_field(block, list1, LIST_BAG_INDEX)?;
+                        let input_bag_2 =
+                            builder.add_get_tuple_field(block, list2, LIST_BAG_INDEX)?;
+                        let input_bag_3 =
+                            builder.add_get_tuple_field(block, list3, LIST_BAG_INDEX)?;
+                        let input_bag_4 =
+                            builder.add_get_tuple_field(block, list4, LIST_BAG_INDEX)?;
+
+                        let element_1 = builder.add_bag_get(block, input_bag_1)?;
+                        let element_2 = builder.add_bag_get(block, input_bag_2)?;
+                        let element_3 = builder.add_bag_get(block, input_bag_3)?;
+                        let element_4 = builder.add_bag_get(block, input_bag_4)?;
+
+                        let new_element = call_function!(
+                            builder,
+                            block,
+                            [element_1, element_2, element_3, element_4]
+                        );
+
+                        list_append(builder, block, update_mode_var, state, new_element)
+                    };
+
+                    let output_element_type = layout_spec(builder, ret_layout)?;
+
+                    let state_layout = Layout::Builtin(Builtin::List(ret_layout));
+                    let state_type = layout_spec(builder, &state_layout)?;
+
+                    let init_state = new_list(builder, block, output_element_type)?;
+
+                    add_loop(builder, block, state_type, init_state, loop_body)
                 }
 
-                ListKeepIf { xs } | ListKeepOks { xs } | ListKeepErrs { xs } => {
+                ListKeepIf { xs } => {
                     let list = env.symbols[xs];
-                    let closure_env = env.symbols[function_env];
 
-                    let bag = builder.add_get_tuple_field(block, list, LIST_BAG_INDEX)?;
-                    // let _cell = builder.add_get_tuple_field(block, list, LIST_CELL_INDEX)?;
+                    let loop_body = |builder: &mut FuncDefBuilder, block, state| {
+                        let bag = builder.add_get_tuple_field(block, state, LIST_BAG_INDEX)?;
+                        let cell = builder.add_get_tuple_field(block, state, LIST_CELL_INDEX)?;
 
-                    let first = builder.add_bag_get(block, bag)?;
+                        let element = builder.add_bag_get(block, bag)?;
 
-                    let argument = if closure_env_layout.is_none() {
-                        builder.add_make_tuple(block, &[first])?
-                    } else {
-                        builder.add_make_tuple(block, &[first, closure_env])?
+                        let _ = call_function!(builder, block, [element]);
+
+                        // NOTE: we assume the element is not kept
+                        builder.add_update(block, update_mode_var, cell)?;
+
+                        let removed = builder.add_bag_remove(block, bag)?;
+
+                        // decrement the removed element
+                        let removed_element = builder.add_get_tuple_field(block, removed, 1)?;
+                        builder.add_recursive_touch(block, removed_element)?;
+
+                        let new_bag = builder.add_get_tuple_field(block, removed, 0)?;
+                        let new_cell = builder.add_new_heap_cell(block)?;
+
+                        builder.add_make_tuple(block, &[new_cell, new_bag])
                     };
-                    let result = builder.add_call(block, spec_var, module, name, argument)?;
-                    let unit = builder.add_tuple_type(&[])?;
-                    builder.add_unknown_with(block, &[result], unit)?;
+
+                    let state_layout = Layout::Builtin(Builtin::List(&arg_layouts[0]));
+                    let state_type = layout_spec(builder, &state_layout)?;
+                    let init_state = list;
+
+                    add_loop(builder, block, state_type, init_state, loop_body)
+                }
+                ListKeepOks { xs } | ListKeepErrs { xs } => {
+                    let list = env.symbols[xs];
+
+                    let keep_result = match op {
+                        ListKeepOks { .. } => KeepResult::Oks,
+                        ListKeepErrs { .. } => KeepResult::Errs,
+                        _ => unreachable!(),
+                    };
+
+                    let result_repr = ResultRepr::from_layout(ret_layout);
+
+                    let output_element_layout = match (keep_result, result_repr) {
+                        (KeepResult::Errs, ResultRepr::NonRecursive { err, .. }) => err,
+                        (KeepResult::Oks, ResultRepr::NonRecursive { ok, .. }) => ok,
+                        (_, ResultRepr::Int1) => Layout::Struct(&[]),
+                    };
+
+                    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 err_or_ok = call_function!(builder, block, [element]);
+
+                        let kept_branch = builder.add_block();
+                        let not_kept_branch = builder.add_block();
+
+                        let element_kept = {
+                            let block = kept_branch;
+
+                            // a Result can be represented as a Int1
+                            let new_element = result_repr.unwrap(
+                                builder,
+                                block,
+                                err_or_ok,
+                                keep_result as u32,
+                            )?;
+
+                            list_append(builder, block, update_mode_var, state, new_element)?
+                        };
+
+                        let element_not_kept = {
+                            let block = not_kept_branch;
+
+                            // a Result can be represented as a Int1
+                            let dropped_element = result_repr.unwrap(
+                                builder,
+                                block,
+                                err_or_ok,
+                                keep_result.invert() as u32,
+                            )?;
+
+                            // decrement the element we will not keep
+                            builder.add_recursive_touch(block, dropped_element)?;
+
+                            state
+                        };
+
+                        builder.add_choice(
+                            block,
+                            &[
+                                BlockExpr(not_kept_branch, element_not_kept),
+                                BlockExpr(kept_branch, element_kept),
+                            ],
+                        )
+                    };
+
+                    let output_element_type = layout_spec(builder, &output_element_layout)?;
+                    let init_state = new_list(builder, block, output_element_type)?;
+
+                    let state_layout = Layout::Builtin(Builtin::List(&output_element_layout));
+                    let state_type = layout_spec(builder, &state_layout)?;
+
+                    add_loop(builder, block, state_type, init_state, loop_body)
                 }
             }
-
-            // TODO overly pessimstic
-            // filter_map because one of the arguments is a function name, which
-            // is not defined in the env
-            let arguments: Vec<_> = call
-                .arguments
-                .iter()
-                .filter_map(|symbol| env.symbols.get(symbol))
-                .copied()
-                .collect();
-
-            let result_type = layout_spec(builder, layout)?;
-
-            builder.add_unknown_with(block, &arguments, result_type)
         }
     }
 }
 
+fn list_append(
+    builder: &mut FuncDefBuilder,
+    block: BlockId,
+    update_mode_var: UpdateModeVar,
+    list: ValueId,
+    to_insert: ValueId,
+) -> Result<ValueId> {
+    let bag = builder.add_get_tuple_field(block, list, LIST_BAG_INDEX)?;
+    let cell = builder.add_get_tuple_field(block, list, LIST_CELL_INDEX)?;
+
+    let _unit = builder.add_update(block, update_mode_var, cell)?;
+
+    let new_bag = builder.add_bag_insert(block, bag, to_insert)?;
+
+    let new_cell = builder.add_new_heap_cell(block)?;
+    builder.add_make_tuple(block, &[new_cell, new_bag])
+}
+
 fn lowlevel_spec(
     builder: &mut FuncDefBuilder,
     env: &Env,
@@ -883,6 +1173,10 @@ fn lowlevel_spec(
             let bag = builder.add_get_tuple_field(block, list, LIST_BAG_INDEX)?;
             let cell = builder.add_get_tuple_field(block, list, LIST_CELL_INDEX)?;
 
+            // decrement the overwritten element
+            let overwritten = builder.add_bag_get(block, bag)?;
+            let _unit = builder.add_recursive_touch(block, overwritten)?;
+
             let _unit = builder.add_update(block, update_mode_var, cell)?;
 
             builder.add_bag_insert(block, bag, to_insert)?;
@@ -916,16 +1210,7 @@ fn lowlevel_spec(
             let list = env.symbols[&arguments[0]];
             let to_insert = env.symbols[&arguments[1]];
 
-            let bag = builder.add_get_tuple_field(block, list, LIST_BAG_INDEX)?;
-            let cell = builder.add_get_tuple_field(block, list, LIST_CELL_INDEX)?;
-
-            let _unit = builder.add_update(block, update_mode_var, cell)?;
-
-            // TODO new heap cell
-            builder.add_bag_insert(block, bag, to_insert)?;
-
-            let new_cell = builder.add_new_heap_cell(block)?;
-            builder.add_make_tuple(block, &[new_cell, bag])
+            list_append(builder, block, update_mode_var, list, to_insert)
         }
         StrToUtf8 => {
             let string = env.symbols[&arguments[0]];
@@ -1425,8 +1710,8 @@ fn static_list_type<TC: TypeContext>(builder: &mut TC) -> Result<TypeId> {
     builder.add_tuple_type(&[cell, bag])
 }
 
-// const OK_TAG_ID: u8 = 1u8;
-// const ERR_TAG_ID: u8 = 0u8;
+const OK_TAG_ID: u32 = 1;
+const ERR_TAG_ID: u32 = 0;
 
 const LIST_CELL_INDEX: u32 = 0;
 const LIST_BAG_INDEX: u32 = 1;

compiler/mono/src/borrow.rs

@@ -651,6 +651,21 @@ impl<'a> BorrowInfState<'a> {
                             self.own_var(*zs);
                         }
                     }
+                    ListMap4 { xs, ys, zs, ws } => {
+                        // own the lists if the function wants to own the element
+                        if !function_ps[0].borrow {
+                            self.own_var(*xs);
+                        }
+                        if !function_ps[1].borrow {
+                            self.own_var(*ys);
+                        }
+                        if !function_ps[2].borrow {
+                            self.own_var(*zs);
+                        }
+                        if !function_ps[3].borrow {
+                            self.own_var(*ws);
+                        }
+                    }
                     ListSortWith { xs } => {
                         // always own the input list
                         self.own_var(*xs);
@@ -933,6 +948,7 @@ pub fn lowlevel_borrow_signature(arena: &Bump, op: LowLevel) -> &[bool] {
         ListMap | ListMapWithIndex => arena.alloc_slice_copy(&[owned, function, closure_data]),
         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 => {
             arena.alloc_slice_copy(&[owned, function, closure_data])
         }

compiler/mono/src/inc_dec.rs

@@ -467,6 +467,7 @@ impl<'a> Context<'a> {
                 op,
                 closure_env_layout,
                 specialization_id,
+                update_mode,
                 arg_layouts,
                 ret_layout,
                 function_name,
@@ -485,6 +486,7 @@ impl<'a> Context<'a> {
                                     closure_env_layout: *closure_env_layout,
                                     function_owns_closure_data: true,
                                     specialization_id: *specialization_id,
+                                    update_mode: *update_mode,
                                     function_name: *function_name,
                                     function_env: *function_env,
                                     arg_layouts,
@@ -576,6 +578,27 @@ impl<'a> Context<'a> {
 
                         &*self.arena.alloc(Stmt::Let(z, v, l, b))
                     }
+                    ListMap4 { xs, ys, zs, ws } => {
+                        let borrows = [
+                            function_ps[0].borrow,
+                            function_ps[1].borrow,
+                            function_ps[2].borrow,
+                            function_ps[3].borrow,
+                            FUNCTION,
+                            CLOSURE_DATA,
+                        ];
+
+                        let b = self.add_dec_after_lowlevel(arguments, &borrows, b, b_live_vars);
+
+                        let b = decref_if_owned!(function_ps[0].borrow, *xs, b);
+                        let b = decref_if_owned!(function_ps[1].borrow, *ys, b);
+                        let b = decref_if_owned!(function_ps[2].borrow, *zs, b);
+                        let b = decref_if_owned!(function_ps[3].borrow, *ws, b);
+
+                        let v = create_call!(function_ps.get(3));
+
+                        &*self.arena.alloc(Stmt::Let(z, v, l, b))
+                    }
                     ListMapWithIndex { xs } => {
                         let borrows = [function_ps[1].borrow, FUNCTION, CLOSURE_DATA];
 

compiler/mono/src/ir.rs

@@ -1181,6 +1181,10 @@ pub enum CallType<'a> {
 
         /// specialization id of the function argument, used for name generation
         specialization_id: CallSpecId,
+
+        /// update mode of the higher order lowlevel itself
+        update_mode: UpdateModeId,
+
         /// function layout, used for name generation
         arg_layouts: &'a [Layout<'a>],
         ret_layout: Layout<'a>,
@@ -4016,11 +4020,12 @@ pub fn with_hole<'a>(
                                 lambda_set,
                                 op,
                                 closure_data_symbol,
-                                |top_level_function, closure_data, closure_env_layout, specialization_id| self::Call {
+                                |(top_level_function, closure_data, closure_env_layout,  specialization_id, update_mode)| self::Call {
                                     call_type: CallType::HigherOrderLowLevel {
                                         op: crate::low_level::HigherOrder::$ho { $($x,)* },
                                         closure_env_layout,
                                         specialization_id,
+                                        update_mode,
                                         function_owns_closure_data: false,
                                         function_env: closure_data_symbol,
                                         function_name: top_level_function,
@@ -4144,6 +4149,16 @@ pub fn with_hole<'a>(
 
                     match_on_closure_argument!(ListMap3, [xs, ys, zs])
                 }
+                ListMap4 => {
+                    debug_assert_eq!(arg_symbols.len(), 5);
+
+                    let xs = arg_symbols[0];
+                    let ys = arg_symbols[1];
+                    let zs = arg_symbols[2];
+                    let ws = arg_symbols[3];
+
+                    match_on_closure_argument!(ListMap4, [xs, ys, zs, ws])
+                }
                 _ => {
                     let call = self::Call {
                         call_type: CallType::LowLevel {
@@ -6192,7 +6207,7 @@ fn reuse_function_symbol<'a>(
             // and closures by unification. Here we record whether this function captures
             // anything.
             let captures = partial_proc.captured_symbols.captures();
-            let captured = partial_proc.captured_symbols.clone();
+            let captured = partial_proc.captured_symbols;
 
             match res_layout {
                 RawFunctionLayout::Function(_, lambda_set, _) => {
@@ -7903,6 +7918,8 @@ pub fn num_argument_to_int_or_float(
     }
 }
 
+type ToLowLevelCallArguments<'a> = (Symbol, Symbol, Option<Layout<'a>>, CallSpecId, UpdateModeId);
+
 /// Use the lambda set to figure out how to make a lowlevel call
 #[allow(clippy::too_many_arguments)]
 fn lowlevel_match_on_lambda_set<'a, ToLowLevelCall>(
@@ -7916,7 +7933,7 @@ fn lowlevel_match_on_lambda_set<'a, ToLowLevelCall>(
     hole: &'a Stmt<'a>,
 ) -> Stmt<'a>
 where
-    ToLowLevelCall: Fn(Symbol, Symbol, Option<Layout<'a>>, CallSpecId) -> Call<'a> + Copy,
+    ToLowLevelCall: Fn(ToLowLevelCallArguments<'a>) -> Call<'a> + Copy,
 {
     match lambda_set.runtime_representation() {
         Layout::Union(union_layout) => {
@@ -7951,12 +7968,14 @@ where
         Layout::Struct(_) => match lambda_set.set.get(0) {
             Some((function_symbol, _)) => {
                 let call_spec_id = env.next_call_specialization_id();
-                let call = to_lowlevel_call(
+                let update_mode = env.next_update_mode_id();
+                let call = to_lowlevel_call((
                     *function_symbol,
                     closure_data_symbol,
                     lambda_set.is_represented(),
                     call_spec_id,
-                );
+                    update_mode,
+                ));
 
                 build_call(env, call, assigned, return_layout, env.arena.alloc(hole))
             }
@@ -8021,7 +8040,7 @@ fn lowlevel_union_lambda_set_to_switch<'a, ToLowLevelCall>(
     hole: &'a Stmt<'a>,
 ) -> Stmt<'a>
 where
-    ToLowLevelCall: Fn(Symbol, Symbol, Option<Layout<'a>>, CallSpecId) -> Call<'a> + Copy,
+    ToLowLevelCall: Fn(ToLowLevelCallArguments<'a>) -> Call<'a> + Copy,
 {
     debug_assert!(!lambda_set.is_empty());
 
@@ -8035,12 +8054,14 @@ where
         let hole = Stmt::Jump(join_point_id, env.arena.alloc([assigned]));
 
         let call_spec_id = env.next_call_specialization_id();
-        let call = to_lowlevel_call(
+        let update_mode = env.next_update_mode_id();
+        let call = to_lowlevel_call((
             *function_symbol,
             closure_data_symbol,
             closure_env_layout,
             call_spec_id,
-        );
+            update_mode,
+        ));
         let stmt = build_call(env, call, assigned, return_layout, env.arena.alloc(hole));
 
         branches.push((i as u64, BranchInfo::None, stmt));
@@ -8458,7 +8479,7 @@ fn lowlevel_enum_lambda_set_to_switch<'a, ToLowLevelCall>(
     hole: &'a Stmt<'a>,
 ) -> Stmt<'a>
 where
-    ToLowLevelCall: Fn(Symbol, Symbol, Option<Layout<'a>>, CallSpecId) -> Call<'a> + Copy,
+    ToLowLevelCall: Fn(ToLowLevelCallArguments<'a>) -> Call<'a> + Copy,
 {
     debug_assert!(!lambda_set.is_empty());
 
@@ -8472,12 +8493,14 @@ where
         let hole = Stmt::Jump(join_point_id, env.arena.alloc([result_symbol]));
 
         let call_spec_id = env.next_call_specialization_id();
-        let call = to_lowlevel_call(
+        let update_mode = env.next_update_mode_id();
+        let call = to_lowlevel_call((
             *function_symbol,
             closure_data_symbol,
             closure_env_layout,
             call_spec_id,
-        );
+            update_mode,
+        ));
         let stmt = build_call(
             env,
             call,

compiler/mono/src/low_level.rs

@@ -2,18 +2,55 @@ use roc_module::symbol::Symbol;
 
 #[derive(Clone, Copy, Debug, PartialEq)]
 pub enum HigherOrder {
-    ListMap { xs: Symbol },
-    ListMap2 { xs: Symbol, ys: Symbol },
-    ListMap3 { xs: Symbol, ys: Symbol, zs: Symbol },
-    ListMapWithIndex { xs: Symbol },
-    ListKeepIf { xs: Symbol },
-    ListWalk { xs: Symbol, state: Symbol },
-    ListWalkUntil { xs: Symbol, state: Symbol },
-    ListWalkBackwards { xs: Symbol, state: Symbol },
-    ListKeepOks { xs: Symbol },
-    ListKeepErrs { xs: Symbol },
-    ListSortWith { xs: Symbol },
-    DictWalk { xs: Symbol, state: Symbol },
+    ListMap {
+        xs: Symbol,
+    },
+    ListMap2 {
+        xs: Symbol,
+        ys: Symbol,
+    },
+    ListMap3 {
+        xs: Symbol,
+        ys: Symbol,
+        zs: Symbol,
+    },
+    ListMap4 {
+        xs: Symbol,
+        ys: Symbol,
+        zs: Symbol,
+        ws: Symbol,
+    },
+    ListMapWithIndex {
+        xs: Symbol,
+    },
+    ListKeepIf {
+        xs: Symbol,
+    },
+    ListWalk {
+        xs: Symbol,
+        state: Symbol,
+    },
+    ListWalkUntil {
+        xs: Symbol,
+        state: Symbol,
+    },
+    ListWalkBackwards {
+        xs: Symbol,
+        state: Symbol,
+    },
+    ListKeepOks {
+        xs: Symbol,
+    },
+    ListKeepErrs {
+        xs: Symbol,
+    },
+    ListSortWith {
+        xs: Symbol,
+    },
+    DictWalk {
+        xs: Symbol,
+        state: Symbol,
+    },
 }
 
 impl HigherOrder {
@@ -22,6 +59,7 @@ impl HigherOrder {
             HigherOrder::ListMap { .. } => 1,
             HigherOrder::ListMap2 { .. } => 2,
             HigherOrder::ListMap3 { .. } => 3,
+            HigherOrder::ListMap4 { .. } => 4,
             HigherOrder::ListMapWithIndex { .. } => 2,
             HigherOrder::ListKeepIf { .. } => 1,
             HigherOrder::ListWalk { .. } => 2,
@@ -128,202 +166,3 @@ enum FirstOrder {
     Hash,
     ExpectTrue,
 }
-
-/*
-enum FirstOrHigher {
-    First(FirstOrder),
-    Higher(HigherOrder),
-}
-
-fn from_low_level(low_level: &LowLevel, arguments: &[Symbol]) -> FirstOrHigher {
-    use FirstOrHigher::*;
-    use FirstOrder::*;
-    use HigherOrder::*;
-
-    match low_level {
-        LowLevel::StrConcat => First(StrConcat),
-        LowLevel::StrJoinWith => First(StrJoinWith),
-        LowLevel::StrIsEmpty => First(StrIsEmpty),
-        LowLevel::StrStartsWith => First(StrStartsWith),
-        LowLevel::StrStartsWithCodePt => First(StrStartsWithCodePt),
-        LowLevel::StrEndsWith => First(StrEndsWith),
-        LowLevel::StrSplit => First(StrSplit),
-        LowLevel::StrCountGraphemes => First(StrCountGraphemes),
-        LowLevel::StrFromInt => First(StrFromInt),
-        LowLevel::StrFromUtf8 => First(StrFromUtf8),
-        LowLevel::StrFromUtf8Range => First(StrFromUtf8Range),
-        LowLevel::StrToUtf8 => First(StrToUtf8),
-        LowLevel::StrRepeat => First(StrRepeat),
-        LowLevel::StrFromFloat => First(StrFromFloat),
-        LowLevel::ListLen => First(ListLen),
-        LowLevel::ListGetUnsafe => First(ListGetUnsafe),
-        LowLevel::ListSet => First(ListSet),
-        LowLevel::ListDrop => First(ListDrop),
-        LowLevel::ListDropAt => First(ListDropAt),
-        LowLevel::ListSingle => First(ListSingle),
-        LowLevel::ListRepeat => First(ListRepeat),
-        LowLevel::ListReverse => First(ListReverse),
-        LowLevel::ListConcat => First(ListConcat),
-        LowLevel::ListContains => First(ListContains),
-        LowLevel::ListAppend => First(ListAppend),
-        LowLevel::ListPrepend => First(ListPrepend),
-        LowLevel::ListJoin => First(ListJoin),
-        LowLevel::ListRange => First(ListRange),
-        LowLevel::ListSwap => First(ListSwap),
-        LowLevel::DictSize => First(DictSize),
-        LowLevel::DictEmpty => First(DictEmpty),
-        LowLevel::DictInsert => First(DictInsert),
-        LowLevel::DictRemove => First(DictRemove),
-        LowLevel::DictContains => First(DictContains),
-        LowLevel::DictGetUnsafe => First(DictGetUnsafe),
-        LowLevel::DictKeys => First(DictKeys),
-        LowLevel::DictValues => First(DictValues),
-        LowLevel::DictUnion => First(DictUnion),
-        LowLevel::DictIntersection => First(DictIntersection),
-        LowLevel::DictDifference => First(DictDifference),
-        LowLevel::SetFromList => First(SetFromList),
-        LowLevel::NumAdd => First(NumAdd),
-        LowLevel::NumAddWrap => First(NumAddWrap),
-        LowLevel::NumAddChecked => First(NumAddChecked),
-        LowLevel::NumSub => First(NumSub),
-        LowLevel::NumSubWrap => First(NumSubWrap),
-        LowLevel::NumSubChecked => First(NumSubChecked),
-        LowLevel::NumMul => First(NumMul),
-        LowLevel::NumMulWrap => First(NumMulWrap),
-        LowLevel::NumMulChecked => First(NumMulChecked),
-        LowLevel::NumGt => First(NumGt),
-        LowLevel::NumGte => First(NumGte),
-        LowLevel::NumLt => First(NumLt),
-        LowLevel::NumLte => First(NumLte),
-        LowLevel::NumCompare => First(NumCompare),
-        LowLevel::NumDivUnchecked => First(NumDivUnchecked),
-        LowLevel::NumRemUnchecked => First(NumRemUnchecked),
-        LowLevel::NumIsMultipleOf => First(NumIsMultipleOf),
-        LowLevel::NumAbs => First(NumAbs),
-        LowLevel::NumNeg => First(NumNeg),
-        LowLevel::NumSin => First(NumSin),
-        LowLevel::NumCos => First(NumCos),
-        LowLevel::NumSqrtUnchecked => First(NumSqrtUnchecked),
-        LowLevel::NumLogUnchecked => First(NumLogUnchecked),
-        LowLevel::NumRound => First(NumRound),
-        LowLevel::NumToFloat => First(NumToFloat),
-        LowLevel::NumPow => First(NumPow),
-        LowLevel::NumCeiling => First(NumCeiling),
-        LowLevel::NumPowInt => First(NumPowInt),
-        LowLevel::NumFloor => First(NumFloor),
-        LowLevel::NumIsFinite => First(NumIsFinite),
-        LowLevel::NumAtan => First(NumAtan),
-        LowLevel::NumAcos => First(NumAcos),
-        LowLevel::NumAsin => First(NumAsin),
-        LowLevel::NumBitwiseAnd => First(NumBitwiseAnd),
-        LowLevel::NumBitwiseXor => First(NumBitwiseXor),
-        LowLevel::NumBitwiseOr => First(NumBitwiseOr),
-        LowLevel::NumShiftLeftBy => First(NumShiftLeftBy),
-        LowLevel::NumShiftRightBy => First(NumShiftRightBy),
-        LowLevel::NumBytesToU16 => First(NumBytesToU16),
-        LowLevel::NumBytesToU32 => First(NumBytesToU32),
-        LowLevel::NumShiftRightZfBy => First(NumShiftRightZfBy),
-        LowLevel::NumIntCast => First(NumIntCast),
-        LowLevel::Eq => First(Eq),
-        LowLevel::NotEq => First(NotEq),
-        LowLevel::And => First(And),
-        LowLevel::Or => First(Or),
-        LowLevel::Not => First(Not),
-        LowLevel::Hash => First(Hash),
-        LowLevel::ExpectTrue => First(ExpectTrue),
-        LowLevel::ListMap => {
-            debug_assert_eq!(arguments.len(), 3);
-            Higher(ListMap {
-                xs: arguments[0],
-                function_name: arguments[1],
-                function_env: arguments[2],
-            })
-        }
-        LowLevel::ListMap2 => {
-            debug_assert_eq!(arguments.len(), 4);
-            Higher(ListMap2 {
-                xs: arguments[0],
-                ys: arguments[1],
-                function_name: arguments[2],
-                function_env: arguments[3],
-            })
-        }
-        LowLevel::ListMap3 => {
-            debug_assert_eq!(arguments.len(), 5);
-            Higher(ListMap3 {
-                xs: arguments[0],
-                ys: arguments[1],
-                zs: arguments[2],
-                function_name: arguments[3],
-                function_env: arguments[4],
-            })
-        }
-        LowLevel::ListMapWithIndex => {
-            debug_assert_eq!(arguments.len(), 3);
-            Higher(ListMapWithIndex {
-                xs: arguments[0],
-                function_name: arguments[1],
-                function_env: arguments[2],
-            })
-        }
-        LowLevel::ListKeepIf => {
-            debug_assert_eq!(arguments.len(), 3);
-            Higher(ListKeepIf {
-                xs: arguments[0],
-                function_name: arguments[1],
-                function_env: arguments[2],
-            })
-        }
-        LowLevel::ListWalk => {
-            debug_assert_eq!(arguments.len(), 3);
-            Higher(ListWalk {
-                xs: arguments[0],
-                function_name: arguments[1],
-                function_env: arguments[2],
-            })
-        }
-        LowLevel::ListWalkUntil => {
-            debug_assert_eq!(arguments.len(), 3);
-            Higher(ListWalkUntil {
-                function_name: arguments[1],
-                function_env: arguments[2],
-            })
-        }
-        LowLevel::ListWalkBackwards => {
-            debug_assert_eq!(arguments.len(), 3);
-            Higher(ListWalkBackwards {
-                function_name: arguments[1],
-                function_env: arguments[2],
-            })
-        }
-        LowLevel::ListKeepOks => {
-            debug_assert_eq!(arguments.len(), 3);
-            Higher(ListKeepOks {
-                function_name: arguments[1],
-                function_env: arguments[2],
-            })
-        }
-        LowLevel::ListKeepErrs => {
-            debug_assert_eq!(arguments.len(), 3);
-            Higher(ListKeepErrs {
-                function_name: arguments[1],
-                function_env: arguments[2],
-            })
-        }
-        LowLevel::ListSortWith => {
-            debug_assert_eq!(arguments.len(), 3);
-            Higher(ListSortWith {
-                function_name: arguments[1],
-                function_env: arguments[2],
-            })
-        }
-        LowLevel::DictWalk => {
-            debug_assert_eq!(arguments.len(), 3);
-            Higher(DictWalk {
-                function_name: arguments[1],
-                function_env: arguments[2],
-            })
-        }
-    }
-}
-*/