-- |
-- Module      :  $Header$
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable
{-# LANGUAGE Safe #-}

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
module Cryptol.TypeCheck.Monad
  ( module Cryptol.TypeCheck.Monad
  , module Cryptol.TypeCheck.InferTypes
  ) where

import           Cryptol.ModuleSystem.Name (FreshM(..),Supply)
import           Cryptol.Parser.Position
import qualified Cryptol.Parser.AST as P
import           Cryptol.TypeCheck.AST
import           Cryptol.TypeCheck.Subst
import           Cryptol.TypeCheck.Unify(mgu, Result(..), UnificationError(..))
import           Cryptol.TypeCheck.InferTypes
import qualified Cryptol.TypeCheck.Solver.CrySAT as CrySAT
import           Cryptol.Utils.PP(pp, (<+>), Doc, text, quotes)
import           Cryptol.Utils.Panic(panic)

import qualified Control.Applicative as A
import           Control.Monad.Fix(MonadFix(..))
import qualified Data.Map as Map
import qualified Data.Set as Set
import           Data.Map (Map)
import           Data.Set (Set)
import           Data.List(find, minimumBy, groupBy, sortBy)
import           Data.Maybe(mapMaybe)
import           Data.Function(on)
import           MonadLib hiding (mapM)

import GHC.Generics (Generic)
import Control.DeepSeq

import Prelude ()
import Prelude.Compat


-- | Information needed for type inference.
data InferInput = InferInput
  { inpRange     :: Range             -- ^ Location of program source
  , inpVars      :: Map Name Schema   -- ^ Variables that are in scope
  , inpTSyns     :: Map Name TySyn    -- ^ Type synonyms that are in scope
  , inpNewtypes  :: Map Name Newtype  -- ^ Newtypes in scope
  , inpNameSeeds :: NameSeeds         -- ^ Private state of type-checker
  , inpMonoBinds :: Bool              -- ^ Should local bindings without
                                      --   signatures be monomorphized?

  , inpSolverConfig :: SolverConfig   -- ^ Options for the constraint solver

  , inpPrimNames :: !PrimMap          -- ^ The mapping from 'Ident' to 'Name',
                                      -- for names that the typechecker
                                      -- needs to refer to.

  , inpSupply :: !Supply              -- ^ The supply for fresh name generation
  } deriving Show


-- | This is used for generating various names.
data NameSeeds = NameSeeds
  { seedTVar    :: !Int
  , seedGoal    :: !Int
  } deriving (Show, Generic, NFData)

-- | The initial seeds, used when checking a fresh program.
nameSeeds :: NameSeeds
nameSeeds = NameSeeds { seedTVar = 10, seedGoal = 0 }


-- | The results of type inference.
data InferOutput a
  = InferFailed [(Range,Warning)] [(Range,Error)]
    -- ^ We found some errors

  | InferOK [(Range,Warning)] NameSeeds Supply a
    -- ^ Type inference was successful.


    deriving Show

runInferM :: TVars a => InferInput -> InferM a -> IO (InferOutput a)
runInferM info (IM m) = CrySAT.withSolver (inpSolverConfig info) $ \solver ->
  do rec ro <- return RO { iRange     = inpRange info
                     , iVars          = Map.map ExtVar (inpVars info)
                     , iTVars         = []
                     , iTSyns         = fmap mkExternal (inpTSyns info)
                     , iNewtypes      = fmap mkExternal (inpNewtypes info)
                     , iSolvedHasLazy = iSolvedHas finalRW     -- RECURSION
                     , iMonoBinds     = inpMonoBinds info
                     , iSolver        = solver
                     , iPrimNames     = inpPrimNames info
                     }

         (result, finalRW) <- runStateT rw
                            $ runReaderT ro m  -- RECURSION

     let theSu    = iSubst finalRW
         defSu    = defaultingSubst theSu
         warns    = [(r,apSubst theSu w) | (r,w) <- iWarnings finalRW ]

     case iErrors finalRW of
       [] ->
         case (iCts finalRW, iHasCts finalRW) of
           (cts,[])
             | nullGoals cts
                   -> return $ InferOK warns
                                  (iNameSeeds finalRW)
                                  (iSupply finalRW)
                                  (apSubst defSu result)
           (cts,has) -> return $ InferFailed warns
                $ dropErrorsFromSameLoc
                [ ( goalRange g
                  , UnsolvedGoal False (apSubst theSu g)
                  ) | g <- fromGoals cts ++ map hasGoal has
                ]
       errs -> return $ InferFailed warns
                      $ dropErrorsFromSameLoc
                                  [(r,apSubst theSu e) | (r,e) <- errs]

  where
  mkExternal x = (IsExternal, x)
  rw = RW { iErrors     = []
          , iWarnings   = []
          , iSubst      = emptySubst
          , iExistTVars = []

          , iNameSeeds  = inpNameSeeds info

          , iCts        = emptyGoals
          , iHasCts     = []
          , iSolvedHas  = Map.empty

          , iSupply     = inpSupply info
          }

  dropErrorsFromSameLoc = map chooseBestError . groupBy ((==)    `on` fst)
                                              . sortBy  (cmpRange `on` fst)

  addErrorSize (r,e) = (length (show (pp e)), (r,e))
  chooseBestError    = snd . minimumBy (compare `on` fst) . map addErrorSize

  -- The actual order does not matter
  cmpRange (Range x y z) (Range a b c) = compare (x,y,z) (a,b,c)




newtype InferM a = IM { unIM :: ReaderT RO (StateT RW IO) a }

data DefLoc = IsLocal | IsExternal

-- | Read-only component of the monad.
data RO = RO
  { iRange    :: Range                  -- ^ Source code being analysed
  , iVars     :: Map Name VarType      -- ^ Type of variable that are in scope

  {- NOTE: We assume no shadowing between these two, so it does not matter
  where we look first. Similarly, we assume no shadowing with
  the existential type variable (in RW).  See `checkTShadowing`. -}

  , iTVars    :: [TParam]                  -- ^ Type variable that are in scope
  , iTSyns    :: Map Name (DefLoc, TySyn) -- ^ Type synonyms that are in scope
  , iNewtypes :: Map Name (DefLoc, Newtype)
   -- ^ Newtype declarations in scope
   --
   -- NOTE: type synonyms take precedence over newtype.  The reason is
   -- that we can define local type synonyms, but not local newtypes.
   -- So, either a type-synonym shadows a newtype, or it was declared
   -- at the top-level, but then there can't be a newtype with the
   -- same name (this should be caught by the renamer).

  , iSolvedHasLazy :: Map Int (Expr -> Expr)
    -- ^ NOTE: This field is lazy in an important way!  It is the
    -- final version of `iSolvedHas` in `RW`, and the two are tied
    -- together through recursion.  The field is here so that we can
    -- look thing up before they are defined, which is OK because we
    -- don't need to know the results until everything is done.

  , iMonoBinds :: Bool
    -- ^ When this flag is set to true, bindings that lack signatures
    -- in where-blocks will never be generalized. Bindings with type
    -- signatures, and all bindings at top level are unaffected.

  , iSolver :: CrySAT.Solver

  , iPrimNames :: !PrimMap
  }

-- | Read-write component of the monad.
data RW = RW
  { iErrors   :: ![(Range,Error)]       -- ^ Collected errors
  , iWarnings :: ![(Range,Warning)]     -- ^ Collected warnings
  , iSubst    :: !Subst                 -- ^ Accumulated substitution

  , iExistTVars  :: [Map Name Type]
    -- ^ These keeps track of what existential type variables are available.
    -- When we start checking a function, we push a new scope for
    -- its arguments, and we pop it when we are done checking the function
    -- body. The front element of the list is the current scope, which is
    -- the only thing that will be modified, as follows.  When we encounter
    -- a existential type variable:
    --     1. we look in all scopes to see if it is already defined.
    --     2. if it was not defined, we create a fresh type variable,
    --        and we add it to the current scope.
    --     3. it is an error if we encounter an existential variable but we
    --        have no current scope.

  , iSolvedHas :: Map Int (Expr -> Expr)
    -- ^ Selector constraints that have been solved (ref. iSolvedSelectorsLazy)

  -- Generating names
  , iNameSeeds :: !NameSeeds

  -- Constraints that need solving
  , iCts      :: !Goals                -- ^ Ordinary constraints
  , iHasCts   :: ![HasGoal]
    {- ^ Tuple/record projection constraints.  The `Int` is the "name"
         of the constraint, used so that we can name it solution properly. -}

  , iSupply :: !Supply
  }

instance Functor InferM where
  fmap f (IM m) = IM (fmap f m)

instance A.Applicative InferM where
  pure  = return
  (<*>) = ap

instance Monad InferM where
  return x      = IM (return x)
  fail x        = IM (fail x)
  IM m >>= f    = IM (m >>= unIM . f)

instance MonadFix InferM where
  mfix f        = IM (mfix (unIM . f))

instance FreshM InferM where
  liftSupply f = IM $
    do rw <- get
       let (a,s') = f (iSupply rw)
       set rw { iSupply = s' }
       return a


io :: IO a -> InferM a
io m = IM $ inBase m

-- | The monadic computation is about the given range of source code.
-- This is useful for error reporting.
inRange :: Range -> InferM a -> InferM a
inRange r (IM m) = IM $ mapReader (\ro -> ro { iRange = r }) m

inRangeMb :: Maybe Range -> InferM a -> InferM a
inRangeMb Nothing m  = m
inRangeMb (Just r) m = inRange r m

-- | This is the current range that we are working on.
curRange :: InferM Range
curRange = IM $ asks iRange

-- | Report an error.
recordError :: Error -> InferM ()
recordError e =
  do r <- curRange
     IM $ sets_ $ \s -> s { iErrors = (r,e) : iErrors s }

recordWarning :: Warning -> InferM ()
recordWarning w =
  do r <- curRange
     IM $ sets_ $ \s -> s { iWarnings = (r,w) : iWarnings s }

getSolver :: InferM CrySAT.Solver
getSolver =
  do RO { .. } <- IM ask
     return iSolver

-- | Retrieve the mapping between identifiers and declarations in the prelude.
getPrimMap :: InferM PrimMap
getPrimMap  =
  do RO { .. } <- IM ask
     return iPrimNames


--------------------------------------------------------------------------------
newGoal :: ConstraintSource -> Prop -> InferM Goal
newGoal goalSource goal =
  do goalRange <- curRange
     return Goal { .. }

-- | Record some constraints that need to be solved.
-- The string explains where the constraints came from.
newGoals :: ConstraintSource -> [Prop] -> InferM ()
newGoals src ps = addGoals =<< mapM (newGoal src) ps

{- | The constraints are removed, and returned to the caller.
The substitution IS applied to them. -}
getGoals :: InferM [Goal]
getGoals =
  do goals <- applySubst =<< IM (sets $ \s -> (iCts s, s { iCts = emptyGoals }))
     return (fromGoals goals)

-- | Add a bunch of goals that need solving.
addGoals :: [Goal] -> InferM ()
addGoals gs = IM $ sets_ $ \s -> s { iCts = foldl (flip insertGoal) (iCts s) gs }

-- | Collect the goals emitted by the given sub-computation.
-- Does not emit any new goals.
collectGoals :: InferM a -> InferM (a, [Goal])
collectGoals m =
  do origGs <- applySubst =<< getGoals'
     a      <- m
     newGs  <- getGoals
     setGoals' origGs
     return (a, newGs)

  where

  -- retrieve the type map only
  getGoals'    = IM $ sets $ \ RW { .. } -> (iCts, RW { iCts = emptyGoals, .. })

  -- set the type map directly
  setGoals' gs = IM $ sets $ \ RW { .. } -> ((),   RW { iCts = gs, .. })



{- | Record a constraint that when we select from the first type,
we should get a value of the second type.
The returned function should be used to wrap the expression from
which we are selecting (i.e., the record or tuple).  Plese note
that the resulting expression should not be forced before the
constraint is solved.
-}
newHasGoal :: P.Selector -> Type -> Type -> InferM (Expr -> Expr)
newHasGoal l ty f =
  do goalName <- newGoalName
     g        <- newGoal CtSelector (pHas l ty f)
     IM $ sets_ $ \s -> s { iHasCts = HasGoal goalName g : iHasCts s }
     solns    <- IM $ fmap iSolvedHasLazy ask
     return $ case Map.lookup goalName solns of
                Just e1 -> e1
                Nothing -> panic "newHasGoal" ["Unsolved has goal in result"]

-- | Add a previously generate has constrained
addHasGoal :: HasGoal -> InferM ()
addHasGoal g = IM $ sets_ $ \s -> s { iHasCts = g : iHasCts s }

-- | Get the `Has` constraints.  Each of this should either be solved,
-- or added back using `addHasGoal`.
getHasGoals :: InferM [HasGoal]
getHasGoals = do gs <- IM $ sets $ \s -> (iHasCts s, s { iHasCts = [] })
                 applySubst gs

-- | Specify the solution (`Expr -> Expr`) for the given constraint (`Int`).
solveHasGoal :: Int -> (Expr -> Expr) -> InferM ()
solveHasGoal n e =
  IM $ sets_ $ \s -> s { iSolvedHas = Map.insert n e (iSolvedHas s) }


--------------------------------------------------------------------------------


newName :: (NameSeeds -> (a , NameSeeds)) -> InferM a
newName upd = IM $ sets $ \s -> let (x,seeds) = upd (iNameSeeds s)
                                in (x, s { iNameSeeds = seeds })


-- | Generate a new name for a goal.
newGoalName :: InferM Int
newGoalName = newName $ \s -> let x = seedGoal s
                              in (x, s { seedGoal = x + 1})

-- | Generate a new free type variable.
newTVar :: Doc -> Kind -> InferM TVar
newTVar src k = newTVar' src Set.empty k

-- | Generate a new free type variable that depends on these additional
-- type parameters.
newTVar' :: Doc -> Set TVar -> Kind -> InferM TVar
newTVar' src extraBound k =
  do bound <- getBoundInScope
     let vs = Set.union extraBound bound
     newName $ \s -> let x = seedTVar s
                     in (TVFree x k vs src, s { seedTVar = x + 1 })



-- | Generate a new free type variable.
newTParam :: Maybe Name -> Kind -> InferM TParam
newTParam nm k = newName $ \s -> let x = seedTVar s
                                 in (TParam { tpUnique = x
                                            , tpKind   = k
                                            , tpName   = nm
                                            }
                                 , s { seedTVar = x + 1 })


-- | Generate an unknown type.  The doc is a note about what is this type about.
newType :: Doc -> Kind -> InferM Type
newType src k = TVar `fmap` newTVar src k



--------------------------------------------------------------------------------


-- | Record that the two types should be syntactically equal.
unify :: Type -> Type -> InferM [Prop]
unify t1 t2 =
  do t1' <- applySubst t1
     t2' <- applySubst t2
     case mgu t1' t2' of
       OK (su1,ps) -> extendSubst su1 >> return ps
       Error err   ->
         do case err of
              UniTypeLenMismatch _ _ -> recordError (TypeMismatch t1' t2')
              UniTypeMismatch s1 s2 -> recordError (TypeMismatch s1 s2)
              UniKindMismatch k1 k2 -> recordError (KindMismatch k1 k2)
              UniRecursive x t -> recordError (RecursiveType (TVar x) t)
              UniNonPolyDepends x vs -> recordError
                                          (TypeVariableEscaped (TVar x) vs)
              UniNonPoly x t -> recordError (NotForAll x t)
            return []




-- | Apply the accumulated substitution to something with free type variables.
applySubst :: TVars t => t -> InferM t
applySubst t =
  do su <- getSubst
     return (apSubst su t)

-- | Get the substitution that we have accumulated so far.
getSubst :: InferM Subst
getSubst = IM $ fmap iSubst get

-- | Add to the accumulated substitution.
extendSubst :: Subst -> InferM ()
extendSubst su = IM $ sets_ $ \s -> s { iSubst = su @@ iSubst s }


-- | Variables that are either mentioned in the environment or in
-- a selector constraint.
varsWithAsmps :: InferM (Set TVar)
varsWithAsmps =
  do env     <- IM $ fmap (Map.elems . iVars) ask
     fromEnv <- forM env $ \v ->
                  case v of
                    ExtVar sch  -> getVars sch
                    CurSCC _ t  -> getVars t
     sels <- IM $ fmap (map (goal . hasGoal) . iHasCts) get
     fromSels <- mapM getVars sels
     fromEx   <- (getVars . concatMap Map.elems) =<< IM (fmap iExistTVars get)
     return (Set.unions fromEnv `Set.union` Set.unions fromSels
                                `Set.union` fromEx)
  where
  getVars x = fvs `fmap` applySubst x

--------------------------------------------------------------------------------


-- | Lookup the type of a variable.
lookupVar :: Name -> InferM VarType
lookupVar x =
  do mb <- IM $ asks $ Map.lookup x . iVars
     case mb of
       Just t  -> return t
       Nothing ->
         do mbNT <- lookupNewtype x
            case mbNT of
              Just nt -> return (ExtVar (newtypeConType nt))
              Nothing -> do recordError $ UndefinedVariable x
                            a <- newType (text "type of" <+> pp x) KType
                            return $ ExtVar $ Forall [] [] a

-- | Lookup a type variable.  Return `Nothing` if there is no such variable
-- in scope, in which case we must be dealing with a type constant.
lookupTVar :: Name -> InferM (Maybe Type)
lookupTVar x = IM $ asks $ fmap (TVar . tpVar) . find this . iTVars
  where this tp = tpName tp == Just x

-- | Lookup the definition of a type synonym.
lookupTSyn :: Name -> InferM (Maybe TySyn)
lookupTSyn x = fmap (fmap snd . Map.lookup x) getTSyns

-- | Lookup the definition of a newtype
lookupNewtype :: Name -> InferM (Maybe Newtype)
lookupNewtype x = fmap (fmap snd . Map.lookup x) getNewtypes

-- | Check if we already have a name for this existential type variable and,
-- if so, return the definition.  If not, try to create a new definition,
-- if this is allowed.  If not, returns nothing.

existVar :: Name -> Kind -> InferM Type
existVar x k =
  do scopes <- iExistTVars <$> IM get
     case msum (map (Map.lookup x) scopes) of
       Just ty -> return ty
       Nothing ->
         case scopes of
           [] ->
              do recordError $ ErrorMsg $
                    text "Undefined type" <+> quotes (pp x)
                 newType (text "undefined existential type varible" <+>
                                                            quotes (pp x)) k

           sc : more ->
             do ty <- newType (text "existential type variable"
                                                        <+> quotes (pp x)) k
                IM $ sets_ $ \s -> s{ iExistTVars = Map.insert x ty sc : more }
                return ty


-- | Returns the type synonyms that are currently in scope.
getTSyns :: InferM (Map Name (DefLoc,TySyn))
getTSyns = IM $ asks iTSyns

-- | Returns the newtype declarations that are in scope.
getNewtypes :: InferM (Map Name (DefLoc,Newtype))
getNewtypes = IM $ asks iNewtypes

-- | Get the set of bound type variables that are in scope.
getTVars :: InferM (Set Name)
getTVars = IM $ asks $ Set.fromList . mapMaybe tpName . iTVars

-- | Return the keys of the bound variables that are in scope.
getBoundInScope :: InferM (Set TVar)
getBoundInScope = IM $ asks $ Set.fromList . map tpVar . iTVars

-- | Retrieve the value of the `mono-binds` option.
getMonoBinds :: InferM Bool
getMonoBinds  = IM (asks iMonoBinds)

{- | We disallow shadowing between type synonyms and type variables
because it is confusing.  As a bonus, in the implementation we don't
need to worry about where we lookup things (i.e., in the variable or
type synonym environment. -}

checkTShadowing :: String -> Name -> InferM ()
checkTShadowing this new =
  do ro <- IM ask
     rw <- IM get
     let shadowed =
           do _ <- Map.lookup new (iTSyns ro)
              return "type synonym"
           `mplus`
           do guard (new `elem` mapMaybe tpName (iTVars ro))
              return "type variable"
           `mplus`
           do _ <- msum (map (Map.lookup new) (iExistTVars rw))
              return "type"

     case shadowed of
       Nothing -> return ()
       Just that ->
          recordError $ ErrorMsg $
             text "Type" <+> text this <+> quotes (pp new) <+>
             text "shadows an existing" <+>
             text that <+> text "with the same name."



-- | The sub-computation is performed with the given type parameter in scope.
withTParam :: TParam -> InferM a -> InferM a
withTParam p (IM m) =
  do case tpName p of
       Just x  -> checkTShadowing "variable" x
       Nothing -> return ()
     IM $ mapReader (\r -> r { iTVars = p : iTVars r }) m

withTParams :: [TParam] -> InferM a -> InferM a
withTParams ps m = foldr withTParam m ps

-- | The sub-computation is performed with the given type-synonym in scope.
withTySyn :: TySyn -> InferM a -> InferM a
withTySyn t (IM m) =
  do let x = tsName t
     checkTShadowing "synonym" x
     IM $ mapReader (\r -> r { iTSyns = Map.insert x (IsLocal,t) (iTSyns r) }) m

withNewtype :: Newtype -> InferM a -> InferM a
withNewtype t (IM m) =
  IM $ mapReader
        (\r -> r { iNewtypes = Map.insert (ntName t) (IsLocal,t)
                                                     (iNewtypes r) }) m

-- | The sub-computation is performed with the given variable in scope.
withVarType :: Name -> VarType -> InferM a -> InferM a
withVarType x s (IM m) =
  IM $ mapReader (\r -> r { iVars = Map.insert x s (iVars r) }) m

withVarTypes :: k = TVar `a>withVarTypes ) }) m

) }?1n> }?1n> }}?1n> }TVar `a>IM $ mapReader (Or }TVar IsLocal-- | The su'>ro)
< class='hs-varid'>return "type variable"
           `mplus`
           do _ do [oass='hs-comment'>-- | The su'>ro)
< class='hs-varid'>return"Unexpected value in record selection"
  n class='hs-conid'>Functor InferM }?1n> }TVar?1n> }newGs  <- getGoals
(hlahVarrd'>caseFunctor[oass='hs-comment'>-- | The su'>ropan>?1n> }TVar?1n>  <- marrd'>caseFunctor[oass='hs-comment'>-- | The su'>ropan>?1n>pan>?1n> }-paramNeed-- | The su'>ros ->=-- | The su'>rowithVarTypes ->==withVarTypes ->=withVarTypes 



}
) =span class='hs-layout'>}?1n> -- | The su'>ro-- | The su'>roof

-- | The su'>n> =span class='h
-- | The su'>n> =span class='h
- name."of-> InferM return "type variable"
              return >  =span class='h
-- | The su'>n> =span class='h
- name."InferM (Set IM(Set 
}Set(su1[oass='hs-comment'>-- | The class='hs-keyglyph'>-> InferM extcomment'>-- | The class='hs-keyglyph'>-> }-- |>->id'>extcomment'>-- | Thean> }withVarTypes ->==withVarTypes ->(InferM 
< line-594"> n class='hs-conid'ut'>}-varid'>s ->=s ->=< name."




,tSet( ->(InferM 
< line-594"> n clas cla0">< line-594">        (,InferM 
< line-594"> n clas cla0">< line-594">         su

             text > Ma/span>t) tetttttttttttttes quotess-varid'>k1 tetttttttttttttes quotess-varid'>k1 tetttttttttttttes quotess-var cyout'>,InferM this new =
a name="line-566">           this new rid'>m

-- | The sub-computatithVarTypes ->< line-594">.-varid'>extcomment'>-- | The >             tetttttttttttttes  < line-594">        (insert (   n clas cla0">< line-594">        tetiDPtttttttttes quotess-var cyr new =
a name="line-566">           ?1n> }?1n> fmap snd . Map.}?1n> fmap 186id'>quotess-var cyrv of
                     186id'>qu-varmsout'>}?1n> fmap  186id'>qu-varmsout'>}?1n> fmap s-var cyrv of
                     1 s='hs-varid'>fmap      of s-keyword's='hs-keyglyph'><- IM IM return { iTSyns pan> mapReader
fmap pan> mapspan> (recordError $ quotess-var cyr new x  quotess-var cyr  pan> mapReads-var cyr   ?1n> s-var cyrv s-var cyr  ?1n> s-vhs-varid'>fmap pan> makan>s-var cyr  pan> makan>s-var cyr  n class='hs-keyglyph'>&lass='hs-varid'>fromSels <- Name)
getTVars = insert ( of
                     1 s='hs-varid'>fmap recordError $ pan> makan>s-var cyr  n class='hs-keyglyph'>lass='hs-var     /span>s-vhs-varid'>fss='hs-keyglyph'>pan> 1 s='hs-varid'>fmap  n class='hs-keyglyph'>lass='hs-var     /span>s-vhs-varid'>fss='hs-keyglyph'>pan> 1 s='hn>  ?1n> (1 s='hn>   getTclass='hs-layout'>(pan> mas='hs-varid'>recordError  s (IM (IM caseFunctor[oass='hs-comment'>-- | The su'>ropan>?of
ss name="line-179"> pan> mas='hs-varid'>recordError  s (lass='hs-var     /span>s-vhs-varid'e, Located Type, Type)

-- | Infer the type of one arm of a list comprehs='hs-varttttttttttclaclass='hs-varid'yns ?1n> recordError=
a npan> = nan s='hstttttttttttttt='hs-varid'>recordError=
a npan> = nan s='hstttttttttttttt='hs-varid'hs-kean class='hs-layout'>(1 s='hn> <`'>nan s='hsttttttttttteyglyph'>lass='hs-var     /span>s-vhs-varid'>fss='hs-keyglyph'>pan> 1 s=an s='hstttttttttttttt='hs-varid'>recordError=
a npan> Set 
}Set(su1[oass='hs-comment'>-- | The classs-layout'>) where
-- License     : class='hs-varop'>$
pan s='hstttttttttttttttttttts-va'hs-kean class='hs-layout'>(TVars
pan s='hstttttttttttttttttttts-va'hs-kean class='hs-layout'>(TVars
pan sn>
a npan> new) () (happy_x_1

pan clatttan>
pan clatttan>( (IM $ sets $iExistTVars   ass='hs-layout'>( 0hs-layou $ 0hs-layou $pan clatttan>[]
-- | The classs-layout'>) wheres-varid'>iExistTVars   ?5an clatttan> Control.DeepSeq.NFss='su-var -hs-varid'e,>
pan clatttan>[]layou manpan> =   -- | The su'>roof

-- | The su'>n> =span class='h
-- | The su'>n> =span class='h

pan s='hstttttttttttttttttttts-va'hs-kean class='hs-layout'>(TVars
pan s='hstttttttttttttttttttts-va'hs-kean class='hs-layoutyis, Inc.
pan s='hssstttttttttttttttttts-va'hs-kean class='hs-layout'>(TVars
( -- | The su'>ro->
(
 (TVarslasWarning ->s-vhs-varid'>fspan>) getTSynsass='hs-layout'>(s
pan s='hstss='hs-layout'>) -- | The su'>n> =span class='h
=  claepalass='hs-kssis, Inc.
ass='hs-layout'>(=
  do case tpName iRange      $ sets_ $ \
pan s='hsslass='hs-ncpss='hs-lapan class='su-vae="line-576">  do casepan cl'hs-kean claoIin> quotess-var cyout'>,pan s='hsslass='hs-ncpclass='hpan> =
  do -- | Th.Classes.Eqarid'>manpan>$= do =< name."



  $ \
beI='hs-keyword'>of.
panseyglyph'>=< name."
pan s='hstttttttttttttttttttts-va'hs-kean class='hs-la-comment'>-- License     : class='hs-varop'>$
do ==== Just x


 s='hstttttttttttttttttttts-va'hs-kean class='hs-layoutspan> 


 ma="line-569">             text > Ma/span>           ?1n> text > Ma/span> ->=ro
pan s='hstttttttttttttttttttts-va'hs-kean class='hs-la-commens-varid'>fspan> IM  "type synonym"

'>quotess-var cyout'>,panss='hs-var     /span>s-vhs-varid'e, Located Type, Type)

-- | Infer the type of one arm of a list comprehs='hs-varttttttttttclaclass='hs-vtpan> [oass='hs-comment'>-- | The su'>ro
'>quotess-var cyout'>,-- | The classs-layout'>) -- | The classs-layout'>) tpName Cryptol.TypeCheck.Instantiate
             text >   name="line-4">pan s='hstss='hs-layout'>) 1-layout'>) wheres-varid'>iExistTVars  tiate
Data() id'ff\xff\xffs='hs-varid'>tiate
Data[oass='hs-ns-varid'>">        id'ff\xff\xffs='hs-varid'>tiate
pan s='hssstttttttttttttttttts-va'hs-kean class='hs-laspan> { iTSyns IM  []
 [oass='hs-ns-varid'>">-- | The jf a list comprehs='hs-vartttttt comprehs='hs-vartttttt comprehs='hs-vartttttt comprehs='hs-varttt IM fspan> IM <12ter c-lapan class='su-vae="line-576">  name="line-4">pan s='hslspan> ) InferM ta/p>
{ iTSyns e'e, Located Type-va'hs-keyglyph'>ss='hs-keyglyph'>=
a name="line-566">           this =
a name= 186id'>qu-varmsout'>}?1n> fmapv