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 (allLocalBindings)
import Env.Interface
import Env.ModuleAlias (AliasEnv, initAliasEnv)
import Env.OpPrec
import Env.TypeConstructor
import Env.Value
type CompEnv a = (CompilerEnv, a)
data CompilerEnv = CompilerEnv
{ moduleIdent :: ModuleIdent
, filePath :: FilePath
, extensions :: [KnownExtension]
, tokens :: [(Span, Token)]
, interfaceEnv :: InterfaceEnv
, aliasEnv :: AliasEnv
, tyConsEnv :: TCEnv
, valueEnv :: ValueEnv
, opPrecEnv :: OpPrecEnv
}
initCompilerEnv :: ModuleIdent -> CompilerEnv
initCompilerEnv mid = CompilerEnv
{ moduleIdent = mid
, filePath = []
, extensions = []
, tokens = []
, interfaceEnv = initInterfaceEnv
, aliasEnv = initAliasEnv
, tyConsEnv = initTCEnv
, valueEnv = initDCEnv
, opPrecEnv = initOpPrecEnv
}
showCompilerEnv :: CompilerEnv -> String
showCompilerEnv env = 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 $ aliasEnv env
, header "Precedences " $ ppAL $ allLocalBindings $ opPrecEnv env
, header "Type Constructors " $ ppAL $ allLocalBindings $ tyConsEnv env
, header "Values " $ ppAL $ allLocalBindings $ valueEnv env
]
where
header hdr content = hang (text hdr <+> colon) 4 content
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 ' ')