Checks.hs 3.49 KB
Newer Older
Björn Peemöller 's avatar
Björn Peemöller committed
1 2 3
{- |
    Module      :  $Header$
    Description :  Different checks on a Curry module
4
    Copyright   :  (c) 2011 - 2013, Björn Peemöller
Björn Peemöller 's avatar
Björn Peemöller committed
5 6 7 8 9 10 11 12 13
    License     :  OtherLicense

    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.
-}
Björn Peemöller 's avatar
Björn Peemöller committed
14 15
module Checks where

Björn Peemöller 's avatar
Björn Peemöller committed
16 17 18 19 20 21 22
import qualified Checks.InterfaceCheck as IC (interfaceCheck)
import qualified Checks.ExportCheck    as EC (exportCheck)
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.WarnCheck      as WC (warnCheck)
Björn Peemöller 's avatar
Björn Peemöller committed
23

24
import Curry.Base.Monad
25
import Curry.Syntax (Module (..), Interface (..))
Björn Peemöller 's avatar
Björn Peemöller committed
26

Björn Peemöller 's avatar
Björn Peemöller committed
27
import Base.Messages
Björn Peemöller 's avatar
Björn Peemöller committed
28 29 30
import CompilerEnv
import CompilerOpts

31
type Check m a = Options -> CompEnv a -> CYT m (CompEnv a)
Björn Peemöller 's avatar
Björn Peemöller committed
32

33
interfaceCheck :: Monad m => Check m Interface
34
interfaceCheck _ (env, intf)
35 36
  | null msgs = ok (env, intf)
  | otherwise = failMessages msgs
37
  where msgs = IC.interfaceCheck (opPrecEnv env) (tyConsEnv env)
Björn Peemöller 's avatar
Björn Peemöller committed
38 39
                                 (valueEnv env) intf

Björn Peemöller 's avatar
Björn Peemöller committed
40
-- |Check the kinds of type definitions and signatures.
41 42 43 44
--
-- * Declarations: Nullary type constructors and type variables are
--                 disambiguated
-- * Environment:  remains unchanged
Björn Peemöller 's avatar
Björn Peemöller committed
45
kindCheck :: Monad m => Check m Module
46
kindCheck _ (env, mdl)
Björn Peemöller 's avatar
Björn Peemöller committed
47
  | null msgs = ok (env, mdl')
48
  | otherwise = failMessages msgs
Björn Peemöller 's avatar
Björn Peemöller committed
49
  where (mdl', msgs) = KC.kindCheck (tyConsEnv env) mdl
Björn Peemöller 's avatar
Björn Peemöller committed
50

Björn Peemöller 's avatar
Björn Peemöller committed
51
-- |Check for a correct syntax.
52 53
--
-- * Declarations: Nullary data constructors and variables are
54
--                 disambiguated, variables are renamed
55
-- * Environment:  remains unchanged
Björn Peemöller 's avatar
Björn Peemöller committed
56
syntaxCheck :: Monad m => Check m Module
57
syntaxCheck opts (env, mdl)
58 59
  | null msgs = ok (env { extensions = exts }, mdl')
  | otherwise = failMessages msgs
60
  where ((mdl', exts), msgs) = SC.syntaxCheck opts (valueEnv env) mdl
Björn Peemöller 's avatar
Björn Peemöller committed
61

Björn Peemöller 's avatar
Björn Peemöller committed
62
-- |Check the precedences of infix operators.
63 64 65 66
--
-- * Declarations: Expressions are reordered according to the specified
--                 precedences
-- * Environment:  The operator precedence environment is updated
Björn Peemöller 's avatar
Björn Peemöller committed
67
precCheck :: Monad m => Check m Module
68
precCheck _ (env, Module ps m es is ds)
69 70
  | null msgs = ok (env { opPrecEnv = pEnv' }, Module ps m es is ds')
  | otherwise = failMessages msgs
Björn Peemöller 's avatar
Björn Peemöller committed
71 72 73 74 75
  where (ds', pEnv', msgs) = PC.precCheck (moduleIdent env) (opPrecEnv env) ds

-- |Apply the correct typing of the module.
-- The declarations remain unchanged; the type constructor and value
-- environments are updated.
Björn Peemöller 's avatar
Björn Peemöller committed
76
typeCheck :: Monad m => Check m Module
77
typeCheck _ (env, mdl@(Module _ _ _ _ ds))
78 79
  | null msgs = ok (env { tyConsEnv = tcEnv', valueEnv = tyEnv' }, mdl)
  | otherwise = failMessages msgs
80 81
  where (tcEnv', tyEnv', msgs) = TC.typeCheck (moduleIdent env)
                                 (tyConsEnv env) (valueEnv env) ds
Björn Peemöller 's avatar
Björn Peemöller committed
82

83
-- |Check the export specification
Björn Peemöller 's avatar
Björn Peemöller committed
84
exportCheck :: Monad m => Check m Module
85
exportCheck _ (env, Module ps m es is ds)
86 87
  | null msgs = ok (env, Module ps m es' is ds)
  | otherwise = failMessages msgs
88 89
  where (es', msgs) = EC.exportCheck (moduleIdent env) (aliasEnv env)
                                     (tyConsEnv env) (valueEnv env) es
90

Björn Peemöller 's avatar
Björn Peemöller committed
91
-- |Check for warnings.
92
warnCheck :: Options -> CompilerEnv -> Module -> [Message]
93 94
warnCheck opts env mdl = WC.warnCheck (optWarnOpts opts) (aliasEnv env)
  (valueEnv env) (tyConsEnv env) mdl