WARNING! Access to this system is limited to authorised users only.
Unauthorised users may be subject to prosecution.
Unauthorised access to this system is a criminal offence under Australian law (Federal Crimes Act 1914 Part VIA)
It is a criminal offence to:
(1) Obtain access to data without authority. -Penalty 2 years imprisonment.
(2) Damage, delete, alter or insert data without authority. -Penalty 10 years imprisonment.
User activity is monitored and recorded. Anyone using this system expressly consents to such monitoring and recording.

Commit 7eff9168 authored by nathyong's avatar nathyong
Browse files

Export TyCons with STG as STG-Simple Intermediate

parent 18834f48
......@@ -15,12 +15,14 @@ cabal-version: >=1.10
hs-source-dirs: src
ghc-options: -Wall
exposed-modules: Compiler.Mu
, Compiler.Mu.FromSTG
, Compiler.Mu.Types
, Compiler.Mu.PprMu
, Language.Haskell.GHC.Simple.Extra
build-depends: base >= 4.7 && < 5
, text
, mtl
, ghc
, ghc-simple
, containers
......@@ -41,8 +43,10 @@ executable anuhc-exe
test-suite anuhc-test
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: Spec.hs
main-is: TestMain.hs
build-depends: base
, tasty
, tasty-program
, ghc
, ghc-paths
, ghc-simple
{-# LANGUAGE FlexibleInstances, CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Lower level building blocks for custom code generation.
module Language.Haskell.GHC.Simple.Extra (
) where
-- GHC scaffolding
import GHC hiding (Warning)
import GhcMonad (liftIO)
import HscTypes
import CostCentre
import CorePrep
import StgSyn
import CoreSyn
import CoreToStg
import SimplStg
import DriverPipeline
import Language.Haskell.GHC.Simple.Types
instance Intermediate ([TyCon], [StgBinding], CollectedCCs) where
prepare = toSimplifiedStgPlus
-- | Compile a 'ModSummary' into a list of simplified 'StgBinding's.
-- See <https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/StgSynType>
-- for more information about STG and how it relates to core and Haskell.
toSimplifiedStgPlus :: ModSummary -> CgGuts -> CompPipeline ([TyCon], [StgBinding], CollectedCCs)
toSimplifiedStgPlus ms cgguts = do
env <- hsc_env `fmap` getPipeState
let dfs = hsc_dflags env
liftIO $ do
prog <- prepareCore env dfs ms cgguts
stg <- coreToStg dfs (ms_mod ms) prog
(binds, ccs) <- stg2stg dfs (ms_mod ms) stg
return (cg_tycons cgguts, binds, ccs)
-- | Prepare a core module for code generation.
prepareCore :: HscEnv -> DynFlags -> ModSummary -> CgGuts -> IO CoreProgram
prepareCore env dfs _ms p = do
#if __GLASGOW_HASKELL__ >= 800
liftIO $ corePrepPgm env (ms_mod _ms) (ms_location _ms) (cg_binds p) (cg_tycons p)
#elif __GLASGOW_HASKELL__ >= 710
liftIO $ corePrepPgm env (ms_location _ms) (cg_binds p) (cg_tycons p)
liftIO $ corePrepPgm dfs env (cg_binds p) (cg_tycons p)
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