{- |
    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 qualified Data.Map as Map
import           Data.Maybe               (fromMaybe, 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, posMessage, 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 :: [KnownExtension] -> TCEnv -> Module a
                -> ((Module a, [KnownExtension]), [Message])
typeSyntaxCheck :: [KnownExtension]
-> TCEnv -> Module a -> ((Module a, [KnownExtension]), [Message])
typeSyntaxCheck exts :: [KnownExtension]
exts 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, [KnownExtension])
-> TSCState -> ((Module a, [KnownExtension]), [Message])
forall a. TSCM a -> TSCState -> (a, [Message])
runTSCM (Module a -> TSCM (Module a, [KnownExtension])
forall a. Module a -> TSCM (Module a, [KnownExtension])
checkModule Module a
mdl) TSCState
state
            else ((Module a
mdl, [KnownExtension]
exts), [[Position] -> Message
errMultipleDefaultDeclarations [Position]
dfps])
    tss :: [[Ident]]
tss -> ((Module a
mdl, [KnownExtension]
exts), ([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 :: [Position]
dfps = (Decl a -> Position) -> [Decl a] -> [Position]
forall a b. (a -> b) -> [a] -> [b]
map (\(DefaultDecl p :: SpanInfo
p _) -> SpanInfo -> Position
forall a. HasSpanInfo a => a -> Position
spanInfo2Pos 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
-> [KnownExtension]
-> RenameEnv
-> Integer
-> [Message]
-> TSCState
TSCState ModuleIdent
m TypeEnv
tEnv [KnownExtension]
exts RenameEnv
forall k a. Map k a
Map.empty 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 -> [KnownExtension]
extensions  :: [KnownExtension]
  , TSCState -> RenameEnv
renameEnv   :: RenameEnv
  , 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

hasExtension :: KnownExtension -> TSCM Bool
hasExtension :: KnownExtension -> TSCM Bool
hasExtension ext :: KnownExtension
ext = (TSCState -> Bool) -> TSCM Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets (KnownExtension -> [KnownExtension] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem KnownExtension
ext ([KnownExtension] -> Bool)
-> (TSCState -> [KnownExtension]) -> TSCState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TSCState -> [KnownExtension]
extensions)

enableExtension :: KnownExtension -> TSCM ()
enableExtension :: KnownExtension -> TSCM ()
enableExtension e :: KnownExtension
e = (TSCState -> TSCState) -> TSCM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((TSCState -> TSCState) -> TSCM ())
-> (TSCState -> TSCState) -> TSCM ()
forall a b. (a -> b) -> a -> b
$ \s :: TSCState
s -> TSCState
s { extensions :: [KnownExtension]
extensions = KnownExtension
e KnownExtension -> [KnownExtension] -> [KnownExtension]
forall a. a -> [a] -> [a]
: TSCState -> [KnownExtension]
extensions TSCState
s }

getExtensions :: TSCM [KnownExtension]
getExtensions :: TSCM [KnownExtension]
getExtensions = (TSCState -> [KnownExtension]) -> TSCM [KnownExtension]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets TSCState -> [KnownExtension]
extensions

getRenameEnv :: TSCM RenameEnv
getRenameEnv :: TSCM RenameEnv
getRenameEnv = (TSCState -> RenameEnv) -> TSCM RenameEnv
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets TSCState -> RenameEnv
renameEnv

modifyRenameEnv :: (RenameEnv -> RenameEnv) -> TSCM ()
modifyRenameEnv :: (RenameEnv -> RenameEnv) -> TSCM ()
modifyRenameEnv f :: RenameEnv -> RenameEnv
f = (TSCState -> TSCState) -> TSCM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((TSCState -> TSCState) -> TSCM ())
-> (TSCState -> TSCState) -> TSCM ()
forall a b. (a -> b) -> a -> b
$ \s :: TSCState
s -> TSCState
s { renameEnv :: RenameEnv
renameEnv = RenameEnv -> RenameEnv
f (RenameEnv -> RenameEnv) -> RenameEnv -> RenameEnv
forall a b. (a -> b) -> a -> b
$ TSCState -> RenameEnv
renameEnv TSCState
s }

withLocalEnv :: TSCM a -> TSCM a
withLocalEnv :: TSCM a -> TSCM a
withLocalEnv act :: TSCM a
act = do
  RenameEnv
oldEnv <- TSCM RenameEnv
getRenameEnv
  a
res <- TSCM a
act
  (RenameEnv -> RenameEnv) -> TSCM ()
modifyRenameEnv ((RenameEnv -> RenameEnv) -> TSCM ())
-> (RenameEnv -> RenameEnv) -> TSCM ()
forall a b. (a -> b) -> a -> b
$ RenameEnv -> RenameEnv -> RenameEnv
forall a b. a -> b -> a
const RenameEnv
oldEnv
  a -> TSCM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

resetEnv :: TSCM ()
resetEnv :: TSCM ()
resetEnv = (RenameEnv -> RenameEnv) -> TSCM ()
modifyRenameEnv ((RenameEnv -> RenameEnv) -> TSCM ())
-> (RenameEnv -> RenameEnv) -> TSCM ()
forall a b. (a -> b) -> a -> b
$ RenameEnv -> RenameEnv -> RenameEnv
forall a b. a -> b -> a
const RenameEnv
forall k a. Map k a
Map.empty

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) -> TSCM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((TSCState -> TSCState) -> TSCM ())
-> (TSCState -> TSCState) -> TSCM ()
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 -> TSCM ()
report err :: Message
err = (TSCState -> TSCState) -> TSCM ()
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 :: TSCM ()
ok = () -> TSCM ()
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

-- As preparation for the kind check, type variables within type declarations
-- have to be renamed since existentially quantified type variable may shadow
-- a universally quantified variable from the left hand side of a type
-- declaration.

-- TODO: This renaming may be used to support scoped type variables in future.

-- TODO: In the long run, this renaming may be merged with the syntax check
-- renaming and moved into a separate module.

type RenameEnv = Map.Map Ident Ident

class Rename a where
  rename :: a -> TSCM a

renameTypeSig :: (Expr a, Rename a) => a -> TSCM a
renameTypeSig :: a -> TSCM a
renameTypeSig x :: a
x = TSCM a -> TSCM a
forall a. TSCM a -> TSCM a
withLocalEnv (TSCM a -> TSCM a) -> TSCM a -> TSCM a
forall a b. (a -> b) -> a -> b
$ do
  RenameEnv
env <- TSCM RenameEnv
getRenameEnv
  [Ident] -> TSCM ()
bindVars ((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` RenameEnv -> [Ident]
forall k a. Map k a -> [k]
Map.keys RenameEnv
env) ([Ident] -> [Ident]) -> [Ident] -> [Ident]
forall a b. (a -> b) -> a -> b
$ a -> [Ident]
forall e. Expr e => e -> [Ident]
fv a
x)
  a -> TSCM a
forall a. Rename a => a -> TSCM a
rename a
x

renameReset :: Rename a => a -> TSCM a
renameReset :: a -> TSCM a
renameReset x :: a
x = TSCM a -> TSCM a
forall a. TSCM a -> TSCM a
withLocalEnv (TSCM a -> TSCM a) -> TSCM a -> TSCM a
forall a b. (a -> b) -> a -> b
$ TSCM ()
resetEnv TSCM () -> TSCM a -> TSCM a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> TSCM a
forall a. Rename a => a -> TSCM a
rename a
x

instance Rename a => Rename [a] where
  rename :: [a] -> TSCM [a]
rename = (a -> StateT TSCState Identity a) -> [a] -> TSCM [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> StateT TSCState Identity a
forall a. Rename a => a -> TSCM a
rename

instance Rename (Decl a) where
  rename :: Decl a -> TSCM (Decl a)
rename (InfixDecl p :: SpanInfo
p fix :: Infix
fix pr :: Maybe Integer
pr ops :: [Ident]
ops) = 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 -> Infix -> Maybe Integer -> [Ident] -> Decl a
forall a. SpanInfo -> Infix -> Maybe Integer -> [Ident] -> Decl a
InfixDecl SpanInfo
p Infix
fix Maybe Integer
pr [Ident]
ops
  rename (DataDecl p :: SpanInfo
p tc :: Ident
tc tvs :: [Ident]
tvs cs :: [ConstrDecl]
cs clss :: [QualIdent]
clss) = TSCM (Decl a) -> TSCM (Decl a)
forall a. TSCM a -> TSCM a
withLocalEnv (TSCM (Decl a) -> TSCM (Decl a)) -> TSCM (Decl a) -> TSCM (Decl a)
forall a b. (a -> b) -> a -> b
$ do
    [Ident] -> TSCM ()
bindVars [Ident]
tvs
    SpanInfo
-> Ident -> [Ident] -> [ConstrDecl] -> [QualIdent] -> Decl a
forall a.
SpanInfo
-> Ident -> [Ident] -> [ConstrDecl] -> [QualIdent] -> Decl a
DataDecl SpanInfo
p Ident
tc ([Ident] -> [ConstrDecl] -> [QualIdent] -> Decl a)
-> StateT TSCState Identity [Ident]
-> StateT TSCState Identity ([ConstrDecl] -> [QualIdent] -> Decl a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident] -> StateT TSCState Identity [Ident]
forall a. Rename a => a -> TSCM a
rename [Ident]
tvs StateT TSCState Identity ([ConstrDecl] -> [QualIdent] -> Decl a)
-> StateT TSCState Identity [ConstrDecl]
-> StateT TSCState Identity ([QualIdent] -> Decl a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ConstrDecl] -> StateT TSCState Identity [ConstrDecl]
forall a. Rename a => a -> TSCM a
rename [ConstrDecl]
cs StateT TSCState Identity ([QualIdent] -> Decl a)
-> StateT TSCState Identity [QualIdent] -> TSCM (Decl a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [QualIdent] -> StateT TSCState Identity [QualIdent]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [QualIdent]
clss
  rename (ExternalDataDecl p :: SpanInfo
p tc :: Ident
tc tvs :: [Ident]
tvs) = TSCM (Decl a) -> TSCM (Decl a)
forall a. TSCM a -> TSCM a
withLocalEnv (TSCM (Decl a) -> TSCM (Decl a)) -> TSCM (Decl a) -> TSCM (Decl a)
forall a b. (a -> b) -> a -> b
$ do
    [Ident] -> TSCM ()
bindVars [Ident]
tvs
    SpanInfo -> Ident -> [Ident] -> Decl a
forall a. SpanInfo -> Ident -> [Ident] -> Decl a
ExternalDataDecl SpanInfo
p Ident
tc ([Ident] -> Decl a)
-> StateT TSCState Identity [Ident] -> TSCM (Decl a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident] -> StateT TSCState Identity [Ident]
forall a. Rename a => a -> TSCM a
rename [Ident]
tvs
  rename (NewtypeDecl p :: SpanInfo
p tc :: Ident
tc tvs :: [Ident]
tvs nc :: NewConstrDecl
nc clss :: [QualIdent]
clss) = TSCM (Decl a) -> TSCM (Decl a)
forall a. TSCM a -> TSCM a
withLocalEnv (TSCM (Decl a) -> TSCM (Decl a)) -> TSCM (Decl a) -> TSCM (Decl a)
forall a b. (a -> b) -> a -> b
$ do
    [Ident] -> TSCM ()
bindVars [Ident]
tvs
    SpanInfo
-> Ident -> [Ident] -> NewConstrDecl -> [QualIdent] -> Decl a
forall a.
SpanInfo
-> Ident -> [Ident] -> NewConstrDecl -> [QualIdent] -> Decl a
NewtypeDecl SpanInfo
p Ident
tc ([Ident] -> NewConstrDecl -> [QualIdent] -> Decl a)
-> StateT TSCState Identity [Ident]
-> StateT
     TSCState Identity (NewConstrDecl -> [QualIdent] -> Decl a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident] -> StateT TSCState Identity [Ident]
forall a. Rename a => a -> TSCM a
rename [Ident]
tvs StateT TSCState Identity (NewConstrDecl -> [QualIdent] -> Decl a)
-> StateT TSCState Identity NewConstrDecl
-> StateT TSCState Identity ([QualIdent] -> Decl a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewConstrDecl -> StateT TSCState Identity NewConstrDecl
forall a. Rename a => a -> TSCM a
rename NewConstrDecl
nc StateT TSCState Identity ([QualIdent] -> Decl a)
-> StateT TSCState Identity [QualIdent] -> TSCM (Decl a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [QualIdent] -> StateT TSCState Identity [QualIdent]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [QualIdent]
clss
  rename (TypeDecl p :: SpanInfo
p tc :: Ident
tc tvs :: [Ident]
tvs ty :: TypeExpr
ty) = TSCM (Decl a) -> TSCM (Decl a)
forall a. TSCM a -> TSCM a
withLocalEnv (TSCM (Decl a) -> TSCM (Decl a)) -> TSCM (Decl a) -> TSCM (Decl a)
forall a b. (a -> b) -> a -> b
$ do
    [Ident] -> TSCM ()
bindVars [Ident]
tvs
    SpanInfo -> Ident -> [Ident] -> TypeExpr -> Decl a
forall a. SpanInfo -> Ident -> [Ident] -> TypeExpr -> Decl a
TypeDecl SpanInfo
p Ident
tc ([Ident] -> TypeExpr -> Decl a)
-> StateT TSCState Identity [Ident]
-> StateT TSCState Identity (TypeExpr -> Decl a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident] -> StateT TSCState Identity [Ident]
forall a. Rename a => a -> TSCM a
rename [Ident]
tvs StateT TSCState Identity (TypeExpr -> Decl a)
-> StateT TSCState Identity TypeExpr -> TSCM (Decl a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty
  rename (TypeSig p :: SpanInfo
p fs :: [Ident]
fs qty :: QualTypeExpr
qty) = SpanInfo -> [Ident] -> QualTypeExpr -> Decl a
forall a. SpanInfo -> [Ident] -> QualTypeExpr -> Decl a
TypeSig SpanInfo
p [Ident]
fs (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
forall a. (Expr a, Rename a) => a -> TSCM a
renameTypeSig QualTypeExpr
qty
  rename (FunctionDecl p :: SpanInfo
p a :: a
a 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
p a
a 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]
forall a. Rename a => a -> TSCM a
renameReset [Equation a]
eqs
  rename (ExternalDecl p :: SpanInfo
p fs :: [Var a]
fs) = 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 -> [Var a] -> Decl a
forall a. SpanInfo -> [Var a] -> Decl a
ExternalDecl SpanInfo
p [Var a]
fs
  rename (PatternDecl p :: SpanInfo
p ts :: Pattern a
ts 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
ts (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. Rename a => a -> TSCM a
renameReset Rhs a
rhs
  rename (FreeDecl p :: SpanInfo
p fvs :: [Var a]
fvs) = 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 -> [Var a] -> Decl a
forall a. SpanInfo -> [Var a] -> Decl a
FreeDecl SpanInfo
p [Var a]
fvs
  rename (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 -> StateT TSCState Identity 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 -> StateT TSCState Identity TypeExpr
forall a. (Expr a, Rename a) => a -> TSCM a
renameTypeSig [TypeExpr]
tys
  rename (ClassDecl p :: SpanInfo
p cx :: Context
cx cls :: Ident
cls tv :: Ident
tv ds :: [Decl a]
ds) = TSCM (Decl a) -> TSCM (Decl a)
forall a. TSCM a -> TSCM a
withLocalEnv (TSCM (Decl a) -> TSCM (Decl a)) -> TSCM (Decl a) -> TSCM (Decl a)
forall a b. (a -> b) -> a -> b
$ do
    Ident -> TSCM ()
bindVar Ident
tv
    SpanInfo -> Context -> Ident -> Ident -> [Decl a] -> Decl a
forall a.
SpanInfo -> Context -> Ident -> Ident -> [Decl a] -> Decl a
ClassDecl SpanInfo
p (Context -> Ident -> Ident -> [Decl a] -> Decl a)
-> StateT TSCState Identity Context
-> StateT TSCState Identity (Ident -> Ident -> [Decl a] -> Decl a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> StateT TSCState Identity Context
forall a. Rename a => a -> TSCM a
rename Context
cx StateT TSCState Identity (Ident -> Ident -> [Decl a] -> Decl a)
-> StateT TSCState Identity Ident
-> StateT TSCState Identity (Ident -> [Decl a] -> Decl a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ident -> StateT TSCState Identity Ident
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ident
cls StateT TSCState Identity (Ident -> [Decl a] -> Decl a)
-> StateT TSCState Identity Ident
-> StateT TSCState Identity ([Decl a] -> Decl a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ident -> StateT TSCState Identity Ident
forall a. Rename a => a -> TSCM a
rename Ident
tv StateT TSCState Identity ([Decl a] -> Decl a)
-> StateT TSCState Identity [Decl a] -> TSCM (Decl a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Decl a] -> StateT TSCState Identity [Decl a]
forall a. Rename a => a -> TSCM a
rename [Decl a]
ds
  rename (InstanceDecl p :: SpanInfo
p cx :: Context
cx cls :: QualIdent
cls ty :: TypeExpr
ty ds :: [Decl a]
ds) = TSCM (Decl a) -> TSCM (Decl a)
forall a. TSCM a -> TSCM a
withLocalEnv (TSCM (Decl a) -> TSCM (Decl a)) -> TSCM (Decl a) -> TSCM (Decl a)
forall a b. (a -> b) -> a -> b
$ do
    [Ident] -> TSCM ()
bindVars (TypeExpr -> [Ident]
forall e. Expr e => e -> [Ident]
fv TypeExpr
ty)
    SpanInfo -> Context -> QualIdent -> TypeExpr -> [Decl a] -> Decl a
forall a.
SpanInfo -> Context -> QualIdent -> TypeExpr -> [Decl a] -> Decl a
InstanceDecl SpanInfo
p (Context -> QualIdent -> TypeExpr -> [Decl a] -> Decl a)
-> StateT TSCState Identity Context
-> StateT
     TSCState Identity (QualIdent -> TypeExpr -> [Decl a] -> Decl a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> StateT TSCState Identity Context
forall a. Rename a => a -> TSCM a
rename Context
cx StateT
  TSCState Identity (QualIdent -> TypeExpr -> [Decl a] -> Decl a)
-> StateT TSCState Identity QualIdent
-> StateT TSCState Identity (TypeExpr -> [Decl a] -> Decl a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QualIdent -> StateT TSCState Identity QualIdent
forall (f :: * -> *) a. Applicative f => a -> f a
pure QualIdent
cls StateT TSCState Identity (TypeExpr -> [Decl a] -> Decl a)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity ([Decl a] -> Decl a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty StateT TSCState Identity ([Decl a] -> Decl a)
-> StateT TSCState Identity [Decl a] -> TSCM (Decl a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Decl a] -> StateT TSCState Identity [Decl a]
forall a. Rename a => a -> TSCM a
renameReset [Decl a]
ds

instance Rename ConstrDecl where
  rename :: ConstrDecl -> TSCM ConstrDecl
rename (ConstrDecl p :: SpanInfo
p c :: Ident
c tys :: [TypeExpr]
tys) = TSCM ConstrDecl -> TSCM ConstrDecl
forall a. TSCM a -> TSCM a
withLocalEnv (TSCM ConstrDecl -> TSCM ConstrDecl)
-> TSCM ConstrDecl -> TSCM ConstrDecl
forall a b. (a -> b) -> a -> b
$ do
    SpanInfo -> Ident -> [TypeExpr] -> ConstrDecl
ConstrDecl SpanInfo
p (Ident -> [TypeExpr] -> ConstrDecl)
-> StateT TSCState Identity Ident
-> StateT TSCState Identity ([TypeExpr] -> ConstrDecl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> StateT TSCState Identity Ident
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ident
c StateT TSCState Identity ([TypeExpr] -> ConstrDecl)
-> StateT TSCState Identity [TypeExpr] -> TSCM ConstrDecl
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [TypeExpr] -> StateT TSCState Identity [TypeExpr]
forall a. Rename a => a -> TSCM a
rename [TypeExpr]
tys
  rename (ConOpDecl p :: SpanInfo
p ty1 :: TypeExpr
ty1 op :: Ident
op ty2 :: TypeExpr
ty2) = TSCM ConstrDecl -> TSCM ConstrDecl
forall a. TSCM a -> TSCM a
withLocalEnv (TSCM ConstrDecl -> TSCM ConstrDecl)
-> TSCM ConstrDecl -> TSCM ConstrDecl
forall a b. (a -> b) -> a -> b
$ do
    SpanInfo -> TypeExpr -> Ident -> TypeExpr -> ConstrDecl
ConOpDecl SpanInfo
p (TypeExpr -> Ident -> TypeExpr -> ConstrDecl)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity (Ident -> TypeExpr -> ConstrDecl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty1 StateT TSCState Identity (Ident -> TypeExpr -> ConstrDecl)
-> StateT TSCState Identity Ident
-> StateT TSCState Identity (TypeExpr -> ConstrDecl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ident -> StateT TSCState Identity Ident
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ident
op StateT TSCState Identity (TypeExpr -> ConstrDecl)
-> StateT TSCState Identity TypeExpr -> TSCM ConstrDecl
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty2
  rename (RecordDecl p :: SpanInfo
p c :: Ident
c fs :: [FieldDecl]
fs) = TSCM ConstrDecl -> TSCM ConstrDecl
forall a. TSCM a -> TSCM a
withLocalEnv (TSCM ConstrDecl -> TSCM ConstrDecl)
-> TSCM ConstrDecl -> TSCM ConstrDecl
forall a b. (a -> b) -> a -> b
$ do
    SpanInfo -> Ident -> [FieldDecl] -> ConstrDecl
RecordDecl SpanInfo
p (Ident -> [FieldDecl] -> ConstrDecl)
-> StateT TSCState Identity Ident
-> StateT TSCState Identity ([FieldDecl] -> ConstrDecl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> StateT TSCState Identity Ident
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ident
c StateT TSCState Identity ([FieldDecl] -> ConstrDecl)
-> StateT TSCState Identity [FieldDecl] -> TSCM ConstrDecl
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [FieldDecl] -> StateT TSCState Identity [FieldDecl]
forall a. Rename a => a -> TSCM a
rename [FieldDecl]
fs

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

instance Rename NewConstrDecl where
  rename :: NewConstrDecl -> StateT TSCState Identity NewConstrDecl
rename (NewConstrDecl p :: SpanInfo
p c :: Ident
c ty :: TypeExpr
ty) = SpanInfo -> Ident -> TypeExpr -> NewConstrDecl
NewConstrDecl SpanInfo
p Ident
c (TypeExpr -> NewConstrDecl)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity NewConstrDecl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty
  rename (NewRecordDecl p :: SpanInfo
p c :: Ident
c (l :: Ident
l, ty :: TypeExpr
ty)) = SpanInfo -> Ident -> (Ident, TypeExpr) -> NewConstrDecl
NewRecordDecl SpanInfo
p Ident
c ((Ident, TypeExpr) -> NewConstrDecl)
-> (TypeExpr -> (Ident, TypeExpr)) -> TypeExpr -> NewConstrDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) Ident
l (TypeExpr -> NewConstrDecl)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity NewConstrDecl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty

instance Rename Constraint where
  rename :: Constraint -> TSCM Constraint
rename (Constraint spi :: SpanInfo
spi cls :: QualIdent
cls ty :: TypeExpr
ty) = SpanInfo -> QualIdent -> TypeExpr -> Constraint
Constraint SpanInfo
spi QualIdent
cls (TypeExpr -> Constraint)
-> StateT TSCState Identity TypeExpr -> TSCM Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty

instance Rename QualTypeExpr where
  rename :: QualTypeExpr -> StateT TSCState Identity QualTypeExpr
rename (QualTypeExpr spi :: SpanInfo
spi cx :: Context
cx ty :: TypeExpr
ty) = SpanInfo -> Context -> TypeExpr -> QualTypeExpr
QualTypeExpr SpanInfo
spi (Context -> TypeExpr -> QualTypeExpr)
-> StateT TSCState Identity Context
-> StateT TSCState Identity (TypeExpr -> QualTypeExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> StateT TSCState Identity Context
forall a. Rename a => a -> TSCM a
rename Context
cx StateT TSCState Identity (TypeExpr -> QualTypeExpr)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity QualTypeExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty

instance Rename TypeExpr where
  rename :: TypeExpr -> StateT TSCState Identity TypeExpr
rename (ConstructorType spi :: SpanInfo
spi tc :: QualIdent
tc) = TypeExpr -> StateT TSCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> StateT TSCState Identity TypeExpr)
-> TypeExpr -> StateT TSCState Identity TypeExpr
forall a b. (a -> b) -> a -> b
$ SpanInfo -> QualIdent -> TypeExpr
ConstructorType SpanInfo
spi QualIdent
tc
  rename (ApplyType spi :: SpanInfo
spi ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = SpanInfo -> TypeExpr -> TypeExpr -> TypeExpr
ApplyType SpanInfo
spi (TypeExpr -> TypeExpr -> TypeExpr)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity (TypeExpr -> TypeExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty1 StateT TSCState Identity (TypeExpr -> TypeExpr)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity TypeExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty2
  rename (VariableType spi :: SpanInfo
spi tv :: Ident
tv) = SpanInfo -> Ident -> TypeExpr
VariableType SpanInfo
spi (Ident -> TypeExpr)
-> StateT TSCState Identity Ident
-> StateT TSCState Identity TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> StateT TSCState Identity Ident
forall a. Rename a => a -> TSCM a
rename Ident
tv
  rename (TupleType spi :: SpanInfo
spi tys :: [TypeExpr]
tys) = SpanInfo -> [TypeExpr] -> TypeExpr
TupleType SpanInfo
spi ([TypeExpr] -> TypeExpr)
-> StateT TSCState Identity [TypeExpr]
-> StateT TSCState Identity TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeExpr] -> StateT TSCState Identity [TypeExpr]
forall a. Rename a => a -> TSCM a
rename [TypeExpr]
tys
  rename (ListType spi :: SpanInfo
spi ty :: TypeExpr
ty) = SpanInfo -> TypeExpr -> TypeExpr
ListType SpanInfo
spi (TypeExpr -> TypeExpr)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty
  rename (ArrowType spi :: SpanInfo
spi ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = SpanInfo -> TypeExpr -> TypeExpr -> TypeExpr
ArrowType SpanInfo
spi (TypeExpr -> TypeExpr -> TypeExpr)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity (TypeExpr -> TypeExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty1 StateT TSCState Identity (TypeExpr -> TypeExpr)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity TypeExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty2
  rename (ParenType spi :: SpanInfo
spi ty :: TypeExpr
ty) = SpanInfo -> TypeExpr -> TypeExpr
ParenType SpanInfo
spi (TypeExpr -> TypeExpr)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty
  rename (ForallType spi :: SpanInfo
spi vs :: [Ident]
vs ty :: TypeExpr
ty) = do
    [Ident] -> TSCM ()
bindVars [Ident]
vs
    SpanInfo -> [Ident] -> TypeExpr -> TypeExpr
ForallType SpanInfo
spi ([Ident] -> TypeExpr -> TypeExpr)
-> StateT TSCState Identity [Ident]
-> StateT TSCState Identity (TypeExpr -> TypeExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ident -> StateT TSCState Identity Ident)
-> [Ident] -> StateT TSCState Identity [Ident]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ident -> StateT TSCState Identity Ident
forall a. Rename a => a -> TSCM a
rename [Ident]
vs StateT TSCState Identity (TypeExpr -> TypeExpr)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity TypeExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExpr -> StateT TSCState Identity TypeExpr
forall a. Rename a => a -> TSCM a
rename TypeExpr
ty

instance Rename (Equation a) where
  rename :: Equation a -> TSCM (Equation a)
rename (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. Rename a => a -> TSCM a
rename Rhs a
rhs

instance Rename (Rhs a) where
  rename :: Rhs a -> TSCM (Rhs a)
rename (SimpleRhs  spi :: SpanInfo
spi e :: Expression a
e  ds :: [Decl a]
ds) = SpanInfo -> Expression a -> [Decl a] -> Rhs a
forall a. SpanInfo -> Expression a -> [Decl a] -> Rhs a
SimpleRhs  SpanInfo
spi (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. Rename a => a -> TSCM a
rename 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]
forall a. Rename a => a -> TSCM a
rename [Decl a]
ds
  rename (GuardedRhs spi :: SpanInfo
spi es :: [CondExpr a]
es ds :: [Decl a]
ds) = SpanInfo -> [CondExpr a] -> [Decl a] -> Rhs a
forall a. SpanInfo -> [CondExpr a] -> [Decl a] -> Rhs a
GuardedRhs SpanInfo
spi ([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]
forall a. Rename a => a -> TSCM a
rename [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]
forall a. Rename a => a -> TSCM a
rename [Decl a]
ds

instance Rename (CondExpr a) where
  rename :: CondExpr a -> TSCM (CondExpr a)
rename (CondExpr spi :: SpanInfo
spi c :: Expression a
c 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. Rename a => a -> TSCM a
rename Expression a
c 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. Rename a => a -> TSCM a
rename Expression a
e

instance Rename (Expression a) where
  rename :: Expression a -> TSCM (Expression a)
rename (Literal spi :: SpanInfo
spi a :: a
a l :: Literal
l) = Expression a -> TSCM (Expression a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression a -> TSCM (Expression a))
-> Expression a -> TSCM (Expression a)
forall a b. (a -> b) -> a -> b
$ SpanInfo -> a -> Literal -> Expression a
forall a. SpanInfo -> a -> Literal -> Expression a
Literal SpanInfo
spi a
a Literal
l
  rename (Variable spi :: SpanInfo
spi a :: a
a v :: QualIdent
v) = Expression a -> TSCM (Expression a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression a -> TSCM (Expression a))
-> Expression a -> TSCM (Expression a)
forall a b. (a -> b) -> a -> b
$ SpanInfo -> a -> QualIdent -> Expression a
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
spi a
a QualIdent
v
  rename (Constructor spi :: SpanInfo
spi a :: a
a c :: QualIdent
c) = Expression a -> TSCM (Expression a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression a -> TSCM (Expression a))
-> Expression a -> TSCM (Expression a)
forall a b. (a -> b) -> a -> b
$ SpanInfo -> a -> QualIdent -> Expression a
forall a. SpanInfo -> a -> QualIdent -> Expression a
Constructor SpanInfo
spi a
a QualIdent
c
  rename (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. Rename a => a -> TSCM a
rename Expression a
e
  rename (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. Rename a => a -> TSCM a
rename 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
forall a. (Expr a, Rename a) => a -> TSCM a
renameTypeSig QualTypeExpr
qty
  rename (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)]
forall a. Rename a => a -> TSCM a
rename [Field (Expression a)]
fs
  rename (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. Rename a => a -> TSCM a
rename 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)]
forall a. Rename a => a -> TSCM a
rename [Field (Expression a)]
fs
  rename (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] -> StateT TSCState Identity [Expression a]
forall a. Rename a => a -> TSCM a
rename [Expression a]
es
  rename (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] -> StateT TSCState Identity [Expression a]
forall a. Rename a => a -> TSCM a
rename [Expression a]
es
  rename (ListCompr spi :: SpanInfo
spi e :: Expression a
e stmts :: [Statement a]
stmts) = 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. Rename a => a -> TSCM a
rename 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]
forall a. Rename a => a -> TSCM a
rename [Statement a]
stmts
  rename (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. Rename a => a -> TSCM a
rename Expression a
e
  rename (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. Rename a => a -> TSCM a
rename 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. Rename a => a -> TSCM a
rename Expression a
e2
  rename (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. Rename a => a -> TSCM a
rename 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. Rename a => a -> TSCM a
rename Expression a
e2
  rename (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. Rename a => a -> TSCM a
rename 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. Rename a => a -> TSCM a
rename 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. Rename a => a -> TSCM a
rename Expression a
e3
  rename (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. Rename a => a -> TSCM a
rename Expression a
e
  rename (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. Rename a => a -> TSCM a
rename 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. Rename a => a -> TSCM a
rename Expression a
e2
  rename (InfixApply spi :: SpanInfo
spi e1 :: Expression a
e1 op :: InfixOp a
op e2 :: Expression a
e2) =
    (Expression a -> InfixOp a -> Expression a -> Expression a)
-> InfixOp a -> Expression a -> Expression a -> Expression a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SpanInfo
-> Expression a -> InfixOp a -> Expression a -> Expression a
forall a.
SpanInfo
-> Expression a -> InfixOp a -> Expression a -> Expression a
InfixApply SpanInfo
spi) InfixOp a
op (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. Rename a => a -> TSCM a
rename 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. Rename a => a -> TSCM a
rename Expression a
e2
  rename (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. Rename a => a -> TSCM a
rename Expression a
e
  rename (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. Rename a => a -> TSCM a
rename Expression a
e
  rename (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. Rename a => a -> TSCM a
rename Expression a
e
  rename (Let spi :: SpanInfo
spi ds :: [Decl a]
ds e :: Expression a
e) = SpanInfo -> [Decl a] -> Expression a -> Expression a
forall a. SpanInfo -> [Decl a] -> Expression a -> Expression a
Let SpanInfo
spi ([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]
forall a. Rename a => a -> TSCM a
rename [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. Rename a => a -> TSCM a
rename Expression a
e
  rename (Do spi :: SpanInfo
spi stmts :: [Statement a]
stmts e :: Expression a
e) = SpanInfo -> [Statement a] -> Expression a -> Expression a
forall a. SpanInfo -> [Statement a] -> Expression a -> Expression a
Do SpanInfo
spi ([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]
forall a. Rename a => a -> TSCM a
rename [Statement a]
stmts 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. Rename a => a -> TSCM a
rename Expression a
e
  rename (IfThenElse spi :: SpanInfo
spi c :: Expression a
c e1 :: Expression a
e1 e2 :: Expression a
e2) =
    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. Rename a => a -> TSCM a
rename Expression a
c 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. Rename a => a -> TSCM a
rename 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. Rename a => a -> TSCM a
rename Expression a
e2
  rename (Case spi :: SpanInfo
spi ct :: CaseType
ct e :: Expression a
e alts :: [Alt a]
alts) = SpanInfo -> CaseType -> Expression a -> [Alt a] -> Expression a
forall a.
SpanInfo -> CaseType -> Expression a -> [Alt a] -> Expression a
Case SpanInfo
spi 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. Rename a => a -> TSCM a
rename 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]
forall a. Rename a => a -> TSCM a
rename [Alt a]
alts

instance Rename (Statement a) where
  rename :: Statement a -> TSCM (Statement a)
rename (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. Rename a => a -> TSCM a
rename Expression a
e
  rename (StmtDecl spi :: SpanInfo
spi ds :: [Decl a]
ds) = SpanInfo -> [Decl a] -> Statement a
forall a. SpanInfo -> [Decl a] -> Statement a
StmtDecl SpanInfo
spi ([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]
forall a. Rename a => a -> TSCM a
rename [Decl a]
ds
  rename (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. Rename a => a -> TSCM a
rename Expression a
e

instance Rename (Alt a) where
  rename :: Alt a -> TSCM (Alt a)
rename (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. Rename a => a -> TSCM a
rename Rhs a
rhs

instance Rename a => Rename (Field a) where
  rename :: Field a -> TSCM (Field a)
rename (Field spi :: SpanInfo
spi l :: QualIdent
l x :: a
x) = SpanInfo -> QualIdent -> a -> Field a
forall a. SpanInfo -> QualIdent -> a -> Field a
Field SpanInfo
spi QualIdent
l (a -> Field a) -> StateT TSCState Identity a -> TSCM (Field a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> StateT TSCState Identity a
forall a. Rename a => a -> TSCM a
rename a
x

instance Rename Ident where
  rename :: Ident -> StateT TSCState Identity Ident
rename tv :: Ident
tv | Ident -> Bool
isAnonId Ident
tv = Ident -> Integer -> Ident
renameIdent Ident
tv (Integer -> Ident)
-> TSCM Integer -> StateT TSCState Identity Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TSCM Integer
newId
            | Bool
otherwise   = SpanInfo -> Ident -> Ident
forall a. HasSpanInfo a => SpanInfo -> a -> a
setSpanInfo (Ident -> SpanInfo
forall a. HasSpanInfo a => a -> SpanInfo
getSpanInfo Ident
tv) (Ident -> Ident) -> (Maybe Ident -> Ident) -> Maybe Ident -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Ident -> Maybe Ident -> Ident
forall a. a -> Maybe a -> a
fromMaybe Ident
tv (Maybe Ident -> Ident)
-> StateT TSCState Identity (Maybe Ident)
-> StateT TSCState Identity Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> StateT TSCState Identity (Maybe Ident)
lookupVar Ident
tv

bindVar :: Ident -> TSCM ()
bindVar :: Ident -> TSCM ()
bindVar tv :: Ident
tv = do
  Integer
k <- TSCM Integer
newId
  (RenameEnv -> RenameEnv) -> TSCM ()
modifyRenameEnv ((RenameEnv -> RenameEnv) -> TSCM ())
-> (RenameEnv -> RenameEnv) -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Ident -> Ident -> RenameEnv -> RenameEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ident
tv (Ident -> Integer -> Ident
renameIdent Ident
tv Integer
k)

bindVars :: [Ident] -> TSCM ()
bindVars :: [Ident] -> TSCM ()
bindVars = (Ident -> TSCM ()) -> [Ident] -> TSCM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Ident -> TSCM ()
bindVar

lookupVar :: Ident -> TSCM (Maybe Ident)
lookupVar :: Ident -> StateT TSCState Identity (Maybe Ident)
lookupVar tv :: Ident
tv = do
  RenameEnv
env <- TSCM RenameEnv
getRenameEnv
  Maybe Ident -> StateT TSCState Identity (Maybe Ident)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Ident -> StateT TSCState Identity (Maybe Ident))
-> Maybe Ident -> StateT TSCState Identity (Maybe Ident)
forall a b. (a -> b) -> a -> b
$ Ident -> RenameEnv -> Maybe Ident
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
tv RenameEnv
env

-- 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, [KnownExtension])
checkModule :: Module a -> TSCM (Module a, [KnownExtension])
checkModule (Module spi :: SpanInfo
spi 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
  [Decl a]
ds'' <- [Decl a] -> StateT TSCState Identity [Decl a]
forall a. Rename a => a -> TSCM a
rename [Decl a]
ds'
  [KnownExtension]
exts <- TSCM [KnownExtension]
getExtensions
  (Module a, [KnownExtension]) -> TSCM (Module a, [KnownExtension])
forall (m :: * -> *) a. Monad m => a -> m a
return (SpanInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
forall a.
SpanInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
Module SpanInfo
spi [ModulePragma]
ps ModuleIdent
m Maybe ExportSpec
es [ImportDecl]
is [Decl a]
ds'', [KnownExtension]
exts)

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] -> TSCM ()
checkTypeLhs [Ident]
tvs
  [ConstrDecl]
cs' <- (ConstrDecl -> TSCM 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 -> TSCM ConstrDecl
checkConstrDecl [Ident]
tvs) [ConstrDecl]
cs
  (QualIdent -> TSCM ()) -> [QualIdent] -> TSCM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ QualIdent -> TSCM ()
checkClass [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] -> TSCM ()
checkTypeLhs [Ident]
tvs
  NewConstrDecl
nc' <- [Ident] -> NewConstrDecl -> StateT TSCState Identity NewConstrDecl
checkNewConstrDecl [Ident]
tvs NewConstrDecl
nc
  (QualIdent -> TSCM ()) -> [QualIdent] -> TSCM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ QualIdent -> TSCM ()
checkClass [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] -> TSCM ()
checkTypeLhs [Ident]
tvs
  TypeExpr
ty' <- [Ident] -> TypeExpr -> StateT TSCState Identity 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 -> StateT TSCState Identity 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 -> StateT TSCState Identity TypeExpr
checkType [TypeExpr]
tys
checkDecl (ClassDecl p :: SpanInfo
p cx :: Context
cx cls :: Ident
cls clsvar :: Ident
clsvar ds :: [Decl a]
ds) = do
  String -> [Ident] -> TSCM ()
checkTypeVars "class declaration" [Ident
clsvar]
  Context
cx' <- [Ident] -> Context -> StateT TSCState Identity Context
checkClosedContext [Ident
clsvar] Context
cx
  Context -> TSCM ()
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 -> TSCM ()) -> [Decl a] -> TSCM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ident -> Decl a -> TSCM ()
forall a. Ident -> Decl a -> TSCM ()
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 -> Context -> Ident -> Ident -> [Decl a] -> Decl a
forall a.
SpanInfo -> Context -> Ident -> Ident -> [Decl a] -> Decl a
ClassDecl SpanInfo
p Context
cx' Ident
cls Ident
clsvar [Decl a]
ds'
checkDecl (InstanceDecl p :: SpanInfo
p cx :: Context
cx qcls :: QualIdent
qcls inst :: TypeExpr
inst ds :: [Decl a]
ds) = do
  QualIdent -> TSCM ()
checkClass 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 -> TSCM ()
checkSimpleContext Context
cx'
  SpanInfo -> TypeExpr -> TSCM ()
checkInstanceType SpanInfo
p TypeExpr
inst'
  SpanInfo -> Context -> QualIdent -> TypeExpr -> [Decl a] -> Decl a
forall a.
SpanInfo -> Context -> QualIdent -> TypeExpr -> [Decl a] -> Decl a
InstanceDecl SpanInfo
p 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 -> TSCM ConstrDecl
checkConstrDecl tvs :: [Ident]
tvs (ConstrDecl p :: SpanInfo
p c :: Ident
c tys :: [TypeExpr]
tys) = do
  [TypeExpr]
tys' <- (TypeExpr -> StateT TSCState Identity 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 -> StateT TSCState Identity TypeExpr
checkClosedType [Ident]
tvs) [TypeExpr]
tys
  ConstrDecl -> TSCM ConstrDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstrDecl -> TSCM ConstrDecl) -> ConstrDecl -> TSCM 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 -> StateT TSCState Identity 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 -> StateT TSCState Identity TypeExpr
checkClosedType [Ident]
tvs) [TypeExpr
ty1, TypeExpr
ty2]
  let [ty1' :: TypeExpr
ty1', ty2' :: TypeExpr
ty2'] = [TypeExpr]
tys'
  ConstrDecl -> TSCM ConstrDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstrDecl -> TSCM ConstrDecl) -> ConstrDecl -> TSCM 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 -> TSCM 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 -> TSCM FieldDecl
checkFieldDecl [Ident]
tvs) [FieldDecl]
fs
  ConstrDecl -> TSCM ConstrDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstrDecl -> TSCM ConstrDecl) -> ConstrDecl -> TSCM 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 -> TSCM 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)
-> StateT TSCState Identity TypeExpr -> TSCM FieldDecl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident] -> TypeExpr -> StateT TSCState Identity TypeExpr
checkClosedType [Ident]
tvs TypeExpr
ty

checkNewConstrDecl :: [Ident] -> NewConstrDecl -> TSCM NewConstrDecl
checkNewConstrDecl :: [Ident] -> NewConstrDecl -> StateT TSCState Identity NewConstrDecl
checkNewConstrDecl tvs :: [Ident]
tvs (NewConstrDecl p :: SpanInfo
p c :: Ident
c ty :: TypeExpr
ty) = do
  TypeExpr
ty'  <- [Ident] -> TypeExpr -> StateT TSCState Identity TypeExpr
checkClosedType [Ident]
tvs TypeExpr
ty
  NewConstrDecl -> StateT TSCState Identity NewConstrDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (NewConstrDecl -> StateT TSCState Identity NewConstrDecl)
-> NewConstrDecl -> StateT TSCState Identity 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 -> StateT TSCState Identity TypeExpr
checkClosedType [Ident]
tvs TypeExpr
ty
  NewConstrDecl -> StateT TSCState Identity NewConstrDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (NewConstrDecl -> StateT TSCState Identity NewConstrDecl)
-> NewConstrDecl -> StateT TSCState Identity 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 -> TSCM ()
checkSimpleContext = (Constraint -> TSCM ()) -> Context -> TSCM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Constraint -> TSCM ()
checkSimpleConstraint

checkSimpleConstraint :: Constraint -> TSCM ()
checkSimpleConstraint :: Constraint -> TSCM ()
checkSimpleConstraint c :: Constraint
c@(Constraint _ _ ty :: TypeExpr
ty) =
  Bool -> TSCM () -> TSCM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TypeExpr -> Bool
isVariableType TypeExpr
ty) (TSCM () -> TSCM ()) -> TSCM () -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Message -> TSCM ()
report (Message -> TSCM ()) -> Message -> TSCM ()
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 -> TSCM ()
checkClassMethod tv :: Ident
tv (TypeSig spi :: SpanInfo
spi _ qty :: QualTypeExpr
qty) = do
  Bool -> TSCM () -> TSCM ()
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) (TSCM () -> TSCM ()) -> TSCM () -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Message -> TSCM ()
report (Message -> TSCM ()) -> Message -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Position -> Ident -> Message
errAmbiguousType Position
p Ident
tv
  let QualTypeExpr _ cx :: Context
cx _ = QualTypeExpr
qty
  Bool -> TSCM () -> TSCM ()
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) (TSCM () -> TSCM ()) -> TSCM () -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Message -> TSCM ()
report (Message -> TSCM ()) -> Message -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Position -> Ident -> Message
errConstrainedClassVariable Position
p Ident
tv
  where p :: Position
p = SpanInfo -> Position
forall a. HasSpanInfo a => a -> Position
spanInfo2Pos SpanInfo
spi
checkClassMethod _ _ = TSCM ()
ok

checkInstanceType :: SpanInfo -> InstanceType -> TSCM ()
checkInstanceType :: SpanInfo -> TypeExpr -> TSCM ()
checkInstanceType p :: SpanInfo
p inst :: TypeExpr
inst = do
  TypeEnv
tEnv <- TSCM TypeEnv
getTypeEnv
  Bool -> TSCM () -> TSCM ()
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)) (TSCM () -> TSCM ()) -> TSCM () -> TSCM ()
forall a b. (a -> b) -> a -> b
$
      Message -> TSCM ()
report (Message -> TSCM ()) -> Message -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Position -> TypeExpr -> Message
errIllegalInstanceType (SpanInfo -> Position
forall a. HasSpanInfo a => a -> Position
spanInfo2Pos SpanInfo
p) TypeExpr
inst

checkTypeLhs :: [Ident] -> TSCM ()
checkTypeLhs :: [Ident] -> TSCM ()
checkTypeLhs = String -> [Ident] -> TSCM ()
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] -> TSCM ()
checkTypeVars _    []         = TSCM ()
ok
checkTypeVars what :: String
what (tv :: Ident
tv : tvs :: [Ident]
tvs) = do
  Bool -> TSCM () -> TSCM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ident -> Bool
isAnonId Ident
tv) (TSCM () -> TSCM ()) -> TSCM () -> TSCM ()
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 -> TSCM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TSCM TypeEnv
getTypeEnv
    Bool -> TSCM () -> TSCM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isTypeConstrOrClass (TSCM () -> TSCM ()) -> TSCM () -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Message -> TSCM ()
report (Message -> TSCM ()) -> Message -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Ident -> String -> Message
errNoVariable Ident
tv String
what
    Bool -> TSCM () -> TSCM ()
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) (TSCM () -> TSCM ()) -> TSCM () -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Message -> TSCM ()
report (Message -> TSCM ()) -> Message -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Ident -> String -> Message
errNonLinear Ident
tv String
what
  String -> [Ident] -> TSCM ()
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 e :: Expression a
e  ds :: [Decl a]
ds) = SpanInfo -> Expression a -> [Decl a] -> Rhs a
forall a. SpanInfo -> Expression a -> [Decl a] -> Rhs a
SimpleRhs  SpanInfo
spi (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 es :: [CondExpr a]
es ds :: [Decl a]
ds) = SpanInfo -> [CondExpr a] -> [Decl a] -> Rhs a
forall a. SpanInfo -> [CondExpr a] -> [Decl a] -> Rhs a
GuardedRhs SpanInfo
spi ([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 ds :: [Decl a]
ds e :: Expression a
e) = SpanInfo -> [Decl a] -> Expression a -> Expression a
forall a. SpanInfo -> [Decl a] -> Expression a -> Expression a
Let SpanInfo
spi ([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 sts :: [Statement a]
sts e :: Expression a
e) = SpanInfo -> [Statement a] -> Expression a -> Expression a
forall a. SpanInfo -> [Statement a] -> Expression a -> Expression a
Do SpanInfo
spi ([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 ct :: CaseType
ct e :: Expression a
e alts :: [Alt a]
alts) = SpanInfo -> CaseType -> Expression a -> [Alt a] -> Expression a
forall a.
SpanInfo -> CaseType -> Expression a -> [Alt a] -> Expression a
Case SpanInfo
spi 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  ds :: [Decl a]
ds) = SpanInfo -> [Decl a] -> Statement a
forall a. SpanInfo -> [Decl a] -> Statement a
StmtDecl SpanInfo
spi   ([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 -> StateT TSCState Identity TypeExpr
checkType TypeExpr
ty
  Context
cx' <- [Ident] -> Context -> StateT TSCState Identity 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 -> StateT TSCState Identity Context
checkClosedContext tvs :: [Ident]
tvs cx :: Context
cx = do
  Context
cx' <- Context -> StateT TSCState Identity Context
checkContext Context
cx
  (Constraint -> TSCM ()) -> Context -> TSCM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Constraint _ _ ty :: TypeExpr
ty) -> [Ident] -> TypeExpr -> TSCM ()
checkClosed [Ident]
tvs TypeExpr
ty) Context
cx'
  Context -> StateT TSCState Identity Context
forall (m :: * -> *) a. Monad m => a -> m a
return Context
cx'

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

checkConstraint :: Constraint -> TSCM Constraint
checkConstraint :: Constraint -> TSCM Constraint
checkConstraint c :: Constraint
c@(Constraint spi :: SpanInfo
spi qcls :: QualIdent
qcls ty :: TypeExpr
ty) = do
  QualIdent -> TSCM ()
checkClass QualIdent
qcls
  TypeExpr
ty' <- TypeExpr -> StateT TSCState Identity TypeExpr
checkType TypeExpr
ty
  Bool -> TSCM () -> TSCM ()
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') (TSCM () -> TSCM ()) -> TSCM () -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Message -> TSCM ()
report (Message -> TSCM ()) -> Message -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Constraint -> Message
errIllegalConstraint Constraint
c
  Constraint -> TSCM Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return (Constraint -> TSCM Constraint) -> Constraint -> TSCM 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 :: QualIdent -> TSCM ()
checkClass :: QualIdent -> TSCM ()
checkClass 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 -> TSCM ()
report (Message -> TSCM ()) -> Message -> TSCM ()
forall a b. (a -> b) -> a -> b
$ QualIdent -> Message
errUndefinedClass QualIdent
qcls
    [Class _ _] -> TSCM ()
ok
    [_] -> Message -> TSCM ()
report (Message -> TSCM ()) -> Message -> TSCM ()
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 _ _] -> TSCM ()
ok
      [_] -> Message -> TSCM ()
report (Message -> TSCM ()) -> Message -> TSCM ()
forall a b. (a -> b) -> a -> b
$ QualIdent -> Message
errUndefinedClass QualIdent
qcls
      _ -> Message -> TSCM ()
report (Message -> TSCM ()) -> Message -> TSCM ()
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 -> StateT TSCState Identity TypeExpr
checkClosedType tvs :: [Ident]
tvs ty :: TypeExpr
ty = do
  TypeExpr
ty' <- TypeExpr -> StateT TSCState Identity TypeExpr
checkType TypeExpr
ty
  [Ident] -> TypeExpr -> TSCM ()
checkClosed [Ident]
tvs TypeExpr
ty'
  TypeExpr -> StateT TSCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
ty'

checkType :: TypeExpr -> TSCM TypeExpr
checkType :: TypeExpr -> StateT TSCState Identity 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 -> StateT TSCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
c
      | Bool -> Bool
not (QualIdent -> Bool
isQualified QualIdent
tc) -> TypeExpr -> StateT TSCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeExpr -> StateT TSCState Identity TypeExpr)
-> TypeExpr -> StateT TSCState 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 -> Message -> TSCM ()
report (QualIdent -> Message
errUndefinedType QualIdent
tc) TSCM ()
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity TypeExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> StateT TSCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
c
    [Class _ _] -> Message -> TSCM ()
report (QualIdent -> Message
errUndefinedType QualIdent
tc) TSCM ()
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity TypeExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> StateT TSCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
c
    [_] -> TypeExpr -> StateT TSCState Identity 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 -> TSCM ()
report (QualIdent -> Message
errUndefinedType QualIdent
tc) TSCM ()
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity TypeExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> StateT TSCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
c
      [_] -> TypeExpr -> StateT TSCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
c
      _ -> Message -> TSCM ()
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) TSCM ()
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity TypeExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> StateT TSCState Identity 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)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity (TypeExpr -> TypeExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> StateT TSCState Identity TypeExpr
checkType TypeExpr
ty1
                                                  StateT TSCState Identity (TypeExpr -> TypeExpr)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity TypeExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExpr -> StateT TSCState Identity TypeExpr
checkType TypeExpr
ty2
checkType v :: TypeExpr
v@(VariableType spi :: SpanInfo
spi tv :: Ident
tv)
  | Ident -> Bool
isAnonId Ident
tv = TypeExpr -> StateT TSCState Identity TypeExpr
forall (m :: * -> *) a. Monad m => a -> m a
return TypeExpr
v
  | Bool
otherwise   = TypeExpr -> StateT TSCState Identity TypeExpr
checkType (TypeExpr -> StateT TSCState Identity TypeExpr)
-> TypeExpr -> StateT TSCState 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) = SpanInfo -> [TypeExpr] -> TypeExpr
TupleType  SpanInfo
spi    ([TypeExpr] -> TypeExpr)
-> StateT TSCState Identity [TypeExpr]
-> StateT TSCState Identity TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeExpr -> StateT TSCState Identity 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 -> StateT TSCState Identity TypeExpr
checkType [TypeExpr]
tys
checkType (ListType       spi :: SpanInfo
spi ty :: TypeExpr
ty) = SpanInfo -> TypeExpr -> TypeExpr
ListType   SpanInfo
spi    (TypeExpr -> TypeExpr)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> StateT TSCState Identity 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)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity (TypeExpr -> TypeExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> StateT TSCState Identity TypeExpr
checkType TypeExpr
ty1
                                                      StateT TSCState Identity (TypeExpr -> TypeExpr)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity TypeExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExpr -> StateT TSCState Identity TypeExpr
checkType TypeExpr
ty2
checkType (ParenType      spi :: SpanInfo
spi ty :: TypeExpr
ty) = SpanInfo -> TypeExpr -> TypeExpr
ParenType  SpanInfo
spi    (TypeExpr -> TypeExpr)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> StateT TSCState Identity 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)
-> StateT TSCState Identity TypeExpr
-> StateT TSCState Identity TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExpr -> StateT TSCState Identity TypeExpr
checkType TypeExpr
ty

checkClosed :: [Ident] -> TypeExpr -> TSCM ()
checkClosed :: [Ident] -> TypeExpr -> TSCM ()
checkClosed _   (ConstructorType _ _) = TSCM ()
ok
checkClosed tvs :: [Ident]
tvs (ApplyType _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = (TypeExpr -> TSCM ()) -> [TypeExpr] -> TSCM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Ident] -> TypeExpr -> TSCM ()
checkClosed [Ident]
tvs) [TypeExpr
ty1, TypeExpr
ty2]
checkClosed tvs :: [Ident]
tvs (VariableType   _ tv :: Ident
tv) =
  Bool -> TSCM () -> TSCM ()
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) (TSCM () -> TSCM ()) -> TSCM () -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Message -> TSCM ()
report (Message -> TSCM ()) -> Message -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Ident -> Message
errUnboundVariable Ident
tv
checkClosed tvs :: [Ident]
tvs (TupleType     _ tys :: [TypeExpr]
tys) = (TypeExpr -> TSCM ()) -> [TypeExpr] -> TSCM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Ident] -> TypeExpr -> TSCM ()
checkClosed [Ident]
tvs) [TypeExpr]
tys
checkClosed tvs :: [Ident]
tvs (ListType       _ ty :: TypeExpr
ty) = [Ident] -> TypeExpr -> TSCM ()
checkClosed [Ident]
tvs TypeExpr
ty
checkClosed tvs :: [Ident]
tvs (ArrowType _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = (TypeExpr -> TSCM ()) -> [TypeExpr] -> TSCM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Ident] -> TypeExpr -> TSCM ()
checkClosed [Ident]
tvs) [TypeExpr
ty1, TypeExpr
ty2]
checkClosed tvs :: [Ident]
tvs (ParenType      _ ty :: TypeExpr
ty) = [Ident] -> TypeExpr -> TSCM ()
checkClosed [Ident]
tvs TypeExpr
ty
checkClosed tvs :: [Ident]
tvs (ForallType  _ vs :: [Ident]
vs ty :: TypeExpr
ty) = [Ident] -> TypeExpr -> TSCM ()
checkClosed ([Ident]
tvs [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ [Ident]
vs) TypeExpr
ty

checkUsedExtension :: Position -> String -> KnownExtension -> TSCM ()
checkUsedExtension :: Position -> String -> KnownExtension -> TSCM ()
checkUsedExtension pos :: Position
pos msg :: String
msg ext :: KnownExtension
ext = do
  Bool
enabled <- KnownExtension -> TSCM Bool
hasExtension KnownExtension
ext
  Bool -> TSCM () -> TSCM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
enabled (TSCM () -> TSCM ()) -> TSCM () -> TSCM ()
forall a b. (a -> b) -> a -> b
$ do
    Message -> TSCM ()
report (Message -> TSCM ()) -> Message -> TSCM ()
forall a b. (a -> b) -> a -> b
$ Position -> String -> KnownExtension -> Message
errMissingLanguageExtension Position
pos String
msg KnownExtension
ext
    KnownExtension -> TSCM ()
enableExtension KnownExtension
ext

-- ---------------------------------------------------------------------------
-- 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 :: [Position] -> Message
errMultipleDefaultDeclarations :: [Position] -> Message
errMultipleDefaultDeclarations ps :: [Position]
ps = Position -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage ([Position] -> Position
forall a. [a] -> a
head [Position]
ps) (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
$ (Position -> Doc) -> [Position] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Position -> Doc
showPos [Position]
ps)
  where showPos :: Position -> Doc
showPos = String -> Doc
text (String -> Doc) -> (Position -> String) -> Position -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> String
showLine

errMultipleDeclarations :: [Ident] -> Message
errMultipleDeclarations :: [Ident] -> Message
errMultipleDeclarations is :: [Ident]
is = Ident -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage 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

errMissingLanguageExtension :: Position -> String -> KnownExtension -> Message
errMissingLanguageExtension :: Position -> String -> KnownExtension -> Message
errMissingLanguageExtension p :: Position
p what :: String
what ext :: KnownExtension
ext = Position -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage Position
p (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$
  String -> Doc
text String
what Doc -> Doc -> Doc
<+> String -> Doc
text "are not supported in standard Curry." Doc -> Doc -> Doc
$+$
  Int -> Doc -> Doc
nest 2 (String -> Doc
text "Use flag -X" Doc -> Doc -> Doc
<+> String -> Doc
text (KnownExtension -> String
forall a. Show a => a -> String
show KnownExtension
ext)
          Doc -> Doc -> Doc
<+> String -> Doc
text "to enable this extension.")

errUndefined :: String -> QualIdent -> Message
errUndefined :: String -> QualIdent -> Message
errUndefined what :: String
what qident :: QualIdent
qident = QualIdent -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage 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 p. HasPosition p => p -> Doc -> Message
posMessage 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 :: Position -> Ident -> Message
errAmbiguousType :: Position -> Ident -> Message
errAmbiguousType p :: Position
p ident :: Ident
ident = Position -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage Position
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 :: Position -> Ident -> Message
errConstrainedClassVariable :: Position -> Ident -> Message
errConstrainedClassVariable p :: Position
p ident :: Ident
ident = Position -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage Position
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 p. HasPosition p => p -> Doc -> Message
posMessage 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 p. HasPosition p => p -> Doc -> Message
posMessage 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 ([String] -> [Doc]) -> [String] -> [Doc]
forall a b. (a -> b) -> a -> b
$
  [ "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 p. HasPosition p => p -> Doc -> Message
posMessage 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 p. HasPosition p => p -> Doc -> Message
posMessage 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
ppConstraint 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 p. HasPosition p => p -> Doc -> Message
posMessage 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
ppConstraint 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 :: Position -> InstanceType -> Message
errIllegalInstanceType :: Position -> TypeExpr -> Message
errIllegalInstanceType p :: Position
p inst :: TypeExpr
inst = Position -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage Position
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
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."
  ]