module TC.Helpers where

import Control.Monad.Identity hiding (guard)
import Control.Monad.Except   hiding (guard)
import Control.Monad.RWS      hiding (guard)

import Data.Set (Set)
import qualified Data.Set as S
import qualified Data.Map as M

import qualified Data.Text as T

import Type
import Misc

generalize :: MonoT -> Infer PolyT
generalize t = ask >>= \env -> pure (Forall (free t \\ free env) t)

guard :: Applicative f => f () -> Bool -> f ()
guard _ True = pure ()
guard f False = f

constructs :: Id -> MonoT -> Bool
constructs i (TArr _ t) = constructs i t
constructs i1 (TCon i2) = i1 == i2
constructs _ _          = False

fresh :: Infer MonoT
fresh = do
  (var:vars) <- get
  put vars
  pure (TVar var)

uniR :: MonoT -> MonoT -> Infer ()
uniR t1 t2 = tell [(t1, t2, UnifyRight)]

-- replace polymorphic type variables with monomorphic ones
instantiate :: PolyT -> Infer MonoT
instantiate (Mono t) = pure t
instantiate (Forall is t) = foldM freshInsert emptySubst is >>= pure . (flip apply) t
  where
    freshInsert :: Subst -> Id -> Infer Subst
    freshInsert s k = (\a -> M.insert k a s) <$> fresh