Checks.hs 2.97 KB
Newer Older
Björn Peemöller 's avatar
Björn Peemöller committed
1
2
3
4
5
6
7
8
9
10
11
12
13
{- |
    Module      :  $Header$
    Description :  Different checks on a Curry module
    Copyright   :  (c) 2011, Björn Peemöller (bjp@informatik.uni-kiel.de)
    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
import Curry.Syntax (Module (..))

import Base.Messages
Björn Peemöller 's avatar
Björn Peemöller committed
19

Björn Peemöller 's avatar
Björn Peemöller committed
20
21
22
23
24
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
25
26
27
28

import CompilerEnv
import CompilerOpts

Björn Peemöller 's avatar
Björn Peemöller committed
29
30
31
32
33
34
35
36
37
38
data CheckStatus a
  = CheckFailed [Message]
  | CheckSuccess a

instance Monad CheckStatus where
  return  = CheckSuccess
  m >>= f = case m of
    CheckFailed  errs -> CheckFailed  errs
    CheckSuccess    a -> f a

Björn Peemöller 's avatar
Björn Peemöller committed
39
40
41
-- TODO: More documentation

-- |Check the kinds of type definitions and signatures.
Björn Peemöller 's avatar
Björn Peemöller committed
42
43
-- In addition, nullary type constructors and type variables are
-- disambiguated in the declarations; the environment remains unchanged.
Björn Peemöller 's avatar
Björn Peemöller committed
44
45
46
47
48
kindCheck :: CompilerEnv -> Module -> (CompilerEnv, Module)
kindCheck env (Module m es is ds)
  | null msgs = (env, Module m es is ds')
  | otherwise = errorMessages msgs
  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
51
52
-- |Check for a correct syntax.
-- In addition, nullary data constructors and variables are
-- disambiguated in the declarations; the environment remains unchanged.
Björn Peemöller 's avatar
Björn Peemöller committed
53
54
55
56
57
syntaxCheck :: Options -> CompilerEnv -> Module -> (CompilerEnv, Module)
syntaxCheck opts env (Module m es is ds)
  | null msgs = (env, Module m es is ds')
  | otherwise = errorMessages msgs
  where (ds', msgs) = SC.syntaxCheck opts (moduleIdent env) (aliasEnv env)
58
                   (arityEnv env) (valueEnv env) (tyConsEnv env) ds
Björn Peemöller 's avatar
Björn Peemöller committed
59

Björn Peemöller 's avatar
Björn Peemöller committed
60
61
62
63
64
65
66
67
68
69
70
71
-- |Check the precedences of infix operators.
-- In addition, the abstract syntax tree is rearranged to reflect the
-- relative precedences; the operator precedence environment is updated.
precCheck :: CompilerEnv -> Module -> (CompilerEnv, Module)
precCheck env (Module m es is ds)
  | null msgs = (env { opPrecEnv = pEnv' }, Module m es is ds')
  | otherwise = errorMessages msgs
  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
72
73
typeCheck :: CompilerEnv -> Module -> (CompilerEnv, Module)
typeCheck env mdl@(Module _ _ _ ds) = (env { tyConsEnv = tcEnv', valueEnv = tyEnv' }, mdl)
Björn Peemöller 's avatar
Björn Peemöller committed
74
  where (tcEnv', tyEnv') = TC.typeCheck (moduleIdent env)
75
                              (tyConsEnv env) (valueEnv env) ds
Björn Peemöller 's avatar
Björn Peemöller committed
76

77
-- TODO: Which kind of warnings?
Björn Peemöller 's avatar
Björn Peemöller committed
78
79

-- |Check for warnings.
Björn Peemöller 's avatar
Björn Peemöller committed
80
warnCheck :: CompilerEnv -> Module -> [Message]
Björn Peemöller 's avatar
Björn Peemöller committed
81
warnCheck env mdl = WC.warnCheck (valueEnv env) mdl