Correctly compile unified recursive tag unions

crates/compiler/constrain/src/expr.rs

@@ -1981,13 +1981,13 @@ fn constrain_typed_def(
     );
 
     def_pattern_state.constraints.push(constraints.equal_types(
-        expr_type,
+        expr_type.clone(),
         annotation_expected,
         Category::Storage(std::file!(), std::line!()),
         Region::span_across(&annotation.region, &def.loc_expr.region),
     ));
 
-    // when a def is annotated, and it's body is a closure, treat this
+    // when a def is annotated, and its body is a closure, treat this
     // as a named function (in elm terms) for error messages.
     //
     // This means we get errors like "the first argument of `f` is weird"
@@ -2114,7 +2114,7 @@ fn constrain_typed_def(
                 AnnotationSource::TypedBody {
                     region: annotation.region,
                 },
-                signature.clone(),
+                expr_type,
             );
 
             let ret_constraint = constrain_expr(
@@ -2124,14 +2124,7 @@ fn constrain_typed_def(
                 &def.loc_expr.value,
                 annotation_expected,
             );
-            let ret_constraint = attach_resolution_constraints(constraints, env, ret_constraint);
-
-            let cons = [
-                ret_constraint,
-                // Store type into AST vars. We use Store so errors aren't reported twice
-                constraints.store(signature, expr_var, std::file!(), std::line!()),
-            ];
-            let expr_con = constraints.and_constraint(cons);
+            let expr_con = attach_resolution_constraints(constraints, env, ret_constraint);
 
             constrain_def_make_constraint(
                 constraints,

crates/compiler/mono/src/ir.rs

@@ -2317,6 +2317,8 @@ fn from_can_let<'a>(
                         let (_specialization_mark, (var, specialized_symbol)) =
                             needed_specializations.next().unwrap();
 
+                        // Make sure rigid variables in the annotation are converted to flex variables.
+                        instantiate_rigids(env.subs, def.expr_var);
                         // Unify the expr_var with the requested specialization once.
                         let _res = env.unify(var, def.expr_var);
 
@@ -2333,6 +2335,9 @@ fn from_can_let<'a>(
                     _n => {
                         let mut stmt = rest;
 
+                        // Make sure rigid variables in the annotation are converted to flex variables.
+                        instantiate_rigids(env.subs, def.expr_var);
+
                         // Need to eat the cost and create a specialized version of the body for
                         // each specialization.
                         for (_specialization_mark, (var, specialized_symbol)) in

crates/compiler/solve/tests/solve_expr.rs

@@ -4024,7 +4024,8 @@ mod solve_expr {
                     { x, y }
                 "#
             ),
-            "{ x : I64, y ? Bool }* -> { x : I64, y : Bool }",
+            // TODO: when structural types unify with alias, they should take the alias name
+            "{ x : I64, y ? [False, True] }* -> { x : I64, y : Bool }",
         );
     }
 

crates/compiler/test_mono/generated/call_function_in_empty_list_unbound.txt

@@ -1,6 +1,6 @@
 procedure List.5 (#Attr.2, #Attr.3):
-    Error UnresolvedTypeVar crates/compiler/mono/src/ir.rs line 5030
+    Error UnresolvedTypeVar crates/compiler/mono/src/ir.rs line 5035
 
 procedure Test.0 ():
     let Test.1 : List {} = Array [];
-    Error UnresolvedTypeVar crates/compiler/mono/src/ir.rs line 4557
+    Error UnresolvedTypeVar crates/compiler/mono/src/ir.rs line 4562

crates/compiler/test_mono/generated/instantiate_annotated_as_recursive_alias_multiple_polymorphic_expr.txt

@@ -0,0 +1,5 @@
+procedure Test.0 ():
+    let Test.9 : [<rnu><null>, C List *self] = TagId(1) ;
+    let Test.10 : [C List [<rnu><null>, C List *self], C U16, C ] = TagId(2) ;
+    let Test.12 : {[<rnu><null>, C List *self], [C List [<rnu><null>, C List *self], C U16, C ]} = Struct {Test.9, Test.10};
+    ret Test.12;

crates/compiler/test_mono/generated/instantiate_annotated_as_recursive_alias_polymorphic_expr.txt

@@ -0,0 +1,3 @@
+procedure Test.0 ():
+    let Test.5 : [<rnu><null>, C List *self] = TagId(1) ;
+    ret Test.5;

crates/compiler/test_mono/src/tests.rs

@@ -1718,3 +1718,66 @@ fn call_function_in_empty_list_unbound() {
         "#
     )
 }
+
+#[mono_test]
+#[ignore = "TODO"]
+fn instantiate_annotated_as_recursive_alias_toplevel() {
+    indoc!(
+        r#"
+        app "test" provides [it] to "./platform"
+
+        Value : [Nil, Array (List Value)]
+
+        foo : [Nil]*
+        foo = Nil
+
+        it : Value
+        it = foo
+        "#
+    )
+}
+
+#[mono_test]
+fn instantiate_annotated_as_recursive_alias_polymorphic_expr() {
+    indoc!(
+        r#"
+        app "test" provides [main] to "./platform"
+
+        main =
+            Value : [Nil, Array (List Value)]
+
+            foo : [Nil]*
+            foo = Nil
+
+            it : Value
+            it = foo
+
+            it
+        "#
+    )
+}
+
+#[mono_test]
+fn instantiate_annotated_as_recursive_alias_multiple_polymorphic_expr() {
+    indoc!(
+        r#"
+        app "test" provides [main] to "./platform"
+
+        main =
+            Value : [Nil, Array (List Value)]
+
+            foo : [Nil]*
+            foo = Nil
+
+            v1 : Value
+            v1 = foo
+
+            Value2 : [Nil, B U16, Array (List Value)]
+
+            v2 : Value2
+            v2 = foo
+
+            {v1, v2}
+        "#
+    )
+}