Merge pull request #6284 from JRI98/issue_6196

Fix list rest bind in when branch tuple destructure

crates/compiler/mono/src/ir/pattern.rs

@@ -1544,7 +1544,13 @@ fn store_list_pattern<'a>(
         }
     }
 
-    stmt = store_list_rest(env, list_sym, list_arity, list_layout, opt_rest, stmt);
+    stmt = match store_list_rest(env, list_sym, list_arity, list_layout, opt_rest, stmt) {
+        StorePattern::Productive(new) => {
+            is_productive = true;
+            new
+        }
+        StorePattern::NotProductive(new) => new,
+    };
 
     if is_productive {
         StorePattern::Productive(stmt)
@@ -1560,8 +1566,12 @@ fn store_list_rest<'a>(
     list_layout: InLayout<'a>,
     opt_rest: &Option<(usize, Option<Symbol>)>,
     mut stmt: Stmt<'a>,
-) -> Stmt<'a> {
+) -> StorePattern<'a> {
+    let mut is_productive = false;
+
     if let Some((index, Some(rest_sym))) = opt_rest {
+        is_productive = true;
+
         let usize_layout = Layout::usize(env.target_info);
 
         let total_dropped = list_arity.min_len();
@@ -1608,7 +1618,12 @@ fn store_list_rest<'a>(
             stmt = Stmt::Let(sym, expr, lay, env.arena.alloc(stmt));
         }
     }
-    stmt
+
+    if is_productive {
+        StorePattern::Productive(stmt)
+    } else {
+        StorePattern::NotProductive(stmt)
+    }
 }
 
 #[allow(clippy::too_many_arguments)]

crates/compiler/test_mono/generated/issue_6196.txt

@@ -0,0 +1,47 @@
+procedure Num.20 (#Attr.2, #Attr.3):
+    let Num.291 : U64 = lowlevel NumSub #Attr.2 #Attr.3;
+    ret Num.291;
+
+procedure Test.1 (#Derived_gen.0, #Derived_gen.1):
+    joinpoint Test.12 Test.2 Test.3:
+        let Test.13 : {List Str, U64} = Struct {Test.2, Test.3};
+        let Test.31 : List Str = StructAtIndex 0 Test.13;
+        let Test.32 : U64 = lowlevel ListLen Test.31;
+        let Test.33 : U64 = 1i64;
+        let Test.34 : Int1 = lowlevel NumGte Test.32 Test.33;
+        if Test.34 then
+            let Test.28 : U64 = StructAtIndex 1 Test.13;
+            let Test.29 : U64 = 0i64;
+            let Test.30 : Int1 = lowlevel Eq Test.29 Test.28;
+            if Test.30 then
+                let Test.21 : List Str = StructAtIndex 0 Test.13;
+                let Test.22 : U64 = 0i64;
+                let Test.6 : Str = lowlevel ListGetUnsafe Test.21 Test.22;
+                inc Test.6;
+                dec Test.21;
+                let Test.16 : [C {}, C Str] = TagId(1) Test.6;
+                ret Test.16;
+            else
+                let Test.23 : List Str = StructAtIndex 0 Test.13;
+                let Test.24 : U64 = 1i64;
+                let Test.25 : U64 = lowlevel ListLen Test.23;
+                let Test.26 : U64 = lowlevel NumSub Test.25 Test.24;
+                let Test.27 : U64 = 1i64;
+                let Test.8 : List Str = lowlevel ListSublist Test.23 Test.27 Test.26;
+                let Test.19 : U64 = 1i64;
+                let Test.18 : U64 = CallByName Num.20 Test.3 Test.19;
+                jump Test.12 Test.8 Test.18;
+        else
+            dec Test.31;
+            let Test.15 : {} = Struct {};
+            let Test.14 : [C {}, C Str] = TagId(0) Test.15;
+            ret Test.14;
+    in
+    jump Test.12 #Derived_gen.0 #Derived_gen.1;
+
+procedure Test.0 ():
+    let Test.35 : Str = "a";
+    let Test.10 : List Str = Array [Test.35];
+    let Test.11 : U64 = 0i64;
+    let Test.9 : [C {}, C Str] = CallByName Test.1 Test.10 Test.11;
+    ret Test.9;

crates/compiler/test_mono/src/tests.rs

@@ -3447,3 +3447,19 @@ fn inspect_derived_dict() {
         "#
     )
 }
+
+#[mono_test]
+fn issue_6196() {
+    indoc!(
+        r#"
+        nth : List a, Nat -> Result a [OutOfBounds]
+        nth = \l, i ->
+            when (l, i) is
+                ([], _) -> Err OutOfBounds
+                ([e, ..], 0) -> Ok e
+                ([_, .. as rest], _) -> nth rest (i - 1)
+
+        nth ["a"] 0
+        "#
+    )
+}