{- |
Module : $Header$
Description : Environment containing the module's information
Copyright : (c) 2011 - 2015 Björn Peemöller
License : BSD-3-clause
Maintainer : bjp@informatik.uni-kiel.de
Stability : experimental
Portability : portable
This module defines the compilation environment for a single module,
containing the information needed throughout the compilation process.
-}
module CompilerEnv where
import qualified Data.Map as Map (Map, keys, toList)
import Curry.Base.Ident (ModuleIdent, moduleName)
import Curry.Base.Pretty
import Curry.Base.Span (Span)
import Curry.Syntax
import Base.TopEnv (allBindings, allLocalBindings)
import Env.Class
import Env.Instance
import Env.Interface
import Env.ModuleAlias (AliasEnv, initAliasEnv)
import Env.OpPrec
import Env.TypeConstructor
import Env.Value
type CompEnv a = (CompilerEnv, a)
-- |A compiler environment contains information about the module currently
-- compiled. The information is updated during the different stages of
-- compilation.
data CompilerEnv = CompilerEnv
{ moduleIdent :: ModuleIdent -- ^ identifier of the module
, filePath :: FilePath -- ^ 'FilePath' of compilation target
, extensions :: [KnownExtension] -- ^ enabled language extensions
, tokens :: [(Span, Token)] -- ^ token list of module
, interfaceEnv :: InterfaceEnv -- ^ declarations of imported interfaces
, aliasEnv :: AliasEnv -- ^ aliases for imported modules
, tyConsEnv :: TCEnv -- ^ type constructors and type classes
, classEnv :: ClassEnv -- ^ all type classes with their super classes
, instEnv :: InstEnv -- ^ instances
, valueEnv :: ValueEnv -- ^ functions and data constructors
, opPrecEnv :: OpPrecEnv -- ^ operator precedences
}
-- |Initial 'CompilerEnv'
initCompilerEnv :: ModuleIdent -> CompilerEnv
initCompilerEnv mid = CompilerEnv
{ moduleIdent = mid
, filePath = []
, extensions = []
, tokens = []
, interfaceEnv = initInterfaceEnv
, aliasEnv = initAliasEnv
, tyConsEnv = initTCEnv
, classEnv = initClassEnv
, instEnv = initInstEnv
, valueEnv = initDCEnv
, opPrecEnv = initOpPrecEnv
}
-- |Show the 'CompilerEnv'
showCompilerEnv :: CompilerEnv -> Bool -> Bool -> String
showCompilerEnv env allBinds simpleEnv = show $ vcat
[ header "Module Identifier " $ text $ moduleName $ moduleIdent env
, header "FilePath" $ text $ filePath env
, header "Language Extensions" $ text $ show $ extensions env
, header "Interfaces " $ hcat $ punctuate comma
$ map (text . moduleName)
$ Map.keys $ interfaceEnv env
, header "Module Aliases " $ ppMap simpleEnv $ aliasEnv env
, header "Precedences " $ ppAL simpleEnv $ bindings $ opPrecEnv env
, header "Type Constructors " $ ppAL simpleEnv $ bindings $ tyConsEnv env
, header "Classes " $ ppMap simpleEnv $ classEnv env
, header "Instances " $ ppMap simpleEnv $ instEnv env
, header "Values " $ ppAL simpleEnv $ bindings $ valueEnv env
]
where
header hdr content = hang (text hdr <+> colon) 4 content
bindings = if allBinds then allBindings else allLocalBindings
-- |Pretty print a 'Map'
ppMap :: (Show a, Pretty a, Show b, Pretty b) => Bool-> Map.Map a b -> Doc
ppMap True = ppMapPretty
ppMap False = ppMapShow
ppMapShow :: (Show a, Show b) => Map.Map a b -> Doc
ppMapShow = ppALShow . Map.toList
ppMapPretty :: (Pretty a, Pretty b) => Map.Map a b -> Doc
ppMapPretty = ppALPretty . Map.toList
-- |Pretty print an association list
ppAL :: (Show a, Pretty a, Show b, Pretty b) => Bool -> [(a, b)] -> Doc
ppAL True = ppALPretty
ppAL False = ppALShow
ppALShow :: (Show a, Show b) => [(a, b)] -> Doc
ppALShow 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 ' ')
ppALPretty :: (Pretty a, Pretty b) => [(a, b)] -> Doc
ppALPretty xs = vcat
$ map (\(a,b) -> text (pad a keyWidth) <+> equals <+> text b) showXs
where showXs = map (\(a,b) -> (render (pPrint a), render (pPrint b))) xs
keyWidth = maximum (0 : map (length .fst) showXs)
pad s n = take n (s ++ repeat ' ')