module Checks where
import qualified Checks.InstanceCheck as INC (instanceCheck)
import qualified Checks.InterfaceCheck as IC (interfaceCheck)
import qualified Checks.ImportSyntaxCheck as ISC (importCheck)
import qualified Checks.DeriveCheck as DC (deriveCheck)
import qualified Checks.ExportCheck as EC (exportCheck, expandExports)
import qualified Checks.ExtensionCheck as EXC (extensionCheck)
import qualified Checks.KindCheck as KC (kindCheck)
import qualified Checks.PrecCheck as PC (precCheck)
import qualified Checks.SyntaxCheck as SC (syntaxCheck)
import qualified Checks.TypeCheck as TC (typeCheck)
import qualified Checks.TypeSyntaxCheck as TSC (typeSyntaxCheck)
import qualified Checks.WarnCheck as WC (warnCheck)
import Curry.Base.Monad
import Curry.Syntax (Module (..), Interface (..), ImportSpec)
import Base.Messages
import Base.Types
import CompilerEnv
import CompilerOpts
type Check m a = Options -> CompEnv a -> CYT m (CompEnv a)
interfaceCheck :: Monad m => Check m Interface
interfaceCheck :: Check m Interface
interfaceCheck _ (env :: CompilerEnv
env, intf :: Interface
intf)
| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs = (CompilerEnv, Interface) -> CYT m (CompilerEnv, Interface)
forall (m :: * -> *) a. Monad m => a -> CYT m a
ok (CompilerEnv
env, Interface
intf)
| Bool
otherwise = [Message] -> CYT m (CompilerEnv, Interface)
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [Message]
msgs
where msgs :: [Message]
msgs = OpPrecEnv
-> TCEnv
-> ClassEnv
-> InstEnv
-> ValueEnv
-> Interface
-> [Message]
IC.interfaceCheck (CompilerEnv -> OpPrecEnv
opPrecEnv CompilerEnv
env) (CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env) (CompilerEnv -> ClassEnv
classEnv CompilerEnv
env)
(CompilerEnv -> InstEnv
instEnv CompilerEnv
env) (CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env) Interface
intf
importCheck :: Monad m => Interface -> Maybe ImportSpec
-> CYT m (Maybe ImportSpec)
importCheck :: Interface -> Maybe ImportSpec -> CYT m (Maybe ImportSpec)
importCheck intf :: Interface
intf is :: Maybe ImportSpec
is
| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs = Maybe ImportSpec -> CYT m (Maybe ImportSpec)
forall (m :: * -> *) a. Monad m => a -> CYT m a
ok Maybe ImportSpec
is'
| Bool
otherwise = [Message] -> CYT m (Maybe ImportSpec)
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [Message]
msgs
where (is' :: Maybe ImportSpec
is', msgs :: [Message]
msgs) = Interface -> Maybe ImportSpec -> (Maybe ImportSpec, [Message])
ISC.importCheck Interface
intf Maybe ImportSpec
is
extensionCheck :: Monad m => Check m (Module a)
extensionCheck :: Check m (Module a)
extensionCheck opts :: Options
opts (env :: CompilerEnv
env, mdl :: Module a
mdl)
| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs = (CompilerEnv, Module a) -> CYT m (CompilerEnv, Module a)
forall (m :: * -> *) a. Monad m => a -> CYT m a
ok (CompilerEnv
env { extensions :: [KnownExtension]
extensions = [KnownExtension]
exts }, Module a
mdl)
| Bool
otherwise = [Message] -> CYT m (CompilerEnv, Module a)
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [Message]
msgs
where (exts :: [KnownExtension]
exts, msgs :: [Message]
msgs) = Options -> Module a -> ([KnownExtension], [Message])
forall a. Options -> Module a -> ([KnownExtension], [Message])
EXC.extensionCheck Options
opts Module a
mdl
typeSyntaxCheck :: Monad m => Check m (Module a)
typeSyntaxCheck :: Check m (Module a)
typeSyntaxCheck _ (env :: CompilerEnv
env, mdl :: Module a
mdl)
| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs = (CompilerEnv, Module a) -> CYT m (CompilerEnv, Module a)
forall (m :: * -> *) a. Monad m => a -> CYT m a
ok (CompilerEnv
env, Module a
mdl')
| Bool
otherwise = [Message] -> CYT m (CompilerEnv, Module a)
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [Message]
msgs
where (mdl' :: Module a
mdl', msgs :: [Message]
msgs) = TCEnv -> Module a -> (Module a, [Message])
forall a. TCEnv -> Module a -> (Module a, [Message])
TSC.typeSyntaxCheck (CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env) Module a
mdl
kindCheck :: Monad m => Check m (Module a)
kindCheck :: Check m (Module a)
kindCheck _ (env :: CompilerEnv
env, mdl :: Module a
mdl)
| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs = (CompilerEnv, Module a) -> CYT m (CompilerEnv, Module a)
forall (m :: * -> *) a. Monad m => a -> CYT m a
ok (CompilerEnv
env { tyConsEnv :: TCEnv
tyConsEnv = TCEnv
tcEnv', classEnv :: ClassEnv
classEnv = ClassEnv
clsEnv' }, Module a
mdl)
| Bool
otherwise = [Message] -> CYT m (CompilerEnv, Module a)
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [Message]
msgs
where ((tcEnv' :: TCEnv
tcEnv', clsEnv' :: ClassEnv
clsEnv'), msgs :: [Message]
msgs) = TCEnv -> ClassEnv -> Module a -> ((TCEnv, ClassEnv), [Message])
forall a.
TCEnv -> ClassEnv -> Module a -> ((TCEnv, ClassEnv), [Message])
KC.kindCheck (CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env) (CompilerEnv -> ClassEnv
classEnv CompilerEnv
env)
Module a
mdl
syntaxCheck :: Monad m => Check m (Module ())
syntaxCheck :: Check m (Module ())
syntaxCheck _ (env :: CompilerEnv
env, mdl :: Module ()
mdl)
| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs = (CompilerEnv, Module ()) -> CYT m (CompilerEnv, Module ())
forall (m :: * -> *) a. Monad m => a -> CYT m a
ok (CompilerEnv
env { extensions :: [KnownExtension]
extensions = [KnownExtension]
exts }, Module ()
mdl')
| Bool
otherwise = [Message] -> CYT m (CompilerEnv, Module ())
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [Message]
msgs
where ((mdl' :: Module ()
mdl', exts :: [KnownExtension]
exts), msgs :: [Message]
msgs) = [KnownExtension]
-> TCEnv
-> ValueEnv
-> Module ()
-> ((Module (), [KnownExtension]), [Message])
SC.syntaxCheck (CompilerEnv -> [KnownExtension]
extensions CompilerEnv
env) (CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env)
(CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env) Module ()
mdl
precCheck :: Monad m => Check m (Module a)
precCheck :: Check m (Module a)
precCheck _ (env :: CompilerEnv
env, Module spi :: SpanInfo
spi li :: LayoutInfo
li ps :: [ModulePragma]
ps m :: ModuleIdent
m es :: Maybe ExportSpec
es is :: [ImportDecl]
is ds :: [Decl a]
ds)
| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs = (CompilerEnv, Module a) -> CYT m (CompilerEnv, Module a)
forall (m :: * -> *) a. Monad m => a -> CYT m a
ok (CompilerEnv
env { opPrecEnv :: OpPrecEnv
opPrecEnv = OpPrecEnv
pEnv' }, SpanInfo
-> LayoutInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
forall a.
SpanInfo
-> LayoutInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
Module SpanInfo
spi LayoutInfo
li [ModulePragma]
ps ModuleIdent
m Maybe ExportSpec
es [ImportDecl]
is [Decl a]
ds')
| Bool
otherwise = [Message] -> CYT m (CompilerEnv, Module a)
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [Message]
msgs
where (ds' :: [Decl a]
ds', pEnv' :: OpPrecEnv
pEnv', msgs :: [Message]
msgs) = ModuleIdent
-> OpPrecEnv -> [Decl a] -> ([Decl a], OpPrecEnv, [Message])
forall a.
ModuleIdent
-> OpPrecEnv -> [Decl a] -> ([Decl a], OpPrecEnv, [Message])
PC.precCheck (CompilerEnv -> ModuleIdent
moduleIdent CompilerEnv
env) (CompilerEnv -> OpPrecEnv
opPrecEnv CompilerEnv
env) [Decl a]
ds
deriveCheck :: Monad m => Check m (Module a)
deriveCheck :: Check m (Module a)
deriveCheck _ (env :: CompilerEnv
env, mdl :: Module a
mdl) = case TCEnv -> Module a -> [Message]
forall a. TCEnv -> Module a -> [Message]
DC.deriveCheck (CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env) Module a
mdl of
msgs :: [Message]
msgs | [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs -> (CompilerEnv, Module a) -> CYT m (CompilerEnv, Module a)
forall (m :: * -> *) a. Monad m => a -> CYT m a
ok (CompilerEnv
env, Module a
mdl)
| Bool
otherwise -> [Message] -> CYT m (CompilerEnv, Module a)
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [Message]
msgs
instanceCheck :: Monad m => Check m (Module a)
instanceCheck :: Check m (Module a)
instanceCheck _ (env :: CompilerEnv
env, Module spi :: SpanInfo
spi li :: LayoutInfo
li ps :: [ModulePragma]
ps m :: ModuleIdent
m es :: Maybe ExportSpec
es is :: [ImportDecl]
is ds :: [Decl a]
ds)
| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs = (CompilerEnv, Module a) -> CYT m (CompilerEnv, Module a)
forall (m :: * -> *) a. Monad m => a -> CYT m a
ok (CompilerEnv
env { instEnv :: InstEnv
instEnv = InstEnv
inEnv' }, SpanInfo
-> LayoutInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
forall a.
SpanInfo
-> LayoutInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
Module SpanInfo
spi LayoutInfo
li [ModulePragma]
ps ModuleIdent
m Maybe ExportSpec
es [ImportDecl]
is [Decl a]
ds)
| Bool
otherwise = [Message] -> CYT m (CompilerEnv, Module a)
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [Message]
msgs
where (inEnv' :: InstEnv
inEnv', msgs :: [Message]
msgs) = ModuleIdent
-> TCEnv -> ClassEnv -> InstEnv -> [Decl a] -> (InstEnv, [Message])
forall a.
ModuleIdent
-> TCEnv -> ClassEnv -> InstEnv -> [Decl a] -> (InstEnv, [Message])
INC.instanceCheck (CompilerEnv -> ModuleIdent
moduleIdent CompilerEnv
env) (CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env)
(CompilerEnv -> ClassEnv
classEnv CompilerEnv
env) (CompilerEnv -> InstEnv
instEnv CompilerEnv
env) [Decl a]
ds
typeCheck :: Monad m => Options -> CompEnv (Module a)
-> CYT m (CompEnv (Module PredType))
typeCheck :: Options -> CompEnv (Module a) -> CYT m (CompEnv (Module PredType))
typeCheck _ (env :: CompilerEnv
env, Module spi :: SpanInfo
spi li :: LayoutInfo
li ps :: [ModulePragma]
ps m :: ModuleIdent
m es :: Maybe ExportSpec
es is :: [ImportDecl]
is ds :: [Decl a]
ds)
| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs = CompEnv (Module PredType) -> CYT m (CompEnv (Module PredType))
forall (m :: * -> *) a. Monad m => a -> CYT m a
ok (CompilerEnv
env { valueEnv :: ValueEnv
valueEnv = ValueEnv
vEnv' }, SpanInfo
-> LayoutInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl PredType]
-> Module PredType
forall a.
SpanInfo
-> LayoutInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
Module SpanInfo
spi LayoutInfo
li [ModulePragma]
ps ModuleIdent
m Maybe ExportSpec
es [ImportDecl]
is [Decl PredType]
ds')
| Bool
otherwise = [Message] -> CYT m (CompEnv (Module PredType))
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [Message]
msgs
where (ds' :: [Decl PredType]
ds', vEnv' :: ValueEnv
vEnv', msgs :: [Message]
msgs) = ModuleIdent
-> TCEnv
-> ValueEnv
-> ClassEnv
-> InstEnv
-> [Decl a]
-> ([Decl PredType], ValueEnv, [Message])
forall a.
ModuleIdent
-> TCEnv
-> ValueEnv
-> ClassEnv
-> InstEnv
-> [Decl a]
-> ([Decl PredType], ValueEnv, [Message])
TC.typeCheck (CompilerEnv -> ModuleIdent
moduleIdent CompilerEnv
env) (CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env)
(CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env) (CompilerEnv -> ClassEnv
classEnv CompilerEnv
env)
(CompilerEnv -> InstEnv
instEnv CompilerEnv
env) [Decl a]
ds
exportCheck :: Monad m => Check m (Module a)
exportCheck :: Check m (Module a)
exportCheck _ (env :: CompilerEnv
env, mdl :: Module a
mdl@(Module _ _ _ _ es :: Maybe ExportSpec
es _ _))
| [Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
msgs = (CompilerEnv, Module a) -> CYT m (CompilerEnv, Module a)
forall (m :: * -> *) a. Monad m => a -> CYT m a
ok (CompilerEnv
env, Module a
mdl)
| Bool
otherwise = [Message] -> CYT m (CompilerEnv, Module a)
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [Message]
msgs
where msgs :: [Message]
msgs = ModuleIdent
-> AliasEnv -> TCEnv -> ValueEnv -> Maybe ExportSpec -> [Message]
EC.exportCheck (CompilerEnv -> ModuleIdent
moduleIdent CompilerEnv
env) (CompilerEnv -> AliasEnv
aliasEnv CompilerEnv
env)
(CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env) (CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env) Maybe ExportSpec
es
expandExports :: Monad m => Options -> CompEnv (Module a) -> m (CompEnv (Module a))
expandExports :: Options -> CompEnv (Module a) -> m (CompEnv (Module a))
expandExports _ (env :: CompilerEnv
env, Module spi :: SpanInfo
spi li :: LayoutInfo
li ps :: [ModulePragma]
ps m :: ModuleIdent
m es :: Maybe ExportSpec
es is :: [ImportDecl]
is ds :: [Decl a]
ds)
= CompEnv (Module a) -> m (CompEnv (Module a))
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerEnv
env, SpanInfo
-> LayoutInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
forall a.
SpanInfo
-> LayoutInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
Module SpanInfo
spi LayoutInfo
li [ModulePragma]
ps ModuleIdent
m (ExportSpec -> Maybe ExportSpec
forall a. a -> Maybe a
Just ExportSpec
es') [ImportDecl]
is [Decl a]
ds)
where es' :: ExportSpec
es' = ModuleIdent
-> AliasEnv -> TCEnv -> ValueEnv -> Maybe ExportSpec -> ExportSpec
EC.expandExports (CompilerEnv -> ModuleIdent
moduleIdent CompilerEnv
env) (CompilerEnv -> AliasEnv
aliasEnv CompilerEnv
env)
(CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env) (CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env) Maybe ExportSpec
es
warnCheck :: Options -> CompilerEnv -> Module a -> [Message]
warnCheck :: Options -> CompilerEnv -> Module a -> [Message]
warnCheck opts :: Options
opts env :: CompilerEnv
env mdl :: Module a
mdl = WarnOpts
-> CaseMode
-> AliasEnv
-> ValueEnv
-> TCEnv
-> ClassEnv
-> Module a
-> [Message]
forall a.
WarnOpts
-> CaseMode
-> AliasEnv
-> ValueEnv
-> TCEnv
-> ClassEnv
-> Module a
-> [Message]
WC.warnCheck (Options -> WarnOpts
optWarnOpts Options
opts) (Options -> CaseMode
optCaseMode Options
opts)
(CompilerEnv -> AliasEnv
aliasEnv CompilerEnv
env) (CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env) (CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env) (CompilerEnv -> ClassEnv
classEnv CompilerEnv
env) Module a
mdl