module Checks.InterfaceSyntaxCheck (intfSyntaxCheck) where
import Control.Monad (liftM, liftM2, unless, when)
import qualified Control.Monad.State as S
import Data.List (nub, partition)
import Data.Maybe (isNothing)
import Base.Expr
import Base.Messages (Message, spanInfoMessage, internalError)
import Base.TopEnv
import Base.Utils (findMultiples, findDouble)
import Env.TypeConstructor
import Env.Type
import Curry.Base.Ident
import Curry.Base.SpanInfo
import Curry.Base.Pretty
import Curry.Syntax
data ISCState = ISCState
{ ISCState -> TypeEnv
typeEnv :: TypeEnv
, ISCState -> [Message]
errors :: [Message]
}
type ISC = S.State ISCState
getTypeEnv :: ISC TypeEnv
getTypeEnv :: ISC TypeEnv
getTypeEnv = (ISCState -> TypeEnv) -> ISC TypeEnv
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets ISCState -> TypeEnv
typeEnv
report :: Message -> ISC ()
report :: Message -> ISC ()
report msg :: Message
msg = (ISCState -> ISCState) -> ISC ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((ISCState -> ISCState) -> ISC ())
-> (ISCState -> ISCState) -> ISC ()
forall a b. (a -> b) -> a -> b
$ \ s :: ISCState
s -> ISCState
s { errors :: [Message]
errors = Message
msg Message -> [Message] -> [Message]
forall a. a -> [a] -> [a]
: ISCState -> [Message]
errors ISCState
s }
intfSyntaxCheck :: Interface -> (Interface, [Message])
intfSyntaxCheck :: Interface -> (Interface, [Message])
intfSyntaxCheck (Interface n :: ModuleIdent
n is :: [IImportDecl]
is ds :: [IDecl]
ds) = (ModuleIdent -> [IImportDecl] -> [IDecl] -> Interface
Interface ModuleIdent
n [IImportDecl]
is [IDecl]
ds', [Message] -> [Message]
forall a. [a] -> [a]
reverse ([Message] -> [Message]) -> [Message] -> [Message]
forall a b. (a -> b) -> a -> b
$ ISCState -> [Message]
errors ISCState
s')
where (ds' :: [IDecl]
ds', s' :: ISCState
s') = State ISCState [IDecl] -> ISCState -> ([IDecl], ISCState)
forall s a. State s a -> s -> (a, s)
S.runState ((IDecl -> StateT ISCState Identity IDecl)
-> [IDecl] -> State ISCState [IDecl]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IDecl -> StateT ISCState Identity IDecl
checkIDecl [IDecl]
ds) (TypeEnv -> [Message] -> ISCState
ISCState TypeEnv
env [])
env :: TypeEnv
env = (IDecl -> TypeEnv -> TypeEnv) -> TypeEnv -> [IDecl] -> TypeEnv
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IDecl -> TypeEnv -> TypeEnv
bindType ((TypeInfo -> TypeKind) -> TopEnv TypeInfo -> TypeEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeInfo -> TypeKind
toTypeKind TopEnv TypeInfo
initTCEnv) [IDecl]
ds
bindType :: IDecl -> TypeEnv -> TypeEnv
bindType :: IDecl -> TypeEnv -> TypeEnv
bindType (IInfixDecl _ _ _ _) = TypeEnv -> TypeEnv
forall a. a -> a
id
bindType (HidingDataDecl _ tc :: QualIdent
tc _ _) = QualIdent -> TypeKind -> TypeEnv -> TypeEnv
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualBindTopEnv QualIdent
tc (QualIdent -> [Ident] -> TypeKind
Data QualIdent
tc [])
bindType (IDataDecl _ tc :: QualIdent
tc _ _ cs :: [ConstrDecl]
cs _) =
QualIdent -> TypeKind -> TypeEnv -> TypeEnv
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualBindTopEnv QualIdent
tc (QualIdent -> [Ident] -> TypeKind
Data QualIdent
tc ((ConstrDecl -> Ident) -> [ConstrDecl] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map ConstrDecl -> Ident
constrId [ConstrDecl]
cs))
bindType (INewtypeDecl _ tc :: QualIdent
tc _ _ nc :: NewConstrDecl
nc _) =
QualIdent -> TypeKind -> TypeEnv -> TypeEnv
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualBindTopEnv QualIdent
tc (QualIdent -> [Ident] -> TypeKind
Data QualIdent
tc [NewConstrDecl -> Ident
nconstrId NewConstrDecl
nc])
bindType (ITypeDecl _ tc :: QualIdent
tc _ _ _) = QualIdent -> TypeKind -> TypeEnv -> TypeEnv
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualBindTopEnv QualIdent
tc (QualIdent -> TypeKind
Alias QualIdent
tc)
bindType (IFunctionDecl _ _ _ _ _) = TypeEnv -> TypeEnv
forall a. a -> a
id
bindType (HidingClassDecl _ _ cls :: QualIdent
cls _ _) = QualIdent -> TypeKind -> TypeEnv -> TypeEnv
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualBindTopEnv QualIdent
cls (QualIdent -> [Ident] -> TypeKind
Class QualIdent
cls [])
bindType (IClassDecl _ _ cls :: QualIdent
cls _ _ ms :: [IMethodDecl]
ms hs :: [Ident]
hs) =
QualIdent -> TypeKind -> TypeEnv -> TypeEnv
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualBindTopEnv QualIdent
cls (QualIdent -> [Ident] -> TypeKind
Class QualIdent
cls ((Ident -> Bool) -> [Ident] -> [Ident]
forall a. (a -> Bool) -> [a] -> [a]
filter (Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Ident]
hs) ((IMethodDecl -> Ident) -> [IMethodDecl] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map IMethodDecl -> Ident
imethod [IMethodDecl]
ms)))
bindType (IInstanceDecl _ _ _ _ _ _) = TypeEnv -> TypeEnv
forall a. a -> a
id
checkIDecl :: IDecl -> ISC IDecl
checkIDecl :: IDecl -> StateT ISCState Identity IDecl
checkIDecl (IInfixDecl p :: Position
p fix :: Infix
fix pr :: Precedence
pr op :: QualIdent
op) = IDecl -> StateT ISCState Identity IDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (Position -> Infix -> Precedence -> QualIdent -> IDecl
IInfixDecl Position
p Infix
fix Precedence
pr QualIdent
op)
checkIDecl (HidingDataDecl p :: Position
p tc :: QualIdent
tc k :: Maybe KindExpr
k tvs :: [Ident]
tvs) = do
[Ident] -> ISC ()
checkTypeLhs [Ident]
tvs
IDecl -> StateT ISCState Identity IDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (Position -> QualIdent -> Maybe KindExpr -> [Ident] -> IDecl
HidingDataDecl Position
p QualIdent
tc Maybe KindExpr
k [Ident]
tvs)
checkIDecl (IDataDecl p :: Position
p tc :: QualIdent
tc k :: Maybe KindExpr
k tvs :: [Ident]
tvs cs :: [ConstrDecl]
cs hs :: [Ident]
hs) = do
[Ident] -> ISC ()
checkTypeLhs [Ident]
tvs
QualIdent -> [Ident] -> [Ident] -> ISC ()
checkHiddenType QualIdent
tc ([Ident]
cons [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ [Ident]
labels) [Ident]
hs
[ConstrDecl]
cs' <- (ConstrDecl -> StateT ISCState Identity ConstrDecl)
-> [ConstrDecl] -> StateT ISCState Identity [ConstrDecl]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Ident] -> ConstrDecl -> StateT ISCState Identity ConstrDecl
checkConstrDecl [Ident]
tvs) [ConstrDecl]
cs
IDecl -> StateT ISCState Identity IDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IDecl -> StateT ISCState Identity IDecl)
-> IDecl -> StateT ISCState Identity IDecl
forall a b. (a -> b) -> a -> b
$ Position
-> QualIdent
-> Maybe KindExpr
-> [Ident]
-> [ConstrDecl]
-> [Ident]
-> IDecl
IDataDecl Position
p QualIdent
tc Maybe KindExpr
k [Ident]
tvs [ConstrDecl]
cs' [Ident]
hs
where cons :: [Ident]
cons = (ConstrDecl -> Ident) -> [ConstrDecl] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map ConstrDecl -> Ident
constrId [ConstrDecl]
cs
labels :: [Ident]
labels = [Ident] -> [Ident]
forall a. Eq a => [a] -> [a]
nub ([Ident] -> [Ident]) -> [Ident] -> [Ident]
forall a b. (a -> b) -> a -> b
$ (ConstrDecl -> [Ident]) -> [ConstrDecl] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConstrDecl -> [Ident]
recordLabels [ConstrDecl]
cs
checkIDecl (INewtypeDecl p :: Position
p tc :: QualIdent
tc k :: Maybe KindExpr
k tvs :: [Ident]
tvs nc :: NewConstrDecl
nc hs :: [Ident]
hs) = do
[Ident] -> ISC ()
checkTypeLhs [Ident]
tvs
QualIdent -> [Ident] -> [Ident] -> ISC ()
checkHiddenType QualIdent
tc (Ident
con Ident -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
: [Ident]
labels) [Ident]
hs
NewConstrDecl
nc' <- [Ident] -> NewConstrDecl -> ISC NewConstrDecl
checkNewConstrDecl [Ident]
tvs NewConstrDecl
nc
IDecl -> StateT ISCState Identity IDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IDecl -> StateT ISCState Identity IDecl)
-> IDecl -> StateT ISCState Identity IDecl
forall a b. (a -> b) -> a -> b
$ Position
-> QualIdent
-> Maybe KindExpr
-> [Ident]
-> NewConstrDecl
-> [Ident]
-> IDecl
INewtypeDecl Position
p QualIdent
tc Maybe KindExpr
k [Ident]
tvs NewConstrDecl
nc' [Ident]
hs
where con :: Ident
con = NewConstrDecl -> Ident
nconstrId NewConstrDecl
nc
labels :: [Ident]
labels = NewConstrDecl -> [Ident]
nrecordLabels NewConstrDecl
nc
checkIDecl (ITypeDecl p :: Position
p tc :: QualIdent
tc k :: Maybe KindExpr
k tvs :: [Ident]
tvs ty :: TypeExpr
ty) = do
[Ident] -> ISC ()
checkTypeLhs [Ident]
tvs
(TypeExpr -> IDecl)
-> StateT ISCState Identity TypeExpr
-> StateT ISCState Identity IDecl
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Position
-> QualIdent -> Maybe KindExpr -> [Ident] -> TypeExpr -> IDecl
ITypeDecl Position
p QualIdent
tc Maybe KindExpr
k [Ident]
tvs) ([Ident] -> TypeExpr -> StateT ISCState Identity TypeExpr
checkClosedType [Ident]
tvs TypeExpr
ty)
checkIDecl (IFunctionDecl p :: Position
p f :: QualIdent
f cm :: Maybe Ident
cm n :: Arity
n qty :: QualTypeExpr
qty) =
(QualTypeExpr -> IDecl)
-> StateT ISCState Identity QualTypeExpr
-> StateT ISCState Identity IDecl
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Position
-> QualIdent -> Maybe Ident -> Arity -> QualTypeExpr -> IDecl
IFunctionDecl Position
p QualIdent
f Maybe Ident
cm Arity
n) (QualTypeExpr -> StateT ISCState Identity QualTypeExpr
checkQualType QualTypeExpr
qty)
checkIDecl (HidingClassDecl p :: Position
p cx :: Context
cx qcls :: QualIdent
qcls k :: Maybe KindExpr
k clsvar :: Ident
clsvar) = do
String -> [Ident] -> ISC ()
checkTypeVars "hiding class declaration" [Ident
clsvar]
Context
cx' <- [Ident] -> Context -> ISC Context
checkClosedContext [Ident
clsvar] Context
cx
Context -> ISC ()
checkSimpleContext Context
cx'
IDecl -> StateT ISCState Identity IDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IDecl -> StateT ISCState Identity IDecl)
-> IDecl -> StateT ISCState Identity IDecl
forall a b. (a -> b) -> a -> b
$ Position
-> Context -> QualIdent -> Maybe KindExpr -> Ident -> IDecl
HidingClassDecl Position
p Context
cx' QualIdent
qcls Maybe KindExpr
k Ident
clsvar
checkIDecl (IClassDecl p :: Position
p cx :: Context
cx qcls :: QualIdent
qcls k :: Maybe KindExpr
k clsvar :: Ident
clsvar ms :: [IMethodDecl]
ms hs :: [Ident]
hs) = do
String -> [Ident] -> ISC ()
checkTypeVars "class declaration" [Ident
clsvar]
Context
cx' <- [Ident] -> Context -> ISC Context
checkClosedContext [Ident
clsvar] Context
cx
Context -> ISC ()
checkSimpleContext Context
cx'
[IMethodDecl]
ms' <- (IMethodDecl -> StateT ISCState Identity IMethodDecl)
-> [IMethodDecl] -> StateT ISCState Identity [IMethodDecl]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ident -> IMethodDecl -> StateT ISCState Identity IMethodDecl
checkIMethodDecl Ident
clsvar) [IMethodDecl]
ms
(QualIdent -> Ident -> Message)
-> QualIdent -> [Ident] -> [Ident] -> ISC ()
checkHidden (String -> String -> QualIdent -> Ident -> Message
errNoElement "method" "class") QualIdent
qcls ((IMethodDecl -> Ident) -> [IMethodDecl] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map IMethodDecl -> Ident
imethod [IMethodDecl]
ms') [Ident]
hs
IDecl -> StateT ISCState Identity IDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IDecl -> StateT ISCState Identity IDecl)
-> IDecl -> StateT ISCState Identity IDecl
forall a b. (a -> b) -> a -> b
$ Position
-> Context
-> QualIdent
-> Maybe KindExpr
-> Ident
-> [IMethodDecl]
-> [Ident]
-> IDecl
IClassDecl Position
p Context
cx' QualIdent
qcls Maybe KindExpr
k Ident
clsvar [IMethodDecl]
ms' [Ident]
hs
checkIDecl (IInstanceDecl p :: Position
p cx :: Context
cx qcls :: QualIdent
qcls inst :: TypeExpr
inst is :: [IMethodImpl]
is m :: Maybe ModuleIdent
m) = do
QualIdent -> ISC ()
checkClass QualIdent
qcls
QualTypeExpr _ cx' :: Context
cx' inst' :: TypeExpr
inst' <- QualTypeExpr -> StateT ISCState Identity QualTypeExpr
checkQualType (QualTypeExpr -> StateT ISCState Identity QualTypeExpr)
-> QualTypeExpr -> StateT ISCState Identity QualTypeExpr
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Context -> TypeExpr -> QualTypeExpr
QualTypeExpr SpanInfo
NoSpanInfo Context
cx TypeExpr
inst
Context -> ISC ()
checkSimpleContext Context
cx'
TypeExpr -> ISC ()
checkInstanceType TypeExpr
inst'
([Ident] -> ISC ()) -> [[Ident]] -> ISC ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Message -> ISC ()
report (Message -> ISC ()) -> ([Ident] -> Message) -> [Ident] -> ISC ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Message
errMultipleImplementation (Ident -> Message) -> ([Ident] -> Ident) -> [Ident] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> Ident
forall a. [a] -> a
head) ([[Ident]] -> ISC ()) -> [[Ident]] -> ISC ()
forall a b. (a -> b) -> a -> b
$ [Ident] -> [[Ident]]
forall a. Eq a => [a] -> [[a]]
findMultiples ([Ident] -> [[Ident]]) -> [Ident] -> [[Ident]]
forall a b. (a -> b) -> a -> b
$ (IMethodImpl -> Ident) -> [IMethodImpl] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map IMethodImpl -> Ident
forall a b. (a, b) -> a
fst [IMethodImpl]
is
IDecl -> StateT ISCState Identity IDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IDecl -> StateT ISCState Identity IDecl)
-> IDecl -> StateT ISCState Identity IDecl
forall a b. (a -> b) -> a -> b
$ Position
-> Context
-> QualIdent
-> TypeExpr
-> [IMethodImpl]
-> Maybe ModuleIdent
-> IDecl
IInstanceDecl Position
p Context
cx' QualIdent
qcls TypeExpr
inst' [IMethodImpl]
is Maybe ModuleIdent
m
checkHiddenType :: QualIdent -> [Ident] -> [Ident] -> ISC ()
checkHiddenType :: QualIdent -> [Ident] -> [Ident] -> ISC ()
checkHiddenType = (QualIdent -> Ident -> Message)
-> QualIdent -> [Ident] -> [Ident] -> ISC ()
checkHidden ((QualIdent -> Ident -> Message)
-> QualIdent -> [Ident] -> [Ident] -> ISC ())
-> (QualIdent -> Ident -> Message)
-> QualIdent
-> [Ident]
-> [Ident]
-> ISC ()
forall a b. (a -> b) -> a -> b
$ String -> String -> QualIdent -> Ident -> Message
errNoElement "constructor or label" "type"
checkHidden :: (QualIdent -> Ident -> Message) -> QualIdent -> [Ident]
-> [Ident] -> ISC ()
checkHidden :: (QualIdent -> Ident -> Message)
-> QualIdent -> [Ident] -> [Ident] -> ISC ()
checkHidden err :: QualIdent -> Ident -> Message
err tc :: QualIdent
tc csls :: [Ident]
csls hs :: [Ident]
hs =
(Ident -> ISC ()) -> [Ident] -> ISC ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Message -> ISC ()
report (Message -> ISC ()) -> (Ident -> Message) -> Ident -> ISC ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualIdent -> Ident -> Message
err QualIdent
tc) ([Ident] -> ISC ()) -> [Ident] -> ISC ()
forall a b. (a -> b) -> a -> b
$ [Ident] -> [Ident]
forall a. Eq a => [a] -> [a]
nub ([Ident] -> [Ident]) -> [Ident] -> [Ident]
forall a b. (a -> b) -> a -> b
$ (Ident -> Bool) -> [Ident] -> [Ident]
forall a. (a -> Bool) -> [a] -> [a]
filter (Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Ident]
csls) [Ident]
hs
checkTypeLhs :: [Ident] -> ISC ()
checkTypeLhs :: [Ident] -> ISC ()
checkTypeLhs = String -> [Ident] -> ISC ()
checkTypeVars "left hand side of type declaration"
checkTypeVars :: String -> [Ident] -> ISC ()
checkTypeVars :: String -> [Ident] -> ISC ()
checkTypeVars what :: String
what tvs :: [Ident]
tvs = do
TypeEnv
tyEnv <- ISC TypeEnv
getTypeEnv
let (tcs :: [Ident]
tcs, tvs' :: [Ident]
tvs') = (Ident -> Bool) -> [Ident] -> ([Ident], [Ident])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Ident -> Bool
isTypeConstrOrClass [Ident]
tvs
isTypeConstrOrClass :: Ident -> Bool
isTypeConstrOrClass tv :: Ident
tv = Bool -> Bool
not ([TypeKind] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Ident -> TypeEnv -> [TypeKind]
lookupTypeKind Ident
tv TypeEnv
tyEnv))
(Ident -> ISC ()) -> [Ident] -> ISC ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Message -> ISC ()
report (Message -> ISC ()) -> (Ident -> Message) -> Ident -> ISC ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ident -> String -> Message) -> String -> Ident -> Message
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ident -> String -> Message
errNoVariable String
what) ([Ident] -> [Ident]
forall a. Eq a => [a] -> [a]
nub [Ident]
tcs)
([Ident] -> ISC ()) -> [[Ident]] -> ISC ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Message -> ISC ()
report (Message -> ISC ()) -> ([Ident] -> Message) -> [Ident] -> ISC ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ident -> String -> Message) -> String -> Ident -> Message
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ident -> String -> Message
errNonLinear String
what (Ident -> Message) -> ([Ident] -> Ident) -> [Ident] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> Ident
forall a. [a] -> a
head) ([Ident] -> [[Ident]]
forall a. Eq a => [a] -> [[a]]
findMultiples [Ident]
tvs')
checkConstrDecl :: [Ident] -> ConstrDecl -> ISC ConstrDecl
checkConstrDecl :: [Ident] -> ConstrDecl -> StateT ISCState Identity ConstrDecl
checkConstrDecl tvs :: [Ident]
tvs (ConstrDecl p :: SpanInfo
p c :: Ident
c tys :: [TypeExpr]
tys) = do
([TypeExpr] -> ConstrDecl)
-> StateT ISCState Identity [TypeExpr]
-> StateT ISCState Identity ConstrDecl
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SpanInfo -> Ident -> [TypeExpr] -> ConstrDecl
ConstrDecl SpanInfo
p Ident
c) ((TypeExpr -> StateT ISCState Identity TypeExpr)
-> [TypeExpr] -> StateT ISCState Identity [TypeExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Ident] -> TypeExpr -> StateT ISCState Identity TypeExpr
checkClosedType [Ident]
tvs) [TypeExpr]
tys)
checkConstrDecl tvs :: [Ident]
tvs (ConOpDecl p :: SpanInfo
p ty1 :: TypeExpr
ty1 op :: Ident
op ty2 :: TypeExpr
ty2) = do
(TypeExpr -> TypeExpr -> ConstrDecl)
-> StateT ISCState Identity TypeExpr
-> StateT ISCState Identity TypeExpr
-> StateT ISCState Identity ConstrDecl
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\t1 :: TypeExpr
t1 t2 :: TypeExpr
t2 -> SpanInfo -> TypeExpr -> Ident -> TypeExpr -> ConstrDecl
ConOpDecl SpanInfo
p TypeExpr
t1 Ident
op TypeExpr
t2)
([Ident] -> TypeExpr -> StateT ISCState Identity TypeExpr
checkClosedType [Ident]
tvs TypeExpr
ty1)
([Ident] -> TypeExpr -> StateT ISCState Identity TypeExpr
checkClosedType [Ident]
tvs TypeExpr
ty2)
checkConstrDecl tvs :: [Ident]
tvs (RecordDecl p :: SpanInfo
p c :: Ident
c fs :: [FieldDecl]
fs) = do
([FieldDecl] -> ConstrDecl)
-> StateT ISCState Identity [FieldDecl]
-> StateT ISCState Identity ConstrDecl
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SpanInfo -> Ident -> [FieldDecl] -> ConstrDecl
RecordDecl SpanInfo
p Ident
c) ((FieldDecl -> StateT ISCState Identity FieldDecl)
-> [FieldDecl] -> StateT ISCState Identity [FieldDecl]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Ident] -> FieldDecl -> StateT ISCState Identity FieldDecl
checkFieldDecl [Ident]
tvs) [FieldDecl]
fs)
checkFieldDecl :: [Ident] -> FieldDecl -> ISC FieldDecl
checkFieldDecl :: [Ident] -> FieldDecl -> StateT ISCState Identity FieldDecl
checkFieldDecl tvs :: [Ident]
tvs (FieldDecl p :: SpanInfo
p ls :: [Ident]
ls ty :: TypeExpr
ty) =
(TypeExpr -> FieldDecl)
-> StateT ISCState Identity TypeExpr
-> StateT ISCState Identity FieldDecl
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SpanInfo -> [Ident] -> TypeExpr -> FieldDecl
FieldDecl SpanInfo
p [Ident]
ls) ([Ident] -> TypeExpr -> StateT ISCState Identity TypeExpr
checkClosedType [Ident]
tvs TypeExpr
ty)
checkNewConstrDecl :: [Ident] -> NewConstrDecl -> ISC NewConstrDecl
checkNewConstrDecl :: [Ident] -> NewConstrDecl -> ISC NewConstrDecl
checkNewConstrDecl tvs :: [Ident]
tvs (NewConstrDecl p :: SpanInfo
p c :: Ident
c ty :: TypeExpr
ty) =
(TypeExpr -> NewConstrDecl)
-> StateT ISCState Identity TypeExpr -> ISC NewConstrDecl
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SpanInfo -> Ident -> TypeExpr -> NewConstrDecl
NewConstrDecl SpanInfo
p Ident
c) ([Ident] -> TypeExpr -> StateT ISCState Identity TypeExpr
checkClosedType [Ident]
tvs TypeExpr
ty)
checkNewConstrDecl tvs :: [Ident]
tvs (NewRecordDecl p :: SpanInfo
p c :: Ident
c (l :: Ident
l, ty :: TypeExpr
ty)) = do
TypeExpr
ty' <- [Ident] -> TypeExpr -> StateT ISCState Identity TypeExpr
checkClosedType [Ident]
tvs TypeExpr
ty
NewConstrDecl -> ISC NewConstrDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (NewConstrDecl -> ISC NewConstrDecl)
-> NewConstrDecl -> ISC NewConstrDecl
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Ident -> (Ident, TypeExpr) -> NewConstrDecl
NewRecordDecl SpanInfo
p Ident
c (Ident
l, TypeExpr
ty')
checkSimpleContext :: Context -> ISC ()
checkSimpleContext :: Context -> ISC ()
checkSimpleContext = (Constraint -> ISC ()) -> Context -> ISC ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Constraint -> ISC ()
checkSimpleConstraint
checkSimpleConstraint :: Constraint -> ISC ()
checkSimpleConstraint :: Constraint -> ISC ()
checkSimpleConstraint c :: Constraint
c@(Constraint _ _ ty :: TypeExpr
ty) =
Bool -> ISC () -> ISC ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TypeExpr -> Bool
isVariableType TypeExpr
ty) (ISC () -> ISC ()) -> ISC () -> ISC ()
forall a b. (a -> b) -> a -> b
$ Message -> ISC ()
report (Message -> ISC ()) -> Message -> ISC ()
forall a b. (a -> b) -> a -> b
$ Constraint -> Message
errIllegalSimpleConstraint Constraint
c
checkIMethodDecl :: Ident -> IMethodDecl -> ISC IMethodDecl
checkIMethodDecl :: Ident -> IMethodDecl -> StateT ISCState Identity IMethodDecl
checkIMethodDecl tv :: Ident
tv (IMethodDecl p :: Position
p f :: Ident
f a :: Maybe Arity
a qty :: QualTypeExpr
qty) = do
QualTypeExpr
qty' <- QualTypeExpr -> StateT ISCState Identity QualTypeExpr
checkQualType QualTypeExpr
qty
Bool -> ISC () -> ISC ()
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') (ISC () -> ISC ()) -> ISC () -> ISC ()
forall a b. (a -> b) -> a -> b
$ Message -> ISC ()
report (Message -> ISC ()) -> Message -> ISC ()
forall a b. (a -> b) -> a -> b
$ Ident -> Ident -> Message
forall s. HasSpanInfo s => s -> Ident -> Message
errAmbiguousType Ident
f Ident
tv
let QualTypeExpr _ cx :: Context
cx _ = QualTypeExpr
qty'
Bool -> ISC () -> ISC ()
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) (ISC () -> ISC ()) -> ISC () -> ISC ()
forall a b. (a -> b) -> a -> b
$ Message -> ISC ()
report (Message -> ISC ()) -> Message -> ISC ()
forall a b. (a -> b) -> a -> b
$ Ident -> Ident -> Message
forall s. HasSpanInfo s => s -> Ident -> Message
errConstrainedClassVariable Ident
f Ident
tv
IMethodDecl -> StateT ISCState Identity IMethodDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IMethodDecl -> StateT ISCState Identity IMethodDecl)
-> IMethodDecl -> StateT ISCState Identity IMethodDecl
forall a b. (a -> b) -> a -> b
$ Position -> Ident -> Maybe Arity -> QualTypeExpr -> IMethodDecl
IMethodDecl Position
p Ident
f Maybe Arity
a QualTypeExpr
qty'
checkInstanceType :: InstanceType -> ISC ()
checkInstanceType :: TypeExpr -> ISC ()
checkInstanceType inst :: TypeExpr
inst = do
TypeEnv
tEnv <- ISC TypeEnv
getTypeEnv
Bool -> ISC () -> ISC ()
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
&&
[Ident] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((Ident -> Bool) -> [Ident] -> [Ident]
forall a. (a -> Bool) -> [a] -> [a]
filter Ident -> Bool
isAnonId ([Ident] -> [Ident]) -> [Ident] -> [Ident]
forall a b. (a -> b) -> a -> b
$ TypeExpr -> [Ident]
typeVars 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)) (ISC () -> ISC ()) -> ISC () -> ISC ()
forall a b. (a -> b) -> a -> b
$
Message -> ISC ()
report (Message -> ISC ()) -> Message -> ISC ()
forall a b. (a -> b) -> a -> b
$ TypeExpr -> TypeExpr -> Message
forall s. HasSpanInfo s => s -> TypeExpr -> Message
errIllegalInstanceType TypeExpr
inst TypeExpr
inst
checkQualType :: QualTypeExpr -> ISC QualTypeExpr
checkQualType :: QualTypeExpr -> StateT ISCState Identity QualTypeExpr
checkQualType (QualTypeExpr spi :: SpanInfo
spi cx :: Context
cx ty :: TypeExpr
ty) = do
TypeExpr
ty' <- TypeExpr -> StateT ISCState Identity TypeExpr
checkType TypeExpr
ty
Context
cx' <- [Ident] -> Context -> ISC Context
checkClosedContext (TypeExpr -> [Ident]
forall e. Expr e => e -> [Ident]
fv TypeExpr
ty') Context
cx
QualTypeExpr -> StateT ISCState Identity QualTypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (QualTypeExpr -> StateT ISCState Identity QualTypeExpr)
-> QualTypeExpr -> StateT ISCState Identity QualTypeExpr
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Context -> TypeExpr -> QualTypeExpr
QualTypeExpr SpanInfo
spi Context
cx' TypeExpr
ty'
checkClosedContext :: [Ident] -> Context -> ISC Context
checkClosedContext :: [Ident] -> Context -> ISC Context
checkClosedContext tvs :: [Ident]
tvs cx :: Context
cx = do
Context
cx' <- Context -> ISC Context
checkContext Context
cx
(Constraint -> ISC ()) -> Context -> ISC ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Constraint _ _ ty :: TypeExpr
ty) -> [Ident] -> TypeExpr -> ISC ()
checkClosed [Ident]
tvs TypeExpr
ty) Context
cx'
Context -> ISC Context
forall (m :: * -> *) a. Monad m => a -> m a
return Context
cx'
checkContext :: Context -> ISC Context
checkContext :: Context -> ISC Context
checkContext = (Constraint -> StateT ISCState Identity Constraint)
-> Context -> ISC Context
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Constraint -> StateT ISCState Identity Constraint
checkConstraint
checkConstraint :: Constraint -> ISC Constraint
checkConstraint :: Constraint -> StateT ISCState Identity Constraint
checkConstraint (Constraint spi :: SpanInfo
spi qcls :: QualIdent
qcls ty :: TypeExpr
ty) = do
QualIdent -> ISC ()
checkClass QualIdent
qcls
SpanInfo -> QualIdent -> TypeExpr -> Constraint
Constraint SpanInfo
spi QualIdent
qcls (TypeExpr -> Constraint)
-> StateT ISCState Identity TypeExpr
-> StateT ISCState Identity Constraint
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` TypeExpr -> StateT ISCState Identity TypeExpr
checkType TypeExpr
ty
checkClass :: QualIdent -> ISC ()
checkClass :: QualIdent -> ISC ()
checkClass qcls :: QualIdent
qcls = do
TypeEnv
tEnv <- ISC TypeEnv
getTypeEnv
case QualIdent -> TypeEnv -> [TypeKind]
qualLookupTypeKind QualIdent
qcls TypeEnv
tEnv of
[] -> Message -> ISC ()
report (Message -> ISC ()) -> Message -> ISC ()
forall a b. (a -> b) -> a -> b
$ QualIdent -> Message
errUndefinedClass QualIdent
qcls
[Class _ _] -> () -> ISC ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[_] -> Message -> ISC ()
report (Message -> ISC ()) -> Message -> ISC ()
forall a b. (a -> b) -> a -> b
$ QualIdent -> Message
errUndefinedClass QualIdent
qcls
_ -> String -> ISC ()
forall a. String -> a
internalError (String -> ISC ()) -> String -> ISC ()
forall a b. (a -> b) -> a -> b
$ "Checks.InterfaceSyntaxCheck.checkClass: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"ambiguous identifier " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualIdent -> String
forall a. Show a => a -> String
show QualIdent
qcls
checkClosedType :: [Ident] -> TypeExpr -> ISC TypeExpr
checkClosedType :: [Ident] -> TypeExpr -> StateT ISCState Identity TypeExpr
checkClosedType tvs :: [Ident]
tvs ty :: TypeExpr
ty = do
TypeExpr
ty' <- TypeExpr -> StateT ISCState Identity TypeExpr
checkType TypeExpr
ty
[Ident] -> TypeExpr -> ISC ()
checkClosed [Ident]
tvs TypeExpr
ty'
TypeExpr -> StateT ISCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
ty'
checkType :: TypeExpr -> ISC TypeExpr
checkType :: TypeExpr -> StateT ISCState Identity TypeExpr
checkType (ConstructorType spi :: SpanInfo
spi tc :: QualIdent
tc) = SpanInfo -> QualIdent -> StateT ISCState Identity TypeExpr
checkTypeConstructor SpanInfo
spi QualIdent
tc
checkType (ApplyType spi :: SpanInfo
spi ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) =
(TypeExpr -> TypeExpr -> TypeExpr)
-> StateT ISCState Identity TypeExpr
-> StateT ISCState Identity TypeExpr
-> StateT ISCState Identity TypeExpr
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (SpanInfo -> TypeExpr -> TypeExpr -> TypeExpr
ApplyType SpanInfo
spi) (TypeExpr -> StateT ISCState Identity TypeExpr
checkType TypeExpr
ty1) (TypeExpr -> StateT ISCState Identity TypeExpr
checkType TypeExpr
ty2)
checkType (VariableType spi :: SpanInfo
spi tv :: Ident
tv) =
TypeExpr -> StateT ISCState Identity TypeExpr
checkType (TypeExpr -> StateT ISCState Identity TypeExpr)
-> TypeExpr -> StateT ISCState Identity 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) = ([TypeExpr] -> TypeExpr)
-> StateT ISCState Identity [TypeExpr]
-> StateT ISCState Identity TypeExpr
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SpanInfo -> [TypeExpr] -> TypeExpr
TupleType SpanInfo
spi) ((TypeExpr -> StateT ISCState Identity TypeExpr)
-> [TypeExpr] -> StateT ISCState Identity [TypeExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TypeExpr -> StateT ISCState Identity TypeExpr
checkType [TypeExpr]
tys)
checkType (ListType spi :: SpanInfo
spi ty :: TypeExpr
ty) = (TypeExpr -> TypeExpr)
-> StateT ISCState Identity TypeExpr
-> StateT ISCState Identity TypeExpr
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SpanInfo -> TypeExpr -> TypeExpr
ListType SpanInfo
spi) (TypeExpr -> StateT ISCState Identity TypeExpr
checkType TypeExpr
ty)
checkType (ArrowType spi :: SpanInfo
spi ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) =
(TypeExpr -> TypeExpr -> TypeExpr)
-> StateT ISCState Identity TypeExpr
-> StateT ISCState Identity TypeExpr
-> StateT ISCState Identity TypeExpr
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (SpanInfo -> TypeExpr -> TypeExpr -> TypeExpr
ArrowType SpanInfo
spi) (TypeExpr -> StateT ISCState Identity TypeExpr
checkType TypeExpr
ty1) (TypeExpr -> StateT ISCState Identity TypeExpr
checkType TypeExpr
ty2)
checkType (ParenType spi :: SpanInfo
spi ty :: TypeExpr
ty) = (TypeExpr -> TypeExpr)
-> StateT ISCState Identity TypeExpr
-> StateT ISCState Identity TypeExpr
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SpanInfo -> TypeExpr -> TypeExpr
ParenType SpanInfo
spi) (TypeExpr -> StateT ISCState Identity TypeExpr
checkType TypeExpr
ty)
checkType (ForallType spi :: SpanInfo
spi vs :: [Ident]
vs ty :: TypeExpr
ty) = (TypeExpr -> TypeExpr)
-> StateT ISCState Identity TypeExpr
-> StateT ISCState Identity TypeExpr
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SpanInfo -> [Ident] -> TypeExpr -> TypeExpr
ForallType SpanInfo
spi [Ident]
vs) (TypeExpr -> StateT ISCState Identity TypeExpr
checkType TypeExpr
ty)
checkClosed :: [Ident] -> TypeExpr -> ISC ()
checkClosed :: [Ident] -> TypeExpr -> ISC ()
checkClosed _ (ConstructorType _ _) = () -> ISC ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkClosed tvs :: [Ident]
tvs (ApplyType _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = (TypeExpr -> ISC ()) -> [TypeExpr] -> ISC ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Ident] -> TypeExpr -> ISC ()
checkClosed [Ident]
tvs) [TypeExpr
ty1, TypeExpr
ty2]
checkClosed tvs :: [Ident]
tvs (VariableType _ tv :: Ident
tv) =
Bool -> ISC () -> ISC ()
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) (ISC () -> ISC ()) -> ISC () -> ISC ()
forall a b. (a -> b) -> a -> b
$ Message -> ISC ()
report (Message -> ISC ()) -> Message -> ISC ()
forall a b. (a -> b) -> a -> b
$ Ident -> Message
errUnboundVariable Ident
tv
checkClosed tvs :: [Ident]
tvs (TupleType _ tys :: [TypeExpr]
tys) = (TypeExpr -> ISC ()) -> [TypeExpr] -> ISC ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Ident] -> TypeExpr -> ISC ()
checkClosed [Ident]
tvs) [TypeExpr]
tys
checkClosed tvs :: [Ident]
tvs (ListType _ ty :: TypeExpr
ty) = [Ident] -> TypeExpr -> ISC ()
checkClosed [Ident]
tvs TypeExpr
ty
checkClosed tvs :: [Ident]
tvs (ArrowType _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = (TypeExpr -> ISC ()) -> [TypeExpr] -> ISC ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Ident] -> TypeExpr -> ISC ()
checkClosed [Ident]
tvs) [TypeExpr
ty1, TypeExpr
ty2]
checkClosed tvs :: [Ident]
tvs (ParenType _ ty :: TypeExpr
ty) = [Ident] -> TypeExpr -> ISC ()
checkClosed [Ident]
tvs TypeExpr
ty
checkClosed tvs :: [Ident]
tvs (ForallType _ vs :: [Ident]
vs ty :: TypeExpr
ty) = [Ident] -> TypeExpr -> ISC ()
checkClosed ([Ident]
tvs [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ [Ident]
vs) TypeExpr
ty
checkTypeConstructor :: SpanInfo -> QualIdent -> ISC TypeExpr
checkTypeConstructor :: SpanInfo -> QualIdent -> StateT ISCState Identity TypeExpr
checkTypeConstructor spi :: SpanInfo
spi tc :: QualIdent
tc = do
TypeEnv
tyEnv <- ISC TypeEnv
getTypeEnv
case QualIdent -> TypeEnv -> [TypeKind]
qualLookupTypeKind QualIdent
tc TypeEnv
tyEnv of
[] | QualIdent -> Bool
isQTupleId QualIdent
tc -> TypeExpr -> StateT ISCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> StateT ISCState Identity TypeExpr)
-> TypeExpr -> StateT ISCState Identity TypeExpr
forall a b. (a -> b) -> a -> b
$ SpanInfo -> QualIdent -> TypeExpr
ConstructorType SpanInfo
spi QualIdent
tc
| Bool -> Bool
not (QualIdent -> Bool
isQualified QualIdent
tc) -> TypeExpr -> StateT ISCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> StateT ISCState Identity TypeExpr)
-> TypeExpr -> StateT ISCState Identity 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 -> do
Message -> ISC ()
report (Message -> ISC ()) -> Message -> ISC ()
forall a b. (a -> b) -> a -> b
$ QualIdent -> Message
errUndefinedType QualIdent
tc
TypeExpr -> StateT ISCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> StateT ISCState Identity TypeExpr)
-> TypeExpr -> StateT ISCState Identity TypeExpr
forall a b. (a -> b) -> a -> b
$ SpanInfo -> QualIdent -> TypeExpr
ConstructorType SpanInfo
spi QualIdent
tc
[Data _ _] -> TypeExpr -> StateT ISCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> StateT ISCState Identity TypeExpr)
-> TypeExpr -> StateT ISCState Identity TypeExpr
forall a b. (a -> b) -> a -> b
$ SpanInfo -> QualIdent -> TypeExpr
ConstructorType SpanInfo
spi QualIdent
tc
[Alias _] -> do
Message -> ISC ()
report (Message -> ISC ()) -> Message -> ISC ()
forall a b. (a -> b) -> a -> b
$ QualIdent -> Message
errBadTypeSynonym QualIdent
tc
TypeExpr -> StateT ISCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> StateT ISCState Identity TypeExpr)
-> TypeExpr -> StateT ISCState Identity TypeExpr
forall a b. (a -> b) -> a -> b
$ SpanInfo -> QualIdent -> TypeExpr
ConstructorType SpanInfo
spi QualIdent
tc
_ ->
String -> StateT ISCState Identity TypeExpr
forall a. String -> a
internalError "Checks.InterfaceSyntaxCheck.checkTypeConstructor"
typeVars :: TypeExpr -> [Ident]
typeVars :: TypeExpr -> [Ident]
typeVars (ConstructorType _ _) = []
typeVars (ApplyType _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = TypeExpr -> [Ident]
typeVars TypeExpr
ty1 [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ TypeExpr -> [Ident]
typeVars TypeExpr
ty2
typeVars (VariableType _ tv :: Ident
tv) = [Ident
tv]
typeVars (TupleType _ tys :: [TypeExpr]
tys) = (TypeExpr -> [Ident]) -> [TypeExpr] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TypeExpr -> [Ident]
typeVars [TypeExpr]
tys
typeVars (ListType _ ty :: TypeExpr
ty) = TypeExpr -> [Ident]
typeVars TypeExpr
ty
typeVars (ArrowType _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = TypeExpr -> [Ident]
typeVars TypeExpr
ty1 [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ TypeExpr -> [Ident]
typeVars TypeExpr
ty2
typeVars (ParenType _ ty :: TypeExpr
ty) = TypeExpr -> [Ident]
typeVars TypeExpr
ty
typeVars (ForallType _ vs :: [Ident]
vs ty :: TypeExpr
ty) = [Ident]
vs [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ TypeExpr -> [Ident]
typeVars TypeExpr
ty
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
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"
errMultipleImplementation :: Ident -> Message
errMultipleImplementation :: Ident -> Message
errMultipleImplementation f :: Ident
f = Ident -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage Ident
f (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
["Arity information for method", Ident -> String
idName Ident
f, "occurs more than once"]
errAmbiguousType :: HasSpanInfo s => s -> Ident -> Message
errAmbiguousType :: s -> Ident -> Message
errAmbiguousType p :: s
p ident :: Ident
ident = s -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage s
p (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 :: HasSpanInfo s => s -> Ident -> Message
errConstrainedClassVariable :: s -> Ident -> Message
errConstrainedClassVariable p :: s
p ident :: Ident
ident = s -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage s
p (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
escName 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
escName 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
$
String -> Doc
text "Undefined type variable" Doc -> Doc -> Doc
<+> String -> Doc
text (Ident -> String
escName Ident
tv)
errBadTypeSynonym :: QualIdent -> Message
errBadTypeSynonym :: QualIdent -> Message
errBadTypeSynonym tc :: QualIdent
tc = QualIdent -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage QualIdent
tc (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "Synonym type"
Doc -> Doc -> Doc
<+> String -> Doc
text (QualIdent -> String
qualName QualIdent
tc) Doc -> Doc -> Doc
<+> String -> Doc
text "in interface"
errNoElement :: String -> String -> QualIdent -> Ident -> Message
errNoElement :: String -> String -> QualIdent -> Ident -> Message
errNoElement what :: String
what for :: String
for tc :: QualIdent
tc x :: Ident
x = Ident -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage Ident
x (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
[ "Hidden", String
what, Ident -> String
escName Ident
x, "is not defined for", String
for, QualIdent -> String
qualName QualIdent
tc ]
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 :: HasSpanInfo s => s -> InstanceType -> Message
errIllegalInstanceType :: s -> TypeExpr -> Message
errIllegalInstanceType p :: s
p inst :: TypeExpr
inst = s -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage s
p (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
forall a. Pretty a => a -> Doc
pPrint 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."
]