| ... |
... |
@@ -31,7 +31,6 @@ module GHC.Driver.Main.Interactive |
|
31
|
31
|
, hscParseExpr
|
|
32
|
32
|
, hscParseType
|
|
33
|
33
|
, hscCompileCoreExpr
|
|
34
|
|
- , hscTidy
|
|
35
|
34
|
|
|
36
|
35
|
) where
|
|
37
|
36
|
|
| ... |
... |
@@ -39,7 +38,7 @@ import GHC.Prelude |
|
39
|
38
|
|
|
40
|
39
|
import GHC.Driver.Main.Hsc
|
|
41
|
40
|
import {-# SOURCE #-} GHC.Driver.Main.Passes
|
|
42
|
|
- ( hscDesugar', hscSimplify, hscCompileCoreExpr )
|
|
|
41
|
+ ( hscDesugar', hscSimplify, hscTidy, hscCompileCoreExpr )
|
|
43
|
42
|
|
|
44
|
43
|
import {-# SOURCE #-} GHC.Driver.Main.Compile
|
|
45
|
44
|
( mkCgInteractiveGuts, generateFreshByteCodeLinkable )
|
| ... |
... |
@@ -47,11 +46,9 @@ import {-# SOURCE #-} GHC.Driver.Main.Compile |
|
47
|
46
|
import GHC.Driver.Session
|
|
48
|
47
|
import GHC.Driver.Env
|
|
49
|
48
|
import GHC.Driver.Errors.Types
|
|
50
|
|
-import GHC.Driver.Config.Core.Lint ( endPassHscEnvIO )
|
|
51
|
49
|
import GHC.Driver.Config.Core.Lint.Interactive ( lintInteractiveExpr )
|
|
52
|
50
|
import GHC.Driver.Config.Parser (initParserOpts)
|
|
53
|
51
|
import GHC.Driver.Config.Diagnostic
|
|
54
|
|
-import GHC.Driver.Config.Tidy
|
|
55
|
52
|
|
|
56
|
53
|
import GHC.Runtime.Context
|
|
57
|
54
|
import GHCi.RemoteTypes
|
| ... |
... |
@@ -66,16 +63,12 @@ import GHC.HsToCore |
|
66
|
63
|
|
|
67
|
64
|
|
|
68
|
65
|
import GHC.Iface.Load ( loadSysInterface )
|
|
69
|
|
-import GHC.Iface.Tidy
|
|
70
|
66
|
|
|
71
|
67
|
import GHC.Core
|
|
72
|
68
|
import GHC.Core.ConLike
|
|
73
|
|
-import GHC.Core.Opt.Pipeline.Types ( CoreToDo (..))
|
|
74
|
69
|
import GHC.Core.TyCon
|
|
75
|
70
|
import GHC.Core.InstEnv
|
|
76
|
71
|
import GHC.Core.FamInstEnv
|
|
77
|
|
-import GHC.Core.Rules
|
|
78
|
|
-import GHC.Core.Stats
|
|
79
|
72
|
|
|
80
|
73
|
import GHC.Parser.Errors.Types
|
|
81
|
74
|
import GHC.Parser
|
| ... |
... |
@@ -570,43 +563,3 @@ hscParseThingWithLocation source linenumber parser str = do |
|
570
|
563
|
FormatHaskell (showAstData NoBlankSrcSpan NoBlankEpAnnotations thing)
|
|
571
|
564
|
return thing
|
|
572
|
565
|
|
|
573
|
|
-hscTidy :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails)
|
|
574
|
|
-hscTidy hsc_env guts = do
|
|
575
|
|
- let logger = hsc_logger hsc_env
|
|
576
|
|
- let this_mod = mg_module guts
|
|
577
|
|
-
|
|
578
|
|
- opts <- initTidyOpts hsc_env
|
|
579
|
|
- (cgguts, details) <- withTiming logger
|
|
580
|
|
- (text "CoreTidy"<+>brackets (ppr this_mod))
|
|
581
|
|
- (const ())
|
|
582
|
|
- $! {-# SCC "CoreTidy" #-} tidyProgram opts guts
|
|
583
|
|
-
|
|
584
|
|
- -- post tidy pretty-printing and linting...
|
|
585
|
|
- let tidy_rules = md_rules details
|
|
586
|
|
- let all_tidy_binds = cg_binds cgguts
|
|
587
|
|
- let name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) (mg_rdr_env guts)
|
|
588
|
|
- ptc = initPromotionTickContext (hsc_dflags hsc_env)
|
|
589
|
|
-
|
|
590
|
|
- endPassHscEnvIO hsc_env name_ppr_ctx CoreTidy all_tidy_binds tidy_rules
|
|
591
|
|
-
|
|
592
|
|
- -- If the endPass didn't print the rules, but ddump-rules is
|
|
593
|
|
- -- on, print now
|
|
594
|
|
- unless (logHasDumpFlag logger Opt_D_dump_simpl) $
|
|
595
|
|
- putDumpFileMaybe logger Opt_D_dump_rules
|
|
596
|
|
- "Tidy Core rules"
|
|
597
|
|
- FormatText
|
|
598
|
|
- (pprRulesForUser tidy_rules)
|
|
599
|
|
-
|
|
600
|
|
- -- Print one-line size info
|
|
601
|
|
- let cs = coreBindsStats all_tidy_binds
|
|
602
|
|
- putDumpFileMaybe logger Opt_D_dump_core_stats "Core Stats"
|
|
603
|
|
- FormatText
|
|
604
|
|
- (text "Tidy size (terms,types,coercions)"
|
|
605
|
|
- <+> ppr (moduleName this_mod) <> colon
|
|
606
|
|
- <+> int (cs_tm cs)
|
|
607
|
|
- <+> int (cs_ty cs)
|
|
608
|
|
- <+> int (cs_co cs))
|
|
609
|
|
-
|
|
610
|
|
- pure (cgguts, details)
|
|
611
|
|
-
|
|
612
|
|
- |