Check for recursive inductive types in the GEB pipeline (#1909)

Currently, only recursion in functions is checked. This PR also adds
some utilities (TypeDependencyInfo) that will be useful for issue #1907.

---------

Co-authored-by: janmasrovira <janmasrovira@gmail.com>

src/Juvix/Compiler/Core/Data/TypeDependencyInfo.hs

@@ -0,0 +1,29 @@
+module Juvix.Compiler.Core.Data.TypeDependencyInfo where
+
+import Data.HashMap.Strict qualified as HashMap
+import Data.HashSet qualified as HashSet
+import Juvix.Compiler.Core.Data.InfoTable
+import Juvix.Compiler.Core.Extra.Utils
+import Juvix.Compiler.Core.Language
+
+type TypeDependencyInfo = DependencyInfo Symbol
+
+createTypeDependencyInfo :: InfoTable -> TypeDependencyInfo
+createTypeDependencyInfo tab = createDependencyInfo graph startVertices
+  where
+    graph :: HashMap Symbol (HashSet Symbol)
+    graph =
+      HashSet.fromList . (^.. inductiveSymbols)
+        <$> HashMap.filter (isNothing . (^. inductiveBuiltin)) (tab ^. infoInductives)
+
+    constructorTypes :: SimpleFold ConstructorInfo Type
+    constructorTypes = constructorType . to typeArgs . each
+
+    inductiveSymbols :: SimpleFold InductiveInfo Symbol
+    inductiveSymbols = inductiveConstructors . each . constructorTypes . nodeInductives
+
+    startVertices :: HashSet Symbol
+    startVertices = HashSet.fromList syms
+
+    syms :: [Symbol]
+    syms = map (^. inductiveSymbol) (HashMap.elems (tab ^. infoInductives))

src/Juvix/Compiler/Core/Extra/Utils.hs

@@ -55,6 +55,13 @@ nodeIdents f = ufoldA reassemble go
       NIdt i -> NIdt <$> f i
       n -> pure n
 
+nodeInductives :: Traversal' Node Symbol
+nodeInductives f = ufoldA reassemble go
+  where
+    go = \case
+      NTyp ty -> NTyp <$> traverseOf typeConstrSymbol f ty
+      n -> pure n
+
 -- | Prism for NRec
 _NRec :: SimpleFold Node LetRec
 _NRec f = \case

src/Juvix/Compiler/Core/Transformation/CheckGeb.hs

@@ -2,6 +2,7 @@ module Juvix.Compiler.Core.Transformation.CheckGeb where
 
 import Data.HashMap.Strict qualified as HashMap
 import Juvix.Compiler.Core.Data.IdentDependencyInfo
+import Juvix.Compiler.Core.Data.TypeDependencyInfo
 import Juvix.Compiler.Core.Error
 import Juvix.Compiler.Core.Extra
 import Juvix.Compiler.Core.Info.LocationInfo (getInfoLocation)
@@ -10,6 +11,7 @@ import Juvix.Compiler.Core.Transformation.Base
 checkGeb :: forall r. Member (Error CoreError) r => InfoTable -> Sem r InfoTable
 checkGeb tab =
   checkNoRecursion
+    >> checkNoRecursiveTypes
     >> mapAllNodesM checkNoIO tab
     >> mapAllNodesM checkBuiltins tab
     >> mapAllNodesM checkTypes tab
@@ -68,16 +70,24 @@ checkGeb tab =
           _ -> return node
 
     checkNoRecursion :: Sem r ()
-    checkNoRecursion
-      | isCyclic (createIdentDependencyInfo tab) =
+    checkNoRecursion =
+      when (isCyclic (createIdentDependencyInfo tab)) $
         throw
           CoreError
             { _coreErrorMsg = "recursion not supported for the GEB target",
               _coreErrorNode = Nothing,
               _coreErrorLoc = defaultLoc
             }
-      | otherwise =
-          return ()
+
+    checkNoRecursiveTypes :: Sem r ()
+    checkNoRecursiveTypes =
+      when (isCyclic (createTypeDependencyInfo tab)) $
+        throw
+          CoreError
+            { _coreErrorMsg = "recursive types not supported for the GEB target",
+              _coreErrorNode = Nothing,
+              _coreErrorLoc = defaultLoc
+            }
 
     dynamicTypeError :: Node -> Maybe Location -> CoreError
     dynamicTypeError node loc =