Commit 7e4e6a73 authored by Alan Zimmerman's avatar Alan Zimmerman
Browse files

Add dump flags for the renamed and typechecked hsSyn ASTs

Summary:
D2958 brought in the "dump-parsed-ast" functionality.

Extend it to include "dump-rn-ast" and "dump-tc-ast"

Test Plan: ./validate

Reviewers: austin, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D3107
parent a94b4847
......@@ -343,6 +343,7 @@ data DumpFlag
| Opt_D_dump_parsed
| Opt_D_dump_parsed_ast
| Opt_D_dump_rn
| Opt_D_dump_rn_ast
| Opt_D_dump_shape
| Opt_D_dump_simpl
| Opt_D_dump_simpl_iterations
......@@ -353,6 +354,7 @@ data DumpFlag
| Opt_D_dump_stranal
| Opt_D_dump_str_signatures
| Opt_D_dump_tc
| Opt_D_dump_tc_ast
| Opt_D_dump_types
| Opt_D_dump_rules
| Opt_D_dump_cse
......@@ -2905,6 +2907,8 @@ dynamic_flags_deps = [
(setDumpFlag Opt_D_dump_parsed_ast)
, make_ord_flag defGhcFlag "ddump-rn"
(setDumpFlag Opt_D_dump_rn)
, make_ord_flag defGhcFlag "ddump-rn-ast"
(setDumpFlag Opt_D_dump_rn_ast)
, make_ord_flag defGhcFlag "ddump-simpl"
(setDumpFlag Opt_D_dump_simpl)
, make_ord_flag defGhcFlag "ddump-simpl-iterations"
......@@ -2923,6 +2927,8 @@ dynamic_flags_deps = [
(setDumpFlag Opt_D_dump_str_signatures)
, make_ord_flag defGhcFlag "ddump-tc"
(setDumpFlag Opt_D_dump_tc)
, make_ord_flag defGhcFlag "ddump-tc-ast"
(setDumpFlag Opt_D_dump_tc_ast)
, make_ord_flag defGhcFlag "ddump-types"
(setDumpFlag Opt_D_dump_types)
, make_ord_flag defGhcFlag "ddump-rules"
......
......@@ -123,6 +123,8 @@ import Util
import Bag
import Inst (tcGetInsts)
import qualified GHC.LanguageExtensions as LangExt
import HsDumpAst
import Data.Data ( Data )
import Control.Monad
......@@ -1237,7 +1239,7 @@ rnTopSrcDecls group
= tcg_env };
-- Dump trace of renaming part
rnDump (ppr rn_decls) ;
rnDump rn_decls ;
return (tcg_env', rn_decls)
}
......@@ -1963,7 +1965,7 @@ tcUserStmt rdr_stmt@(L loc _)
return (fix_env, emptyFVs)
-- Don't try to typecheck if the renamer fails!
; traceRn "tcRnStmt" (vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs])
; rnDump (ppr rn_stmt) ;
; rnDump rn_stmt ;
; ghciStep <- getGhciStepIO
; let gi_stmt
......@@ -2417,9 +2419,11 @@ loadUnqualIfaces hsc_env ictxt
************************************************************************
-}
rnDump :: SDoc -> TcRn ()
rnDump :: (Outputable a, Data a) => a -> TcRn ()
-- Dump, with a banner, if -ddump-rn
rnDump doc = do { traceOptTcRn Opt_D_dump_rn (mkDumpDoc "Renamer" doc) }
rnDump rn = do { traceOptTcRn Opt_D_dump_rn (mkDumpDoc "Renamer" (ppr rn))
; traceOptTcRn Opt_D_dump_rn_ast
(mkDumpDoc "Renamer" (text (showAstData NoBlankSrcSpan rn))) }
tcDump :: TcGblEnv -> TcRn ()
tcDump env
......@@ -2430,13 +2434,17 @@ tcDump env
(printForUserTcRn short_dump) ;
-- Dump bindings if -ddump-tc
traceOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump)
traceOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump);
-- Dump bindings as an hsSyn AST if -ddump-tc-ast
traceOptTcRn Opt_D_dump_tc_ast (mkDumpDoc "Typechecker" ast_dump)
}
where
short_dump = pprTcGblEnv env
full_dump = pprLHsBinds (tcg_binds env)
-- NB: foreign x-d's have undefined's in their types;
-- hence can't show the tc_fords
ast_dump = text (showAstData NoBlankSrcSpan (tcg_binds env))
-- It's unpleasant having both pprModGuts and pprModDetails here
pprTcGblEnv :: TcGblEnv -> SDoc
......
......@@ -46,10 +46,18 @@ Dumping out compiler intermediate structures
Dump renamer output
.. ghc-flag:: -ddump-rn-ast
Dump renamer output as a syntax tree
.. ghc-flag:: -ddump-tc
Dump typechecker output
.. ghc-flag:: -ddump-tc-ast
Dump typechecker output as a syntax tree
.. ghc-flag:: -ddump-splices
Dump Template Haskell expressions that we splice in, and what
......
......@@ -8,6 +8,4 @@ type family Length (as :: [k]) :: Peano where
Length (a : as) = Succ (Length as)
Length '[] = Zero
type family Length' (as :: [k]) :: Peano where
Length' ((:) a as) = Succ (Length' as)
Length' '[] = Zero
main = putStrLn "hello"
......@@ -189,141 +189,46 @@
({ DumpParsedAst.hs:7:35-39 }
(Unqual {OccName: Peano}))))))]))))
(Nothing))))),
({ DumpParsedAst.hs:11:1-40 }
(TyClD
(FamDecl
(FamilyDecl
(ClosedTypeFamily
(Just
[
({ DumpParsedAst.hs:12:3-40 }
(TyFamEqn
({ DumpParsedAst.hs:12:3-9 }
(Unqual {OccName: Length'}))
(HsIB
(PlaceHolder)
[
({ DumpParsedAst.hs:12:11-20 }
(HsParTy
({ DumpParsedAst.hs:12:12-19 }
(HsAppsTy
[
({ DumpParsedAst.hs:12:12-14 }
(HsAppPrefix
({ DumpParsedAst.hs:12:12-14 }
(HsTyVar
(NotPromoted)
({ DumpParsedAst.hs:12:12-14 }
(Exact {Name: ghc-prim:GHC.Types.:{(w) d 66}})))))),
({ DumpParsedAst.hs:12:16 }
(HsAppPrefix
({ DumpParsedAst.hs:12:16 }
(HsTyVar
(NotPromoted)
({ DumpParsedAst.hs:12:16 }
(Unqual {OccName: a})))))),
({ DumpParsedAst.hs:12:18-19 }
(HsAppPrefix
({ DumpParsedAst.hs:12:18-19 }
(HsTyVar
(NotPromoted)
({ DumpParsedAst.hs:12:18-19 }
(Unqual {OccName: as}))))))]))))])
(Prefix)
({ DumpParsedAst.hs:12:24-40 }
(HsAppsTy
[
({ DumpParsedAst.hs:12:24-27 }
(HsAppPrefix
({ DumpParsedAst.hs:12:24-27 }
(HsTyVar
(NotPromoted)
({ DumpParsedAst.hs:12:24-27 }
(Unqual {OccName: Succ})))))),
({ DumpParsedAst.hs:12:29-40 }
(HsAppPrefix
({ DumpParsedAst.hs:12:29-40 }
(HsParTy
({ DumpParsedAst.hs:12:30-39 }
(HsAppsTy
[
({ DumpParsedAst.hs:12:30-36 }
(HsAppPrefix
({ DumpParsedAst.hs:12:30-36 }
(HsTyVar
(NotPromoted)
({ DumpParsedAst.hs:12:30-36 }
(Unqual {OccName: Length'})))))),
({ DumpParsedAst.hs:12:38-39 }
(HsAppPrefix
({ DumpParsedAst.hs:12:38-39 }
(HsTyVar
(NotPromoted)
({ DumpParsedAst.hs:12:38-39 }
(Unqual {OccName: as}))))))]))))))])))),
({ DumpParsedAst.hs:13:3-27 }
(TyFamEqn
({ DumpParsedAst.hs:13:3-9 }
(Unqual {OccName: Length'}))
(HsIB
(PlaceHolder)
[
({ DumpParsedAst.hs:13:11-13 }
(HsExplicitListTy
(Promoted)
(PlaceHolder)
[]))])
(Prefix)
({ DumpParsedAst.hs:13:24-27 }
(HsAppsTy
[
({ DumpParsedAst.hs:13:24-27 }
(HsAppPrefix
({ DumpParsedAst.hs:13:24-27 }
(HsTyVar
(NotPromoted)
({ DumpParsedAst.hs:13:24-27 }
(Unqual {OccName: Zero}))))))]))))]))
({ DumpParsedAst.hs:11:13-19 }
(Unqual {OccName: Length'}))
(HsQTvs
(PlaceHolder)
({ DumpParsedAst.hs:11:1-23 }
(ValD
(FunBind
({ DumpParsedAst.hs:11:1-4 }
(Unqual {OccName: main}))
(MG
({ DumpParsedAst.hs:11:1-23 }
[
({ DumpParsedAst.hs:11:21-31 }
(KindedTyVar
({ DumpParsedAst.hs:11:22-23 }
(Unqual {OccName: as}))
({ DumpParsedAst.hs:11:28-30 }
(HsAppsTy
[
({ DumpParsedAst.hs:11:28-30 }
(HsAppPrefix
({ DumpParsedAst.hs:11:28-30 }
(HsListTy
({ DumpParsedAst.hs:11:29 }
(HsAppsTy
[
({ DumpParsedAst.hs:11:29 }
(HsAppPrefix
({ DumpParsedAst.hs:11:29 }
(HsTyVar
(NotPromoted)
({ DumpParsedAst.hs:11:29 }
(Unqual {OccName: k}))))))]))))))]))))]
(PlaceHolder))
(Prefix)
({ DumpParsedAst.hs:11:33-40 }
(KindSig
({ DumpParsedAst.hs:11:36-40 }
(HsAppsTy
[
({ DumpParsedAst.hs:11:36-40 }
(HsAppPrefix
({ DumpParsedAst.hs:11:36-40 }
(HsTyVar
(NotPromoted)
({ DumpParsedAst.hs:11:36-40 }
(Unqual {OccName: Peano}))))))]))))
(Nothing)))))]
({ DumpParsedAst.hs:11:1-23 }
(Match
(FunRhs
({ DumpParsedAst.hs:11:1-4 }
(Unqual {OccName: main}))
(Prefix))
[]
(Nothing)
(GRHSs
[
({ DumpParsedAst.hs:11:6-23 }
(GRHS
[]
({ DumpParsedAst.hs:11:8-23 }
(HsApp
({ DumpParsedAst.hs:11:8-15 }
(HsVar
({ DumpParsedAst.hs:11:8-15 }
(Unqual {OccName: putStrLn}))))
({ DumpParsedAst.hs:11:17-23 }
(HsLit
(HsString
(SourceText "\"hello\"") {FastString: "hello"})))))))]
({ <no location info> }
(EmptyLocalBinds)))))])
[]
(PlaceHolder)
(FromSource))
(WpHole)
(PlaceHolder)
[])))]
(Nothing)
(Nothing)))
{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies #-}
module DumpRenamedAst where
data Peano = Zero | Succ Peano
type family Length (as :: [k]) :: Peano where
Length (a : as) = Succ (Length as)
Length '[] = Zero
main = putStrLn "hello"
==================== Renamer ====================
(HsGroup
(ValBindsOut
[
((,)
(NonRecursive) {Bag(Located (HsBind Name)):
[
({ DumpRenamedAst.hs:11:1-23 }
(FunBind
({ DumpRenamedAst.hs:11:1-4 }{Name: main:DumpRenamedAst.main{v rqD}})
(MG
({ DumpRenamedAst.hs:11:1-23 }
[
({ DumpRenamedAst.hs:11:1-23 }
(Match
(FunRhs
({ DumpRenamedAst.hs:11:1-4 }{Name: main:DumpRenamedAst.main{v rqD}})
(Prefix))
[]
(Nothing)
(GRHSs
[
({ DumpRenamedAst.hs:11:6-23 }
(GRHS
[]
({ DumpRenamedAst.hs:11:8-23 }
(HsApp
({ DumpRenamedAst.hs:11:8-15 }
(HsVar
({ DumpRenamedAst.hs:11:8-15 }{Name: base:System.IO.putStrLn{v r1J}})))
({ DumpRenamedAst.hs:11:17-23 }
(HsLit
(HsString
(SourceText "\"hello\"") {FastString: "hello"})))))))]
({ <no location info> }
(EmptyLocalBinds)))))])
[]
(PlaceHolder)
(FromSource))
(WpHole) {NameSet:
[]}
[]))]})]
[])
[]
[
(TyClGroup
[
({ DumpRenamedAst.hs:5:1-30 }
(DataDecl
({ DumpRenamedAst.hs:5:6-10 }{Name: main:DumpRenamedAst.Peano{tc rqA}})
(HsQTvs
[]
[] {NameSet:
[]})
(Prefix)
(HsDataDefn
(DataType)
({ <no location info> }
[])
(Nothing)
(Nothing)
[
({ DumpRenamedAst.hs:5:14-17 }
(ConDeclH98
({ DumpRenamedAst.hs:5:14-17 }{Name: main:DumpRenamedAst.Zero{d rqB}})
(Nothing)
(Just
({ <no location info> }
[]))
(PrefixCon
[])
(Nothing))),
({ DumpRenamedAst.hs:5:21-30 }
(ConDeclH98
({ DumpRenamedAst.hs:5:21-24 }{Name: main:DumpRenamedAst.Succ{d rqC}})
(Nothing)
(Just
({ <no location info> }
[]))
(PrefixCon
[
({ DumpRenamedAst.hs:5:26-30 }
(HsTyVar
(NotPromoted)
({ DumpRenamedAst.hs:5:26-30 }{Name: main:DumpRenamedAst.Peano{tc rqA}})))])
(Nothing)))]
({ <no location info> }
[]))
(True) {NameSet:
[{Name: main:DumpRenamedAst.Peano{tc rqA}}]}))]
[]
[]),
(TyClGroup
[
({ DumpRenamedAst.hs:7:1-39 }
(FamDecl
(FamilyDecl
(ClosedTypeFamily
(Just
[
({ DumpRenamedAst.hs:8:3-36 }
(TyFamEqn
({ DumpRenamedAst.hs:8:3-8 }{Name: main:DumpRenamedAst.Length{tc roG}})
(HsIB
[{Name: a{tv aqH}},{Name: as{tv aqI}}]
[
({ DumpRenamedAst.hs:8:10-17 }
(HsParTy
({ DumpRenamedAst.hs:8:11-16 }
(HsOpTy
({ DumpRenamedAst.hs:8:11 }
(HsTyVar
(NotPromoted)
({ DumpRenamedAst.hs:8:11 }{Name: a{tv aqH}})))
({ DumpRenamedAst.hs:8:13 }{Name: ghc-prim:GHC.Types.:{(w) d 66}})
({ DumpRenamedAst.hs:8:15-16 }
(HsTyVar
(NotPromoted)
({ DumpRenamedAst.hs:8:15-16 }{Name: as{tv aqI}})))))))])
(Prefix)
({ DumpRenamedAst.hs:8:21-36 }
(HsAppTy
({ DumpRenamedAst.hs:8:21-24 }
(HsTyVar
(NotPromoted)
({ DumpRenamedAst.hs:8:21-24 }{Name: main:DumpRenamedAst.Succ{d rqC}})))
({ DumpRenamedAst.hs:8:26-36 }
(HsParTy
({ DumpRenamedAst.hs:8:27-35 }
(HsAppTy
({ DumpRenamedAst.hs:8:27-32 }
(HsTyVar
(NotPromoted)
({ DumpRenamedAst.hs:8:27-32 }{Name: main:DumpRenamedAst.Length{tc roG}})))
({ DumpRenamedAst.hs:8:34-35 }
(HsTyVar
(NotPromoted)
({ DumpRenamedAst.hs:8:34-35 }{Name: as{tv aqI}}))))))))))),
({ DumpRenamedAst.hs:9:3-24 }
(TyFamEqn
({ DumpRenamedAst.hs:9:3-8 }{Name: main:DumpRenamedAst.Length{tc roG}})
(HsIB
[]
[
({ DumpRenamedAst.hs:9:10-12 }
(HsExplicitListTy
(Promoted)
(PlaceHolder)
[]))])
(Prefix)
({ DumpRenamedAst.hs:9:21-24 }
(HsTyVar
(NotPromoted)
({ DumpRenamedAst.hs:9:21-24 }{Name: main:DumpRenamedAst.Zero{d rqB}})))))]))
({ DumpRenamedAst.hs:7:13-18 }{Name: main:DumpRenamedAst.Length{tc roG}})
(HsQTvs
[{Name: k{tv aqF}}]
[
({ DumpRenamedAst.hs:7:20-30 }
(KindedTyVar
({ DumpRenamedAst.hs:7:21-22 }{Name: as{tv aqG}})
({ DumpRenamedAst.hs:7:27-29 }
(HsListTy
({ DumpRenamedAst.hs:7:28 }
(HsTyVar
(NotPromoted)
({ DumpRenamedAst.hs:7:28 }{Name: k{tv aqF}})))))))] {NameSet:
[]})
(Prefix)
({ DumpRenamedAst.hs:7:32-39 }
(KindSig
({ DumpRenamedAst.hs:7:35-39 }
(HsTyVar
(NotPromoted)
({ DumpRenamedAst.hs:7:35-39 }{Name: main:DumpRenamedAst.Peano{tc rqA}})))))
(Nothing))))]
[]
[])]
[]
[]
[]
[]
[]
[]
[]
[]
[])
{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies #-}
module DumpTypecheckedAst where
data Peano = Zero | Succ Peano
type family Length (as :: [k]) :: Peano where
Length (a : as) = Succ (Length as)
Length '[] = Zero
main = putStrLn "hello"
==================== Typechecker ====================
{Bag(Located (HsBind Var)):
[
({ <no location info> }
(VarBind {Var: (main:DumpTypecheckedAst.$tcPeano{v rHa} [lidx] :: ghc-prim:GHC.Types.TyCon{tc 61Z})}
({ <no location info> }
(HsApp
({ <no location info> }
(HsApp
({ <no location info> }
(HsApp
({ <no location info> }
(HsApp
({ <no location info> }
(HsConLikeOut
({abstract:ConLike})))
({ <no location info> }
(HsLit
(HsWordPrim
(NoSourceText)
(8575021419490388262))))))
({ <no location info> }
(HsLit
(HsWordPrim
(NoSourceText)
(11015472196725198936))))))
({ <no location info> }
(HsVar
({ <no location info> }{Var: (main:DumpTypecheckedAst.$trModule{v rHO} [lidx] :: ghc-prim:GHC.Types.Module{tc 625})})))))
({ <no location info> }
(HsApp
({ <no location info> }
(HsConLikeOut
({abstract:ConLike})))
({ <no location info> }
(HsLit
(HsStringPrim
(NoSourceText) "Peano")))))))
(False))),
({ <no location info> }
(VarBind {Var: (main:DumpTypecheckedAst.$tc'Zero{v rFM} [lidx] :: ghc-prim:GHC.Types.TyCon{tc 61Z})}
({ <no location info> }
(HsApp
({ <no location info> }
(HsApp
({ <no location info> }
(HsApp
({ <no location info> }
(HsApp
({ <no location info> }
(HsConLikeOut
({abstract:ConLike})))
({ <no location info> }
(HsLit
(HsWordPrim
(NoSourceText)
(2837710233032485839))))))
({ <no location info> }
(HsLit
(HsWordPrim
(NoSourceText)
(4722402035995040741))))))
({ <no location info> }
(HsVar
({ <no location info> }{Var: (main:DumpTypecheckedAst.$trModule{v rHO} [lidx] :: ghc-prim:GHC.Types.Module{tc 625})})))))
({ <no location info> }
(HsApp
({ <no location info> }
(HsConLikeOut
({abstract:ConLike})))
({ <no location info> }
(HsLit
(HsStringPrim
(NoSourceText) "'Zero")))))))
(False))),
({ <no location info> }
(VarBind {Var: (main:DumpTypecheckedAst.$tc'Succ{v rH3} [lidx] :: ghc-prim:GHC.Types.TyCon{tc 61Z})}
({ <no location info> }
(HsApp
({ <no location info> }
(HsApp
({ <no location info> }
(HsApp
({ <no location info> }
(HsApp
({ <no location info> }
(HsConLikeOut
({abstract:ConLike})))
({ <no location info> }
(HsLit
(HsWordPrim
(NoSourceText)
(16648669567626715052))))))
({ <no location info> }
(HsLit
(HsWordPrim
(NoSourceText)
(1296291977643060110))))))
({ <no location info> }
(HsVar
({ <no location info> }{Var: (main:DumpTypecheckedAst.$trModule{v rHO} [lidx] :: ghc-prim:GHC.Types.Module{tc 625})})))))