{- |
    Module      :  $Header$
    Description :  Different checks on a Curry module
    Copyright   :  (c) 2011 - 2013 Björn Peemöller
                       2016 - 2017 Finn Teegen
    License     :  BSD-3-clause

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

    This module subsumes the different checks to be performed on a Curry
    module during compilation, e.g. type checking.
-}
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

-- |Check for enabled language extensions.
--
-- * Declarations: remain unchanged
-- * Environment:  The enabled language extensions are updated
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

-- |Check the type syntax of type definitions and signatures.
--
-- * Declarations: Nullary type constructors and type variables are
--                 disambiguated
-- * Environment:  remains unchanged
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 { 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 ((mdl' :: Module a
mdl', exts :: [KnownExtension]
exts), msgs :: [Message]
msgs) = [KnownExtension]
-> TCEnv -> Module a -> ((Module a, [KnownExtension]), [Message])
forall a.
[KnownExtension]
-> TCEnv -> Module a -> ((Module a, [KnownExtension]), [Message])
TSC.typeSyntaxCheck (CompilerEnv -> [KnownExtension]
extensions CompilerEnv
env)
                                                   (CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env) Module a
mdl

-- |Check the kinds of type definitions and signatures.
--
-- * Declarations: remain unchanged
-- * Environment:  The type constructor and class environment are updated
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

-- |Check for a correct syntax.
--
-- * Declarations: Nullary data constructors and variables are
--                 disambiguated, variables are renamed
-- * Environment:  remains unchanged
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

-- |Check the precedences of infix operators.
--
-- * Declarations: Expressions are reordered according to the specified
--                 precedences
-- * Environment:  The operator precedence environment is updated
precCheck :: Monad m => Check m (Module a)
precCheck :: Check m (Module a)
precCheck _ (env :: CompilerEnv
env, Module spi :: SpanInfo
spi 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
-> [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')
  | 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

-- |Check the deriving clauses.
--
-- * Declarations: remain unchanged
-- * Environment:  remain unchanged
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

-- |Check the instances.
--
-- * Declarations: remain unchanged
-- * Environment:  The instance environment is updated
instanceCheck :: Monad m => Check m (Module a)
instanceCheck :: Check m (Module a)
instanceCheck _ (env :: CompilerEnv
env, Module spi :: SpanInfo
spi 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
-> [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)
  | 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

-- |Apply the correct typing of the module.
--
-- * Declarations: Type annotations are added to all expressions.
-- * Environment:  The value environment is updated.
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 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
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl PredType]
-> Module PredType
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 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

-- |Check the export specification
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

-- |Check the export specification
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 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
-> [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 (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

-- |Check for warnings.
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