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)
data CompilerEnv = CompilerEnv
{ CompilerEnv -> ModuleIdent
moduleIdent :: ModuleIdent
, CompilerEnv -> FilePath
filePath :: FilePath
, CompilerEnv -> [KnownExtension]
extensions :: [KnownExtension]
, CompilerEnv -> [(Span, Token)]
tokens :: [(Span, Token)]
, CompilerEnv -> InterfaceEnv
interfaceEnv :: InterfaceEnv
, CompilerEnv -> AliasEnv
aliasEnv :: AliasEnv
, CompilerEnv -> TCEnv
tyConsEnv :: TCEnv
, CompilerEnv -> ClassEnv
classEnv :: ClassEnv
, CompilerEnv -> InstEnv
instEnv :: InstEnv
, CompilerEnv -> ValueEnv
valueEnv :: ValueEnv
, CompilerEnv -> OpPrecEnv
opPrecEnv :: OpPrecEnv
}
initCompilerEnv :: ModuleIdent -> CompilerEnv
initCompilerEnv :: ModuleIdent -> CompilerEnv
initCompilerEnv mid :: ModuleIdent
mid = CompilerEnv :: ModuleIdent
-> FilePath
-> [KnownExtension]
-> [(Span, Token)]
-> InterfaceEnv
-> AliasEnv
-> TCEnv
-> ClassEnv
-> InstEnv
-> ValueEnv
-> OpPrecEnv
-> CompilerEnv
CompilerEnv
{ moduleIdent :: ModuleIdent
moduleIdent = ModuleIdent
mid
, filePath :: FilePath
filePath = []
, extensions :: [KnownExtension]
extensions = []
, tokens :: [(Span, Token)]
tokens = []
, interfaceEnv :: InterfaceEnv
interfaceEnv = InterfaceEnv
initInterfaceEnv
, aliasEnv :: AliasEnv
aliasEnv = AliasEnv
initAliasEnv
, tyConsEnv :: TCEnv
tyConsEnv = TCEnv
initTCEnv
, classEnv :: ClassEnv
classEnv = ClassEnv
initClassEnv
, instEnv :: InstEnv
instEnv = InstEnv
initInstEnv
, valueEnv :: ValueEnv
valueEnv = ValueEnv
initDCEnv
, opPrecEnv :: OpPrecEnv
opPrecEnv = OpPrecEnv
initOpPrecEnv
}
showCompilerEnv :: CompilerEnv -> Bool -> Bool -> String
showCompilerEnv :: CompilerEnv -> Bool -> Bool -> FilePath
showCompilerEnv env :: CompilerEnv
env allBinds :: Bool
allBinds simpleEnv :: Bool
simpleEnv = Doc -> FilePath
forall a. Show a => a -> FilePath
show (Doc -> FilePath) -> Doc -> FilePath
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
[ FilePath -> Doc -> Doc
header "Module Identifier " (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$ ModuleIdent -> FilePath
moduleName (ModuleIdent -> FilePath) -> ModuleIdent -> FilePath
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> ModuleIdent
moduleIdent CompilerEnv
env
, FilePath -> Doc -> Doc
header "FilePath" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> FilePath
filePath CompilerEnv
env
, FilePath -> Doc -> Doc
header "Language Extensions" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$ [KnownExtension] -> FilePath
forall a. Show a => a -> FilePath
show ([KnownExtension] -> FilePath) -> [KnownExtension] -> FilePath
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> [KnownExtension]
extensions CompilerEnv
env
, FilePath -> Doc -> Doc
header "Interfaces " (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma
([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (ModuleIdent -> Doc) -> [ModuleIdent] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Doc
text (FilePath -> Doc)
-> (ModuleIdent -> FilePath) -> ModuleIdent -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> FilePath
moduleName)
([ModuleIdent] -> [Doc]) -> [ModuleIdent] -> [Doc]
forall a b. (a -> b) -> a -> b
$ InterfaceEnv -> [ModuleIdent]
forall k a. Map k a -> [k]
Map.keys (InterfaceEnv -> [ModuleIdent]) -> InterfaceEnv -> [ModuleIdent]
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> InterfaceEnv
interfaceEnv CompilerEnv
env
, FilePath -> Doc -> Doc
header "Module Aliases " (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Bool -> AliasEnv -> Doc
forall a b.
(Show a, Pretty a, Show b, Pretty b) =>
Bool -> Map a b -> Doc
ppMap Bool
simpleEnv (AliasEnv -> Doc) -> AliasEnv -> Doc
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> AliasEnv
aliasEnv CompilerEnv
env
, FilePath -> Doc -> Doc
header "Precedences " (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Bool -> [(QualIdent, PrecInfo)] -> Doc
forall a b.
(Show a, Pretty a, Show b, Pretty b) =>
Bool -> [(a, b)] -> Doc
ppAL Bool
simpleEnv ([(QualIdent, PrecInfo)] -> Doc) -> [(QualIdent, PrecInfo)] -> Doc
forall a b. (a -> b) -> a -> b
$ OpPrecEnv -> [(QualIdent, PrecInfo)]
forall a. TopEnv a -> [(QualIdent, a)]
bindings (OpPrecEnv -> [(QualIdent, PrecInfo)])
-> OpPrecEnv -> [(QualIdent, PrecInfo)]
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> OpPrecEnv
opPrecEnv CompilerEnv
env
, FilePath -> Doc -> Doc
header "Type Constructors " (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Bool -> [(QualIdent, TypeInfo)] -> Doc
forall a b.
(Show a, Pretty a, Show b, Pretty b) =>
Bool -> [(a, b)] -> Doc
ppAL Bool
simpleEnv ([(QualIdent, TypeInfo)] -> Doc) -> [(QualIdent, TypeInfo)] -> Doc
forall a b. (a -> b) -> a -> b
$ TCEnv -> [(QualIdent, TypeInfo)]
forall a. TopEnv a -> [(QualIdent, a)]
bindings (TCEnv -> [(QualIdent, TypeInfo)])
-> TCEnv -> [(QualIdent, TypeInfo)]
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env
, FilePath -> Doc -> Doc
header "Classes " (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Bool -> ClassEnv -> Doc
forall a b.
(Show a, Pretty a, Show b, Pretty b) =>
Bool -> Map a b -> Doc
ppMap Bool
simpleEnv (ClassEnv -> Doc) -> ClassEnv -> Doc
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> ClassEnv
classEnv CompilerEnv
env
, FilePath -> Doc -> Doc
header "Instances " (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Bool -> InstEnv -> Doc
forall a b.
(Show a, Pretty a, Show b, Pretty b) =>
Bool -> Map a b -> Doc
ppMap Bool
simpleEnv (InstEnv -> Doc) -> InstEnv -> Doc
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> InstEnv
instEnv CompilerEnv
env
, FilePath -> Doc -> Doc
header "Values " (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Bool -> [(QualIdent, ValueInfo)] -> Doc
forall a b.
(Show a, Pretty a, Show b, Pretty b) =>
Bool -> [(a, b)] -> Doc
ppAL Bool
simpleEnv ([(QualIdent, ValueInfo)] -> Doc)
-> [(QualIdent, ValueInfo)] -> Doc
forall a b. (a -> b) -> a -> b
$ ValueEnv -> [(QualIdent, ValueInfo)]
forall a. TopEnv a -> [(QualIdent, a)]
bindings (ValueEnv -> [(QualIdent, ValueInfo)])
-> ValueEnv -> [(QualIdent, ValueInfo)]
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env
]
where
header :: FilePath -> Doc -> Doc
header hdr :: FilePath
hdr content :: Doc
content = Doc -> Int -> Doc -> Doc
hang (FilePath -> Doc
text FilePath
hdr Doc -> Doc -> Doc
<+> Doc
colon) 4 Doc
content
bindings :: TopEnv a -> [(QualIdent, a)]
bindings = if Bool
allBinds then TopEnv a -> [(QualIdent, a)]
forall a. TopEnv a -> [(QualIdent, a)]
allBindings else TopEnv a -> [(QualIdent, a)]
forall a. TopEnv a -> [(QualIdent, a)]
allLocalBindings
ppMap :: (Show a, Pretty a, Show b, Pretty b) => Bool-> Map.Map a b -> Doc
ppMap :: Bool -> Map a b -> Doc
ppMap True = Map a b -> Doc
forall a b. (Pretty a, Pretty b) => Map a b -> Doc
ppMapPretty
ppMap False = Map a b -> Doc
forall a b. (Show a, Show b) => Map a b -> Doc
ppMapShow
ppMapShow :: (Show a, Show b) => Map.Map a b -> Doc
ppMapShow :: Map a b -> Doc
ppMapShow = [(a, b)] -> Doc
forall a b. (Show a, Show b) => [(a, b)] -> Doc
ppALShow ([(a, b)] -> Doc) -> (Map a b -> [(a, b)]) -> Map a b -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList
ppMapPretty :: (Pretty a, Pretty b) => Map.Map a b -> Doc
ppMapPretty :: Map a b -> Doc
ppMapPretty = [(a, b)] -> Doc
forall a b. (Pretty a, Pretty b) => [(a, b)] -> Doc
ppALPretty ([(a, b)] -> Doc) -> (Map a b -> [(a, b)]) -> Map a b -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList
ppAL :: (Show a, Pretty a, Show b, Pretty b) => Bool -> [(a, b)] -> Doc
ppAL :: Bool -> [(a, b)] -> Doc
ppAL True = [(a, b)] -> Doc
forall a b. (Pretty a, Pretty b) => [(a, b)] -> Doc
ppALPretty
ppAL False = [(a, b)] -> Doc
forall a b. (Show a, Show b) => [(a, b)] -> Doc
ppALShow
ppALShow :: (Show a, Show b) => [(a, b)] -> Doc
ppALShow :: [(a, b)] -> Doc
ppALShow xs :: [(a, b)]
xs = [Doc] -> Doc
vcat
([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath) -> Doc) -> [(FilePath, FilePath)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: FilePath
a,b :: FilePath
b) -> FilePath -> Doc
text (FilePath -> Int -> FilePath
pad FilePath
a Int
keyWidth) Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> FilePath -> Doc
text FilePath
b) [(FilePath, FilePath)]
showXs
where showXs :: [(FilePath, FilePath)]
showXs = ((a, b) -> (FilePath, FilePath))
-> [(a, b)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: a
a,b :: b
b) -> (a -> FilePath
forall a. Show a => a -> FilePath
show a
a, b -> FilePath
forall a. Show a => a -> FilePath
show b
b)) [(a, b)]
xs
keyWidth :: Int
keyWidth = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((FilePath, FilePath) -> Int) -> [(FilePath, FilePath)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> Int)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst) [(FilePath, FilePath)]
showXs)
pad :: FilePath -> Int -> FilePath
pad s :: FilePath
s n :: Int
n = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
n (FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char -> FilePath
forall a. a -> [a]
repeat ' ')
ppALPretty :: (Pretty a, Pretty b) => [(a, b)] -> Doc
ppALPretty :: [(a, b)] -> Doc
ppALPretty xs :: [(a, b)]
xs = [Doc] -> Doc
vcat
([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath) -> Doc) -> [(FilePath, FilePath)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: FilePath
a,b :: FilePath
b) -> FilePath -> Doc
text (FilePath -> Int -> FilePath
pad FilePath
a Int
keyWidth) Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> FilePath -> Doc
text FilePath
b) [(FilePath, FilePath)]
showXs
where showXs :: [(FilePath, FilePath)]
showXs = ((a, b) -> (FilePath, FilePath))
-> [(a, b)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: a
a,b :: b
b) -> (Doc -> FilePath
render (a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
a), Doc -> FilePath
render (b -> Doc
forall a. Pretty a => a -> Doc
pPrint b
b))) [(a, b)]
xs
keyWidth :: Int
keyWidth = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((FilePath, FilePath) -> Int) -> [(FilePath, FilePath)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> Int)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst) [(FilePath, FilePath)]
showXs)
pad :: FilePath -> Int -> FilePath
pad s :: FilePath
s n :: Int
n = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
n (FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char -> FilePath
forall a. a -> [a]
repeat ' ')