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.Syntax (Module (..), Interface (..))
Björn Peemöller 's avatar
Björn Peemöller committed
25

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

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

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

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

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

Björn Peemöller 's avatar
Björn Peemöller committed
61
-- |Check the precedences of infix operators.
62
63
64
65
--
-- * 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
66
precCheck :: Monad m => Check m Module
67
68
precCheck _ env (Module ps m es is ds)
  | null msgs = right (env { opPrecEnv = pEnv' }, Module ps m es is ds')
69
  | otherwise = left msgs
Björn Peemöller 's avatar
Björn Peemöller committed
70
71
72
73
74
  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
75
typeCheck :: Monad m => Check m Module
76
typeCheck _ env mdl@(Module _ _ _ _ ds)
77
78
  | null msgs = right (env { tyConsEnv = tcEnv', valueEnv = tyEnv' }, mdl)
  | otherwise = left msgs
79
80
  where (tcEnv', tyEnv', msgs) = TC.typeCheck (moduleIdent env)
                                 (tyConsEnv env) (valueEnv env) ds
Björn Peemöller 's avatar
Björn Peemöller committed
81

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

90
-- TODO: Which kind of warnings?
Björn Peemöller 's avatar
Björn Peemöller committed
91
92

-- |Check for warnings.
93
warnCheck :: Options -> CompilerEnv -> Module -> [Message]
94
95
warnCheck opts env mdl
  = WC.warnCheck (optWarnOpts opts) (valueEnv env) (tyConsEnv env) mdl