{- |
    Module      :  $Header$
    Description :  Checks interface declarations
    Copyright   :  (c) 2000 - 2007 Wolfgang Lux
                       2011 - 2015 Björn Peemöller
                       2015        Jan Tikovsky
                       2016        Finn Teegen
    License     :  BSD-3-clause

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

   Similar to Curry source files, some post-processing has to be applied
   to parsed interface files. In particular, the compiler must
   disambiguate nullary type constructors and type variables. In
   addition, the compiler also checks that all type constructor
   applications are saturated. Since interface files are closed -- i.e.,
   they include declarations of all entities which are defined in other
   modules -- the compiler can perform this check without reference to
   the global environments.
-}

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 a syntax error
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

-- The compiler requires information about the arity of each defined type
-- constructor as well as information whether the type constructor
-- denotes an algebraic data type, a renaming type, or a type synonym.
-- The latter must not occur in type expressions in interfaces.

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

-- The checks applied to the interface are similar to those performed
-- during syntax checking of type expressions.

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
    [] | 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"

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

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

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

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."
  ]