Presence constraints for tag union types

This work is related to restricting tag union sizes in input positions.
As an example, for something like

```
\x -> when x is
    A M -> X
    A N -> X
    A _ -> X
```

we'd like to infer `[A [M, N]* ]` rather than the `[A, [M, N]* ]*` we
infer today. Notice the difference is that the former type tells us we
only accepts `A`s, but the argument of the `A` can be `M`, `N` or
anything else (hence the `_`).

So what's the idea? It's an encoding of the "must have"/"might have"
design discussed in https://github.com/rtfeldman/roc/issues/1758. Let's
take our example above and walk through unification of each branch.

Suppose `x` starts off as a flex var `t`.

```
\x -> when x is
    A M -> X
```

Now we introduce a new kind of constraint called a "presence"
constraint. It says "t has at least [A [M]]". I'll notate this as `t +=
[A [M]]`. When `t` is free as it is here, this is equivalent to `t ~
[A [M]]`.

```
\x -> when x is
    ...
    A N -> X
```

At this branch we introduce the presence constraint `[A [M]] += [A [N]]`.
Notice that there's two tag unions we care about resolving here - one is
the toplevel one that says "I have an `A ...` inside of me", and the
other one is the tag union that's the tyarg to `A`. They are distinct
and at different depths.

For the toplevel one, we first figure out if the number of tags in the
union needs to expand. It does not - we're hoping to resolve the type
`[A [M, N]]`, which only has `A` in the toplevel union. So, we don't
need to do anything extra there, other than the merge the nested tag
unions.

We recurse on the shared tags, and now we have the presence constraint
`[M] += [N]`. At this point it's important to remember that the left and
right hand types are backed by type variables, so this is really
something like `t11 [M] += t12 [N]`, where `[M]` and `[N]` are just what
we know the variables `t11` and `t12` to be at this moment. So how do we
solve for `t11 [M, N]` from here? Well, we can encode this constraint as
a type variable definition and a unification constraint we already know
how to solve:

```
New definition: t11 [M]a    (a fresh)
New constraint: a ~ t12 [N]
```

That's it; upon unification, `t11 [M, N]` falls out.

Okay, last step.

```
\x -> when x is
    ...
    A _ -> X
```

We now have `[A [M, N]] += [A a]`, where `a` is a fresh unbound
variable. Again nothing has to happen on the toplevel. We walk down and
find `t11 [M, N] += t21 a`. This is actually called an "open constraint"; we
differentiate it at the time we generate constraints because it follows
syntactically from the presence of an `_`, but it's semantically
equivalent to the presence constraint `t11 [M, N] += t21 a`. It's just
called opening because literally the only way `t11 [M, N] += t21 a` can
be true is if we set `t11 a`. Well, actually, we assume `a` is a tag
union, so we just make `t11` the open tag union `[M, N]a`. Since `a` is
unbound, this eventually becomes a wildcard and hence falls out `[M, N]*`.
Also, once we open a tag union with an open constraint, we never close
it again.

That's it. The rest falls out recursively. This gives us a really easy
way to encode these ordering constraints in the unification-based system
we have today with minimal additional intervention. We do have to patch
variables in-place sometimes, and the additive nature of these
constraints feels about out-of-place relative to unification, but it
seems to work well.

Resolves #1758

ast/src/solve_type.rs

@@ -224,7 +224,7 @@ fn solve<'a>(
                 expectation.get_type_ref(),
             );
 
-            match unify(subs, actual, expected) {
+            match unify(subs, actual, expected, false) {
                 Success(vars) => {
                     introduce(subs, rank, pools, &vars);
 
@@ -317,7 +317,7 @@ fn solve<'a>(
                         expectation.get_type_ref(),
                     );
 
-                    match unify(subs, actual, expected) {
+                    match unify(subs, actual, expected, false) {
                         Success(vars) => {
                             introduce(subs, rank, pools, &vars);
 
@@ -386,7 +386,8 @@ fn solve<'a>(
                 expectation.get_type_ref(),
             );
 
-            match unify(subs, actual, expected) {
+            // TODO(ayazhafiz): presence constraints for Expr2/Type2
+            match unify(subs, actual, expected, false) {
                 Success(vars) => {
                     introduce(subs, rank, pools, &vars);
 

compiler/can/src/constraint.rs

@@ -1,20 +1,37 @@
 use crate::expected::{Expected, PExpected};
 use roc_collections::all::{MutSet, SendMap};
-use roc_module::symbol::Symbol;
+use roc_module::{ident::TagName, symbol::Symbol};
 use roc_region::all::{Loc, Region};
 use roc_types::types::{Category, PatternCategory, Type};
 use roc_types::{subs::Variable, types::VariableDetail};
 
+/// A presence constraint is an additive constraint that defines the lower bound
+/// of a type. For example, `Present(t1, IncludesTag(A, []))` means that the
+/// type `t1` must contain at least the tag `A`. The additive nature of these
+/// constraints makes them behaviorally different from unification-based constraints.
+#[derive(Debug, Clone, PartialEq)]
+pub enum PresenceConstraint {
+    IncludesTag(TagName, Vec<Type>),
+    IsOpen,
+}
+
 #[derive(Debug, Clone, PartialEq)]
 pub enum Constraint {
     Eq(Type, Expected<Type>, Category, Region),
     Store(Type, Variable, &'static str, u32),
     Lookup(Symbol, Expected<Type>, Region),
-    Pattern(Region, PatternCategory, Type, PExpected<Type>),
+    Pattern(
+        Region,
+        PatternCategory,
+        Type,
+        PExpected<Type>,
+        bool, /* Treat the pattern as a presence constraint */
+    ),
     True, // Used for things that always unify, e.g. blanks and runtime errors
     SaveTheEnvironment,
     Let(Box<LetConstraint>),
     And(Vec<Constraint>),
+    Present(Type, PresenceConstraint),
 }
 
 #[derive(Debug, Clone, PartialEq)]
@@ -66,7 +83,7 @@ impl Constraint {
             Constraint::Eq(_, _, _, _) => false,
             Constraint::Store(_, _, _, _) => false,
             Constraint::Lookup(_, _, _) => false,
-            Constraint::Pattern(_, _, _, _) => false,
+            Constraint::Pattern(_, _, _, _, _) => false,
             Constraint::True => false,
             Constraint::SaveTheEnvironment => true,
             Constraint::Let(boxed) => {
@@ -74,6 +91,7 @@ impl Constraint {
                     || boxed.defs_constraint.contains_save_the_environment()
             }
             Constraint::And(cs) => cs.iter().any(|c| c.contains_save_the_environment()),
+            Constraint::Present(_, _) => false,
         }
     }
 }
@@ -124,7 +142,7 @@ fn validate_help(constraint: &Constraint, declared: &Declared, accum: &mut Varia
             subtract(declared, &typ.variables_detail(), accum);
             subtract(declared, &expected.get_type_ref().variables_detail(), accum);
         }
-        Constraint::Pattern(_, _, typ, expected) => {
+        Constraint::Pattern(_, _, typ, expected, _) => {
             subtract(declared, &typ.variables_detail(), accum);
             subtract(declared, &expected.get_type_ref().variables_detail(), accum);
         }
@@ -143,5 +161,16 @@ fn validate_help(constraint: &Constraint, declared: &Declared, accum: &mut Varia
                 validate_help(c, declared, accum);
             }
         }
+        Constraint::Present(typ, constr) => {
+            subtract(declared, &typ.variables_detail(), accum);
+            match &constr {
+                &PresenceConstraint::IncludesTag(_, tys) => {
+                    for ty in tys {
+                        subtract(declared, &ty.variables_detail(), accum);
+                    }
+                }
+                &PresenceConstraint::IsOpen => {}
+            }
+        }
     }
 }

compiler/constrain/src/expr.rs

@@ -77,6 +77,7 @@ fn constrain_untyped_args(
             loc_pattern.region,
             pattern_expected,
             &mut pattern_state,
+            false,
         );
 
         vars.push(*pattern_var);
@@ -1039,6 +1040,7 @@ fn constrain_when_branch(
             loc_pattern.region,
             pattern_expected.clone(),
             &mut state,
+            true,
         );
     }
 
@@ -1142,6 +1144,7 @@ fn constrain_def_pattern(env: &Env, loc_pattern: &Loc<Pattern>, expr_type: Type)
         loc_pattern.region,
         pattern_expected,
         &mut state,
+        false,
     );
 
     state
@@ -1262,6 +1265,7 @@ fn constrain_def(env: &Env, def: &Def, body_con: Constraint) -> Constraint {
                                 loc_pattern.region,
                                 pattern_expected,
                                 &mut state,
+                                false,
                             );
                         }
 
@@ -1629,6 +1633,7 @@ pub fn rec_defs_help(
                                     loc_pattern.region,
                                     pattern_expected,
                                     &mut state,
+                                    false,
                                 );
                             }
 

compiler/constrain/src/pattern.rs

@@ -1,6 +1,6 @@
 use crate::builtins;
 use crate::expr::{constrain_expr, Env};
-use roc_can::constraint::Constraint;
+use roc_can::constraint::{Constraint, PresenceConstraint};
 use roc_can::expected::{Expected, PExpected};
 use roc_can::pattern::Pattern::{self, *};
 use roc_can::pattern::{DestructType, RecordDestruct};
@@ -127,8 +127,21 @@ pub fn constrain_pattern(
     region: Region,
     expected: PExpected<Type>,
     state: &mut PatternState,
+    destruct_position: bool,
 ) {
     match pattern {
+        Underscore if destruct_position => {
+            // This is an underscore in a position where we destruct a variable,
+            // like a when expression:
+            //   when x is
+            //     A -> ""
+            //     _ -> ""
+            // so, we know that "x" (in this case, a tag union) must be open.
+            state.constraints.push(Constraint::Present(
+                expected.get_type(),
+                PresenceConstraint::IsOpen,
+            ));
+        }
         Underscore | UnsupportedPattern(_) | MalformedPattern(_, _) | Shadowed(_, _) => {
             // Neither the _ pattern nor erroneous ones add any constraints.
         }
@@ -138,9 +151,15 @@ pub fn constrain_pattern(
                 *symbol,
                 Loc {
                     region,
-                    value: expected.get_type(),
+                    value: expected.get_type_ref().clone(),
                 },
             );
+            if destruct_position {
+                state.constraints.push(Constraint::Present(
+                    expected.get_type(),
+                    PresenceConstraint::IsOpen,
+                ));
+            }
         }
 
         NumLiteral(var, _, _) => {
@@ -151,6 +170,7 @@ pub fn constrain_pattern(
                 PatternCategory::Num,
                 builtins::num_num(Type::Variable(*var)),
                 expected,
+                false,
             ));
         }
 
@@ -160,6 +180,7 @@ pub fn constrain_pattern(
                 PatternCategory::Int,
                 builtins::num_int(Type::Variable(*precision_var)),
                 expected,
+                false,
             ));
         }
 
@@ -169,6 +190,7 @@ pub fn constrain_pattern(
                 PatternCategory::Float,
                 builtins::num_float(Type::Variable(*precision_var)),
                 expected,
+                false,
             ));
         }
 
@@ -178,6 +200,7 @@ pub fn constrain_pattern(
                 PatternCategory::Str,
                 builtins::str_type(),
                 expected,
+                false,
             ));
         }
 
@@ -223,10 +246,18 @@ pub fn constrain_pattern(
                                 pat_type.clone(),
                                 loc_guard.region,
                             ),
+                            destruct_position,
                         ));
                         state.vars.push(*guard_var);
 
-                        constrain_pattern(env, &loc_guard.value, loc_guard.region, expected, state);
+                        constrain_pattern(
+                            env,
+                            &loc_guard.value,
+                            loc_guard.region,
+                            expected,
+                            state,
+                            destruct_position,
+                        );
 
                         RecordField::Demanded(pat_type)
                     }
@@ -240,6 +271,7 @@ pub fn constrain_pattern(
                                 pat_type.clone(),
                                 loc_expr.region,
                             ),
+                            destruct_position,
                         ));
 
                         state.vars.push(*expr_var);
@@ -281,6 +313,7 @@ pub fn constrain_pattern(
                 PatternCategory::Record,
                 Type::Variable(*whole_var),
                 expected,
+                destruct_position,
             );
 
             state.constraints.push(whole_con);
@@ -307,10 +340,23 @@ pub fn constrain_pattern(
                     pattern_type,
                     region,
                 );
-                constrain_pattern(env, &loc_pattern.value, loc_pattern.region, expected, state);
+                constrain_pattern(
+                    env,
+                    &loc_pattern.value,
+                    loc_pattern.region,
+                    expected,
+                    state,
+                    destruct_position,
+                );
             }
 
-            let whole_con = Constraint::Eq(
+            let whole_con = if destruct_position {
+                Constraint::Present(
+                    expected.clone().get_type(),
+                    PresenceConstraint::IncludesTag(tag_name.clone(), argument_types.clone()),
+                )
+            } else {
+                Constraint::Eq(
                     Type::Variable(*whole_var),
                     Expected::NoExpectation(Type::TagUnion(
                         vec![(tag_name.clone(), argument_types)],
@@ -318,13 +364,15 @@ pub fn constrain_pattern(
                     )),
                     Category::Storage(std::file!(), std::line!()),
                     region,
-            );
+                )
+            };
 
             let tag_con = Constraint::Pattern(
                 region,
                 PatternCategory::Ctor(tag_name.clone()),
                 Type::Variable(*whole_var),
                 expected,
+                destruct_position,
             );
 
             state.vars.push(*whole_var);

compiler/mono/src/ir.rs

@@ -2227,7 +2227,7 @@ fn specialize_external<'a>(
     let snapshot = env.subs.snapshot();
     let cache_snapshot = layout_cache.snapshot();
 
-    let _unified = roc_unify::unify::unify(env.subs, partial_proc.annotation, fn_var);
+    let _unified = roc_unify::unify::unify(env.subs, partial_proc.annotation, fn_var, false);
 
     // This will not hold for programs with type errors
     // let is_valid = matches!(unified, roc_unify::unify::Unified::Success(_));

compiler/solve/src/solve.rs

@@ -1,4 +1,5 @@
 use roc_can::constraint::Constraint::{self, *};
+use roc_can::constraint::PresenceConstraint;
 use roc_can::expected::{Expected, PExpected};
 use roc_collections::all::MutMap;
 use roc_module::ident::TagName;
@@ -205,7 +206,7 @@ fn solve(
                 expectation.get_type_ref(),
             );
 
-            match unify(subs, actual, expected) {
+            match unify(subs, actual, expected, false) {
                 Success(vars) => {
                     introduce(subs, rank, pools, &vars);
 
@@ -240,7 +241,7 @@ fn solve(
             let actual = type_to_var(subs, rank, pools, cached_aliases, source);
             let target = *target;
 
-            match unify(subs, actual, target) {
+            match unify(subs, actual, target, false) {
                 Success(vars) => {
                     introduce(subs, rank, pools, &vars);
 
@@ -294,7 +295,7 @@ fn solve(
                         cached_aliases,
                         expectation.get_type_ref(),
                     );
-                    match unify(subs, actual, expected) {
+                    match unify(subs, actual, expected, false) {
                         Success(vars) => {
                             introduce(subs, rank, pools, &vars);
 
@@ -349,7 +350,7 @@ fn solve(
 
             state
         }
-        Pattern(region, category, typ, expectation) => {
+        Pattern(region, category, typ, expectation, presence) => {
             let actual = type_to_var(subs, rank, pools, cached_aliases, typ);
             let expected = type_to_var(
                 subs,
@@ -359,7 +360,7 @@ fn solve(
                 expectation.get_type_ref(),
             );
 
-            match unify(subs, actual, expected) {
+            match unify(subs, actual, expected, *presence) {
                 Success(vars) => {
                     introduce(subs, rank, pools, &vars);
 
@@ -622,6 +623,69 @@ fn solve(
                 }
             }
         }
+        Present(typ, constr) => {
+            let actual = type_to_var(subs, rank, pools, cached_aliases, typ);
+            match constr {
+                PresenceConstraint::IsOpen => {
+                    let mut new_desc = subs.get(actual);
+                    match new_desc.content {
+                        Content::Structure(FlatType::TagUnion(tags, _)) => {
+                            let new_ext = subs.fresh_unnamed_flex_var();
+                            let new_union = Content::Structure(FlatType::TagUnion(tags, new_ext));
+                            new_desc.content = new_union;
+                            subs.set(actual, new_desc);
+                            state
+                        }
+                        _ => {
+                            // Today, an "open" constraint doesn't affect any types
+                            // other than tag unions. Recursive tag unions are constructed
+                            // at a later time (during occurs checks after tag unions are
+                            // resolved), so that's not handled here either.
+                            // NB: Handle record types here if we add presence constraints
+                            // to their type inference as well.
+                            state
+                        }
+                    }
+                }
+                PresenceConstraint::IncludesTag(tag_name, tys) => {
+                    let tag_ty = Type::TagUnion(
+                        vec![(tag_name.clone(), tys.clone())],
+                        Box::new(Type::EmptyTagUnion),
+                    );
+                    let includes = type_to_var(subs, rank, pools, cached_aliases, &tag_ty);
+
+                    match unify(subs, actual, includes, true) {
+                        Success(vars) => {
+                            introduce(subs, rank, pools, &vars);
+
+                            state
+                        }
+                        Failure(vars, actual_type, expected_type) => {
+                            introduce(subs, rank, pools, &vars);
+
+                            // TODO: do we need a better error type here?
+                            let problem = TypeError::BadExpr(
+                                Region::zero(),
+                                Category::When,
+                                actual_type,
+                                Expected::NoExpectation(expected_type),
+                            );
+
+                            problems.push(problem);
+
+                            state
+                        }
+                        BadType(vars, problem) => {
+                            introduce(subs, rank, pools, &vars);
+
+                            problems.push(TypeError::BadType(problem));
+
+                            state
+                        }
+                    }
+                }
+            }
+        }
     }
 }
 
@@ -1437,6 +1501,24 @@ fn adjust_rank_content(
 
                 TagUnion(tags, ext_var) => {
                     let mut rank = adjust_rank(subs, young_mark, visit_mark, group_rank, *ext_var);
+                    // For performance reasons, we only keep one representation of empty tag unions
+                    // in subs. That representation exists at rank 0, which we don't always want to
+                    // reflect the whole tag union as, because doing so may over-generalize free
+                    // type variables.
+                    // Normally this is not a problem because of the loop below that maximizes the
+                    // rank from nested types in the union. But suppose we have the simple tag
+                    // union
+                    //   [ Z ]{}
+                    // there are no nested types in the tags, and the empty tag union is at rank 0,
+                    // so we promote the tag union to rank 0. Now if we introduce the presence
+                    // constraint
+                    //   [ Z ]{} += [ S a ]
+                    // we'll wind up with [ Z, S a ]{}, but it will be at rank 0, and "a" will get
+                    // over-generalized. Really, the empty tag union should be introduced at
+                    // whatever current group rank we're at, and so that's how we encode it here.
+                    if *ext_var == Variable::EMPTY_TAG_UNION && rank.is_none() {
+                        rank = group_rank;
+                    }
 
                     for (_, index) in tags.iter_all() {
                         let slice = subs[index];

compiler/solve/tests/solve_expr.rs

@@ -1354,7 +1354,7 @@ mod solve_expr {
                             False -> 0
                 "#
             ),
-            "[ False, True ]* -> Num *",
+            "[ False, True ] -> Num *",
         );
     }
 
@@ -2416,7 +2416,7 @@ mod solve_expr {
                    toBit
                 "#
             ),
-            "[ False, True ]* -> Num *",
+            "[ False, True ] -> Num *",
         );
     }
 
@@ -2680,7 +2680,7 @@ mod solve_expr {
                     map
                        "#
             ),
-            "(a -> b), [ Cons a c, Nil ]* as c -> [ Cons b d, Nil ]* as d",
+            "(a -> b), [ Cons a c, Nil ] as c -> [ Cons b d, Nil ]* as d",
         );
     }
 
@@ -2941,7 +2941,7 @@ mod solve_expr {
                     map
                 "#
             ),
-            "[ S a, Z ]* as a -> [ S b, Z ]* as b",
+            "[ S a, Z ] as a -> [ S b, Z ]* as b",
         );
     }
 
@@ -2960,7 +2960,7 @@ mod solve_expr {
                     map
                 "#
             ),
-            "[ S a, Z ]* as a -> [ S b, Z ]* as b",
+            "[ S a, Z ] as a -> [ S b, Z ]* as b",
         );
     }
 
@@ -3031,7 +3031,7 @@ mod solve_expr {
                     map
                 "#
             ),
-            "(a -> b), [ Cons { x : a, xs : c }*, Nil ]* as c -> [ Cons { x : b, xs : d }, Nil ]* as d",
+            "(a -> b), [ Cons { x : a, xs : c }*, Nil ] as c -> [ Cons { x : b, xs : d }, Nil ]* as d",
         );
     }
 
@@ -3100,7 +3100,7 @@ mod solve_expr {
                    toAs
                 "#
             ),
-            "(a -> b), [ Cons c [ Cons a d, Nil ]*, Nil ]* as d -> [ Cons c [ Cons b e ]*, Nil ]* as e"
+            "(a -> b), [ Cons c [ Cons a d, Nil ], Nil ] as d -> [ Cons c [ Cons b e ]*, Nil ]* as e"
         );
     }
 
@@ -3905,7 +3905,7 @@ mod solve_expr {
                             x
                 "#
             ),
-            "[ Empty, Foo [ Bar ] I64 ]",
+            "[ Empty, Foo Bar I64 ]",
         );
     }
 
@@ -4749,4 +4749,164 @@ mod solve_expr {
             "List elem -> LinkedList elem",
         )
     }
+
+    #[test]
+    fn infer_union_input_position1() {
+        infer_eq_without_problem(
+            indoc!(
+                r#"
+                 \tag ->
+                     when tag is
+                       A -> X
+                       B -> Y
+                 "#
+            ),
+            "[ A, B ] -> [ X, Y ]*",
+        )
+    }
+
+    #[test]
+    fn infer_union_input_position2() {
+        infer_eq_without_problem(
+            indoc!(
+                r#"
+                 \tag ->
+                     when tag is
+                       A -> X
+                       B -> Y
+                       _ -> Z
+                 "#
+            ),
+            "[ A, B ]* -> [ X, Y, Z ]*",
+        )
+    }
+
+    #[test]
+    fn infer_union_input_position3() {
+        infer_eq_without_problem(
+            indoc!(
+                r#"
+                 \tag ->
+                     when tag is
+                       A M -> X
+                       A N -> Y
+                 "#
+            ),
+            "[ A [ M, N ] ] -> [ X, Y ]*",
+        )
+    }
+
+    #[test]
+    fn infer_union_input_position4() {
+        infer_eq_without_problem(
+            indoc!(
+                r#"
+                 \tag ->
+                     when tag is
+                       A M -> X
+                       A N -> Y
+                       A _ -> Z
+                 "#
+            ),
+            "[ A [ M, N ]* ] -> [ X, Y, Z ]*",
+        )
+    }
+
+    #[test]
+    fn infer_union_input_position5() {
+        infer_eq_without_problem(
+            indoc!(
+                r#"
+                 \tag ->
+                     when tag is
+                       A (M J) -> X
+                       A (N K) -> X
+                 "#
+            ),
+            "[ A [ M [ J ], N [ K ] ] ] -> [ X ]*",
+        )
+    }
+
+    #[test]
+    fn infer_union_input_position6() {
+        infer_eq_without_problem(
+            indoc!(
+                r#"
+                 \tag ->
+                     when tag is
+                       A M -> X
+                       B   -> X
+                       A N -> X
+                 "#
+            ),
+            "[ A [ M, N ], B ] -> [ X ]*",
+        )
+    }
+
+    #[test]
+    fn infer_union_input_position7() {
+        infer_eq_without_problem(
+            indoc!(
+                r#"
+                 \tag ->
+                     when tag is
+                         A -> X
+                         t -> t
+                 "#
+            ),
+            // TODO: we could be a bit smarter by subtracting "A" as a possible
+            // tag in the union known by t, which would yield the principal type
+            // [ A, ]a -> [ X ]a
+            "[ A, X ]a -> [ A, X ]a",
+        )
+    }
+
+    #[test]
+    fn infer_union_input_position8() {
+        infer_eq_without_problem(
+            indoc!(
+                r#"
+                 \opt ->
+                     when opt is
+                         Some ({tag: A}) -> 1
+                         Some ({tag: B}) -> 1
+                         None -> 0
+                 "#
+            ),
+            "[ None, Some { tag : [ A, B ] }* ] -> Num *",
+        )
+    }
+
+    #[test]
+    fn infer_union_input_position9() {
+        infer_eq_without_problem(
+            indoc!(
+                r#"
+                 opt : [ Some Str, None ]
+                 opt = Some ""
+                 rcd = { opt }
+
+                 when rcd is
+                     { opt: Some s } -> s
+                     { opt: None } -> "?"
+                 "#
+            ),
+            "Str",
+        )
+    }
+
+    #[test]
+    fn infer_union_input_position10() {
+        infer_eq_without_problem(
+            indoc!(
+                r#"
+                 \r ->
+                     when r is
+                         { x: Blue, y ? 3 } -> y
+                         { x: Red, y ? 5 } -> y
+                 "#
+            ),
+            "{ x : [ Blue, Red ], y ? Num a }* -> Num a",
+        )
+    }
 }

compiler/unify/src/unify.rs

@@ -62,6 +62,12 @@ pub struct Context {
     first_desc: Descriptor,
     second: Variable,
     second_desc: Descriptor,
+    // Whether this unification context should be treated as a presence constraint.
+    // When true, we should treat "second" as additive to "first", rather than
+    // strictly equal.
+    // For example, if present=true and first=t1 and second=A Str, we should "add"
+    // the tag "A Str" to the type of "t1".
+    presence: bool,
 }
 
 #[derive(Debug)]
@@ -74,9 +80,9 @@ pub enum Unified {
 type Outcome = Vec<Mismatch>;
 
 #[inline(always)]
-pub fn unify(subs: &mut Subs, var1: Variable, var2: Variable) -> Unified {
+pub fn unify(subs: &mut Subs, var1: Variable, var2: Variable, presence: bool) -> Unified {
     let mut vars = Vec::new();
-    let mismatches = unify_pool(subs, &mut vars, var1, var2);
+    let mismatches = unify_pool(subs, &mut vars, var1, var2, presence);
 
     if mismatches.is_empty() {
         Unified::Success(vars)
@@ -97,7 +103,13 @@ pub fn unify(subs: &mut Subs, var1: Variable, var2: Variable) -> Unified {
 }
 
 #[inline(always)]
-pub fn unify_pool(subs: &mut Subs, pool: &mut Pool, var1: Variable, var2: Variable) -> Outcome {
+pub fn unify_pool(
+    subs: &mut Subs,
+    pool: &mut Pool,
+    var1: Variable,
+    var2: Variable,
+    presence: bool,
+) -> Outcome {
     if subs.equivalent(var1, var2) {
         Vec::new()
     } else {
@@ -106,6 +118,7 @@ pub fn unify_pool(subs: &mut Subs, pool: &mut Pool, var1: Variable, var2: Variab
             first_desc: subs.get(var1),
             second: var2,
             second_desc: subs.get(var2),
+            presence,
         };
 
         unify_context(subs, pool, ctx)
@@ -177,8 +190,10 @@ fn unify_alias(
             // Alias wins
             merge(subs, ctx, Alias(symbol, args, real_var))
         }
-        RecursionVar { structure, .. } => unify_pool(subs, pool, real_var, *structure),
+        RecursionVar { structure, .. } => {
-        RigidVar(_) => unify_pool(subs, pool, real_var, ctx.second),
+            unify_pool(subs, pool, real_var, *structure, ctx.presence)
+        }
+        RigidVar(_) => unify_pool(subs, pool, real_var, ctx.second, ctx.presence),
         Alias(other_symbol, other_args, other_real_var) => {
             if symbol == *other_symbol {
                 if args.len() == other_args.len() {
@@ -191,7 +206,7 @@ fn unify_alias(
                     for (l, r) in it {
                         let l_var = subs[l];
                         let r_var = subs[r];
-                        problems.extend(unify_pool(subs, pool, l_var, r_var));
+                        problems.extend(unify_pool(subs, pool, l_var, r_var, ctx.presence));
                     }
 
                     if problems.is_empty() {
@@ -206,10 +221,10 @@ fn unify_alias(
                     mismatch!("{:?}", symbol)
                 }
             } else {
-                unify_pool(subs, pool, real_var, *other_real_var)
+                unify_pool(subs, pool, real_var, *other_real_var, ctx.presence)
             }
         }
-        Structure(_) => unify_pool(subs, pool, real_var, ctx.second),
+        Structure(_) => unify_pool(subs, pool, real_var, ctx.second, ctx.presence),
         Error => merge(subs, ctx, Error),
     }
 }
@@ -225,7 +240,26 @@ fn unify_structure(
     match other {
         FlexVar(_) => {
             // If the other is flex, Structure wins!
-            merge(subs, ctx, Structure(flat_type.clone()))
+            let outcome = merge(subs, ctx, Structure(flat_type.clone()));
+
+            // And if we see a flex variable on the right hand side of a presence
+            // constraint, we know we need to open up the structure we're trying to unify with.
+            match (ctx.presence, flat_type) {
+                (true, FlatType::TagUnion(tags, _ext)) => {
+                    let new_ext = subs.fresh_unnamed_flex_var();
+                    let mut new_desc = ctx.first_desc.clone();
+                    new_desc.content = Structure(FlatType::TagUnion(*tags, new_ext));
+                    subs.set(ctx.first, new_desc);
+                }
+                (true, FlatType::FunctionOrTagUnion(tn, sym, _ext)) => {
+                    let new_ext = subs.fresh_unnamed_flex_var();
+                    let mut new_desc = ctx.first_desc.clone();
+                    new_desc.content = Structure(FlatType::FunctionOrTagUnion(*tn, *sym, new_ext));
+                    subs.set(ctx.first, new_desc);
+                }
+                _ => {}
+            }
+            outcome
         }
         RigidVar(name) => {
             // Type mismatch! Rigid can only unify with flex.
@@ -234,16 +268,16 @@ fn unify_structure(
         RecursionVar { structure, .. } => match flat_type {
             FlatType::TagUnion(_, _) => {
                 // unify the structure with this unrecursive tag union
-                unify_pool(subs, pool, ctx.first, *structure)
+                unify_pool(subs, pool, ctx.first, *structure, ctx.presence)
             }
             FlatType::RecursiveTagUnion(rec, _, _) => {
                 debug_assert!(is_recursion_var(subs, *rec));
                 // unify the structure with this recursive tag union
-                unify_pool(subs, pool, ctx.first, *structure)
+                unify_pool(subs, pool, ctx.first, *structure, ctx.presence)
             }
             FlatType::FunctionOrTagUnion(_, _, _) => {
                 // unify the structure with this unrecursive tag union
-                unify_pool(subs, pool, ctx.first, *structure)
+                unify_pool(subs, pool, ctx.first, *structure, ctx.presence)
             }
             _ => todo!("rec structure {:?}", &flat_type),
         },
@@ -252,7 +286,11 @@ fn unify_structure(
             // Unify the two flat types
             unify_flat_type(subs, pool, ctx, flat_type, other_flat_type)
         }
-        Alias(_, _, real_var) => unify_pool(subs, pool, ctx.first, *real_var),
+        Alias(_, _, real_var) => {
+            // NB: not treating this as a presence constraint seems pivotal! I
+            // can't quite figure out why, but it doesn't seem to impact other types.
+            unify_pool(subs, pool, ctx.first, *real_var, false)
+        }
         Error => merge(subs, ctx, Error),
     }
 }
@@ -273,7 +311,7 @@ fn unify_record(
     if separate.only_in_1.is_empty() {
         if separate.only_in_2.is_empty() {
             // these variable will be the empty record, but we must still unify them
-            let ext_problems = unify_pool(subs, pool, ext1, ext2);
+            let ext_problems = unify_pool(subs, pool, ext1, ext2, ctx.presence);
 
             if !ext_problems.is_empty() {
                 return ext_problems;
@@ -289,7 +327,7 @@ fn unify_record(
             let only_in_2 = RecordFields::insert_into_subs(subs, separate.only_in_2);
             let flat_type = FlatType::Record(only_in_2, ext2);
             let sub_record = fresh(subs, pool, ctx, Structure(flat_type));
-            let ext_problems = unify_pool(subs, pool, ext1, sub_record);
+            let ext_problems = unify_pool(subs, pool, ext1, sub_record, ctx.presence);
 
             if !ext_problems.is_empty() {
                 return ext_problems;
@@ -312,7 +350,7 @@ fn unify_record(
         let only_in_1 = RecordFields::insert_into_subs(subs, separate.only_in_1);
         let flat_type = FlatType::Record(only_in_1, ext1);
         let sub_record = fresh(subs, pool, ctx, Structure(flat_type));
-        let ext_problems = unify_pool(subs, pool, sub_record, ext2);
+        let ext_problems = unify_pool(subs, pool, sub_record, ext2, ctx.presence);
 
         if !ext_problems.is_empty() {
             return ext_problems;
@@ -343,12 +381,12 @@ fn unify_record(
         let sub1 = fresh(subs, pool, ctx, Structure(flat_type1));
         let sub2 = fresh(subs, pool, ctx, Structure(flat_type2));
 
-        let rec1_problems = unify_pool(subs, pool, ext1, sub2);
+        let rec1_problems = unify_pool(subs, pool, ext1, sub2, ctx.presence);
         if !rec1_problems.is_empty() {
             return rec1_problems;
         }
 
-        let rec2_problems = unify_pool(subs, pool, sub1, ext2);
+        let rec2_problems = unify_pool(subs, pool, sub1, ext2, ctx.presence);
         if !rec2_problems.is_empty() {
             return rec2_problems;
         }
@@ -383,7 +421,13 @@ fn unify_shared_fields(
     let num_shared_fields = shared_fields.len();
 
     for (name, (actual, expected)) in shared_fields {
-        let local_problems = unify_pool(subs, pool, actual.into_inner(), expected.into_inner());
+        let local_problems = unify_pool(
+            subs,
+            pool,
+            actual.into_inner(),
+            expected.into_inner(),
+            ctx.presence,
+        );
 
         if local_problems.is_empty() {
             use RecordField::*;
@@ -614,14 +658,47 @@ fn unify_tag_union_new(
     initial_ext2: Variable,
     recursion_var: Rec,
 ) -> Outcome {
-    let (separate, ext1, ext2) =
+    let (separate, mut ext1, ext2) =
         separate_union_tags(subs, tags1, initial_ext1, tags2, initial_ext2);
 
     let shared_tags = separate.in_both;
 
+    if let (true, Content::Structure(FlatType::EmptyTagUnion)) =
+        (ctx.presence, subs.get(ext1).content)
+    {
+        if !separate.only_in_2.is_empty() {
+            // Create a new extension variable that we'll fill in with the
+            // contents of the tag union from our presence contraint.
+            //
+            // If there's no new (toplevel) tags we need to register for
+            // presence, for example in the cases
+            //    [A]      += [A]
+            //    [A, B]   += [A]
+            //    [A M, B] += [A N]
+            // then we don't need to create a fresh ext variable, since the
+            // tag union is definitely not growing on the top level.
+            // Notice that in the last case
+            //    [A M, B] += [A N]
+            // the nested tag `A` **will** grow, but we don't need to modify
+            // the top level extension variable for that!
+            let new_ext = fresh(subs, pool, ctx, Content::FlexVar(None));
+            let new_union = Structure(FlatType::TagUnion(tags1, new_ext));
+            let mut new_desc = ctx.first_desc.clone();
+            new_desc.content = new_union;
+            subs.set(ctx.first, new_desc);
+
+            ext1 = new_ext;
+        }
+    }
+
     if separate.only_in_1.is_empty() {
         if separate.only_in_2.is_empty() {
-            let ext_problems = unify_pool(subs, pool, ext1, ext2);
+            let ext_problems = if !ctx.presence {
+                unify_pool(subs, pool, ext1, ext2, ctx.presence)
+            } else {
+                // In a presence context, we don't care about ext2 being equal to ext1
+                vec![]
+            };
 
             if !ext_problems.is_empty() {
                 return ext_problems;
@@ -644,7 +721,7 @@ fn unify_tag_union_new(
             let unique_tags2 = UnionTags::insert_slices_into_subs(subs, separate.only_in_2);
             let flat_type = FlatType::TagUnion(unique_tags2, ext2);
             let sub_record = fresh(subs, pool, ctx, Structure(flat_type));
-            let ext_problems = unify_pool(subs, pool, ext1, sub_record);
+            let ext_problems = unify_pool(subs, pool, ext1, sub_record, ctx.presence);
 
             if !ext_problems.is_empty() {
                 return ext_problems;
@@ -668,13 +745,17 @@ fn unify_tag_union_new(
         let unique_tags1 = UnionTags::insert_slices_into_subs(subs, separate.only_in_1);
         let flat_type = FlatType::TagUnion(unique_tags1, ext1);
         let sub_record = fresh(subs, pool, ctx, Structure(flat_type));
-        let ext_problems = unify_pool(subs, pool, sub_record, ext2);
+
+        // In a presence context, we don't care about ext2 being equal to tags1
+        if !ctx.presence {
+            let ext_problems = unify_pool(subs, pool, sub_record, ext2, ctx.presence);
 
             if !ext_problems.is_empty() {
                 return ext_problems;
             }
+        }
 
-        let mut tag_problems = unify_shared_tags_new(
+        unify_shared_tags_new(
             subs,
             pool,
             ctx,
@@ -682,18 +763,19 @@ fn unify_tag_union_new(
             OtherTags2::Empty,
             sub_record,
             recursion_var,
-        );
+        )
-
-        tag_problems.extend(ext_problems);
-
-        tag_problems
     } else {
         let other_tags = OtherTags2::Union(separate.only_in_1.clone(), separate.only_in_2.clone());
 
         let unique_tags1 = UnionTags::insert_slices_into_subs(subs, separate.only_in_1);
         let unique_tags2 = UnionTags::insert_slices_into_subs(subs, separate.only_in_2);
 
-        let ext = fresh(subs, pool, ctx, Content::FlexVar(None));
+        let ext_content = if ctx.presence {
+            Content::Structure(FlatType::EmptyTagUnion)
+        } else {
+            Content::FlexVar(None)
+        };
+        let ext = fresh(subs, pool, ctx, ext_content);
         let flat_type1 = FlatType::TagUnion(unique_tags1, ext);
         let flat_type2 = FlatType::TagUnion(unique_tags2, ext);
 
@@ -716,27 +798,25 @@ fn unify_tag_union_new(
 
         let snapshot = subs.snapshot();
 
-        let ext1_problems = unify_pool(subs, pool, ext1, sub2);
+        let ext1_problems = unify_pool(subs, pool, ext1, sub2, ctx.presence);
         if !ext1_problems.is_empty() {
             subs.rollback_to(snapshot);
             return ext1_problems;
         }
 
-        let ext2_problems = unify_pool(subs, pool, sub1, ext2);
+        if !ctx.presence {
+            let ext2_problems = unify_pool(subs, pool, sub1, ext2, ctx.presence);
             if !ext2_problems.is_empty() {
                 subs.rollback_to(snapshot);
                 return ext2_problems;
             }
+        }
 
         subs.commit_snapshot(snapshot);
 
-        let mut tag_problems =
+        let tag_problems =
             unify_shared_tags_new(subs, pool, ctx, shared_tags, other_tags, ext, recursion_var);
 
-        tag_problems.reserve(ext1_problems.len() + ext2_problems.len());
-        tag_problems.extend(ext1_problems);
-        tag_problems.extend(ext2_problems);
-
         tag_problems
     }
 }
@@ -813,7 +893,7 @@ fn unify_shared_tags_new(
 
             let mut problems = Vec::new();
 
-            problems.extend(unify_pool(subs, pool, actual, expected));
+            problems.extend(unify_pool(subs, pool, actual, expected, ctx.presence));
 
             // clearly, this is very suspicious: these variables have just been unified. And yet,
             // not doing this leads to stack overflows
@@ -927,11 +1007,11 @@ fn unify_flat_type(
         (EmptyRecord, EmptyRecord) => merge(subs, ctx, Structure(left.clone())),
 
         (Record(fields, ext), EmptyRecord) if fields.has_only_optional_fields(subs) => {
-            unify_pool(subs, pool, *ext, ctx.second)
+            unify_pool(subs, pool, *ext, ctx.second, ctx.presence)
         }
 
         (EmptyRecord, Record(fields, ext)) if fields.has_only_optional_fields(subs) => {
-            unify_pool(subs, pool, ctx.first, *ext)
+            unify_pool(subs, pool, ctx.first, *ext, ctx.presence)
         }
 
         (Record(fields1, ext1), Record(fields2, ext2)) => {
@@ -941,11 +1021,11 @@ fn unify_flat_type(
         (EmptyTagUnion, EmptyTagUnion) => merge(subs, ctx, Structure(left.clone())),
 
         (TagUnion(tags, ext), EmptyTagUnion) if tags.is_empty() => {
-            unify_pool(subs, pool, *ext, ctx.second)
+            unify_pool(subs, pool, *ext, ctx.second, ctx.presence)
         }
 
         (EmptyTagUnion, TagUnion(tags, ext)) if tags.is_empty() => {
-            unify_pool(subs, pool, ctx.first, *ext)
+            unify_pool(subs, pool, ctx.first, *ext, ctx.presence)
         }
 
         (TagUnion(tags1, ext1), TagUnion(tags2, ext2)) => {
@@ -976,7 +1056,7 @@ fn unify_flat_type(
             let rec = Rec::Both(*rec1, *rec2);
             let mut problems =
                 unify_tag_union_new(subs, pool, ctx, *tags1, *ext1, *tags2, *ext2, rec);
-            problems.extend(unify_pool(subs, pool, *rec1, *rec2));
+            problems.extend(unify_pool(subs, pool, *rec1, *rec2, ctx.presence));
 
             problems
         }
@@ -994,8 +1074,8 @@ fn unify_flat_type(
             if l_args.len() == r_args.len() =>
         {
             let arg_problems = unify_zip_slices(subs, pool, *l_args, *r_args);
-            let ret_problems = unify_pool(subs, pool, *l_ret, *r_ret);
+            let ret_problems = unify_pool(subs, pool, *l_ret, *r_ret, ctx.presence);
-            let closure_problems = unify_pool(subs, pool, *l_closure, *r_closure);
+            let closure_problems = unify_pool(subs, pool, *l_closure, *r_closure, ctx.presence);
 
             if arg_problems.is_empty() && closure_problems.is_empty() && ret_problems.is_empty() {
                 merge(subs, ctx, Structure(Func(*r_args, *r_closure, *r_ret)))
@@ -1041,7 +1121,7 @@ fn unify_flat_type(
             let tag_name_2_ref = &subs[*tag_name_2];
 
             if tag_name_1_ref == tag_name_2_ref {
-                let problems = unify_pool(subs, pool, *ext1, *ext2);
+                let problems = unify_pool(subs, pool, *ext1, *ext2, ctx.presence);
                 if problems.is_empty() {
                     let content = subs.get_content_without_compacting(ctx.second).clone();
                     merge(subs, ctx, content)
@@ -1110,7 +1190,9 @@ fn unify_zip_slices(
         let l_var = subs[l_index];
         let r_var = subs[r_index];
 
-        problems.extend(unify_pool(subs, pool, l_var, r_var));
+        problems.extend(unify_pool(
+            subs, pool, l_var, r_var, false, /* presence */
+        ));
     }
 
     problems
@@ -1188,7 +1270,7 @@ fn unify_recursion(
 
         Structure(_) => {
             // unify the structure variable with this Structure
-            unify_pool(subs, pool, structure, ctx.second)
+            unify_pool(subs, pool, structure, ctx.second, ctx.presence)
         }
         RigidVar(_) => mismatch!("RecursionVar {:?} with rigid {:?}", ctx.first, &other),
 
@@ -1204,7 +1286,7 @@ fn unify_recursion(
         Alias(_, _, actual) => {
             // look at the type the alias stands for
 
-            unify_pool(subs, pool, ctx.first, *actual)
+            unify_pool(subs, pool, ctx.first, *actual, ctx.presence)
         }
 
         Error => merge(subs, ctx, Error),
@@ -1274,9 +1356,9 @@ fn unify_function_or_tag_union_and_func(
     let new_tag_union_var = fresh(subs, pool, ctx, content);
 
     let mut problems = if left {
-        unify_pool(subs, pool, new_tag_union_var, function_return)
+        unify_pool(subs, pool, new_tag_union_var, function_return, ctx.presence)
     } else {
-        unify_pool(subs, pool, function_return, new_tag_union_var)
+        unify_pool(subs, pool, function_return, new_tag_union_var, ctx.presence)
     };
 
     {
@@ -1298,9 +1380,21 @@ fn unify_function_or_tag_union_and_func(
         );
 
         let closure_problems = if left {
-            unify_pool(subs, pool, tag_lambda_set, function_lambda_set)
+            unify_pool(
+                subs,
+                pool,
+                tag_lambda_set,
+                function_lambda_set,
+                ctx.presence,
+            )
         } else {
-            unify_pool(subs, pool, function_lambda_set, tag_lambda_set)
+            unify_pool(
+                subs,
+                pool,
+                function_lambda_set,
+                tag_lambda_set,
+                ctx.presence,
+            )
         };
 
         problems.extend(closure_problems);

reporting/tests/test_reporting.rs

@@ -1500,7 +1500,7 @@ mod test_reporting {
 
                 The first pattern is trying to match record values of type:
 
-                    { foo : [ True ]a }
+                    { foo : [ True ] }
 
                 But the expression between `when` and `is` has the type: