module IR.Constraint.Occurs (
  occurs,
) where

import Data.Foldable (foldrM)
import IR.Constraint.Monad (TC)
import IR.Constraint.Type (
  Content (..),
  Descriptor (..),
  FlatType (..),
  Variable,
 )
import qualified IR.Constraint.UnionFind as UF


-- OCCURS

occurs :: Variable -> TC Bool
occurs :: Variable -> TC Bool
occurs Variable
var = [Variable] -> Variable -> Bool -> TC Bool
occursHelp [] Variable
var Bool
False


occursHelp :: [Variable] -> Variable -> Bool -> TC Bool
occursHelp :: [Variable] -> Variable -> Bool -> TC Bool
occursHelp [Variable]
seen Variable
var Bool
foundCycle =
  if Variable
var Variable -> [Variable] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Variable]
seen
    then Bool -> TC Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    else do
      (Descriptor Content
content Int
_ Mark
_ Maybe Variable
_) <- Variable
-> StateT
     TCState (ExceptT Error (WriterT (Doc String) IO)) Descriptor
forall (m :: * -> *) a. MonadIO m => Point a -> m a
UF.get Variable
var
      case Content
content of
        FlexVar TVarId
_ -> Bool -> TC Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
foundCycle
        RigidVar TVarId
_ -> Bool -> TC Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
foundCycle
        Structure FlatType
term ->
          let newSeen :: [Variable]
newSeen = Variable
var Variable -> [Variable] -> [Variable]
forall a. a -> [a] -> [a]
: [Variable]
seen
           in case FlatType
term of
                TCon1 TConId
_ [Variable]
args -> (Variable -> Bool -> TC Bool) -> Bool -> [Variable] -> TC Bool
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM ([Variable] -> Variable -> Bool -> TC Bool
occursHelp [Variable]
newSeen) Bool
foundCycle [Variable]
args
        Content
Error -> Bool -> TC Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
foundCycle