module Toplevel (check) where

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

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

import TC
import TC.Helpers
import Solve
import Type

import PostProcess

import qualified Hm.Abs as H

check :: [H.Def] -> Either TypeError [TL]
check defs = case runInfer M.empty (traverseInfer defs) of
  Left err -> throwError err
  Right (tls,_,cs) -> case runSolve (emptySubst, cs) of
    Left err -> throwError err
    Right sub -> pure tls


traverseInfer :: [H.Def] -> Infer [TL]
traverseInfer defs = do
  tls <- preprocess defs

  env <- accumulateEnv tls

  local (const env) $ do
    mapM checkVar tls

checkVar :: TL -> Infer TL
checkVar t@TypeDef{} = pure t
checkVar v@(VarDef _ _ t exp) = do
  t1 <- instantiate t
  t2 <- infer exp
  uniR t2 t1
  pure v

preprocess :: [H.Def] -> Infer [TL]
preprocess = (flip runProcess) S.empty . postprocess

accumulateEnv :: [TL] -> Infer TypeEnv
accumulateEnv [] = ask
accumulateEnv (t:ts) = case t of
  -- make sure none of the bindings already exist and go ahead
  TypeDef p i [] env -> do
    alreadyDef <- M.keysSet . M.intersection env <$> ask
    mapM_ (throwError . AlreadyDefined p) alreadyDef

    local (M.union env) (accumulateEnv ts)

  VarDef  p i t  exp  -> do
    env <- ask
    guard (throwError (AlreadyDefined p i)) (not (M.member i env))
    local (M.insert i t) (accumulateEnv ts)


  _ -> throwError Oop