-
-
Save Diullei/25b2ceb2d6f598bcc037bb30ff407ea3 to your computer and use it in GitHub Desktop.
Print STG in GHC 8.4.3
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# OPTIONS_GHC -fno-warn-orphans #-} | |
| {-# LANGUAGE FlexibleInstances #-} | |
| {-# LANGUAGE StandaloneDeriving #-} | |
| -- | Print STG in GHC 8.4.3. | |
| module Main where | |
| import Control.Monad.IO.Class (liftIO) | |
| import qualified CorePrep | |
| import qualified CoreSyn | |
| import qualified CoreToStg | |
| import qualified CostCentre | |
| import qualified DynFlags | |
| import qualified GHC | |
| import qualified GHC.Paths | |
| import qualified HscTypes | |
| import qualified Literal | |
| import qualified SimplStg | |
| import qualified StgSyn as GHC | |
| import qualified TyCon | |
| import qualified Unique | |
| main :: IO () | |
| main = | |
| GHC.defaultErrorHandler | |
| DynFlags.defaultFatalMessager | |
| DynFlags.defaultFlushOut | |
| (GHC.runGhc | |
| (Just GHC.Paths.libdir) | |
| (do dflags <- GHC.getSessionDynFlags | |
| _ <- GHC.setSessionDynFlags dflags | |
| target <- GHC.guessTarget "stgdemo.hs" Nothing | |
| GHC.setTargets [target] | |
| _ <- GHC.load GHC.LoadAllTargets | |
| mgraph <- fmap GHC.mgModSummaries GHC.getModuleGraph | |
| mapM_ | |
| (\modSummary -> do | |
| stgs <- compile modSummary | |
| liftIO (print stgs)) | |
| mgraph)) | |
| compile :: | |
| GHC.GhcMonad m | |
| => GHC.ModSummary | |
| -> m [GHC.StgTopBinding] | |
| compile modSummary = do | |
| parsedModule <- GHC.parseModule modSummary | |
| typecheckedModule <- GHC.typecheckModule parsedModule | |
| desugared <- GHC.desugarModule typecheckedModule | |
| let modguts = GHC.dm_core_module desugared | |
| this_mod = GHC.ms_mod modSummary | |
| hsc_env <- GHC.getSession | |
| -- Copied roughly from HcsMain <https://github.com/ghc/ghc/blob/ghc-8.4/compiler/main/HscMain.hs#L1312-L1318> | |
| (prepd_binds, _) <- | |
| liftIO | |
| (CorePrep.corePrepPgm | |
| hsc_env | |
| this_mod | |
| (GHC.ms_location modSummary) | |
| (HscTypes.mg_binds modguts) | |
| (filter TyCon.isDataTyCon (HscTypes.mg_tcs modguts))) | |
| dflags <- DynFlags.getDynFlags | |
| (stg_binds, _) <- liftIO (myCoreToStg dflags this_mod prepd_binds) | |
| pure stg_binds | |
| -- Lifted directly from HscMain <https://github.com/ghc/ghc/blob/ghc-8.4/compiler/main/HscMain.hs#L1481-L1493> | |
| myCoreToStg :: | |
| GHC.DynFlags | |
| -> GHC.Module | |
| -> CoreSyn.CoreProgram | |
| -> IO ([GHC.StgTopBinding], CostCentre.CollectedCCs) | |
| myCoreToStg dflags this_mod prepd_binds = do | |
| let (stg_binds, cost_centre_info) = CoreToStg.coreToStg dflags this_mod prepd_binds | |
| stg_binds2 <- SimplStg.stg2stg dflags stg_binds | |
| return (stg_binds2, cost_centre_info) | |
| -------------------------------------------------------------------------------- | |
| -- Orphan Shows for handy quick look | |
| deriving instance Show (GHC.GenStgTopBinding GHC.Id GHC.Id) | |
| deriving instance Show (GHC.GenStgBinding GHC.Id GHC.Id) | |
| instance Show GHC.Id where show i = "(Id " ++ show (Unique.getKey (Unique.getUnique i)) ++ ")" | |
| deriving instance Show (GHC.GenStgRhs GHC.Id GHC.Id) | |
| deriving instance Show (GHC.GenStgExpr GHC.Id GHC.Id) | |
| deriving instance Show (GHC.GenStgArg GHC.Id) | |
| instance Show CostCentre.CostCentreStack where show _ = "CostCentreStack" | |
| instance Show GHC.StgBinderInfo where show _ = "StgBinderInfo" | |
| deriving instance Show GHC.UpdateFlag | |
| instance Show GHC.DataCon where show _ = "DataCon" | |
| deriving instance Show (CoreSyn.Tickish GHC.Id) | |
| instance Show Literal.Literal where show _ = "Literal" | |
| instance Show GHC.Type where show _ = "Type" | |
| instance Show GHC.StgOp where show _ = "StgOp" | |
| deriving instance Show GHC.AltType | |
| deriving instance Show CoreSyn.AltCon | |
| deriving instance Show CostCentre.CostCentre | |
| instance Show GHC.Module where show _ = "Module" | |
| instance Show TyCon.TyCon where show _ = "TyCon" | |
| deriving instance Show CostCentre.IsCafCC |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| [ StgTopLifted | |
| (StgNonRec | |
| (Id 8286623314361722638) | |
| (StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [] | |
| ReEntrant | |
| [ (Id 8286623314361722608) | |
| , (Id 8286623314361722609) | |
| , (Id 8286623314361722610) | |
| ] | |
| (StgLet | |
| (StgRec | |
| [ ( (Id 8286623314361722611) | |
| , StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [(Id 8286623314361722637)] | |
| Updatable | |
| [] | |
| (StgApp (Id 8286623314361722637) [])) | |
| , ( (Id 8286623314361722637) | |
| , StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [ (Id 8286623314361722608) | |
| , (Id 8286623314361722609) | |
| , (Id 8286623314361722610) | |
| , (Id 8286623314361722611) | |
| ] | |
| ReEntrant | |
| [(Id 8286623314361722612)] | |
| (StgLet | |
| (StgNonRec | |
| (Id 8286623314361722622) | |
| (StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [(Id 8286623314361722609)] | |
| Updatable | |
| [] | |
| (StgLet | |
| (StgNonRec | |
| (Id 8286623314361722621) | |
| (StgRhsCon | |
| CostCentreStack | |
| DataCon | |
| [StgLitArg Literal])) | |
| (StgApp | |
| (Id 3458764513820541088) | |
| [ StgVarArg (Id 8286623314361722609) | |
| , StgVarArg (Id 8286623314361722621) | |
| ])))) | |
| (StgCase | |
| (StgApp | |
| (Id 3458764513820541095) | |
| [ StgVarArg (Id 8286623314361722608) | |
| , StgVarArg (Id 8286623314361722612) | |
| , StgVarArg (Id 8286623314361722622) | |
| ]) | |
| (Id 8286623314361722623) | |
| (AlgAlt TyCon) | |
| [ ( DataAlt DataCon | |
| , [] | |
| , StgLet | |
| (StgNonRec | |
| (Id 8286623314361722625) | |
| (StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [(Id 8286623314361722609)] | |
| Updatable | |
| [] | |
| (StgLet | |
| (StgNonRec | |
| (Id 8286623314361722624) | |
| (StgRhsCon | |
| CostCentreStack | |
| DataCon | |
| [StgLitArg Literal])) | |
| (StgApp | |
| (Id 3458764513820541088) | |
| [ StgVarArg | |
| (Id 8286623314361722609) | |
| , StgVarArg | |
| (Id 8286623314361722624) | |
| ])))) | |
| (StgCase | |
| (StgApp | |
| (Id 3458764513820541095) | |
| [ StgVarArg (Id 8286623314361722608) | |
| , StgVarArg (Id 8286623314361722612) | |
| , StgVarArg (Id 8286623314361722625) | |
| ]) | |
| (Id 8286623314361722626) | |
| (AlgAlt TyCon) | |
| [ ( DataAlt DataCon | |
| , [] | |
| , StgLet | |
| (StgNonRec | |
| (Id 8286623314361722634) | |
| (StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [ (Id 8286623314361722609) | |
| , (Id 8286623314361722611) | |
| , (Id 8286623314361722612) | |
| ] | |
| Updatable | |
| [] | |
| (StgLet | |
| (StgNonRec | |
| (Id 8286623314361722633) | |
| (StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [ (Id | |
| 8286623314361722609) | |
| , (Id | |
| 8286623314361722612) | |
| ] | |
| Updatable | |
| [] | |
| (StgLet | |
| (StgNonRec | |
| (Id | |
| 8286623314361722632) | |
| (StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [ (Id | |
| 8286623314361722609) | |
| ] | |
| Updatable | |
| [] | |
| (StgLet | |
| (StgNonRec | |
| (Id | |
| 8286623314361722631) | |
| (StgRhsCon | |
| CostCentreStack | |
| DataCon | |
| [ StgLitArg | |
| Literal | |
| ])) | |
| (StgApp | |
| (Id | |
| 3458764513820541088) | |
| [ StgVarArg | |
| (Id | |
| 8286623314361722609) | |
| , StgVarArg | |
| (Id | |
| 8286623314361722631) | |
| ])))) | |
| (StgApp | |
| (Id | |
| 3458764513820541089) | |
| [ StgVarArg | |
| (Id | |
| 8286623314361722609) | |
| , StgVarArg | |
| (Id | |
| 8286623314361722612) | |
| , StgVarArg | |
| (Id | |
| 8286623314361722632) | |
| ])))) | |
| (StgApp | |
| (Id 8286623314361722611) | |
| [ StgVarArg | |
| (Id | |
| 8286623314361722633) | |
| ])))) | |
| (StgLet | |
| (StgNonRec | |
| (Id 8286623314361722630) | |
| (StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [ (Id 8286623314361722609) | |
| , (Id 8286623314361722611) | |
| , (Id 8286623314361722612) | |
| ] | |
| Updatable | |
| [] | |
| (StgLet | |
| (StgNonRec | |
| (Id | |
| 8286623314361722629) | |
| (StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [ (Id | |
| 8286623314361722609) | |
| , (Id | |
| 8286623314361722612) | |
| ] | |
| Updatable | |
| [] | |
| (StgLet | |
| (StgNonRec | |
| (Id | |
| 8286623314361722628) | |
| (StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [ (Id | |
| 8286623314361722609) | |
| ] | |
| Updatable | |
| [] | |
| (StgLet | |
| (StgNonRec | |
| (Id | |
| 8286623314361722627) | |
| (StgRhsCon | |
| CostCentreStack | |
| DataCon | |
| [ StgLitArg | |
| Literal | |
| ])) | |
| (StgApp | |
| (Id | |
| 3458764513820541088) | |
| [ StgVarArg | |
| (Id | |
| 8286623314361722609) | |
| , StgVarArg | |
| (Id | |
| 8286623314361722627) | |
| ])))) | |
| (StgApp | |
| (Id | |
| 3458764513820541089) | |
| [ StgVarArg | |
| (Id | |
| 8286623314361722609) | |
| , StgVarArg | |
| (Id | |
| 8286623314361722612) | |
| , StgVarArg | |
| (Id | |
| 8286623314361722628) | |
| ])))) | |
| (StgApp | |
| (Id | |
| 8286623314361722611) | |
| [ StgVarArg | |
| (Id | |
| 8286623314361722629) | |
| ])))) | |
| (StgApp | |
| (Id 8214565720323784718) | |
| [ StgVarArg | |
| (Id 8286623314361722610) | |
| , StgVarArg | |
| (Id 8286623314361722630) | |
| , StgVarArg | |
| (Id 8286623314361722634) | |
| ]))) | |
| , ( DataAlt DataCon | |
| , [] | |
| , StgLet | |
| (StgNonRec | |
| (Id 8286623314361722635) | |
| (StgRhsCon | |
| CostCentreStack | |
| DataCon | |
| [StgLitArg Literal])) | |
| (StgApp | |
| (Id 3458764513820541088) | |
| [ StgVarArg | |
| (Id 8286623314361722610) | |
| , StgVarArg | |
| (Id 8286623314361722635) | |
| ])) | |
| ])) | |
| , ( DataAlt DataCon | |
| , [] | |
| , StgLet | |
| (StgNonRec | |
| (Id 8286623314361722636) | |
| (StgRhsCon | |
| CostCentreStack | |
| DataCon | |
| [StgLitArg Literal])) | |
| (StgApp | |
| (Id 3458764513820541088) | |
| [ StgVarArg (Id 8286623314361722610) | |
| , StgVarArg (Id 8286623314361722636) | |
| ])) | |
| ]))) | |
| ]) | |
| (StgApp (Id 8286623314361722611) [])))) | |
| , StgTopLifted | |
| (StgNonRec | |
| (Id 8286623314361722607) | |
| (StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [] | |
| Updatable | |
| [] | |
| (StgApp (Id 8286623314361722638) []))) | |
| , StgTopLifted | |
| (StgNonRec | |
| (Id 8286623314361722641) | |
| (StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [] | |
| Updatable | |
| [] | |
| (StgLet | |
| (StgNonRec | |
| (Id 8286623314361722640) | |
| (StgRhsCon CostCentreStack DataCon [StgLitArg Literal])) | |
| (StgApp | |
| (Id 8286623314361722607) | |
| [ StgVarArg (Id 8214565720323792744) | |
| , StgVarArg (Id 8214565720323784734) | |
| , StgVarArg (Id 8214565720323784734) | |
| , StgVarArg (Id 8286623314361722640) | |
| ])))) | |
| , StgTopLifted | |
| (StgNonRec | |
| (Id 8286623314361722639) | |
| (StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [] | |
| Updatable | |
| [] | |
| (StgApp | |
| (Id 3458764513820540965) | |
| [ StgVarArg (Id 8214565720323793545) | |
| , StgVarArg (Id 8286623314361722641) | |
| ]))) | |
| , StgTopLifted | |
| (StgNonRec | |
| (Id 8286623314361722642) | |
| (StgRhsClosure | |
| CostCentreStack | |
| StgBinderInfo | |
| [] | |
| Updatable | |
| [] | |
| (StgApp (Id 3458764513820541030) [StgVarArg (Id 8286623314361722639)]))) | |
| , StgTopLifted | |
| (StgNonRec | |
| (Id 8286623314361722645) | |
| (StgRhsCon CostCentreStack DataCon [StgLitArg Literal])) | |
| , StgTopLifted | |
| (StgNonRec | |
| (Id 8286623314361722644) | |
| (StgRhsCon CostCentreStack DataCon [StgLitArg Literal])) | |
| , StgTopLifted | |
| (StgNonRec | |
| (Id 8286623314361722643) | |
| (StgRhsCon | |
| CostCentreStack | |
| DataCon | |
| [ StgVarArg (Id 8286623314361722644) | |
| , StgVarArg (Id 8286623314361722645) | |
| ])) | |
| ] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment