Using GHC API to generate STG

Simon Peyton-Jones simonpj at microsoft.com
Tue Apr 15 10:44:31 EDT 2008


LNull is a constructor, so it has no definition in STG.  How might it be defined?

        LNull = ???

Instead, the code generator takes the list of data types (TyCons) as well as the list of bindings.  From the former it generates all the per-data-type goop, including info tables for its constructors.  So the TyCons are what you want!

Simon

| -----Original Message-----
| From: glasgow-haskell-users-bounces at haskell.org [mailto:glasgow-haskell-users-bounces at haskell.org] On
| Behalf Of Mark Wassell
| Sent: 15 April 2008 11:27
| To: glasgow-haskell-users
| Subject: Using GHC API to generate STG
|
| Hello,
|
| I am looking at how GHC generates STG and I am finding with a very
| simple piece of Haskell my usage of the API is not generating as much
| STG as I see when using -dump-stg option. In particular it  isn't
| generating a binding for the nullary constructor LNull (I hope that's
| the correct terminology)
|
| The code is
|
| module Ex2 where
|
| data List a = LCon a (List a) | LNull -- deriving Show
|
| main :: List Int
| main = LCon 1 LNull
|
| Using the API I get
|
| [sat_s1pdQ = NO_CCS GHC.Base.I#! [1];
|  Ex2.main = NO_CCS Ex2.LCon! [sat_s1pdQ Ex2.LNull];
|  main = \u srt:SRT:[(s1pdS, Ex2.main)] [] Ex2.main;]
|
| with -ddump-stg I get
|
| a_r5Y = NO_CCS GHC.Base.I#! [1];
| SRT(a_r5Y): []
| Ex2.main = NO_CCS Ex2.LCon! [a_r5Y Ex2.LNull];
| SRT(Ex2.main): []
| Ex2.LCon = \r [eta_s67 eta_s68] Ex2.LCon [eta_s67 eta_s68];
| SRT(Ex2.LCon): []
| Ex2.LNull = NO_CCS Ex2.LNull! [];   <---- This is missing
| SRT(Ex2.LNull): []
|
| (in particular the Ex2.LNull is missing from the API STG)
|
| My thrown together API code is
|
|         session <- GHC.newSession $ Just path
|         (dflags,_) <- GHC.getSessionDynFlags session >>=
| Packages.initPackages
|         GHC.setSessionDynFlags session dflags {GHC.hscTarget=GHC.HscAsm}
|         core <- GHC.compileToCore session fp
|         case core of
|               Just core' -> do
|                               core'' <- corePrepPgm dflags core' []
|                               stg <- coreToStg
| (PackageConfig.stringToPackageId "Ex2") core''
|                               putStrLn $ (show $ (ppr stg)
| defaultDumpStyle)
|               Nothing -> return ()
|
|
|
| Mark
| _______________________________________________
| Glasgow-haskell-users mailing list
| Glasgow-haskell-users at haskell.org
| http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


More information about the Glasgow-haskell-users mailing list