Checks.hs 2.6 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 42
-- TODO: More documentation

-- |Check the kinds of type definitions and signatures.
-- In addition, nullary type constructors and type variables are dinstiguished
Björn Peemöller 's avatar
Björn Peemöller committed
43 44 45 46 47
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
48

Björn Peemöller 's avatar
Björn Peemöller committed
49 50
-- |Apply the precendences of infix operators.
-- This function reanrranges the AST.
Björn Peemöller 's avatar
Björn Peemöller committed
51 52 53 54 55
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
Björn Peemöller 's avatar
Björn Peemöller committed
56

Björn Peemöller 's avatar
Björn Peemöller committed
57
-- |Apply the syntax check.
Björn Peemöller 's avatar
Björn Peemöller committed
58 59 60 61 62
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)
63
                   (arityEnv env) (valueEnv env) (tyConsEnv env) ds
Björn Peemöller 's avatar
Björn Peemöller committed
64

Björn Peemöller 's avatar
Björn Peemöller committed
65
-- |Apply the type check.
Björn Peemöller 's avatar
Björn Peemöller committed
66 67
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
68
  where (tcEnv', tyEnv') = TC.typeCheck (moduleIdent env)
69
                              (tyConsEnv env) (valueEnv env) ds
Björn Peemöller 's avatar
Björn Peemöller committed
70

71
-- TODO: Which kind of warnings?
Björn Peemöller 's avatar
Björn Peemöller committed
72 73

-- |Check for warnings.
Björn Peemöller 's avatar
Björn Peemöller committed
74 75
warnCheck :: CompilerEnv -> Module -> [Message]
warnCheck env (Module _ _ is ds)
76
  = WC.warnCheck (moduleIdent env) (valueEnv env) is ds