%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[CodeGen]{@CodeGen@: main module of the code generator}
\begin{code}
#include "HsVersions.h"
-module CodeGen (
- codeGen,
-
- -- and to make the interface self-sufficient...
- UniqFM, AbstractC, StgBinding, Id, FiniteMap
- ) where
+module CodeGen ( codeGen ) where
+import Ubiq{-uitous-}
import StgSyn
import CgMonad
import AbsCSyn
-import CLabelInfo ( modnameToC )
+import AbsCUtils ( mkAbstractCs, mkAbsCStmts )
+import Bag ( foldBag )
import CgClosure ( cgTopRhsClosure )
import CgCon ( cgTopRhsCon )
-import CgConTbls ( genStaticConBits, TCE(..), UniqFM )
-import ClosureInfo ( LambdaFormInfo, mkClosureLFInfo )
-import CmdLineOpts ( GlobalSwitch(..), switchIsOn, stringSwitchSet, SwitchResult )
-import FiniteMap ( FiniteMap )
-import Maybes ( Maybe(..) )
-import PrimKind ( getKindSize )
-import Util
+import CgConTbls ( genStaticConBits )
+import ClosureInfo ( mkClosureLFInfo )
+import CmdLineOpts ( opt_SccProfilingOn, opt_CompilingPrelude,
+ opt_EnsureSplittableC, opt_SccGroup
+ )
+import CStrings ( modnameToC )
+import Maybes ( maybeToBool )
+import PrimRep ( getPrimRepSize, PrimRep(..) )
+import Util ( panic, assertPanic )
\end{code}
\begin{code}
codeGen :: FAST_STRING -- module name
-> ([CostCentre], -- local cost-centres needing declaring/registering
[CostCentre]) -- "extern" cost-centres needing declaring
- -> [FAST_STRING] -- import names
- -> (GlobalSwitch -> SwitchResult)
- -- global switch lookup function
+ -> [Module] -- import names
-> [TyCon] -- tycons with data constructors to convert
- -> FiniteMap TyCon [[Maybe UniType]]
+ -> FiniteMap TyCon [(Bool, [Maybe Type])]
-- tycon specialisation info
- -> PlainStgProgram -- bindings to convert
+ -> [StgBinding] -- bindings to convert
-> AbstractC -- output
-codeGen mod_name (local_CCs, extern_CCs) import_names sw_lookup_fn gen_tycons tycon_specs stg_pgm
+codeGen mod_name (local_CCs, extern_CCs) import_names gen_tycons tycon_specs stg_pgm
= let
- switch_is_on = switchIsOn sw_lookup_fn
- doing_profiling = switch_is_on SccProfilingOn
- compiling_prelude = switch_is_on CompilingPrelude
- splitting = switch_is_on (EnsureSplittableC (panic "codeGen:esc"))
+ doing_profiling = opt_SccProfilingOn
+ compiling_prelude = opt_CompilingPrelude
+ maybe_split = if maybeToBool (opt_EnsureSplittableC)
+ then CSplitMarker
+ else AbsCNop
+
+ cinfo = MkCompInfo mod_name
in
if not doing_profiling then
- let
- cinfo = MkCompInfo switch_is_on mod_name
- in
mkAbstractCs [
genStaticConBits cinfo gen_tycons tycon_specs,
- initC cinfo (cgTopBindings splitting stg_pgm) ]
+ initC cinfo (cgTopBindings maybe_split stg_pgm) ]
else -- yes, cost-centre profiling:
-- Besides the usual stuff, we must produce:
-- into the code-generator, as are the imported-modules' names.)
--
-- Note: we don't register/etc if compiling Prelude bits.
- let
- cinfo = MkCompInfo switch_is_on mod_name
- in
+
mkAbstractCs [
if compiling_prelude
then AbsCNop
mkCcRegister local_CCs import_names],
genStaticConBits cinfo gen_tycons tycon_specs,
- initC cinfo (cgTopBindings splitting stg_pgm) ]
+ initC cinfo (cgTopBindings maybe_split stg_pgm) ]
where
-----------------
- grp_name = case (stringSwitchSet sw_lookup_fn SccGroup) of
+ grp_name = case opt_SccGroup of
Just xx -> _PK_ xx
Nothing -> mod_name -- default: module name
-----------------
mkCcRegister ccs import_names
- = let
+ = let
register_ccs = mkAbstractCs (map mk_register ccs)
- register_imports = mkAbstractCs (map mk_import_register import_names)
+ register_imports
+ = foldr (mkAbsCStmts . mk_import_register) AbsCNop import_names
in
mkAbstractCs [
- CCallProfCCMacro SLIT("START_REGISTER_CCS") [CLitLit (modnameToC (SLIT("_reg") _APPEND_ mod_name)) AddrKind],
+ CCallProfCCMacro SLIT("START_REGISTER_CCS") [CLitLit (modnameToC (SLIT("_reg") _APPEND_ mod_name)) AddrRep],
register_ccs,
register_imports,
CCallProfCCMacro SLIT("END_REGISTER_CCS") []
= CCallProfCCMacro SLIT("REGISTER_CC") [mkCCostCentre cc]
mk_import_register import_name
- = CCallProfCCMacro SLIT("REGISTER_IMPORT") [CLitLit (modnameToC (SLIT("_reg") _APPEND_ import_name)) AddrKind]
+ = CCallProfCCMacro SLIT("REGISTER_IMPORT") [CLitLit (modnameToC (SLIT("_reg") _APPEND_ import_name)) AddrRep]
\end{code}
%************************************************************************
variable.
\begin{code}
-cgTopBindings :: Bool -> PlainStgProgram -> Code
+cgTopBindings :: AbstractC -> [StgBinding] -> Code
+
+cgTopBindings split bindings = mapCs (cgTopBinding split) bindings
-cgTopBindings splitting bindings = mapCs (cgTopBinding splitting) bindings
-
-cgTopBinding :: Bool -> PlainStgBinding -> Code
+cgTopBinding :: AbstractC -> StgBinding -> Code
-cgTopBinding splitting (StgNonRec name rhs)
- = absC maybe_split `thenC`
+cgTopBinding split (StgNonRec name rhs)
+ = absC split `thenC`
cgTopRhs name rhs `thenFC` \ (name, info) ->
addBindC name info
- where
- maybe_split = if splitting then CSplitMarker else AbsCNop
-cgTopBinding splitting (StgRec pairs)
- = absC maybe_split `thenC`
+cgTopBinding split (StgRec pairs)
+ = absC split `thenC`
fixC (\ new_binds -> addBindsC new_binds `thenC`
mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs
) `thenFC` \ new_binds ->
addBindsC new_binds
- where
- maybe_split = if splitting then CSplitMarker else AbsCNop
-- Urgh! I tried moving the forkStatics call from the rhss of cgTopRhs
-- to enclose the listFCs in cgTopBinding, but that tickled the
-- statics "error" call in initC. I DON'T UNDERSTAND WHY!
-cgTopRhs :: Id -> PlainStgRhs -> FCode (Id, CgIdInfo)
+cgTopRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
-- the Id is passed along for setting up a binding...
cgTopRhs name (StgRhsCon cc con args)
= forkStatics (cgTopRhsCon name con args (all zero_size args))
where
- zero_size atom = getKindSize (getAtomKind atom) == 0
+ zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0
cgTopRhs name (StgRhsClosure cc bi fvs upd_flag args body)
= ASSERT(null fvs) -- There should be no free variables
projects / ghc-hetmet.git / blobdiff