Admit occurs check under recursive tag unions when programs have type errors

crates/compiler/debug_flags/src/lib.rs

@@ -33,16 +33,24 @@
 //! These flags are also set in .cargo/config found at the repository root. You can modify them
 //! there to avoid maintaining a separate script.
 
+#[macro_export]
+macro_rules! dbg_set {
+    ($flag:path) => {
+        if !cfg!(debug_assertions) {
+            false
+        } else {
+            let flag = std::env::var($flag);
+            !flag.is_err() && flag.as_deref() != Ok("0")
+        }
+    };
+}
+
 #[macro_export]
 macro_rules! dbg_do {
     ($flag:path, $expr:expr) => {
-        #[cfg(debug_assertions)]
-        {
-            let flag = std::env::var($flag);
-            if !flag.is_err() && flag.as_deref() != Ok("0") {
+        if $crate::dbg_set!($flag) {
             $expr
         }
-        }
     };
 }
 
@@ -91,6 +99,15 @@ flags! {
     /// chainging how defs are constrained.
     ROC_VERIFY_RIGID_LET_GENERALIZED
 
+    /// Verifies that an `occurs` check indeed only contains non-recursive types that need to be
+    /// fixed-up.
+    ///
+    /// This flag is disabled by default because an occurs check may pass through an inferred
+    /// partially-recursive structure if a part of that structure also has type errors. However, in
+    /// the presence of programs without type errors, occurs checks should always consist of only
+    /// non-recursive types, and this flag should pass.
+    ROC_VERIFY_OCCURS_RECURSION
+
     // ===Mono===
 
     /// Writes a pretty-printed mono IR to stderr after function specialization.

crates/compiler/unify/src/unify.rs

@@ -1,6 +1,6 @@
 use bitflags::bitflags;
 use roc_collections::{VecMap, VecSet};
-use roc_debug_flags::dbg_do;
+use roc_debug_flags::{dbg_do, dbg_set, ROC_VERIFY_OCCURS_RECURSION};
 #[cfg(debug_assertions)]
 use roc_debug_flags::{ROC_PRINT_MISMATCHES, ROC_PRINT_UNIFICATIONS};
 use roc_error_macros::internal_error;
@@ -2615,8 +2615,23 @@ fn maybe_mark_union_recursive(env: &mut Env, union_var: Variable) {
         }) {
             return;
         } else {
+            // We may have partially solved a recursive type, but still see an occurs, if the type
+            // has errors inside of it. As such, admit this; however, for well-typed programs, this
+            // case should never be observed. Set ROC_VERIFY_OCCURS_RECURSION to verify this branch
+            // is not reached for well-typed programs.
+            if dbg_set!(ROC_VERIFY_OCCURS_RECURSION)
+                || !chain.iter().any(|&var| {
+                    matches!(
+                        subs.get_content_without_compacting(var),
+                        Content::Structure(FlatType::RecursiveTagUnion(..))
+                    )
+                })
+            {
                 internal_error!("recursive loop does not contain a tag union")
             }
+
+            return;
+        }
     }
 }