CompilerEnv.hs 2.5 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 :  Environment containing the module's information
    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 defines an environment for a module containing the information
    needed throughout the compilation of the module.
-}
Björn Peemöller 's avatar
Björn Peemöller committed
14
15
module CompilerEnv where

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

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

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

Björn Peemöller 's avatar
Björn Peemöller committed
23
24
import Env.Interface
import Env.ModuleAlias
Björn Peemöller 's avatar
Björn Peemöller committed
25
import Env.OpPrec
26
import Env.TypeConstructor
Björn Peemöller 's avatar
Björn Peemöller committed
27
28
import Env.Value

Björn Peemöller 's avatar
Björn Peemöller committed
29
30
31
-- |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
32
data CompilerEnv = CompilerEnv
Björn Peemöller 's avatar
Björn Peemöller committed
33
34
  { moduleIdent  :: ModuleIdent  -- ^ identifier of the module
  , interfaceEnv :: InterfaceEnv -- ^ declarations of imported interfaces
Björn Peemöller 's avatar
Björn Peemöller committed
35
  , aliasEnv     :: AliasEnv     -- ^ aliases for imported modules
Björn Peemöller 's avatar
Björn Peemöller committed
36
  , tyConsEnv    :: TCEnv        -- ^ type constructors
Björn Peemöller 's avatar
Björn Peemöller committed
37
  , valueEnv     :: ValueEnv     -- ^ functions and data constructors
Björn Peemöller 's avatar
Björn Peemöller committed
38
  , opPrecEnv    :: PEnv         -- ^ operator precedences
39
  }
Björn Peemöller 's avatar
Björn Peemöller committed
40
41
42
43

initCompilerEnv :: ModuleIdent -> CompilerEnv
initCompilerEnv mid = CompilerEnv
  { moduleIdent  = mid
Björn Peemöller 's avatar
Björn Peemöller committed
44
  , interfaceEnv = initInterfaceEnv
Björn Peemöller 's avatar
Björn Peemöller committed
45
  , aliasEnv     = initAliasEnv
Björn Peemöller 's avatar
Björn Peemöller committed
46
47
  , tyConsEnv    = initTCEnv
  , valueEnv     = initDCEnv
Björn Peemöller 's avatar
Björn Peemöller committed
48
  , opPrecEnv    = initPEnv
Björn Peemöller 's avatar
Björn Peemöller committed
49
  }
50
51

showCompilerEnv :: CompilerEnv -> String
52
53
54
55
56
57
58
showCompilerEnv env = show $ vcat
  [ header "ModuleIdent     " $ textS  $ moduleIdent 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
59
  ]
60
61
62
63
64
65
66
67
68
69
70
71
  where
  header hdr content = hang (text hdr <+> colon) 4 content
  textS = text . show

ppMap :: (Show a, Show b) => Map.Map a b -> Doc
ppMap = ppAL . Map.toList

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 ' ')