Checks.hs 3.66 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

20
import qualified Checks.ExportCheck as EC (exportCheck)
Björn Peemöller 's avatar
Björn Peemöller committed
21
22
23
24
25
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
26
27
28
29

import CompilerEnv
import CompilerOpts

30
31
32
33
34
35
36
37
38
39
40
41
42
data CheckResult a
  = CheckSuccess a
  | CheckFailed [Message]

instance Monad CheckResult where
  return = CheckSuccess
  (>>=)  = thenCheck

thenCheck :: CheckResult a -> (a -> CheckResult b) -> CheckResult b
thenCheck chk cont = case chk of
  CheckSuccess   a -> cont a
  CheckFailed errs -> CheckFailed errs

Björn Peemöller 's avatar
Björn Peemöller committed
43
44
45
-- TODO: More documentation

-- |Check the kinds of type definitions and signatures.
46
47
48
49
--
-- * Declarations: Nullary type constructors and type variables are
--                 disambiguated
-- * Environment:  remains unchanged
50
kindCheck :: CompilerEnv -> Module -> CheckResult (CompilerEnv, Module)
Björn Peemöller 's avatar
Björn Peemöller committed
51
kindCheck env (Module m es is ds)
52
53
  | null msgs = CheckSuccess (env, Module m es is ds')
  | otherwise = CheckFailed msgs
Björn Peemöller 's avatar
Björn Peemöller committed
54
  where (ds', msgs) = KC.kindCheck (moduleIdent env) (tyConsEnv env) ds
Björn Peemöller 's avatar
Björn Peemöller committed
55

Björn Peemöller 's avatar
Björn Peemöller committed
56
-- |Check for a correct syntax.
57
58
--
-- * Declarations: Nullary data constructors and variables are
59
--                 disambiguated, variables are renamed
60
-- * Environment:  remains unchanged
61
syntaxCheck :: Options -> CompilerEnv -> Module -> CheckResult (CompilerEnv, Module)
Björn Peemöller 's avatar
Björn Peemöller committed
62
syntaxCheck opts env (Module m es is ds)
63
64
  | null msgs = CheckSuccess (env, Module m es is ds')
  | otherwise = CheckFailed msgs
65
66
  where (ds', msgs) = SC.syntaxCheck opts (moduleIdent env)
                      (valueEnv env) (tyConsEnv env) ds
Björn Peemöller 's avatar
Björn Peemöller committed
67

Björn Peemöller 's avatar
Björn Peemöller committed
68
-- |Check the precedences of infix operators.
69
70
71
72
--
-- * Declarations: Expressions are reordered according to the specified
--                 precedences
-- * Environment:  The operator precedence environment is updated
73
precCheck :: CompilerEnv -> Module -> CheckResult (CompilerEnv, Module)
Björn Peemöller 's avatar
Björn Peemöller committed
74
precCheck env (Module m es is ds)
75
76
  | null msgs = CheckSuccess (env { opPrecEnv = pEnv' }, Module m es is ds')
  | otherwise = CheckFailed msgs
Björn Peemöller 's avatar
Björn Peemöller committed
77
78
79
80
81
  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.
82
83
84
85
86
87
typeCheck :: CompilerEnv -> Module -> CheckResult (CompilerEnv, Module)
typeCheck env mdl@(Module _ _ _ ds)
  | null msgs = CheckSuccess (env { tyConsEnv = tcEnv', valueEnv = tyEnv' }, mdl)
  | otherwise = CheckFailed msgs
  where (tcEnv', tyEnv', msgs) = TC.typeCheck (moduleIdent env)
                                 (tyConsEnv env) (valueEnv env) ds
Björn Peemöller 's avatar
Björn Peemöller committed
88

89
-- |Check the export specification
90
exportCheck :: CompilerEnv -> Module -> CheckResult (CompilerEnv, Module)
91
exportCheck env (Module m es is ds)
92
93
  | null msgs = CheckSuccess (env, Module m es' is ds)
  | otherwise = CheckFailed msgs
94
95
  where (es', msgs) = EC.exportCheck (moduleIdent env) (aliasEnv env)
                                     (tyConsEnv env) (valueEnv env) es
96

97
-- TODO: Which kind of warnings?
Björn Peemöller 's avatar
Björn Peemöller committed
98
99

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