Catch illegal alias cycles more strictly

Part of #2458

compiler/can/src/def.rs

@@ -1560,44 +1560,51 @@ fn correct_mutual_recursive_type_alias<'a>(
     // TODO investigate should this be in a loop?
     let defined_symbols: Vec<Symbol> = aliases.keys().copied().collect();
 
-    let cycles = &strongly_connected_components(&defined_symbols, all_successors_with_self);
+    let cycles = strongly_connected_components(&defined_symbols, all_successors_with_self);
 
-    for cycle in cycles {
+    'next_cycle: for cycle in cycles {
         debug_assert!(!cycle.is_empty());
+
+        // Make sure we report only one error for the cycle, not an error for every
+        // alias in the cycle.
+        let mut can_still_report_error = true;
+
+        // Go through and mark every self- and mutually-recursive alias cycle recursive.
         if cycle.len() == 1 {
             let symbol = cycle[0];
             let alias = aliases.get_mut(&symbol).unwrap();
 
-            if alias.typ.contains_symbol(symbol) {
+            if !alias.typ.contains_symbol(symbol) {
-                let mut can_still_report_error = true;
+                // This alias is neither self nor mutually recursive.
-                let mut opt_rec_var = None;
+                continue 'next_cycle;
-
-                let _made_recursive = make_tag_union_of_alias_recursive(
-                    env,
-                    symbol,
-                    alias,
-                    vec![],
-                    var_store,
-                    &mut can_still_report_error,
-                    &mut opt_rec_var,
-                );
-
-                scope.add_alias(
-                    symbol,
-                    alias.region,
-                    alias.type_variables.clone(),
-                    alias.typ.clone(),
-                );
             }
-        } else {
-            // This is a mutually recursive cycle
 
-            // make sure we report only one error for the cycle, not an error for every
+            // This is a self-recursive cycle.
-            // alias in the cycle.
             let mut can_still_report_error = true;
-
             let mut opt_rec_var = None;
-            for symbol in cycle {
+
+            let _made_recursive = make_tag_union_of_alias_recursive(
+                env,
+                symbol,
+                alias,
+                vec![],
+                var_store,
+                &mut can_still_report_error,
+                &mut opt_rec_var,
+            );
+
+            scope.add_alias(
+                symbol,
+                alias.region,
+                alias.type_variables.clone(),
+                alias.typ.clone(),
+            );
+        } else {
+            // This is a mutually recursive cycle.
+            let mut opt_rec_var = None;
+
+            // First mark everything in the cycle recursive, as it needs to be.
+            for symbol in cycle.iter() {
                 let alias = aliases.get_mut(&symbol).unwrap();
 
                 let _made_recursive = make_tag_union_of_alias_recursive(
@@ -1611,20 +1618,23 @@ fn correct_mutual_recursive_type_alias<'a>(
                 );
             }
 
+            // Now go through and instantiate references that are recursive, but we didn't know
+            // they were until now.
+            //
             // TODO use itertools to be more efficient here
-            for rec in cycle {
+            for &rec in cycle.iter() {
                 let mut to_instantiate = ImMap::default();
                 let mut others = Vec::with_capacity(cycle.len() - 1);
-                for other in cycle {
+                for &other in cycle.iter() {
                     if rec != other {
-                        others.push(*other);
+                        others.push(other);
-                        if let Some(alias) = aliases.get(other) {
+                        if let Some(alias) = aliases.get(&other) {
-                            to_instantiate.insert(*other, alias.clone());
+                            to_instantiate.insert(other, alias.clone());
                         }
                     }
                 }
 
-                if let Some(alias) = aliases.get_mut(rec) {
+                if let Some(alias) = aliases.get_mut(&rec) {
                     alias.typ.instantiate_aliases(
                         alias.region,
                         &to_instantiate,
@@ -1634,6 +1644,34 @@ fn correct_mutual_recursive_type_alias<'a>(
                 }
             }
         }
+
+        // The cycle we just marked recursive and instantiated may still be illegal cycles, if
+        // all the types in the cycle are narrow newtypes. We can't figure this out until now,
+        // because we need all the types to be deeply instantiated.
+
+        let all_are_narrow = cycle.iter().all(|sym| {
+            let typ = &aliases.get(sym).unwrap().typ;
+            typ.is_tag_union_like() && typ.is_narrow()
+        });
+        if !all_are_narrow {
+            // We pass through at least one tag union that has a non-recursive variant, so this
+            // cycle is legal.
+            continue 'next_cycle;
+        }
+
+        let mut rest = cycle;
+        let alias_name = rest.pop().unwrap();
+
+        let alias = aliases.get_mut(&alias_name).unwrap();
+
+        mark_cyclic_alias(
+            env,
+            &mut alias.typ,
+            alias_name,
+            alias.region,
+            rest,
+            can_still_report_error,
+        )
     }
 }
 
@@ -1741,17 +1779,27 @@ fn make_tag_union_recursive_help<'a>(
             opt_rec_var,
         ),
         _ => {
-            let problem = roc_types::types::Problem::CyclicAlias(symbol, region, others.clone());
+            mark_cyclic_alias(env, typ, symbol, region, others.clone(), *can_report_error);
-            *typ = Type::Erroneous(problem);
+            *can_report_error = false;
 
-            // ensure cyclic error is only reported for one element of the cycle
-            if *can_report_error {
-                *can_report_error = false;
-
-                let problem = Problem::CyclicAlias(symbol, region, others);
-                env.problems.push(problem);
-            }
             Ok(())
         }
     }
 }
+
+fn mark_cyclic_alias<'a>(
+    env: &mut Env<'a>,
+    typ: &mut Type,
+    symbol: Symbol,
+    region: Region,
+    others: Vec<Symbol>,
+    report: bool,
+) {
+    let problem = roc_types::types::Problem::CyclicAlias(symbol, region, others.clone());
+    *typ = Type::Erroneous(problem);
+
+    if report {
+        let problem = Problem::CyclicAlias(symbol, region, others);
+        env.problems.push(problem);
+    }
+}

compiler/types/src/types.rs

@@ -3,6 +3,7 @@ use crate::subs::{
     GetSubsSlice, RecordFields, Subs, UnionTags, VarStore, Variable, VariableSubsSlice,
 };
 use roc_collections::all::{ImMap, ImSet, Index, MutSet, SendMap};
+use roc_error_macros::internal_error;
 use roc_module::called_via::CalledVia;
 use roc_module::ident::{ForeignSymbol, Ident, Lowercase, TagName};
 use roc_module::low_level::LowLevel;
@@ -869,6 +870,54 @@ impl Type {
             EmptyRec | EmptyTagUnion | ClosureTag { .. } | Erroneous(_) | Variable(_) => {}
         }
     }
+
+    pub fn is_tag_union_like(&self) -> bool {
+        matches!(
+            self,
+            Type::TagUnion(..)
+                | Type::RecursiveTagUnion(..)
+                | Type::FunctionOrTagUnion(..)
+                | Type::EmptyTagUnion
+        )
+    }
+
+    /// We say a type is "narrow" if no type composing it is a proper sum; that is, no type
+    /// composing it is a tag union with more than one variant.
+    ///
+    /// The types checked here must have all of their non-builtin `Apply`s instantiated, as a
+    /// non-instantiated `Apply` would be ambiguous.
+    ///
+    /// The following are narrow:
+    ///
+    ///     U8
+    ///     [ A I8 ]
+    ///     [ A [ B [ C U8 ] ] ]
+    ///     [ A (R a) ] as R a
+    ///
+    /// The following are not:
+    ///
+    ///     [ A I8, B U8 ]
+    ///     [ A [ B [ Result U8 {} ] ] ]         (Result U8 {} is actually [ Ok U8, Err {} ])
+    ///     [ A { lst: List (R a) } ] as R a     (List a is morally [ Cons (List a), Nil ] as List a)
+    pub fn is_narrow(&self) -> bool {
+        match self.shallow_dealias() {
+            Type::TagUnion(tags, ext) | Type::RecursiveTagUnion(_, tags, ext) => {
+                ext.is_empty_tag_union()
+                    && tags.len() == 1
+                    && tags[0].1.len() == 1
+                    && tags[0].1[0].is_narrow()
+            }
+            Type::Record(fields, ext) => {
+                fields.values().all(|field| field.as_inner().is_narrow()) && ext.is_narrow()
+            }
+            // Lists and sets are morally two-tagged unions, as they can be empty
+            Type::Apply(Symbol::LIST_LIST | Symbol::SET_SET, _, _) => false,
+            Type::Apply(..) => internal_error!("cannot chase an Apply!"),
+            Type::Alias { .. } => internal_error!("should be dealiased"),
+            // Non-composite types are trivially narrow
+            _ => true,
+        }
+    }
 }
 
 fn symbols_help(tipe: &Type, accum: &mut ImSet<Symbol>) {

reporting/src/error/type.rs

@@ -148,6 +148,9 @@ pub fn cyclic_alias<'b>(
     region: roc_region::all::Region,
     others: Vec<Symbol>,
 ) -> (RocDocBuilder<'b>, String) {
+    let when_is_recursion_legal =
+        alloc.reflow("Recursion in aliases is only allowed if recursion happens behind a tagged union, at least one variant of which is not recursive.");
+
     let doc = if others.is_empty() {
         alloc.stack(vec![
             alloc
@@ -155,7 +158,7 @@ pub fn cyclic_alias<'b>(
                 .append(alloc.symbol_unqualified(symbol))
                 .append(alloc.reflow(" alias is self-recursive in an invalid way:")),
             alloc.region(lines.convert_region(region)),
-            alloc.reflow("Recursion in aliases is only allowed if recursion happens behind a tag."),
+            when_is_recursion_legal,
         ])
     } else {
         alloc.stack(vec![
@@ -179,7 +182,7 @@ pub fn cyclic_alias<'b>(
                     .map(|other| alloc.symbol_unqualified(other))
                     .collect::<Vec<_>>(),
             ),
-            alloc.reflow("Recursion in aliases is only allowed if recursion happens behind a tag."),
+            when_is_recursion_legal,
         ])
     };
 

reporting/tests/test_reporting.rs

@@ -2852,7 +2852,7 @@ mod test_reporting {
                     ^^^
 
                 Recursion in aliases is only allowed if recursion happens behind a
-                tag.
+                tagged union, at least one variant of which is not recursive.
                 "#
             ),
         )
@@ -7075,7 +7075,7 @@ I need all branches in an `if` to have the same type!
                     ^
 
                 Recursion in aliases is only allowed if recursion happens behind a
-                tag.
+                tagged union, at least one variant of which is not recursive.
                 "#
             ),
         )
@@ -7102,7 +7102,7 @@ I need all branches in an `if` to have the same type!
                     ^
 
                 Recursion in aliases is only allowed if recursion happens behind a
-                tag.
+                tagged union, at least one variant of which is not recursive.
                 "#
             ),
         )
@@ -7128,7 +7128,7 @@ I need all branches in an `if` to have the same type!
                     ^
 
                 Recursion in aliases is only allowed if recursion happens behind a
-                tag.
+                tagged union, at least one variant of which is not recursive.
                 "#
             ),
         )
@@ -7977,4 +7977,95 @@ I need all branches in an `if` to have the same type!
             ),
         )
     }
+
+    #[test]
+    fn recursive_type_alias_is_newtype() {
+        report_problem_as(
+            indoc!(
+                r#"
+                R a : [ Only (R a) ]
+
+                v : R U8
+                v
+                "#
+            ),
+            indoc!(
+                r#"
+                ── CYCLIC ALIAS ────────────────────────────────────────────────────────────────
+
+                The `R` alias is self-recursive in an invalid way:
+
+                1│  R a : [ Only (R a) ]
+                    ^
+
+                Recursion in aliases is only allowed if recursion happens behind a
+                tagged union, at least one variant of which is not recursive.
+                "#
+            ),
+        )
+    }
+
+    #[test]
+    fn recursive_type_alias_is_newtype_deep() {
+        report_problem_as(
+            indoc!(
+                r#"
+                R a : [ Only { very: [ Deep (R a) ] } ]
+
+                v : R U8
+                v
+                "#
+            ),
+            indoc!(
+                r#"
+                ── CYCLIC ALIAS ────────────────────────────────────────────────────────────────
+
+                The `R` alias is self-recursive in an invalid way:
+
+                1│  R a : [ Only { very: [ Deep (R a) ] } ]
+                    ^
+
+                Recursion in aliases is only allowed if recursion happens behind a
+                tagged union, at least one variant of which is not recursive.
+                "#
+            ),
+        )
+    }
+
+    #[test]
+    fn recursive_type_alias_is_newtype_mutual() {
+        report_problem_as(
+            indoc!(
+                r#"
+                Foo a : [ Thing (Bar a) ]
+                Bar a : [ Stuff (Foo a) ]
+
+                v : Bar U8
+                v
+                "#
+            ),
+            indoc!(
+                r#"
+                ── CYCLIC ALIAS ────────────────────────────────────────────────────────────────
+
+                The `Bar` alias is recursive in an invalid way:
+
+                2│  Bar a : [ Stuff (Foo a) ]
+                    ^^^^^
+
+                The `Bar` alias depends on itself through the following chain of
+                definitions:
+
+                    ┌─────┐
+                    │     Bar
+                    │     ↓
+                    │     Foo
+                    └─────┘
+
+                Recursion in aliases is only allowed if recursion happens behind a
+                tagged union, at least one variant of which is not recursive.
+                "#
+            ),
+        )
+    }
 }