Commit efa2490a authored by Kirchmayr's avatar Kirchmayr
Browse files

Add option for dumping all bindings

parent 64349b87
......@@ -43,7 +43,7 @@ module Base.TopEnv
, bindTopEnv, qualBindTopEnv, rebindTopEnv
, qualRebindTopEnv, unbindTopEnv, lookupTopEnv, qualLookupTopEnv
, allImports, moduleImports, localBindings, allLocalBindings
, allEntities, qualElemTopEnv
, allBindings, allEntities, qualElemTopEnv
) where
import Control.Arrow (second)
......@@ -163,6 +163,10 @@ allLocalBindings :: TopEnv a -> [(QualIdent, a)]
allLocalBindings (TopEnv env) = [ (x, y) | (x, ys) <- Map.toList env
, (Local, y) <- ys ]
allBindings :: TopEnv a -> [(QualIdent, a)]
allBindings (TopEnv env) = [ (x, y) | (x, ys) <- Map.toList env
, (_, y) <- ys ]
allEntities :: TopEnv a -> [a]
allEntities (TopEnv env) = [ y | (_, ys) <- Map.toList env, (_, y) <- ys]
......
......@@ -20,7 +20,7 @@ import Curry.Base.Pretty
import Curry.Base.Span (Span)
import Curry.Syntax
import Base.TopEnv (allLocalBindings)
import Base.TopEnv (allBindings, allLocalBindings)
import Env.Interface
import Env.ModuleAlias (AliasEnv, initAliasEnv)
......@@ -60,8 +60,8 @@ initCompilerEnv mid = CompilerEnv
}
-- |Show the 'CompilerEnv'
showCompilerEnv :: CompilerEnv -> String
showCompilerEnv env = show $ vcat
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
......@@ -69,12 +69,13 @@ showCompilerEnv env = show $ vcat
$ 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
, header "Precedences " $ ppAL $ bindings $ opPrecEnv env
, header "Type Constructors " $ ppAL $ bindings $ tyConsEnv env
, header "Values " $ ppAL $ 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, Show b) => Map.Map a b -> Doc
......
......@@ -73,9 +73,12 @@ data WarnOpts = WarnOpts
-- |Debug options
data DebugOpts = DebugOpts
{ dbDumpLevels :: [DumpLevel] -- ^ dump levels
, dbDumpEnv :: Bool -- ^ dump compilation environment
, dbDumpRaw :: Bool -- ^ dump data structure
{ dbDumpLevels :: [DumpLevel] -- ^ dump levels
, dbDumpEnv :: Bool -- ^ dump compilation environment
, dbDumpRaw :: Bool -- ^ dump data structure
, dbDumpAllBindings :: Bool -- ^ dump all bindings instead of just the
-- local bindings
, dbDumpSimple :: Bool -- ^ print more readable environments
} deriving Show
-- | Default compiler options
......@@ -115,9 +118,11 @@ defaultWarnOpts = WarnOpts
-- | Default dump options
defaultDebugOpts :: DebugOpts
defaultDebugOpts = DebugOpts
{ dbDumpLevels = []
, dbDumpEnv = False
, dbDumpRaw = False
{ dbDumpLevels = []
, dbDumpEnv = False
, dbDumpRaw = False
, dbDumpAllBindings = False
, dbDumpSimple = False
}
-- |Modus operandi of the program
......@@ -426,14 +431,19 @@ warnDescriptions
debugDescriptions :: OptErrTable DebugOpts
debugDescriptions =
[ ( "dump-all", "dump everything"
, \ opts -> opts { dbDumpLevels = [minBound .. maxBound] })
, ( "dump-none", "dump nothing"
, \ opts -> opts { dbDumpLevels = [] })
, ( "dump-env" , "additionally dump compiler environment"
, \ opts -> opts { dbDumpEnv = True })
, ( "dump-raw" , "dump as raw AST (instead of pretty printing)"
, \ opts -> opts { dbDumpRaw = True })
[ ( "dump-all" , "dump everything"
, \ opts -> opts { dbDumpLevels = [minBound .. maxBound] })
, ( "dump-none" , "dump nothing"
, \ opts -> opts { dbDumpLevels = [] })
, ( "dump-env" , "additionally dump compiler environment"
, \ opts -> opts { dbDumpEnv = True })
, ( "dump-raw" , "dump as raw AST (instead of pretty printing)"
, \ opts -> opts { dbDumpRaw = True })
, ( "dump-all-bindings" , "when dumping bindings, dump all instead of just local ones"
, \ opts -> opts { dbDumpAllBindings = True })
, ( "dump-simple" , "print a simplified, more readable environment"
, \ opts -> opts { dbDumpSimple = True })
] ++ map toDescr dumpLevel
where
toDescr (flag, name, desc)
......
......@@ -374,7 +374,7 @@ doDump opts (level, env, dump)
putStrLn (heading (capitalize $ lookupHeader dumpLevel) '=')
when (dbDumpEnv opts) $ do
putStrLn (heading "Environment" '-')
putStrLn (showCompilerEnv env)
putStrLn (showCompilerEnv env (dbDumpAllBindings opts) (dbDumpSimple opts))
putStrLn (heading "Source Code" '-')
putStrLn dump
where
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment