CompilerEnv.hs 2.87 KB
Newer Older
Björn Peemöller 's avatar
Björn Peemöller committed
1
2
3
{- |
    Module      :  $Header$
    Description :  Environment containing the module's information
Björn Peemöller 's avatar
Björn Peemöller committed
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
    License     :  OtherLicense

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

Björn Peemöller 's avatar
Björn Peemöller committed
11
12
    This module defines the compilation environment for a single module,
     containing the information needed throughout the compilation process.
Björn Peemöller 's avatar
Björn Peemöller committed
13
-}
Björn Peemöller 's avatar
Björn Peemöller committed
14
15
module CompilerEnv where

16
import qualified Data.Map as Map (Map, keys, toList)
17

Björn Peemöller 's avatar
Björn Peemöller committed
18
19
import Curry.Base.Ident  (ModuleIdent)
import Curry.Base.Pretty
20
import Curry.Syntax
Björn Peemöller 's avatar
Björn Peemöller committed
21

Björn Peemöller 's avatar
Björn Peemöller committed
22
import Base.TopEnv (allLocalBindings)
23

Björn Peemöller 's avatar
Björn Peemöller committed
24
import Env.Interface
Björn Peemöller 's avatar
Björn Peemöller committed
25
import Env.ModuleAlias (AliasEnv, initAliasEnv)
Björn Peemöller 's avatar
Björn Peemöller committed
26
import Env.OpPrec
27
import Env.TypeConstructor
Björn Peemöller 's avatar
Björn Peemöller committed
28
29
import Env.Value

Björn Peemöller 's avatar
Björn Peemöller committed
30
31
32
-- |A compiler environment contains information about the module currently
--  compiled. The information is updated during the different stages of
--  compilation.
Björn Peemöller 's avatar
Björn Peemöller committed
33
data CompilerEnv = CompilerEnv
34
35
36
37
38
39
40
  { moduleIdent  :: ModuleIdent      -- ^ identifier of the module
  , extensions   :: [KnownExtension] -- ^ enabled language extensions
  , interfaceEnv :: InterfaceEnv     -- ^ declarations of imported interfaces
  , aliasEnv     :: AliasEnv         -- ^ aliases for imported modules
  , tyConsEnv    :: TCEnv            -- ^ type constructors
  , valueEnv     :: ValueEnv         -- ^ functions and data constructors
  , opPrecEnv    :: OpPrecEnv        -- ^ operator precedences
41
  }
Björn Peemöller 's avatar
Björn Peemöller committed
42

Björn Peemöller 's avatar
Björn Peemöller committed
43
-- |Initial 'CompilerEnv'
Björn Peemöller 's avatar
Björn Peemöller committed
44
45
46
initCompilerEnv :: ModuleIdent -> CompilerEnv
initCompilerEnv mid = CompilerEnv
  { moduleIdent  = mid
47
  , extensions   = []
Björn Peemöller 's avatar
Björn Peemöller committed
48
  , interfaceEnv = initInterfaceEnv
Björn Peemöller 's avatar
Björn Peemöller committed
49
  , aliasEnv     = initAliasEnv
Björn Peemöller 's avatar
Björn Peemöller committed
50
51
  , tyConsEnv    = initTCEnv
  , valueEnv     = initDCEnv
Björn Peemöller 's avatar
Björn Peemöller committed
52
  , opPrecEnv    = initOpPrecEnv
Björn Peemöller 's avatar
Björn Peemöller committed
53
  }
54

Björn Peemöller 's avatar
Björn Peemöller committed
55
-- |Show the 'CompilerEnv'
56
showCompilerEnv :: CompilerEnv -> String
57
showCompilerEnv env = show $ vcat
58
59
60
61
62
63
64
65
  [ header "ModuleIdent       " $ textS $ moduleIdent env
  , header "Language Etensions" $ text  $ show $ extensions  env
  , header "Interfaces        " $ hcat  $ punctuate comma $ map textS
                                        $ Map.keys $ interfaceEnv env
  , header "ModuleAliases     " $ ppMap $ aliasEnv     env
  , header "TypeConstructors  " $ ppAL $ allLocalBindings $ tyConsEnv env
  , header "Values            " $ ppAL $ allLocalBindings $ valueEnv  env
  , header "Precedences       " $ ppAL $ allLocalBindings $ opPrecEnv env
66
  ]
67
68
69
70
  where
  header hdr content = hang (text hdr <+> colon) 4 content
  textS = text . show

Björn Peemöller 's avatar
Björn Peemöller committed
71
-- |Pretty print a 'Map'
72
73
74
ppMap :: (Show a, Show b) => Map.Map a b -> Doc
ppMap = ppAL . Map.toList

Björn Peemöller 's avatar
Björn Peemöller committed
75
-- |Pretty print an association list
76
77
78
79
80
ppAL :: (Show a, Show b) => [(a, b)] -> Doc
ppAL xs = vcat $ map (\(a,b) -> text (pad a keyWidth) <+> equals <+> text b) showXs
  where showXs   = map (\(a,b) -> (show a, show b)) xs
        keyWidth = maximum (0 : map (length .fst) showXs)
        pad s n  = take n (s ++ repeat ' ')