Generate code for recursive nullable wrapped lambda sets

crates/compiler/mono/src/ir.rs

@@ -3506,6 +3506,7 @@ fn specialize_proc_help<'a>(
                                 UnionLayout::NonRecursive(_)
                                     | UnionLayout::Recursive(_)
                                     | UnionLayout::NullableUnwrapped { .. }
+                                    | UnionLayout::NullableWrapped { .. }
                             ));
                             debug_assert_eq!(field_layouts.len(), captured.len());
 

crates/compiler/mono/src/layout.rs

@@ -1621,11 +1621,27 @@ impl<'a> LambdaSet<'a> {
                             union_layout: union,
                         }
                     }
-                    UnionLayout::NonNullableUnwrapped(_) => todo!("recursive closures"),
                     UnionLayout::NullableWrapped {
                         nullable_id: _,
                         other_tags: _,
-                    } => todo!("recursive closures"),
+                    } => {
+                        let (index, (name, fields)) = self
+                            .set
+                            .iter()
+                            .enumerate()
+                            .find(|(_, (s, layouts))| comparator(*s, layouts))
+                            .unwrap();
+
+                        let closure_name = *name;
+
+                        ClosureRepresentation::Union {
+                            tag_id: index as TagIdIntType,
+                            alphabetic_order_fields: fields,
+                            closure_name,
+                            union_layout: union,
+                        }
+                    }
+                    UnionLayout::NonNullableUnwrapped(_) => internal_error!("I thought a non-nullable-unwrapped variant for a lambda set was impossible: how could such a lambda set be created without a base case?"),
                 }
             }
             Layout::Struct { .. } => {

crates/compiler/test_gen/src/gen_primitives.rs

@@ -3911,6 +3911,34 @@ fn compose_recursive_lambda_set_productive_inferred() {
     );
 }
 
+#[test]
+#[cfg(any(feature = "gen-llvm", feature = "gen-wasm"))]
+fn compose_recursive_lambda_set_productive_nullable_wrapped() {
+    assert_evals_to!(
+        indoc!(
+            r#"
+             app "test" provides [main] to "./platform"
+
+             compose = \forward -> \f, g ->
+                if forward
+                then \x -> g (f x)
+                else \x -> f (g x)
+
+             identity = \x -> x
+             exclame = \s -> "\(s)!"
+             whisper = \s -> "(\(s))"
+
+             main =
+                 res: Str -> Str
+                 res = List.walk [ exclame, whisper ] identity (compose Bool.false)
+                 res "hello"
+             "#
+        ),
+        RocStr::from("(hello)!"),
+        RocStr
+    )
+}
+
 #[test]
 #[cfg(any(feature = "gen-llvm", feature = "gen-wasm"))]
 fn local_binding_aliases_function() {

crates/compiler/test_mono/generated/compose_recursive_lambda_set_productive_nullable_wrapped.txt

@@ -0,0 +1,176 @@
+procedure Bool.2 ():
+    let Bool.23 : Int1 = true;
+    ret Bool.23;
+
+procedure List.139 (List.140, List.141, List.138):
+    let List.513 : [<rnw><null>, C *self Int1, C *self Int1] = CallByName Test.6 List.140 List.141 List.138;
+    ret List.513;
+
+procedure List.18 (List.136, List.137, List.138):
+    let List.494 : [<rnw><null>, C *self Int1, C *self Int1] = CallByName List.92 List.136 List.137 List.138;
+    ret List.494;
+
+procedure List.6 (#Attr.2):
+    let List.511 : U64 = lowlevel ListLen #Attr.2;
+    ret List.511;
+
+procedure List.66 (#Attr.2, #Attr.3):
+    let List.510 : Int1 = lowlevel ListGetUnsafe #Attr.2 #Attr.3;
+    ret List.510;
+
+procedure List.80 (List.517, List.518, List.519, List.520, List.521):
+    joinpoint List.500 List.433 List.434 List.435 List.436 List.437:
+        let List.502 : Int1 = CallByName Num.22 List.436 List.437;
+        if List.502 then
+            let List.509 : Int1 = CallByName List.66 List.433 List.436;
+            let List.503 : [<rnw><null>, C *self Int1, C *self Int1] = CallByName List.139 List.434 List.509 List.435;
+            let List.506 : U64 = 1i64;
+            let List.505 : U64 = CallByName Num.19 List.436 List.506;
+            jump List.500 List.433 List.503 List.435 List.505 List.437;
+        else
+            ret List.434;
+    in
+    jump List.500 List.517 List.518 List.519 List.520 List.521;
+
+procedure List.92 (List.430, List.431, List.432):
+    let List.498 : U64 = 0i64;
+    let List.499 : U64 = CallByName List.6 List.430;
+    let List.497 : [<rnw><null>, C *self Int1, C *self Int1] = CallByName List.80 List.430 List.431 List.432 List.498 List.499;
+    ret List.497;
+
+procedure Num.19 (#Attr.2, #Attr.3):
+    let Num.275 : U64 = lowlevel NumAdd #Attr.2 #Attr.3;
+    ret Num.275;
+
+procedure Num.22 (#Attr.2, #Attr.3):
+    let Num.276 : Int1 = lowlevel NumLt #Attr.2 #Attr.3;
+    ret Num.276;
+
+procedure Str.3 (#Attr.2, #Attr.3):
+    let Str.268 : Str = lowlevel StrConcat #Attr.2 #Attr.3;
+    ret Str.268;
+
+procedure Test.1 (Test.5):
+    ret Test.5;
+
+procedure Test.11 (Test.53, Test.54):
+    joinpoint Test.27 Test.12 #Attr.12:
+        let Test.8 : Int1 = UnionAtIndex (Id 2) (Index 1) #Attr.12;
+        let Test.7 : [<rnw><null>, C *self Int1, C *self Int1] = UnionAtIndex (Id 2) (Index 0) #Attr.12;
+        inc Test.7;
+        dec #Attr.12;
+        joinpoint Test.31 Test.29:
+            let Test.30 : U8 = GetTagId Test.7;
+            switch Test.30:
+                case 0:
+                    dec Test.7;
+                    let Test.28 : Str = CallByName Test.2 Test.29;
+                    dec Test.29;
+                    ret Test.28;
+            
+                case 1:
+                    let Test.28 : Str = CallByName Test.9 Test.29 Test.7;
+                    ret Test.28;
+            
+                default:
+                    jump Test.27 Test.29 Test.7;
+            
+        in
+        switch Test.8:
+            case 0:
+                let Test.32 : Str = CallByName Test.3 Test.12;
+                jump Test.31 Test.32;
+        
+            default:
+                let Test.32 : Str = CallByName Test.4 Test.12;
+                jump Test.31 Test.32;
+        
+    in
+    jump Test.27 Test.53 Test.54;
+
+procedure Test.2 (Test.13):
+    inc Test.13;
+    ret Test.13;
+
+procedure Test.3 (Test.14):
+    let Test.48 : Str = "!";
+    let Test.47 : Str = CallByName Str.3 Test.14 Test.48;
+    dec Test.48;
+    ret Test.47;
+
+procedure Test.4 (Test.15):
+    let Test.44 : Str = "(";
+    let Test.46 : Str = ")";
+    let Test.45 : Str = CallByName Str.3 Test.15 Test.46;
+    dec Test.46;
+    let Test.43 : Str = CallByName Str.3 Test.44 Test.45;
+    dec Test.45;
+    ret Test.43;
+
+procedure Test.6 (Test.7, Test.8, Test.5):
+    if Test.5 then
+        let Test.33 : [<rnw><null>, C *self Int1, C *self Int1] = TagId(1) Test.7 Test.8;
+        ret Test.33;
+    else
+        let Test.26 : [<rnw><null>, C *self Int1, C *self Int1] = TagId(2) Test.7 Test.8;
+        ret Test.26;
+
+procedure Test.9 (Test.10, #Attr.12):
+    let Test.8 : Int1 = UnionAtIndex (Id 1) (Index 1) #Attr.12;
+    let Test.7 : [<rnw><null>, C *self Int1, C *self Int1] = UnionAtIndex (Id 1) (Index 0) #Attr.12;
+    inc Test.7;
+    dec #Attr.12;
+    let Test.37 : U8 = GetTagId Test.7;
+    joinpoint Test.38 Test.36:
+        switch Test.8:
+            case 0:
+                let Test.35 : Str = CallByName Test.3 Test.36;
+                ret Test.35;
+        
+            default:
+                let Test.35 : Str = CallByName Test.4 Test.36;
+                ret Test.35;
+        
+    in
+    switch Test.37:
+        case 0:
+            dec Test.7;
+            let Test.39 : Str = CallByName Test.2 Test.10;
+            dec Test.10;
+            jump Test.38 Test.39;
+    
+        case 1:
+            let Test.39 : Str = CallByName Test.9 Test.10 Test.7;
+            jump Test.38 Test.39;
+    
+        default:
+            let Test.39 : Str = CallByName Test.11 Test.10 Test.7;
+            jump Test.38 Test.39;
+    
+
+procedure Test.0 ():
+    let Test.41 : Int1 = false;
+    let Test.42 : Int1 = true;
+    let Test.20 : List Int1 = Array [Test.41, Test.42];
+    let Test.21 : [<rnw><null>, C *self Int1, C *self Int1] = TagId(0) ;
+    let Test.23 : Int1 = CallByName Bool.2;
+    let Test.22 : Int1 = CallByName Test.1 Test.23;
+    let Test.16 : [<rnw><null>, C *self Int1, C *self Int1] = CallByName List.18 Test.20 Test.21 Test.22;
+    dec Test.20;
+    let Test.18 : Str = "hello";
+    let Test.19 : U8 = GetTagId Test.16;
+    switch Test.19:
+        case 0:
+            dec Test.16;
+            let Test.17 : Str = CallByName Test.2 Test.18;
+            dec Test.18;
+            ret Test.17;
+    
+        case 1:
+            let Test.17 : Str = CallByName Test.9 Test.18 Test.16;
+            ret Test.17;
+    
+        default:
+            let Test.17 : Str = CallByName Test.11 Test.18 Test.16;
+            ret Test.17;
+    

crates/compiler/test_mono/src/tests.rs

@@ -2822,3 +2822,26 @@ fn recursive_lambda_set_resolved_only_upon_specialization() {
         "#
     )
 }
+
+#[mono_test]
+fn compose_recursive_lambda_set_productive_nullable_wrapped() {
+    indoc!(
+        r#"
+         app "test" provides [main] to "./platform"
+
+         compose = \forward -> \f, g ->
+            if forward
+            then \x -> g (f x)
+            else \x -> f (g x)
+
+         identity = \x -> x
+         exclame = \s -> "\(s)!"
+         whisper = \s -> "(\(s))"
+
+         main =
+             res: Str -> Str
+             res = List.walk [ exclame, whisper ] identity (compose Bool.true)
+             res "hello"
+         "#
+    )
+}