{- |
    Module      :  $Header$
    Description :  Checks type syntax
    Copyright   :  (c) 2016 - 2017 Finn Teegen
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

   After the source file has been parsed and all modules have been
   imported, the compiler first checks all type definitions and
   signatures. In particular, this module disambiguates nullary type
   constructors and type variables, which -- in contrast to Haskell -- is
   not possible on purely syntactic criteria. In addition it is checked
   that all type constructors and type variables occurring on the right
   hand side of a type declaration are actually defined and no identifier
   is defined more than once.
-}
{-# LANGUAGE CPP #-}
module Checks.TypeSyntaxCheck (typeSyntaxCheck) where

#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative      ((<$>), (<*>), pure)
#endif
import           Control.Monad            (unless, when)
import qualified Control.Monad.State as S (State, runState, gets, modify)
import           Data.List                (nub)
import           Data.Maybe               (isNothing)

import Curry.Base.Ident
import Curry.Base.Position
import Curry.Base.SpanInfo
import Curry.Base.Pretty
import Curry.Syntax
import Curry.Syntax.Pretty

import Base.Expr (Expr (fv))
import Base.Messages (Message, spanInfoMessage, internalError)
import Base.TopEnv
import Base.Utils (findMultiples, findDouble)

import Env.TypeConstructor (TCEnv)
import Env.Type

-- TODO Use span info for err messages

-- In order to check type constructor applications, the compiler
-- maintains an environment containing all known type constructors and
-- type classes. The function 'typeSyntaxCheck' expects a type constructor
-- environment that is already initialized with the imported type constructors
-- and type classes. The type constructor environment is converted to a type
-- identifier environment, before all locally defined type constructors and
-- type classes are added to this environment and the declarations are checked
-- within this environment.

typeSyntaxCheck :: TCEnv -> Module a -> (Module a, [Message])
typeSyntaxCheck :: TCEnv -> Module a -> (Module a, [Message])
typeSyntaxCheck tcEnv :: TCEnv
tcEnv mdl :: Module a
mdl@(Module _ _ _ m :: ModuleIdent
m _ _ ds :: [Decl a]
ds) =
  case [Ident] -> [[Ident]]
forall a. Eq a => [a] -> [[a]]
findMultiples ([Ident] -> [[Ident]]) -> [Ident] -> [[Ident]]
forall a b. (a -> b) -> a -> b
$ (Decl a -> Ident) -> [Decl a] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map Decl a -> Ident
forall a. Decl a -> Ident
getIdent [Decl a]
tcds of
    [] -> if [Decl a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Decl a]
dfds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1
            then TSCM (Module a) -> TSCState -> (Module a, [Message])
forall a. TSCM a -> TSCState -> (a, [Message])
runTSCM (Module a -> TSCM (Module a)
forall a. Module a -> TSCM (Module a)
checkModule Module a
mdl) TSCState
state
            else (Module a
mdl, [[SpanInfo] -> Message
errMultipleDefaultDeclarations [SpanInfo]
dfps])
    tss :: [[Ident]]
tss -> (Module a
mdl, ([Ident] -> Message) -> [[Ident]] -> [Message]
forall a b. (a -> b) -> [a] -> [b]
map [Ident] -> Message
errMultipleDeclarations [[Ident]]
tss)
  where
    tcds :: [Decl a]
tcds = (Decl a -> Bool) -> [Decl a] -> [Decl a]
forall a. (a -> Bool) -> [a] -> [a]
filter Decl a -> Bool
forall a. Decl a -> Bool
isTypeOrClassDecl [Decl a]
ds
    dfds :: [Decl a]
dfds = (Decl a -> Bool) -> [Decl a] -> [Decl a]
forall a. (a -> Bool) -> [a] -> [a]
filter Decl a -> Bool
forall a. Decl a -> Bool
isDefaultDecl [Decl a]
ds
    dfps :: [SpanInfo]
dfps = (Decl a -> SpanInfo) -> [Decl a] -> [SpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map (\(DefaultDecl p :: SpanInfo
p _) -> SpanInfo
p) [Decl a]
dfds
    tEnv :: TypeEnv
tEnv = (Decl a -> TypeEnv -> TypeEnv) -> TypeEnv -> [Decl a] -> TypeEnv
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ModuleIdent -> Decl a -> TypeEnv -> TypeEnv
forall a. ModuleIdent -> Decl a -> TypeEnv -> TypeEnv
bindType ModuleIdent
m) ((TypeInfo -> TypeKind) -> TCEnv -> TypeEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeInfo -> TypeKind
toTypeKind TCEnv
tcEnv) [Decl a]
tcds
    state :: TSCState
state = ModuleIdent -> TypeEnv -> Integer -> [Message] -> TSCState
TSCState ModuleIdent
m TypeEnv
tEnv 1 []

-- Type Syntax Check Monad
type TSCM = S.State TSCState

-- |Internal state of the Type Syntax Check
data TSCState = TSCState
  { TSCState -> ModuleIdent
moduleIdent :: ModuleIdent
  , TSCState -> TypeEnv
typeEnv     :: TypeEnv
  , TSCState -> Integer
nextId      :: Integer
  , TSCState -> [Message]
errors      :: [Message]
  }

runTSCM :: TSCM a -> TSCState -> (a, [Message])
runTSCM :: TSCM a -> TSCState -> (a, [Message])
runTSCM tscm :: TSCM a
tscm s :: TSCState
s = let (a :: a
a, s' :: TSCState
s') = TSCM a -> TSCState -> (a, TSCState)
forall s a. State s a -> s -> (a, s)
S.runState TSCM a
tscm TSCState
s in (a
a, [Message] -> [Message]
forall a. [a] -> [a]
reverse ([Message] -> [Message]) -> [Message] -> [Message]
forall a b. (a -> b) -> a -> b
$ TSCState -> [Message]
errors TSCState
s')

getModuleIdent :: TSCM ModuleIdent
getModuleIdent :: TSCM ModuleIdent
getModuleIdent = (TSCState -> ModuleIdent) -> TSCM ModuleIdent
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets TSCState -> ModuleIdent
moduleIdent

getTypeEnv :: TSCM TypeEnv
getTypeEnv :: TSCM TypeEnv
getTypeEnv = (TSCState -> TypeEnv) -> TSCM TypeEnv
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets TSCState -> TypeEnv
typeEnv

newId :: TSCM Integer
newId :: TSCM Integer
newId = do
  Integer
curId <- (TSCState -> Integer) -> TSCM Integer
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets TSCState -> Integer
nextId
  (TSCState -> TSCState) -> StateT TSCState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((TSCState -> TSCState) -> StateT TSCState Identity ())
-> (TSCState -> TSCState) -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ \s :: TSCState
s -> TSCState
s { nextId :: Integer
nextId = Integer -> Integer
forall a. Enum a => a -> a
succ Integer
curId }
  Integer -> TSCM Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
curId

report :: Message -> TSCM ()
report :: Message -> StateT TSCState Identity ()
report err :: Message
err = (TSCState -> TSCState) -> StateT TSCState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify (\s :: TSCState
s -> TSCState
s { errors :: [Message]
errors = Message
err Message -> [Message] -> [Message]
forall a. a -> [a] -> [a]
: TSCState -> [Message]
errors TSCState
s })

ok :: TSCM ()
ok :: StateT TSCState Identity ()
ok = () -> StateT TSCState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

bindType :: ModuleIdent -> Decl a -> TypeEnv -> TypeEnv
bindType :: ModuleIdent -> Decl a -> TypeEnv -> TypeEnv
bindType m :: ModuleIdent
m (DataDecl _ tc :: Ident
tc _ cs :: [ConstrDecl]
cs _) = ModuleIdent -> Ident -> TypeKind -> TypeEnv -> TypeEnv
bindTypeKind ModuleIdent
m Ident
tc (QualIdent -> [Ident] -> TypeKind
Data QualIdent
qtc [Ident]
ids)
  where
    qtc :: QualIdent
qtc = ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
m Ident
tc
    ids :: [Ident]
ids = (ConstrDecl -> Ident) -> [ConstrDecl] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map ConstrDecl -> Ident
constrId [ConstrDecl]
cs [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ [Ident] -> [Ident]
forall a. Eq a => [a] -> [a]
nub ((ConstrDecl -> [Ident]) -> [ConstrDecl] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConstrDecl -> [Ident]
recordLabels [ConstrDecl]
cs)
bindType m :: ModuleIdent
m (ExternalDataDecl _ tc :: Ident
tc _) = ModuleIdent -> Ident -> TypeKind -> TypeEnv -> TypeEnv
bindTypeKind ModuleIdent
m Ident
tc (QualIdent -> [Ident] -> TypeKind
Data QualIdent
qtc [])
  where
    qtc :: QualIdent
qtc = ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
m Ident
tc
bindType m :: ModuleIdent
m (NewtypeDecl _ tc :: Ident
tc _ nc :: NewConstrDecl
nc _) = ModuleIdent -> Ident -> TypeKind -> TypeEnv -> TypeEnv
bindTypeKind ModuleIdent
m Ident
tc (QualIdent -> [Ident] -> TypeKind
Data QualIdent
qtc [Ident]
ids)
  where
    qtc :: QualIdent
qtc = ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
m Ident
tc
    ids :: [Ident]
ids = NewConstrDecl -> Ident
nconstrId NewConstrDecl
nc Ident -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
: NewConstrDecl -> [Ident]
nrecordLabels NewConstrDecl
nc
bindType m :: ModuleIdent
m (TypeDecl _ tc :: Ident
tc _ _) = ModuleIdent -> Ident -> TypeKind -> TypeEnv -> TypeEnv
bindTypeKind ModuleIdent
m Ident
tc (QualIdent -> TypeKind
Alias QualIdent
qtc)
  where
    qtc :: QualIdent
qtc = ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
m Ident
tc
bindType m :: ModuleIdent
m (ClassDecl _ _ _ cls :: Ident
cls _ ds :: [Decl a]
ds)  = ModuleIdent -> Ident -> TypeKind -> TypeEnv -> TypeEnv
bindTypeKind ModuleIdent
m Ident
cls (QualIdent -> [Ident] -> TypeKind
Class QualIdent
qcls [Ident]
ms)
  where
    qcls :: QualIdent
qcls = ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
m Ident
cls
    ms :: [Ident]
ms = (Decl a -> [Ident]) -> [Decl a] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl a -> [Ident]
forall a. Decl a -> [Ident]
methods [Decl a]
ds
bindType _ _ = TypeEnv -> TypeEnv
forall a. a -> a
id

-- When type declarations are checked, the compiler will allow anonymous
-- type variables on the left hand side of the declaration, but not on
-- the right hand side. Function and pattern declarations must be
-- traversed because they can contain local type signatures.

checkModule :: Module a -> TSCM (Module a)
checkModule :: Module a -> TSCM (Module a)
checkModule (Module spi :: SpanInfo
spi li :: LayoutInfo
li ps :: [ModulePragma]
ps m :: ModuleIdent
m es :: Maybe ExportSpec
es is :: [ImportDecl]
is ds :: [Decl a]
ds) = do
  [Decl a]
ds' <- (Decl a -> StateT TSCState Identity (Decl a))
-> [Decl a] -> StateT TSCState Identity [Decl a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Decl a -> StateT TSCState Identity (Decl a)
forall a. Decl a -> TSCM (Decl a)
checkDecl [Decl a]
ds
  Module a -> TSCM (Module a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Module a -> TSCM (Module a)) -> Module a -> TSCM (Module a)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> LayoutInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
forall a.
SpanInfo
-> LayoutInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
Module SpanInfo
spi LayoutInfo
li [ModulePragma]
ps ModuleIdent
m Maybe ExportSpec
es [ImportDecl]
is [Decl a]
ds'

checkDecl :: Decl a -> TSCM (Decl a)
checkDecl :: Decl a -> TSCM (Decl a)
checkDecl (DataDecl p :: SpanInfo
p tc :: Ident
tc tvs :: [Ident]
tvs cs :: [ConstrDecl]
cs clss :: [QualIdent]
clss)         = do
  [Ident] -> StateT TSCState Identity ()
checkTypeLhs [Ident]
tvs
  [ConstrDecl]
cs' <- (ConstrDecl -> StateT TSCState Identity ConstrDecl)
-> [ConstrDecl] -> StateT TSCState Identity [ConstrDecl]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Ident] -> ConstrDecl -> StateT TSCState Identity ConstrDecl
checkConstrDecl [Ident]
tvs) [ConstrDecl]
cs
  (QualIdent -> StateT TSCState Identity ())
-> [QualIdent] -> StateT TSCState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> QualIdent -> StateT TSCState Identity ()
checkClass Bool
False) [QualIdent]
clss
  Decl a -> TSCM (Decl a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Decl a -> TSCM (Decl a)) -> Decl a -> TSCM (Decl a)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> Ident -> [Ident] -> [ConstrDecl] -> [QualIdent] -> Decl a
forall a.
SpanInfo
-> Ident -> [Ident] -> [ConstrDecl] -> [QualIdent] -> Decl a
DataDecl SpanInfo
p Ident
tc [Ident]
tvs [ConstrDecl]
cs' [QualIdent]
clss
checkDecl (NewtypeDecl p :: SpanInfo
p tc :: Ident
tc tvs :: [Ident]
tvs nc :: NewConstrDecl
nc clss :: [QualIdent]
clss)      = do
  [Ident] -> StateT TSCState Identity ()
checkTypeLhs [Ident]
tvs
  NewConstrDecl
nc' <- [Ident] -> NewConstrDecl -> TSCM NewConstrDecl
checkNewConstrDecl [Ident]
tvs NewConstrDecl
nc
  (QualIdent -> StateT TSCState Identity ())
-> [QualIdent] -> StateT TSCState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> QualIdent -> StateT TSCState Identity ()
checkClass Bool
False) [QualIdent]
clss
  Decl a -> TSCM (Decl a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Decl a -> TSCM (Decl a)) -> Decl a -> TSCM (Decl a)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> Ident -> [Ident] -> NewConstrDecl -> [QualIdent] -> Decl a
forall a.
SpanInfo
-> Ident -> [Ident] -> NewConstrDecl -> [QualIdent] -> Decl a
NewtypeDecl SpanInfo
p Ident
tc [Ident]
tvs NewConstrDecl
nc' [QualIdent]
clss
checkDecl (TypeDecl p :: SpanInfo
p tc :: Ident
tc tvs :: [Ident]
tvs ty :: TypeExpr
ty)              = do
  [Ident] -> StateT TSCState Identity ()
checkTypeLhs [Ident]
tvs
  TypeExpr
ty' <- [Ident] -> TypeExpr -> TSCM TypeExpr
checkClosedType [Ident]
tvs TypeExpr
ty
  Decl a -> TSCM (Decl a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Decl a -> TSCM (Decl a)) -> Decl a -> TSCM (Decl a)
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Ident -> [Ident] -> TypeExpr -> Decl a
forall a. SpanInfo -> Ident -> [Ident] -> TypeExpr -> Decl a
TypeDecl SpanInfo
p Ident
tc [Ident]
tvs TypeExpr
ty'
checkDecl (TypeSig p :: SpanInfo
p vs :: [Ident]
vs qty :: QualTypeExpr
qty)                   =
  SpanInfo -> [Ident] -> QualTypeExpr -> Decl a
forall a. SpanInfo -> [Ident] -> QualTypeExpr -> Decl a
TypeSig SpanInfo
p [Ident]
vs (QualTypeExpr -> Decl a)
-> StateT TSCState Identity QualTypeExpr -> TSCM (Decl a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualTypeExpr -> StateT TSCState Identity QualTypeExpr
checkQualType QualTypeExpr
qty
checkDecl (FunctionDecl a :: SpanInfo
a p :: a
p f :: Ident
f eqs :: [Equation a]
eqs)            = SpanInfo -> a -> Ident -> [Equation a] -> Decl a
forall a. SpanInfo -> a -> Ident -> [Equation a] -> Decl a
FunctionDecl SpanInfo
a a
p Ident
f ([Equation a] -> Decl a)
-> StateT TSCState Identity [Equation a] -> TSCM (Decl a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (Equation a -> StateT TSCState Identity (Equation a))
-> [Equation a] -> StateT TSCState Identity [Equation a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Equation a -> StateT TSCState Identity (Equation a)
forall a. Equation a -> TSCM (Equation a)
checkEquation [Equation a]
eqs
checkDecl (PatternDecl p :: SpanInfo
p t :: Pattern a
t rhs :: Rhs a
rhs)               = SpanInfo -> Pattern a -> Rhs a -> Decl a
forall a. SpanInfo -> Pattern a -> Rhs a -> Decl a
PatternDecl SpanInfo
p Pattern a
t (Rhs a -> Decl a)
-> StateT TSCState Identity (Rhs a) -> TSCM (Decl a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rhs a -> StateT TSCState Identity (Rhs a)
forall a. Rhs a -> TSCM (Rhs a)
checkRhs Rhs a
rhs
checkDecl (DefaultDecl p :: SpanInfo
p tys :: [TypeExpr]
tys)                 = SpanInfo -> [TypeExpr] -> Decl a
forall a. SpanInfo -> [TypeExpr] -> Decl a
DefaultDecl SpanInfo
p ([TypeExpr] -> Decl a)
-> StateT TSCState Identity [TypeExpr] -> TSCM (Decl a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (TypeExpr -> TSCM TypeExpr)
-> [TypeExpr] -> StateT TSCState Identity [TypeExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Ident] -> TypeExpr -> TSCM TypeExpr
checkClosedType []) [TypeExpr]
tys
checkDecl (ClassDecl p :: SpanInfo
p li :: LayoutInfo
li cx :: Context
cx cls :: Ident
cls clsvar :: Ident
clsvar ds :: [Decl a]
ds)   = do
  String -> [Ident] -> StateT TSCState Identity ()
checkTypeVars "class declaration" [Ident
clsvar]
  Context
cx' <- [Ident] -> Context -> TSCM Context
checkClosedContext [Ident
clsvar] Context
cx
  Context -> StateT TSCState Identity ()
checkSimpleContext Context
cx'
  [Decl a]
ds' <- (Decl a -> TSCM (Decl a))
-> [Decl a] -> StateT TSCState Identity [Decl a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Decl a -> TSCM (Decl a)
forall a. Decl a -> TSCM (Decl a)
checkDecl [Decl a]
ds
  (Decl a -> StateT TSCState Identity ())
-> [Decl a] -> StateT TSCState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ident -> Decl a -> StateT TSCState Identity ()
forall a. Ident -> Decl a -> StateT TSCState Identity ()
checkClassMethod Ident
clsvar) [Decl a]
ds'
  Decl a -> TSCM (Decl a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Decl a -> TSCM (Decl a)) -> Decl a -> TSCM (Decl a)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> LayoutInfo -> Context -> Ident -> Ident -> [Decl a] -> Decl a
forall a.
SpanInfo
-> LayoutInfo -> Context -> Ident -> Ident -> [Decl a] -> Decl a
ClassDecl SpanInfo
p LayoutInfo
li Context
cx' Ident
cls Ident
clsvar [Decl a]
ds'
checkDecl (InstanceDecl p :: SpanInfo
p li :: LayoutInfo
li cx :: Context
cx qcls :: QualIdent
qcls inst :: TypeExpr
inst ds :: [Decl a]
ds) = do
  Bool -> QualIdent -> StateT TSCState Identity ()
checkClass Bool
True QualIdent
qcls
  QualTypeExpr _ cx' :: Context
cx' inst' :: TypeExpr
inst' <- QualTypeExpr -> StateT TSCState Identity QualTypeExpr
checkQualType (QualTypeExpr -> StateT TSCState Identity QualTypeExpr)
-> QualTypeExpr -> StateT TSCState Identity QualTypeExpr
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Context -> TypeExpr -> QualTypeExpr
QualTypeExpr SpanInfo
NoSpanInfo Context
cx TypeExpr
inst
  Context -> StateT TSCState Identity ()
checkSimpleContext Context
cx'
  SpanInfo -> TypeExpr -> StateT TSCState Identity ()
checkInstanceType SpanInfo
p TypeExpr
inst'
  SpanInfo
-> LayoutInfo
-> Context
-> QualIdent
-> TypeExpr
-> [Decl a]
-> Decl a
forall a.
SpanInfo
-> LayoutInfo
-> Context
-> QualIdent
-> TypeExpr
-> [Decl a]
-> Decl a
InstanceDecl SpanInfo
p LayoutInfo
li Context
cx' QualIdent
qcls TypeExpr
inst' ([Decl a] -> Decl a)
-> StateT TSCState Identity [Decl a] -> TSCM (Decl a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Decl a -> TSCM (Decl a))
-> [Decl a] -> StateT TSCState Identity [Decl a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Decl a -> TSCM (Decl a)
forall a. Decl a -> TSCM (Decl a)
checkDecl [Decl a]
ds
checkDecl d :: Decl a
d                                   = Decl a -> TSCM (Decl a)
forall (m :: * -> *) a. Monad m => a -> m a
return Decl a
d

checkConstrDecl :: [Ident] -> ConstrDecl -> TSCM ConstrDecl
checkConstrDecl :: [Ident] -> ConstrDecl -> StateT TSCState Identity ConstrDecl
checkConstrDecl tvs :: [Ident]
tvs (ConstrDecl p :: SpanInfo
p c :: Ident
c tys :: [TypeExpr]
tys) = do
  [TypeExpr]
tys' <- (TypeExpr -> TSCM TypeExpr)
-> [TypeExpr] -> StateT TSCState Identity [TypeExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Ident] -> TypeExpr -> TSCM TypeExpr
checkClosedType [Ident]
tvs) [TypeExpr]
tys
  ConstrDecl -> StateT TSCState Identity ConstrDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstrDecl -> StateT TSCState Identity ConstrDecl)
-> ConstrDecl -> StateT TSCState Identity ConstrDecl
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Ident -> [TypeExpr] -> ConstrDecl
ConstrDecl SpanInfo
p Ident
c [TypeExpr]
tys'
checkConstrDecl tvs :: [Ident]
tvs (ConOpDecl p :: SpanInfo
p ty1 :: TypeExpr
ty1 op :: Ident
op ty2 :: TypeExpr
ty2) = do
  [TypeExpr]
tys' <- (TypeExpr -> TSCM TypeExpr)
-> [TypeExpr] -> StateT TSCState Identity [TypeExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Ident] -> TypeExpr -> TSCM TypeExpr
checkClosedType [Ident]
tvs) [TypeExpr
ty1, TypeExpr
ty2]
  let [ty1' :: TypeExpr
ty1', ty2' :: TypeExpr
ty2'] = [TypeExpr]
tys'
  ConstrDecl -> StateT TSCState Identity ConstrDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstrDecl -> StateT TSCState Identity ConstrDecl)
-> ConstrDecl -> StateT TSCState Identity ConstrDecl
forall a b. (a -> b) -> a -> b
$ SpanInfo -> TypeExpr -> Ident -> TypeExpr -> ConstrDecl
ConOpDecl SpanInfo
p TypeExpr
ty1' Ident
op TypeExpr
ty2'
checkConstrDecl tvs :: [Ident]
tvs (RecordDecl p :: SpanInfo
p c :: Ident
c fs :: [FieldDecl]
fs) = do
  [FieldDecl]
fs' <- (FieldDecl -> StateT TSCState Identity FieldDecl)
-> [FieldDecl] -> StateT TSCState Identity [FieldDecl]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Ident] -> FieldDecl -> StateT TSCState Identity FieldDecl
checkFieldDecl [Ident]
tvs) [FieldDecl]
fs
  ConstrDecl -> StateT TSCState Identity ConstrDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstrDecl -> StateT TSCState Identity ConstrDecl)
-> ConstrDecl -> StateT TSCState Identity ConstrDecl
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Ident -> [FieldDecl] -> ConstrDecl
RecordDecl SpanInfo
p Ident
c [FieldDecl]
fs'

checkFieldDecl :: [Ident] -> FieldDecl -> TSCM FieldDecl
checkFieldDecl :: [Ident] -> FieldDecl -> StateT TSCState Identity FieldDecl
checkFieldDecl tvs :: [Ident]
tvs (FieldDecl p :: SpanInfo
p ls :: [Ident]
ls ty :: TypeExpr
ty) =
  SpanInfo -> [Ident] -> TypeExpr -> FieldDecl
FieldDecl SpanInfo
p [Ident]
ls (TypeExpr -> FieldDecl)
-> TSCM TypeExpr -> StateT TSCState Identity FieldDecl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident] -> TypeExpr -> TSCM TypeExpr
checkClosedType [Ident]
tvs TypeExpr
ty

checkNewConstrDecl :: [Ident] -> NewConstrDecl -> TSCM NewConstrDecl
checkNewConstrDecl :: [Ident] -> NewConstrDecl -> TSCM NewConstrDecl
checkNewConstrDecl tvs :: [Ident]
tvs (NewConstrDecl p :: SpanInfo
p c :: Ident
c ty :: TypeExpr
ty) = do
  TypeExpr
ty'  <- [Ident] -> TypeExpr -> TSCM TypeExpr
checkClosedType [Ident]
tvs TypeExpr
ty
  NewConstrDecl -> TSCM NewConstrDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (NewConstrDecl -> TSCM NewConstrDecl)
-> NewConstrDecl -> TSCM NewConstrDecl
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Ident -> TypeExpr -> NewConstrDecl
NewConstrDecl SpanInfo
p Ident
c TypeExpr
ty'
checkNewConstrDecl tvs :: [Ident]
tvs (NewRecordDecl p :: SpanInfo
p c :: Ident
c (l :: Ident
l, ty :: TypeExpr
ty)) = do
  TypeExpr
ty'  <- [Ident] -> TypeExpr -> TSCM TypeExpr
checkClosedType [Ident]
tvs TypeExpr
ty
  NewConstrDecl -> TSCM NewConstrDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (NewConstrDecl -> TSCM NewConstrDecl)
-> NewConstrDecl -> TSCM NewConstrDecl
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Ident -> (Ident, TypeExpr) -> NewConstrDecl
NewRecordDecl SpanInfo
p Ident
c (Ident
l, TypeExpr
ty')

checkSimpleContext :: Context -> TSCM ()
checkSimpleContext :: Context -> StateT TSCState Identity ()
checkSimpleContext = (Constraint -> StateT TSCState Identity ())
-> Context -> StateT TSCState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Constraint -> StateT TSCState Identity ()
checkSimpleConstraint

checkSimpleConstraint :: Constraint -> TSCM ()
checkSimpleConstraint :: Constraint -> StateT TSCState Identity ()
checkSimpleConstraint c :: Constraint
c@(Constraint _ _ ty :: TypeExpr
ty) =
  Bool -> StateT TSCState Identity () -> StateT TSCState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TypeExpr -> Bool
isVariableType TypeExpr
ty) (StateT TSCState Identity () -> StateT TSCState Identity ())
-> StateT TSCState Identity () -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ Message -> StateT TSCState Identity ()
report (Message -> StateT TSCState Identity ())
-> Message -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ Constraint -> Message
errIllegalSimpleConstraint Constraint
c

-- Class method's type signatures have to obey a few additional restrictions.
-- The class variable must appear in the method's type and the method's
-- context must not contain any additional constraints for that class variable.

checkClassMethod :: Ident -> Decl a -> TSCM ()
checkClassMethod :: Ident -> Decl a -> StateT TSCState Identity ()
checkClassMethod tv :: Ident
tv (TypeSig spi :: SpanInfo
spi _ qty :: QualTypeExpr
qty) = do
  Bool -> StateT TSCState Identity () -> StateT TSCState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ident
tv Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` QualTypeExpr -> [Ident]
forall e. Expr e => e -> [Ident]
fv QualTypeExpr
qty) (StateT TSCState Identity () -> StateT TSCState Identity ())
-> StateT TSCState Identity () -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ Message -> StateT TSCState Identity ()
report (Message -> StateT TSCState Identity ())
-> Message -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Ident -> Message
errAmbiguousType SpanInfo
spi Ident
tv
  let QualTypeExpr _ cx :: Context
cx _ = QualTypeExpr
qty
  Bool -> StateT TSCState Identity () -> StateT TSCState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ident
tv Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Context -> [Ident]
forall e. Expr e => e -> [Ident]
fv Context
cx) (StateT TSCState Identity () -> StateT TSCState Identity ())
-> StateT TSCState Identity () -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ Message -> StateT TSCState Identity ()
report (Message -> StateT TSCState Identity ())
-> Message -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Ident -> Message
errConstrainedClassVariable SpanInfo
spi Ident
tv
checkClassMethod _ _ = StateT TSCState Identity ()
ok

checkInstanceType :: SpanInfo -> InstanceType -> TSCM ()
checkInstanceType :: SpanInfo -> TypeExpr -> StateT TSCState Identity ()
checkInstanceType p :: SpanInfo
p inst :: TypeExpr
inst = do
  TypeEnv
tEnv <- TSCM TypeEnv
getTypeEnv
  Bool -> StateT TSCState Identity () -> StateT TSCState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TypeExpr -> Bool
isSimpleType TypeExpr
inst Bool -> Bool -> Bool
&&
    Bool -> Bool
not (QualIdent -> TypeEnv -> Bool
isTypeSyn (TypeExpr -> QualIdent
typeConstr TypeExpr
inst) TypeEnv
tEnv) Bool -> Bool -> Bool
&&
    Bool -> Bool
not ((Ident -> Bool) -> [Ident] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Ident -> Bool
isAnonId ([Ident] -> Bool) -> [Ident] -> Bool
forall a b. (a -> b) -> a -> b
$ TypeExpr -> [Ident]
typeVariables TypeExpr
inst) Bool -> Bool -> Bool
&&
    Maybe Ident -> Bool
forall a. Maybe a -> Bool
isNothing ([Ident] -> Maybe Ident
forall a. Eq a => [a] -> Maybe a
findDouble ([Ident] -> Maybe Ident) -> [Ident] -> Maybe Ident
forall a b. (a -> b) -> a -> b
$ TypeExpr -> [Ident]
forall e. Expr e => e -> [Ident]
fv TypeExpr
inst)) (StateT TSCState Identity () -> StateT TSCState Identity ())
-> StateT TSCState Identity () -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$
      Message -> StateT TSCState Identity ()
report (Message -> StateT TSCState Identity ())
-> Message -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ SpanInfo -> TypeExpr -> Message
errIllegalInstanceType SpanInfo
p TypeExpr
inst

checkTypeLhs :: [Ident] -> TSCM ()
checkTypeLhs :: [Ident] -> StateT TSCState Identity ()
checkTypeLhs = String -> [Ident] -> StateT TSCState Identity ()
checkTypeVars "left hand side of type declaration"

-- |Checks a list of type variables for
-- * Anonymous type variables are allowed
-- * only type variables (no type constructors)
-- * linearity
checkTypeVars :: String -> [Ident] -> TSCM ()
checkTypeVars :: String -> [Ident] -> StateT TSCState Identity ()
checkTypeVars _    []         = StateT TSCState Identity ()
ok
checkTypeVars what :: String
what (tv :: Ident
tv : tvs :: [Ident]
tvs) = do
  Bool -> StateT TSCState Identity () -> StateT TSCState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ident -> Bool
isAnonId Ident
tv) (StateT TSCState Identity () -> StateT TSCState Identity ())
-> StateT TSCState Identity () -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
isTypeConstrOrClass <- Bool -> Bool
not (Bool -> Bool) -> (TypeEnv -> Bool) -> TypeEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypeKind] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TypeKind] -> Bool) -> (TypeEnv -> [TypeKind]) -> TypeEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> TypeEnv -> [TypeKind]
lookupTypeKind Ident
tv (TypeEnv -> Bool) -> TSCM TypeEnv -> StateT TSCState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TSCM TypeEnv
getTypeEnv
    Bool -> StateT TSCState Identity () -> StateT TSCState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isTypeConstrOrClass (StateT TSCState Identity () -> StateT TSCState Identity ())
-> StateT TSCState Identity () -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ Message -> StateT TSCState Identity ()
report (Message -> StateT TSCState Identity ())
-> Message -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ Ident -> String -> Message
errNoVariable Ident
tv String
what
    Bool -> StateT TSCState Identity () -> StateT TSCState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ident
tv Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ident]
tvs) (StateT TSCState Identity () -> StateT TSCState Identity ())
-> StateT TSCState Identity () -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ Message -> StateT TSCState Identity ()
report (Message -> StateT TSCState Identity ())
-> Message -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ Ident -> String -> Message
errNonLinear Ident
tv String
what
  String -> [Ident] -> StateT TSCState Identity ()
checkTypeVars String
what [Ident]
tvs

-- Checking expressions is rather straight forward. The compiler must
-- only traverse the structure of expressions in order to find local
-- declaration groups.

checkEquation :: Equation a -> TSCM (Equation a)
checkEquation :: Equation a -> TSCM (Equation a)
checkEquation (Equation p :: SpanInfo
p lhs :: Lhs a
lhs rhs :: Rhs a
rhs) = SpanInfo -> Lhs a -> Rhs a -> Equation a
forall a. SpanInfo -> Lhs a -> Rhs a -> Equation a
Equation SpanInfo
p Lhs a
lhs (Rhs a -> Equation a)
-> StateT TSCState Identity (Rhs a) -> TSCM (Equation a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rhs a -> StateT TSCState Identity (Rhs a)
forall a. Rhs a -> TSCM (Rhs a)
checkRhs Rhs a
rhs

checkRhs :: Rhs a -> TSCM (Rhs a)
checkRhs :: Rhs a -> TSCM (Rhs a)
checkRhs (SimpleRhs spi :: SpanInfo
spi li :: LayoutInfo
li e :: Expression a
e ds :: [Decl a]
ds)   =
  SpanInfo -> LayoutInfo -> Expression a -> [Decl a] -> Rhs a
forall a.
SpanInfo -> LayoutInfo -> Expression a -> [Decl a] -> Rhs a
SimpleRhs SpanInfo
spi LayoutInfo
li (Expression a -> [Decl a] -> Rhs a)
-> StateT TSCState Identity (Expression a)
-> StateT TSCState Identity ([Decl a] -> Rhs a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> StateT TSCState Identity (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e StateT TSCState Identity ([Decl a] -> Rhs a)
-> StateT TSCState Identity [Decl a] -> TSCM (Rhs a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Decl a -> StateT TSCState Identity (Decl a))
-> [Decl a] -> StateT TSCState Identity [Decl a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Decl a -> StateT TSCState Identity (Decl a)
forall a. Decl a -> TSCM (Decl a)
checkDecl [Decl a]
ds
checkRhs (GuardedRhs spi :: SpanInfo
spi li :: LayoutInfo
li es :: [CondExpr a]
es ds :: [Decl a]
ds) =
  SpanInfo -> LayoutInfo -> [CondExpr a] -> [Decl a] -> Rhs a
forall a.
SpanInfo -> LayoutInfo -> [CondExpr a] -> [Decl a] -> Rhs a
GuardedRhs SpanInfo
spi LayoutInfo
li ([CondExpr a] -> [Decl a] -> Rhs a)
-> StateT TSCState Identity [CondExpr a]
-> StateT TSCState Identity ([Decl a] -> Rhs a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CondExpr a -> StateT TSCState Identity (CondExpr a))
-> [CondExpr a] -> StateT TSCState Identity [CondExpr a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CondExpr a -> StateT TSCState Identity (CondExpr a)
forall a. CondExpr a -> TSCM (CondExpr a)
checkCondExpr [CondExpr a]
es StateT TSCState Identity ([Decl a] -> Rhs a)
-> StateT TSCState Identity [Decl a] -> TSCM (Rhs a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Decl a -> StateT TSCState Identity (Decl a))
-> [Decl a] -> StateT TSCState Identity [Decl a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Decl a -> StateT TSCState Identity (Decl a)
forall a. Decl a -> TSCM (Decl a)
checkDecl [Decl a]
ds

checkCondExpr :: CondExpr a -> TSCM (CondExpr a)
checkCondExpr :: CondExpr a -> TSCM (CondExpr a)
checkCondExpr (CondExpr spi :: SpanInfo
spi g :: Expression a
g e :: Expression a
e) = SpanInfo -> Expression a -> Expression a -> CondExpr a
forall a. SpanInfo -> Expression a -> Expression a -> CondExpr a
CondExpr SpanInfo
spi (Expression a -> Expression a -> CondExpr a)
-> StateT TSCState Identity (Expression a)
-> StateT TSCState Identity (Expression a -> CondExpr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> StateT TSCState Identity (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
g StateT TSCState Identity (Expression a -> CondExpr a)
-> StateT TSCState Identity (Expression a) -> TSCM (CondExpr a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression a -> StateT TSCState Identity (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e

checkExpr :: Expression a -> TSCM (Expression a)
checkExpr :: Expression a -> TSCM (Expression a)
checkExpr l :: Expression a
l@(Literal             _ _ _) = Expression a -> TSCM (Expression a)
forall (m :: * -> *) a. Monad m => a -> m a
return Expression a
l
checkExpr v :: Expression a
v@(Variable            _ _ _) = Expression a -> TSCM (Expression a)
forall (m :: * -> *) a. Monad m => a -> m a
return Expression a
v
checkExpr c :: Expression a
c@(Constructor         _ _ _) = Expression a -> TSCM (Expression a)
forall (m :: * -> *) a. Monad m => a -> m a
return Expression a
c
checkExpr (Paren                 spi :: SpanInfo
spi e :: Expression a
e) = SpanInfo -> Expression a -> Expression a
forall a. SpanInfo -> Expression a -> Expression a
Paren SpanInfo
spi (Expression a -> Expression a)
-> TSCM (Expression a) -> TSCM (Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e
checkExpr (Typed             spi :: SpanInfo
spi e :: Expression a
e qty :: QualTypeExpr
qty) = SpanInfo -> Expression a -> QualTypeExpr -> Expression a
forall a. SpanInfo -> Expression a -> QualTypeExpr -> Expression a
Typed SpanInfo
spi (Expression a -> QualTypeExpr -> Expression a)
-> TSCM (Expression a)
-> StateT TSCState Identity (QualTypeExpr -> Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e
                                                    StateT TSCState Identity (QualTypeExpr -> Expression a)
-> StateT TSCState Identity QualTypeExpr -> TSCM (Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QualTypeExpr -> StateT TSCState Identity QualTypeExpr
checkQualType QualTypeExpr
qty
checkExpr (Record           spi :: SpanInfo
spi a :: a
a c :: QualIdent
c fs :: [Field (Expression a)]
fs) =
  SpanInfo
-> a -> QualIdent -> [Field (Expression a)] -> Expression a
forall a.
SpanInfo
-> a -> QualIdent -> [Field (Expression a)] -> Expression a
Record SpanInfo
spi a
a QualIdent
c ([Field (Expression a)] -> Expression a)
-> StateT TSCState Identity [Field (Expression a)]
-> TSCM (Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field (Expression a)
 -> StateT TSCState Identity (Field (Expression a)))
-> [Field (Expression a)]
-> StateT TSCState Identity [Field (Expression a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Field (Expression a)
-> StateT TSCState Identity (Field (Expression a))
forall a. Field (Expression a) -> TSCM (Field (Expression a))
checkFieldExpr [Field (Expression a)]
fs
checkExpr (RecordUpdate       spi :: SpanInfo
spi e :: Expression a
e fs :: [Field (Expression a)]
fs) =
  SpanInfo -> Expression a -> [Field (Expression a)] -> Expression a
forall a.
SpanInfo -> Expression a -> [Field (Expression a)] -> Expression a
RecordUpdate SpanInfo
spi (Expression a -> [Field (Expression a)] -> Expression a)
-> TSCM (Expression a)
-> StateT
     TSCState Identity ([Field (Expression a)] -> Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e StateT TSCState Identity ([Field (Expression a)] -> Expression a)
-> StateT TSCState Identity [Field (Expression a)]
-> TSCM (Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field (Expression a)
 -> StateT TSCState Identity (Field (Expression a)))
-> [Field (Expression a)]
-> StateT TSCState Identity [Field (Expression a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Field (Expression a)
-> StateT TSCState Identity (Field (Expression a))
forall a. Field (Expression a) -> TSCM (Field (Expression a))
checkFieldExpr [Field (Expression a)]
fs
checkExpr (Tuple                spi :: SpanInfo
spi es :: [Expression a]
es) = SpanInfo -> [Expression a] -> Expression a
forall a. SpanInfo -> [Expression a] -> Expression a
Tuple SpanInfo
spi ([Expression a] -> Expression a)
-> StateT TSCState Identity [Expression a] -> TSCM (Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expression a -> TSCM (Expression a))
-> [Expression a] -> StateT TSCState Identity [Expression a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr [Expression a]
es
checkExpr (List               spi :: SpanInfo
spi a :: a
a es :: [Expression a]
es) = SpanInfo -> a -> [Expression a] -> Expression a
forall a. SpanInfo -> a -> [Expression a] -> Expression a
List SpanInfo
spi a
a ([Expression a] -> Expression a)
-> StateT TSCState Identity [Expression a] -> TSCM (Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expression a -> TSCM (Expression a))
-> [Expression a] -> StateT TSCState Identity [Expression a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr [Expression a]
es
checkExpr (ListCompr          spi :: SpanInfo
spi e :: Expression a
e qs :: [Statement a]
qs) = SpanInfo -> Expression a -> [Statement a] -> Expression a
forall a. SpanInfo -> Expression a -> [Statement a] -> Expression a
ListCompr SpanInfo
spi (Expression a -> [Statement a] -> Expression a)
-> TSCM (Expression a)
-> StateT TSCState Identity ([Statement a] -> Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e
                                                        StateT TSCState Identity ([Statement a] -> Expression a)
-> StateT TSCState Identity [Statement a] -> TSCM (Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Statement a -> StateT TSCState Identity (Statement a))
-> [Statement a] -> StateT TSCState Identity [Statement a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Statement a -> StateT TSCState Identity (Statement a)
forall a. Statement a -> TSCM (Statement a)
checkStmt [Statement a]
qs
checkExpr (EnumFrom              spi :: SpanInfo
spi e :: Expression a
e) = SpanInfo -> Expression a -> Expression a
forall a. SpanInfo -> Expression a -> Expression a
EnumFrom SpanInfo
spi (Expression a -> Expression a)
-> TSCM (Expression a) -> TSCM (Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e
checkExpr (EnumFromThen      spi :: SpanInfo
spi e1 :: Expression a
e1 e2 :: Expression a
e2) = SpanInfo -> Expression a -> Expression a -> Expression a
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
EnumFromThen SpanInfo
spi (Expression a -> Expression a -> Expression a)
-> TSCM (Expression a)
-> StateT TSCState Identity (Expression a -> Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e1
                                                           StateT TSCState Identity (Expression a -> Expression a)
-> TSCM (Expression a) -> TSCM (Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e2
checkExpr (EnumFromTo        spi :: SpanInfo
spi e1 :: Expression a
e1 e2 :: Expression a
e2) = SpanInfo -> Expression a -> Expression a -> Expression a
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
EnumFromTo SpanInfo
spi (Expression a -> Expression a -> Expression a)
-> TSCM (Expression a)
-> StateT TSCState Identity (Expression a -> Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e1
                                                         StateT TSCState Identity (Expression a -> Expression a)
-> TSCM (Expression a) -> TSCM (Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e2
checkExpr (EnumFromThenTo spi :: SpanInfo
spi e1 :: Expression a
e1 e2 :: Expression a
e2 e3 :: Expression a
e3) = SpanInfo
-> Expression a -> Expression a -> Expression a -> Expression a
forall a.
SpanInfo
-> Expression a -> Expression a -> Expression a -> Expression a
EnumFromThenTo SpanInfo
spi (Expression a -> Expression a -> Expression a -> Expression a)
-> TSCM (Expression a)
-> StateT
     TSCState Identity (Expression a -> Expression a -> Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e1
                                                             StateT
  TSCState Identity (Expression a -> Expression a -> Expression a)
-> TSCM (Expression a)
-> StateT TSCState Identity (Expression a -> Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e2
                                                             StateT TSCState Identity (Expression a -> Expression a)
-> TSCM (Expression a) -> TSCM (Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e3
checkExpr (UnaryMinus            spi :: SpanInfo
spi e :: Expression a
e) = SpanInfo -> Expression a -> Expression a
forall a. SpanInfo -> Expression a -> Expression a
UnaryMinus SpanInfo
spi (Expression a -> Expression a)
-> TSCM (Expression a) -> TSCM (Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e
checkExpr (Apply             spi :: SpanInfo
spi e1 :: Expression a
e1 e2 :: Expression a
e2) = SpanInfo -> Expression a -> Expression a -> Expression a
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
spi (Expression a -> Expression a -> Expression a)
-> TSCM (Expression a)
-> StateT TSCState Identity (Expression a -> Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e1
                                                    StateT TSCState Identity (Expression a -> Expression a)
-> TSCM (Expression a) -> TSCM (Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e2
checkExpr (InfixApply     spi :: SpanInfo
spi e1 :: Expression a
e1 op :: InfixOp a
op e2 :: Expression a
e2) = SpanInfo
-> Expression a -> InfixOp a -> Expression a -> Expression a
forall a.
SpanInfo
-> Expression a -> InfixOp a -> Expression a -> Expression a
InfixApply SpanInfo
spi (Expression a -> InfixOp a -> Expression a -> Expression a)
-> TSCM (Expression a)
-> StateT
     TSCState Identity (InfixOp a -> Expression a -> Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e1
                                                         StateT
  TSCState Identity (InfixOp a -> Expression a -> Expression a)
-> StateT TSCState Identity (InfixOp a)
-> StateT TSCState Identity (Expression a -> Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InfixOp a -> StateT TSCState Identity (InfixOp a)
forall (m :: * -> *) a. Monad m => a -> m a
return InfixOp a
op
                                                         StateT TSCState Identity (Expression a -> Expression a)
-> TSCM (Expression a) -> TSCM (Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e2
checkExpr (LeftSection spi :: SpanInfo
spi e :: Expression a
e op :: InfixOp a
op)        = (Expression a -> InfixOp a -> Expression a)
-> InfixOp a -> Expression a -> Expression a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SpanInfo -> Expression a -> InfixOp a -> Expression a
forall a. SpanInfo -> Expression a -> InfixOp a -> Expression a
LeftSection SpanInfo
spi) InfixOp a
op (Expression a -> Expression a)
-> TSCM (Expression a) -> TSCM (Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e
checkExpr (RightSection spi :: SpanInfo
spi op :: InfixOp a
op e :: Expression a
e)       = SpanInfo -> InfixOp a -> Expression a -> Expression a
forall a. SpanInfo -> InfixOp a -> Expression a -> Expression a
RightSection SpanInfo
spi InfixOp a
op (Expression a -> Expression a)
-> TSCM (Expression a) -> TSCM (Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e
checkExpr (Lambda spi :: SpanInfo
spi ts :: [Pattern a]
ts e :: Expression a
e)             = SpanInfo -> [Pattern a] -> Expression a -> Expression a
forall a. SpanInfo -> [Pattern a] -> Expression a -> Expression a
Lambda SpanInfo
spi [Pattern a]
ts (Expression a -> Expression a)
-> TSCM (Expression a) -> TSCM (Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e
checkExpr (Let spi :: SpanInfo
spi li :: LayoutInfo
li ds :: [Decl a]
ds e :: Expression a
e)             = SpanInfo -> LayoutInfo -> [Decl a] -> Expression a -> Expression a
forall a.
SpanInfo -> LayoutInfo -> [Decl a] -> Expression a -> Expression a
Let SpanInfo
spi LayoutInfo
li ([Decl a] -> Expression a -> Expression a)
-> StateT TSCState Identity [Decl a]
-> StateT TSCState Identity (Expression a -> Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Decl a -> StateT TSCState Identity (Decl a))
-> [Decl a] -> StateT TSCState Identity [Decl a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Decl a -> StateT TSCState Identity (Decl a)
forall a. Decl a -> TSCM (Decl a)
checkDecl [Decl a]
ds
                                                     StateT TSCState Identity (Expression a -> Expression a)
-> TSCM (Expression a) -> TSCM (Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e
checkExpr (Do spi :: SpanInfo
spi li :: LayoutInfo
li sts :: [Statement a]
sts e :: Expression a
e)             = SpanInfo
-> LayoutInfo -> [Statement a] -> Expression a -> Expression a
forall a.
SpanInfo
-> LayoutInfo -> [Statement a] -> Expression a -> Expression a
Do SpanInfo
spi LayoutInfo
li ([Statement a] -> Expression a -> Expression a)
-> StateT TSCState Identity [Statement a]
-> StateT TSCState Identity (Expression a -> Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Statement a -> StateT TSCState Identity (Statement a))
-> [Statement a] -> StateT TSCState Identity [Statement a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Statement a -> StateT TSCState Identity (Statement a)
forall a. Statement a -> TSCM (Statement a)
checkStmt [Statement a]
sts
                                                    StateT TSCState Identity (Expression a -> Expression a)
-> TSCM (Expression a) -> TSCM (Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e
checkExpr (IfThenElse spi :: SpanInfo
spi e1 :: Expression a
e1 e2 :: Expression a
e2 e3 :: Expression a
e3)     = SpanInfo
-> Expression a -> Expression a -> Expression a -> Expression a
forall a.
SpanInfo
-> Expression a -> Expression a -> Expression a -> Expression a
IfThenElse SpanInfo
spi (Expression a -> Expression a -> Expression a -> Expression a)
-> TSCM (Expression a)
-> StateT
     TSCState Identity (Expression a -> Expression a -> Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e1
                                                         StateT
  TSCState Identity (Expression a -> Expression a -> Expression a)
-> TSCM (Expression a)
-> StateT TSCState Identity (Expression a -> Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e2
                                                         StateT TSCState Identity (Expression a -> Expression a)
-> TSCM (Expression a) -> TSCM (Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e3
checkExpr (Case spi :: SpanInfo
spi li :: LayoutInfo
li ct :: CaseType
ct e :: Expression a
e alts :: [Alt a]
alts)       = SpanInfo
-> LayoutInfo
-> CaseType
-> Expression a
-> [Alt a]
-> Expression a
forall a.
SpanInfo
-> LayoutInfo
-> CaseType
-> Expression a
-> [Alt a]
-> Expression a
Case SpanInfo
spi LayoutInfo
li CaseType
ct (Expression a -> [Alt a] -> Expression a)
-> TSCM (Expression a)
-> StateT TSCState Identity ([Alt a] -> Expression a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> TSCM (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e
                                                         StateT TSCState Identity ([Alt a] -> Expression a)
-> StateT TSCState Identity [Alt a] -> TSCM (Expression a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Alt a -> StateT TSCState Identity (Alt a))
-> [Alt a] -> StateT TSCState Identity [Alt a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Alt a -> StateT TSCState Identity (Alt a)
forall a. Alt a -> TSCM (Alt a)
checkAlt [Alt a]
alts

checkStmt :: Statement a -> TSCM (Statement a)
checkStmt :: Statement a -> TSCM (Statement a)
checkStmt (StmtExpr spi :: SpanInfo
spi e :: Expression a
e)     = SpanInfo -> Expression a -> Statement a
forall a. SpanInfo -> Expression a -> Statement a
StmtExpr SpanInfo
spi    (Expression a -> Statement a)
-> StateT TSCState Identity (Expression a) -> TSCM (Statement a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> StateT TSCState Identity (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e
checkStmt (StmtBind spi :: SpanInfo
spi t :: Pattern a
t e :: Expression a
e)   = SpanInfo -> Pattern a -> Expression a -> Statement a
forall a. SpanInfo -> Pattern a -> Expression a -> Statement a
StmtBind SpanInfo
spi Pattern a
t  (Expression a -> Statement a)
-> StateT TSCState Identity (Expression a) -> TSCM (Statement a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> StateT TSCState Identity (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e
checkStmt (StmtDecl spi :: SpanInfo
spi li :: LayoutInfo
li ds :: [Decl a]
ds) = SpanInfo -> LayoutInfo -> [Decl a] -> Statement a
forall a. SpanInfo -> LayoutInfo -> [Decl a] -> Statement a
StmtDecl SpanInfo
spi LayoutInfo
li ([Decl a] -> Statement a)
-> StateT TSCState Identity [Decl a] -> TSCM (Statement a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Decl a -> StateT TSCState Identity (Decl a))
-> [Decl a] -> StateT TSCState Identity [Decl a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Decl a -> StateT TSCState Identity (Decl a)
forall a. Decl a -> TSCM (Decl a)
checkDecl [Decl a]
ds

checkAlt :: Alt a -> TSCM (Alt a)
checkAlt :: Alt a -> TSCM (Alt a)
checkAlt (Alt spi :: SpanInfo
spi t :: Pattern a
t rhs :: Rhs a
rhs) = SpanInfo -> Pattern a -> Rhs a -> Alt a
forall a. SpanInfo -> Pattern a -> Rhs a -> Alt a
Alt SpanInfo
spi Pattern a
t (Rhs a -> Alt a)
-> StateT TSCState Identity (Rhs a) -> TSCM (Alt a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rhs a -> StateT TSCState Identity (Rhs a)
forall a. Rhs a -> TSCM (Rhs a)
checkRhs Rhs a
rhs

checkFieldExpr :: Field (Expression a) -> TSCM (Field (Expression a))
checkFieldExpr :: Field (Expression a) -> TSCM (Field (Expression a))
checkFieldExpr (Field spi :: SpanInfo
spi l :: QualIdent
l e :: Expression a
e) = SpanInfo -> QualIdent -> Expression a -> Field (Expression a)
forall a. SpanInfo -> QualIdent -> a -> Field a
Field SpanInfo
spi QualIdent
l (Expression a -> Field (Expression a))
-> StateT TSCState Identity (Expression a)
-> TSCM (Field (Expression a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a -> StateT TSCState Identity (Expression a)
forall a. Expression a -> TSCM (Expression a)
checkExpr Expression a
e

-- The parser cannot distinguish unqualified nullary type constructors
-- and type variables. Therefore, if the compiler finds an unbound
-- identifier in a position where a type variable is admissible, it will
-- interpret the identifier as such.

checkQualType :: QualTypeExpr -> TSCM QualTypeExpr
checkQualType :: QualTypeExpr -> StateT TSCState Identity QualTypeExpr
checkQualType (QualTypeExpr spi :: SpanInfo
spi cx :: Context
cx ty :: TypeExpr
ty) = do
  TypeExpr
ty' <- TypeExpr -> TSCM TypeExpr
checkType TypeExpr
ty
  Context
cx' <- [Ident] -> Context -> TSCM Context
checkClosedContext (TypeExpr -> [Ident]
forall e. Expr e => e -> [Ident]
fv TypeExpr
ty') Context
cx
  QualTypeExpr -> StateT TSCState Identity QualTypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (QualTypeExpr -> StateT TSCState Identity QualTypeExpr)
-> QualTypeExpr -> StateT TSCState Identity QualTypeExpr
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Context -> TypeExpr -> QualTypeExpr
QualTypeExpr SpanInfo
spi Context
cx' TypeExpr
ty'

checkClosedContext :: [Ident] -> Context -> TSCM Context
checkClosedContext :: [Ident] -> Context -> TSCM Context
checkClosedContext tvs :: [Ident]
tvs cx :: Context
cx = do
  Context
cx' <- Context -> TSCM Context
checkContext Context
cx
  (Constraint -> StateT TSCState Identity ())
-> Context -> StateT TSCState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Constraint _ _ ty :: TypeExpr
ty) -> [Ident] -> TypeExpr -> StateT TSCState Identity ()
checkClosed [Ident]
tvs TypeExpr
ty) Context
cx'
  Context -> TSCM Context
forall (m :: * -> *) a. Monad m => a -> m a
return Context
cx'

checkContext :: Context -> TSCM Context
checkContext :: Context -> TSCM Context
checkContext = (Constraint -> StateT TSCState Identity Constraint)
-> Context -> TSCM Context
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Constraint -> StateT TSCState Identity Constraint
checkConstraint

checkConstraint :: Constraint -> TSCM Constraint
checkConstraint :: Constraint -> StateT TSCState Identity Constraint
checkConstraint c :: Constraint
c@(Constraint spi :: SpanInfo
spi qcls :: QualIdent
qcls ty :: TypeExpr
ty) = do
  Bool -> QualIdent -> StateT TSCState Identity ()
checkClass Bool
False QualIdent
qcls
  TypeExpr
ty' <- TypeExpr -> TSCM TypeExpr
checkType TypeExpr
ty
  Bool -> StateT TSCState Identity () -> StateT TSCState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TypeExpr -> Bool
isVariableType (TypeExpr -> Bool) -> TypeExpr -> Bool
forall a b. (a -> b) -> a -> b
$ TypeExpr -> TypeExpr
rootType TypeExpr
ty') (StateT TSCState Identity () -> StateT TSCState Identity ())
-> StateT TSCState Identity () -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ Message -> StateT TSCState Identity ()
report (Message -> StateT TSCState Identity ())
-> Message -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ Constraint -> Message
errIllegalConstraint Constraint
c
  Constraint -> StateT TSCState Identity Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> StateT TSCState Identity Constraint)
-> Constraint -> StateT TSCState Identity Constraint
forall a b. (a -> b) -> a -> b
$ SpanInfo -> QualIdent -> TypeExpr -> Constraint
Constraint SpanInfo
spi QualIdent
qcls TypeExpr
ty'
  where
    rootType :: TypeExpr -> TypeExpr
rootType (ApplyType _ ty' :: TypeExpr
ty' _) = TypeExpr
ty'
    rootType ty' :: TypeExpr
ty'                 = TypeExpr
ty'

checkClass :: Bool -> QualIdent -> TSCM ()
checkClass :: Bool -> QualIdent -> StateT TSCState Identity ()
checkClass isInstDecl :: Bool
isInstDecl qcls :: QualIdent
qcls = do
  ModuleIdent
m <- TSCM ModuleIdent
getModuleIdent
  TypeEnv
tEnv <- TSCM TypeEnv
getTypeEnv
  case QualIdent -> TypeEnv -> [TypeKind]
qualLookupTypeKind QualIdent
qcls TypeEnv
tEnv of
    [] -> Message -> StateT TSCState Identity ()
report (Message -> StateT TSCState Identity ())
-> Message -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ QualIdent -> Message
errUndefinedClass QualIdent
qcls
    [Class c :: QualIdent
c _]
      | QualIdent
c QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
qDataId -> Bool -> StateT TSCState Identity () -> StateT TSCState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isInstDecl Bool -> Bool -> Bool
&& ModuleIdent
m ModuleIdent -> ModuleIdent -> Bool
forall a. Eq a => a -> a -> Bool
/= ModuleIdent
preludeMIdent) (StateT TSCState Identity () -> StateT TSCState Identity ())
-> StateT TSCState Identity () -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ Message -> StateT TSCState Identity ()
report (Message -> StateT TSCState Identity ())
-> Message -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$
                          QualIdent -> Message
errIllegalDataInstance QualIdent
qcls
      | Bool
otherwise    -> StateT TSCState Identity ()
ok
    [_] -> Message -> StateT TSCState Identity ()
report (Message -> StateT TSCState Identity ())
-> Message -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ QualIdent -> Message
errUndefinedClass QualIdent
qcls
    tks :: [TypeKind]
tks -> case QualIdent -> TypeEnv -> [TypeKind]
qualLookupTypeKind (ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
qcls) TypeEnv
tEnv of
      [Class c :: QualIdent
c _]
        | QualIdent
c QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
qDataId -> Bool -> StateT TSCState Identity () -> StateT TSCState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isInstDecl Bool -> Bool -> Bool
&& ModuleIdent
m ModuleIdent -> ModuleIdent -> Bool
forall a. Eq a => a -> a -> Bool
/= ModuleIdent
preludeMIdent) (StateT TSCState Identity () -> StateT TSCState Identity ())
-> StateT TSCState Identity () -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ Message -> StateT TSCState Identity ()
report (Message -> StateT TSCState Identity ())
-> Message -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$
                            QualIdent -> Message
errIllegalDataInstance QualIdent
qcls
        | Bool
otherwise    -> StateT TSCState Identity ()
ok
      [_] -> Message -> StateT TSCState Identity ()
report (Message -> StateT TSCState Identity ())
-> Message -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ QualIdent -> Message
errUndefinedClass QualIdent
qcls
      _ -> Message -> StateT TSCState Identity ()
report (Message -> StateT TSCState Identity ())
-> Message -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ QualIdent -> [QualIdent] -> Message
errAmbiguousIdent QualIdent
qcls ([QualIdent] -> Message) -> [QualIdent] -> Message
forall a b. (a -> b) -> a -> b
$ (TypeKind -> QualIdent) -> [TypeKind] -> [QualIdent]
forall a b. (a -> b) -> [a] -> [b]
map TypeKind -> QualIdent
forall a. Entity a => a -> QualIdent
origName [TypeKind]
tks

checkClosedType :: [Ident] -> TypeExpr -> TSCM TypeExpr
checkClosedType :: [Ident] -> TypeExpr -> TSCM TypeExpr
checkClosedType tvs :: [Ident]
tvs ty :: TypeExpr
ty = do
  TypeExpr
ty' <- TypeExpr -> TSCM TypeExpr
checkType TypeExpr
ty
  [Ident] -> TypeExpr -> StateT TSCState Identity ()
checkClosed [Ident]
tvs TypeExpr
ty'
  TypeExpr -> TSCM TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
ty'

checkType :: TypeExpr -> TSCM TypeExpr
checkType :: TypeExpr -> TSCM TypeExpr
checkType c :: TypeExpr
c@(ConstructorType spi :: SpanInfo
spi tc :: QualIdent
tc) = do
  ModuleIdent
m <- TSCM ModuleIdent
getModuleIdent
  TypeEnv
tEnv <- TSCM TypeEnv
getTypeEnv
  case QualIdent -> TypeEnv -> [TypeKind]
qualLookupTypeKind QualIdent
tc TypeEnv
tEnv of
    []
      | QualIdent -> Bool
isQTupleId QualIdent
tc -> TypeExpr -> TSCM TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
c
      | Bool -> Bool
not (QualIdent -> Bool
isQualified QualIdent
tc) -> TypeExpr -> TSCM TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> TSCM TypeExpr) -> TypeExpr -> TSCM TypeExpr
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Ident -> TypeExpr
VariableType SpanInfo
spi (Ident -> TypeExpr) -> Ident -> TypeExpr
forall a b. (a -> b) -> a -> b
$ QualIdent -> Ident
unqualify QualIdent
tc
      | Bool
otherwise -> Message -> StateT TSCState Identity ()
report (QualIdent -> Message
errUndefinedType QualIdent
tc) StateT TSCState Identity () -> TSCM TypeExpr -> TSCM TypeExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> TSCM TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
c
    [Class _ _] -> Message -> StateT TSCState Identity ()
report (QualIdent -> Message
errUndefinedType QualIdent
tc) StateT TSCState Identity () -> TSCM TypeExpr -> TSCM TypeExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> TSCM TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
c
    [_] -> TypeExpr -> TSCM TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
c
    tks :: [TypeKind]
tks -> case QualIdent -> TypeEnv -> [TypeKind]
qualLookupTypeKind (ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
tc) TypeEnv
tEnv of
      [Class _ _] -> Message -> StateT TSCState Identity ()
report (QualIdent -> Message
errUndefinedType QualIdent
tc) StateT TSCState Identity () -> TSCM TypeExpr -> TSCM TypeExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> TSCM TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
c
      [_] -> TypeExpr -> TSCM TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
c
      _ -> Message -> StateT TSCState Identity ()
report (QualIdent -> [QualIdent] -> Message
errAmbiguousIdent QualIdent
tc ([QualIdent] -> Message) -> [QualIdent] -> Message
forall a b. (a -> b) -> a -> b
$ (TypeKind -> QualIdent) -> [TypeKind] -> [QualIdent]
forall a b. (a -> b) -> [a] -> [b]
map TypeKind -> QualIdent
forall a. Entity a => a -> QualIdent
origName [TypeKind]
tks) StateT TSCState Identity () -> TSCM TypeExpr -> TSCM TypeExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> TSCM TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
c
checkType (ApplyType spi :: SpanInfo
spi ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = SpanInfo -> TypeExpr -> TypeExpr -> TypeExpr
ApplyType SpanInfo
spi (TypeExpr -> TypeExpr -> TypeExpr)
-> TSCM TypeExpr -> StateT TSCState Identity (TypeExpr -> TypeExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> TSCM TypeExpr
checkType TypeExpr
ty1
                                                  StateT TSCState Identity (TypeExpr -> TypeExpr)
-> TSCM TypeExpr -> TSCM TypeExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExpr -> TSCM TypeExpr
checkType TypeExpr
ty2
checkType (VariableType spi :: SpanInfo
spi tv :: Ident
tv)
  | Ident -> Bool
isAnonId Ident
tv = (SpanInfo -> Ident -> TypeExpr
VariableType SpanInfo
spi (Ident -> TypeExpr) -> (Integer -> Ident) -> Integer -> TypeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Integer -> Ident
renameIdent Ident
tv) (Integer -> TypeExpr) -> TSCM Integer -> TSCM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TSCM Integer
newId
  | Bool
otherwise   = TypeExpr -> TSCM TypeExpr
checkType (TypeExpr -> TSCM TypeExpr) -> TypeExpr -> TSCM TypeExpr
forall a b. (a -> b) -> a -> b
$ SpanInfo -> QualIdent -> TypeExpr
ConstructorType SpanInfo
spi (Ident -> QualIdent
qualify Ident
tv)
checkType (TupleType     spi :: SpanInfo
spi tys :: [TypeExpr]
tys) = SpanInfo -> [TypeExpr] -> TypeExpr
TupleType  SpanInfo
spi    ([TypeExpr] -> TypeExpr)
-> StateT TSCState Identity [TypeExpr] -> TSCM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeExpr -> TSCM TypeExpr)
-> [TypeExpr] -> StateT TSCState Identity [TypeExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TypeExpr -> TSCM TypeExpr
checkType [TypeExpr]
tys
checkType (ListType       spi :: SpanInfo
spi ty :: TypeExpr
ty) = SpanInfo -> TypeExpr -> TypeExpr
ListType   SpanInfo
spi    (TypeExpr -> TypeExpr) -> TSCM TypeExpr -> TSCM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> TSCM TypeExpr
checkType TypeExpr
ty
checkType (ArrowType spi :: SpanInfo
spi ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = SpanInfo -> TypeExpr -> TypeExpr -> TypeExpr
ArrowType  SpanInfo
spi    (TypeExpr -> TypeExpr -> TypeExpr)
-> TSCM TypeExpr -> StateT TSCState Identity (TypeExpr -> TypeExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> TSCM TypeExpr
checkType TypeExpr
ty1
                                                      StateT TSCState Identity (TypeExpr -> TypeExpr)
-> TSCM TypeExpr -> TSCM TypeExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExpr -> TSCM TypeExpr
checkType TypeExpr
ty2
checkType (ParenType      spi :: SpanInfo
spi ty :: TypeExpr
ty) = SpanInfo -> TypeExpr -> TypeExpr
ParenType  SpanInfo
spi    (TypeExpr -> TypeExpr) -> TSCM TypeExpr -> TSCM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> TSCM TypeExpr
checkType TypeExpr
ty
checkType (ForallType  spi :: SpanInfo
spi vs :: [Ident]
vs ty :: TypeExpr
ty) = SpanInfo -> [Ident] -> TypeExpr -> TypeExpr
ForallType SpanInfo
spi [Ident]
vs (TypeExpr -> TypeExpr) -> TSCM TypeExpr -> TSCM TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> TSCM TypeExpr
checkType TypeExpr
ty

checkClosed :: [Ident] -> TypeExpr -> TSCM ()
checkClosed :: [Ident] -> TypeExpr -> StateT TSCState Identity ()
checkClosed _   (ConstructorType _ _) = StateT TSCState Identity ()
ok
checkClosed tvs :: [Ident]
tvs (ApplyType _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = (TypeExpr -> StateT TSCState Identity ())
-> [TypeExpr] -> StateT TSCState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Ident] -> TypeExpr -> StateT TSCState Identity ()
checkClosed [Ident]
tvs) [TypeExpr
ty1, TypeExpr
ty2]
checkClosed tvs :: [Ident]
tvs (VariableType   _ tv :: Ident
tv) =
  Bool -> StateT TSCState Identity () -> StateT TSCState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ident -> Bool
isAnonId Ident
tv Bool -> Bool -> Bool
|| Ident
tv Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Ident]
tvs) (StateT TSCState Identity () -> StateT TSCState Identity ())
-> StateT TSCState Identity () -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ Message -> StateT TSCState Identity ()
report (Message -> StateT TSCState Identity ())
-> Message -> StateT TSCState Identity ()
forall a b. (a -> b) -> a -> b
$ Ident -> Message
errUnboundVariable Ident
tv
checkClosed tvs :: [Ident]
tvs (TupleType     _ tys :: [TypeExpr]
tys) = (TypeExpr -> StateT TSCState Identity ())
-> [TypeExpr] -> StateT TSCState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Ident] -> TypeExpr -> StateT TSCState Identity ()
checkClosed [Ident]
tvs) [TypeExpr]
tys
checkClosed tvs :: [Ident]
tvs (ListType       _ ty :: TypeExpr
ty) = [Ident] -> TypeExpr -> StateT TSCState Identity ()
checkClosed [Ident]
tvs TypeExpr
ty
checkClosed tvs :: [Ident]
tvs (ArrowType _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = (TypeExpr -> StateT TSCState Identity ())
-> [TypeExpr] -> StateT TSCState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Ident] -> TypeExpr -> StateT TSCState Identity ()
checkClosed [Ident]
tvs) [TypeExpr
ty1, TypeExpr
ty2]
checkClosed tvs :: [Ident]
tvs (ParenType      _ ty :: TypeExpr
ty) = [Ident] -> TypeExpr -> StateT TSCState Identity ()
checkClosed [Ident]
tvs TypeExpr
ty
checkClosed tvs :: [Ident]
tvs (ForallType  _ vs :: [Ident]
vs ty :: TypeExpr
ty) = [Ident] -> TypeExpr -> StateT TSCState Identity ()
checkClosed ([Ident]
tvs [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ [Ident]
vs) TypeExpr
ty

-- ---------------------------------------------------------------------------
-- Auxiliary definitions
-- ---------------------------------------------------------------------------

getIdent :: Decl a -> Ident
getIdent :: Decl a -> Ident
getIdent (DataDecl     _ tc :: Ident
tc _ _ _) = Ident
tc
getIdent (ExternalDataDecl _ tc :: Ident
tc _) = Ident
tc
getIdent (NewtypeDecl _ tc :: Ident
tc _ _ _)  = Ident
tc
getIdent (TypeDecl _ tc :: Ident
tc _ _)       = Ident
tc
getIdent (ClassDecl _ _ _ cls :: Ident
cls _ _) = Ident
cls
getIdent _                         = String -> Ident
forall a. String -> a
internalError
  "Checks.TypeSyntaxCheck.getIdent: no type or class declaration"

isTypeSyn :: QualIdent -> TypeEnv -> Bool
isTypeSyn :: QualIdent -> TypeEnv -> Bool
isTypeSyn tc :: QualIdent
tc tEnv :: TypeEnv
tEnv = case QualIdent -> TypeEnv -> [TypeKind]
qualLookupTypeKind QualIdent
tc TypeEnv
tEnv of
  [Alias _] -> Bool
True
  _ -> Bool
False

-- ---------------------------------------------------------------------------
-- Error messages
-- ---------------------------------------------------------------------------

errMultipleDefaultDeclarations :: [SpanInfo] -> Message
errMultipleDefaultDeclarations :: [SpanInfo] -> Message
errMultipleDefaultDeclarations spis :: [SpanInfo]
spis = SpanInfo -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage ([SpanInfo] -> SpanInfo
forall a. [a] -> a
head [SpanInfo]
spis) (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$
  String -> Doc
text "More than one default declaration:" Doc -> Doc -> Doc
$+$
    Int -> Doc -> Doc
nest 2 ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (SpanInfo -> Doc) -> [SpanInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SpanInfo -> Doc
showPos [SpanInfo]
spis)
  where showPos :: SpanInfo -> Doc
showPos = String -> Doc
text (String -> Doc) -> (SpanInfo -> String) -> SpanInfo -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> String
showLine (Position -> String)
-> (SpanInfo -> Position) -> SpanInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanInfo -> Position
forall a. HasPosition a => a -> Position
getPosition

errMultipleDeclarations :: [Ident] -> Message
errMultipleDeclarations :: [Ident] -> Message
errMultipleDeclarations is :: [Ident]
is = Ident -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage Ident
i (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$
  String -> Doc
text "Multiple declarations of" Doc -> Doc -> Doc
<+> String -> Doc
text (Ident -> String
escName Ident
i) Doc -> Doc -> Doc
<+> String -> Doc
text "at:" Doc -> Doc -> Doc
$+$
    Int -> Doc -> Doc
nest 2 ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
showPos [Ident]
is)
  where i :: Ident
i = [Ident] -> Ident
forall a. [a] -> a
head [Ident]
is
        showPos :: Ident -> Doc
showPos = String -> Doc
text (String -> Doc) -> (Ident -> String) -> Ident -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> String
showLine (Position -> String) -> (Ident -> Position) -> Ident -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Position
forall a. HasPosition a => a -> Position
getPosition

errUndefined :: String -> QualIdent -> Message
errUndefined :: String -> QualIdent -> Message
errUndefined what :: String
what qident :: QualIdent
qident = QualIdent -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage QualIdent
qident (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
  ["Undefined", String
what, QualIdent -> String
qualName QualIdent
qident]

errUndefinedClass :: QualIdent -> Message
errUndefinedClass :: QualIdent -> Message
errUndefinedClass = String -> QualIdent -> Message
errUndefined "class"

errUndefinedType :: QualIdent -> Message
errUndefinedType :: QualIdent -> Message
errUndefinedType = String -> QualIdent -> Message
errUndefined "type"

errAmbiguousIdent :: QualIdent -> [QualIdent] -> Message
errAmbiguousIdent :: QualIdent -> [QualIdent] -> Message
errAmbiguousIdent qident :: QualIdent
qident qidents :: [QualIdent]
qidents = QualIdent -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage QualIdent
qident (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$
  String -> Doc
text "Ambiguous identifier" Doc -> Doc -> Doc
<+> String -> Doc
text (QualIdent -> String
escQualName QualIdent
qident) Doc -> Doc -> Doc
$+$
    String -> Doc
text "It could refer to:" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest 2 ([Doc] -> Doc
vcat ((QualIdent -> Doc) -> [QualIdent] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> (QualIdent -> String) -> QualIdent -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualIdent -> String
qualName) [QualIdent]
qidents))

errAmbiguousType :: SpanInfo -> Ident -> Message
errAmbiguousType :: SpanInfo -> Ident -> Message
errAmbiguousType spi :: SpanInfo
spi ident :: Ident
ident = SpanInfo -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage SpanInfo
spi (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
  [ "Method type does not mention class variable", Ident -> String
idName Ident
ident ]

errConstrainedClassVariable :: SpanInfo -> Ident -> Message
errConstrainedClassVariable :: SpanInfo -> Ident -> Message
errConstrainedClassVariable spi :: SpanInfo
spi ident :: Ident
ident = SpanInfo -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage SpanInfo
spi (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
  [ "Method context must not constrain class variable", Ident -> String
idName Ident
ident ]

errNonLinear :: Ident -> String -> Message
errNonLinear :: Ident -> String -> Message
errNonLinear tv :: Ident
tv what :: String
what = Ident -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage Ident
tv (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
  [ "Type variable", Ident -> String
idName Ident
tv, "occurs more than once in", String
what ]

errNoVariable :: Ident -> String -> Message
errNoVariable :: Ident -> String -> Message
errNoVariable tv :: Ident
tv what :: String
what = Ident -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage Ident
tv (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
  ["Type constructor or type class identifier", Ident -> String
idName Ident
tv, "used in", String
what]

errUnboundVariable :: Ident -> Message
errUnboundVariable :: Ident -> Message
errUnboundVariable tv :: Ident
tv = Ident -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage Ident
tv (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
  [ "Unbound type variable", Ident -> String
idName Ident
tv ]

errIllegalConstraint :: Constraint -> Message
errIllegalConstraint :: Constraint -> Message
errIllegalConstraint c :: Constraint
c@(Constraint _ qcls :: QualIdent
qcls _) = QualIdent -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage QualIdent
qcls (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
  [ String -> Doc
text "Illegal class constraint" Doc -> Doc -> Doc
<+> Constraint -> Doc
forall a. Pretty a => a -> Doc
pPrint Constraint
c
  , String -> Doc
text "Constraints must be of the form C u or C (u t1 ... tn),"
  , String -> Doc
text "where C is a type class, u is a type variable and t1, ..., tn are types."
  ]

errIllegalSimpleConstraint :: Constraint -> Message
errIllegalSimpleConstraint :: Constraint -> Message
errIllegalSimpleConstraint c :: Constraint
c@(Constraint _ qcls :: QualIdent
qcls _) = QualIdent -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage QualIdent
qcls (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
  [ String -> Doc
text "Illegal class constraint" Doc -> Doc -> Doc
<+> Constraint -> Doc
forall a. Pretty a => a -> Doc
pPrint Constraint
c
  , String -> Doc
text "Constraints in class and instance declarations must be of"
  , String -> Doc
text "the form C u, where C is a type class and u is a type variable."
  ]

errIllegalInstanceType :: SpanInfo -> InstanceType -> Message
errIllegalInstanceType :: SpanInfo -> TypeExpr -> Message
errIllegalInstanceType spi :: SpanInfo
spi inst :: TypeExpr
inst = SpanInfo -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage SpanInfo
spi (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
  [ String -> Doc
text "Illegal instance type" Doc -> Doc -> Doc
<+> TypeExpr -> Doc
ppInstanceType TypeExpr
inst
  , String -> Doc
text "The instance type must be of the form (T u_1 ... u_n),"
  , String -> Doc
text "where T is not a type synonym and u_1, ..., u_n are"
  , String -> Doc
text "mutually distinct, non-anonymous type variables."
  ]

errIllegalDataInstance :: QualIdent -> Message
errIllegalDataInstance :: QualIdent -> Message
errIllegalDataInstance qcls :: QualIdent
qcls = QualIdent -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage QualIdent
qcls (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
  [ String -> Doc
text "Illegal instance of" Doc -> Doc -> Doc
<+> QualIdent -> Doc
ppQIdent QualIdent
qcls
  , String -> Doc
text "Instances of this class cannot be defined."
  , String -> Doc
text "Instead, they are automatically derived if possible."
  ]