Commit b183d199 authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Improved raw dump output

parent f00cc10b
......@@ -141,7 +141,6 @@ ppExpr p (Letrec bs e) = parenIf (p > 0) $ sep
ppExpr p (Typed e ty) = parenIf (p > 0) $ sep
[ppExpr 0 e, text "::", ppType 0 ty]
ppInfixApp :: Int -> Expression -> QualIdent -> Expression -> Doc
ppInfixApp p e1 op e2 = parenIf (p > 1) $ sep
[ppExpr 2 e1 <+> ppQInfixOp op, nest exprIndent (ppExpr 2 e2)]
......
......@@ -201,7 +201,7 @@ checkModule opts mdl = do
tc <- typeCheck opts pc >>= dumpCS DumpTypeChecked
ec <- exportCheck opts tc >>= dumpCS DumpExportChecked
return ec
where dumpCS = dumpWith opts CS.ppModule
where dumpCS = dumpWith opts CS.showModule CS.ppModule
-- ---------------------------------------------------------------------------
-- Translating a module
......@@ -219,8 +219,8 @@ transModule opts mdl = do
ilCaseComp <- dumpIL DumpCaseCompleted $ completeCase il
return ilCaseComp
where
dumpCS = dumpWith opts CS.ppModule
dumpIL = dumpWith opts IL.ppModule
dumpCS = dumpWith opts CS.showModule CS.ppModule
dumpIL = dumpWith opts IL.showModule IL.ppModule
-- ---------------------------------------------------------------------------
-- Writing output
......@@ -230,7 +230,7 @@ writeOutput :: Options -> FilePath -> CompEnv CS.Module -> IO ()
writeOutput opts fn mdl@(_, modul) = do
writeParsed opts fn modul
mdl' <- expandExports opts mdl
qmdl <- dumpWith opts CS.ppModule DumpQualified $ qual mdl'
qmdl <- dumpWith opts CS.showModule CS.ppModule DumpQualified $ qual mdl'
writeAbstractCurry opts fn qmdl
-- generate interface file
let intf = uncurry exportInterface qmdl
......@@ -296,7 +296,7 @@ writeFlat opts fn env modSum il = do
writeFlatCurry :: Options -> FilePath -> CompilerEnv -> ModuleSummary
-> IL.Module -> IO ()
writeFlatCurry opts fn env modSum il = do
(_, fc) <- dumpWith opts EF.ppProg DumpFlatCurry (env, prog)
(_, fc) <- dumpWith opts show EF.ppProg DumpFlatCurry (env, prog)
when extTarget $ EF.writeExtendedFlat (useSubDir $ extFlatName fn) fc
when fcyTarget $ EF.writeFlatCurry (useSubDir $ flatName fn) fc
where
......@@ -336,9 +336,11 @@ writeAbstractCurry opts fname (env, modul) = do
type Dump = (DumpLevel, CompilerEnv, String)
dumpWith :: (MonadIO m, Show a)
=> Options -> (a -> Doc) -> DumpLevel -> CompEnv a -> m (CompEnv a)
dumpWith opts view lvl res@(env, mdl) = do
let str = if dbDumpRaw (optDebugOpts opts) then show mdl else show (view mdl)
=> Options -> (a -> String) -> (a -> Doc) -> DumpLevel
-> CompEnv a -> m (CompEnv a)
dumpWith opts rawView view lvl res@(env, mdl) = do
let str = if dbDumpRaw (optDebugOpts opts) then rawView mdl
else show (view mdl)
doDump (optDebugOpts opts) (lvl, env, str)
return res
......
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