CompilerEnv.hs 2.67 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
Björn Peemöller 's avatar
Björn Peemöller committed
20

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
import Env.Interface
Björn Peemöller 's avatar
Björn Peemöller committed
24
import Env.ModuleAlias (AliasEnv, initAliasEnv)
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    :: OpPrecEnv    -- ^ operator precedences
39
  }
Björn Peemöller 's avatar
Björn Peemöller committed
40

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

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

Björn Peemöller 's avatar
Björn Peemöller committed
67
-- |Pretty print a 'Map'
68
69
70
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
71
-- |Pretty print an association list
72
73
74
75
76
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 ' ')