summaryrefslogtreecommitdiff
path: root/compiler/codeGen/StgCmm.hs
diff options
context:
space:
mode:
authorSimon Marlow <marlowsd@gmail.com>2012-08-09 11:04:15 +0100
committerSimon Marlow <marlowsd@gmail.com>2012-08-21 09:59:04 +0100
commit0ca757490f47f30a711472469058d1ddacaa690b (patch)
treeaca825f8bf1adbc0d8d2cbb16683f9556d7dc0f7 /compiler/codeGen/StgCmm.hs
parentd421b1696e2685334f496375aff6491939c98c79 (diff)
downloadhaskell-0ca757490f47f30a711472469058d1ddacaa690b.tar.gz
remove tabs
Diffstat (limited to 'compiler/codeGen/StgCmm.hs')
-rw-r--r--compiler/codeGen/StgCmm.hs97
1 files changed, 45 insertions, 52 deletions
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index 305c731ddf..b8ed1aa939 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -6,13 +6,6 @@
--
-----------------------------------------------------------------------------
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
module StgCmm ( codeGen ) where
#define FAST_STRING_NOT_NEEDED
@@ -56,11 +49,11 @@ import Control.Monad (when,void)
import Util
codeGen :: DynFlags
- -> Module
- -> [TyCon]
+ -> Module
+ -> [TyCon]
-> CollectedCCs -- (Local/global) cost-centres needing declaring/registering.
- -> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs
- -> HpcInfo
+ -> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs
+ -> HpcInfo
-> Stream IO CmmGroup () -- Output as a stream, so codegen can
-- be interleaved with output
@@ -108,7 +101,7 @@ codeGen dflags this_mod data_tycons
}
---------------------------------------------------------------
--- Top-level bindings
+-- Top-level bindings
---------------------------------------------------------------
{- 'cgTopBinding' is only used for top-level bindings, since they need
@@ -123,17 +116,17 @@ variable. -}
cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> FCode ()
cgTopBinding dflags (StgNonRec id rhs, _srts)
- = do { id' <- maybeExternaliseId dflags id
+ = do { id' <- maybeExternaliseId dflags id
; (info, fcode) <- cgTopRhs id' rhs
; fcode
; addBindC (cg_id info) info -- Add the *un-externalised* Id to the envt,
- -- so we find it when we look up occurrences
+ -- so we find it when we look up occurrences
}
cgTopBinding dflags (StgRec pairs, _srts)
- = do { let (bndrs, rhss) = unzip pairs
+ = do { let (bndrs, rhss) = unzip pairs
; bndrs' <- Prelude.mapM (maybeExternaliseId dflags) bndrs
- ; let pairs' = zip bndrs' rhss
+ ; let pairs' = zip bndrs' rhss
; r <- sequence $ unzipWith cgTopRhs pairs'
; let (infos, fcodes) = unzip r
; addBindsC infos
@@ -142,8 +135,8 @@ cgTopBinding dflags (StgRec pairs, _srts)
cgTopRhs :: Id -> StgRhs -> FCode (CgIdInfo, FCode ())
- -- The Id is passed along for setting up a binding...
- -- It's already been externalised if necessary
+ -- The Id is passed along for setting up a binding...
+ -- It's already been externalised if necessary
cgTopRhs bndr (StgRhsCon _cc con args)
= forkStatics (cgTopRhsCon bndr con args)
@@ -155,18 +148,18 @@ cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag _srt args body)
---------------------------------------------------------------
--- Module initialisation code
+-- Module initialisation code
---------------------------------------------------------------
{- The module initialisation code looks like this, roughly:
- FN(__stginit_Foo) {
- JMP_(__stginit_Foo_1_p)
- }
+ FN(__stginit_Foo) {
+ JMP_(__stginit_Foo_1_p)
+ }
- FN(__stginit_Foo_1_p) {
- ...
- }
+ FN(__stginit_Foo_1_p) {
+ ...
+ }
We have one version of the init code with a module version and the
'way' attached to it. The version number helps to catch cases
@@ -186,16 +179,16 @@ cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag _srt args body)
has the version and way info appended to it.
We initialise the module tree by keeping a work-stack,
- * pointed to by Sp
- * that grows downward
- * Sp points to the last occupied slot
+ * pointed to by Sp
+ * that grows downward
+ * Sp points to the last occupied slot
-}
mkModuleInit
:: CollectedCCs -- cost centre info
- -> Module
+ -> Module
-> HpcInfo
- -> FCode ()
+ -> FCode ()
mkModuleInit cost_centre_info this_mod hpc_info
= do { initHpc this_mod hpc_info
@@ -207,7 +200,7 @@ mkModuleInit cost_centre_info this_mod hpc_info
---------------------------------------------------------------
--- Generating static stuff for algebraic data types
+-- Generating static stuff for algebraic data types
---------------------------------------------------------------
@@ -223,11 +216,11 @@ cgDataCon :: DataCon -> FCode ()
-- Generate the entry code, info tables, and (for niladic constructor)
-- the static closure, for a constructor.
cgDataCon data_con
- = do { dflags <- getDynFlags
+ = do { dflags <- getDynFlags
; let
(tot_wds, -- #ptr_wds + #nonptr_wds
- ptr_wds, -- #ptr_wds
- arg_things) = mkVirtConstrOffsets dflags arg_reps
+ ptr_wds, -- #ptr_wds
+ arg_things) = mkVirtConstrOffsets dflags arg_reps
nonptr_wds = tot_wds - ptr_wds
@@ -238,29 +231,29 @@ cgDataCon data_con
= emitClosureAndInfoTable info_tbl NativeDirectCall []
$ mk_code ticky_code
- mk_code ticky_code
- = -- NB: We don't set CC when entering data (WDP 94/06)
- do { _ <- ticky_code
- ; ldvEnter (CmmReg nodeReg)
- ; tickyReturnOldCon (length arg_things)
+ mk_code ticky_code
+ = -- NB: We don't set CC when entering data (WDP 94/06)
+ do { _ <- ticky_code
+ ; ldvEnter (CmmReg nodeReg)
+ ; tickyReturnOldCon (length arg_things)
; void $ emitReturn [cmmOffsetB (CmmReg nodeReg)
(tagForCon data_con)]
}
-- The case continuation code expects a tagged pointer
- arg_reps :: [(PrimRep, UnaryType)]
- arg_reps = [(typePrimRep rep_ty, rep_ty) | ty <- dataConRepArgTys data_con, rep_ty <- flattenRepType (repType ty)]
+ arg_reps :: [(PrimRep, UnaryType)]
+ arg_reps = [(typePrimRep rep_ty, rep_ty) | ty <- dataConRepArgTys data_con, rep_ty <- flattenRepType (repType ty)]
- -- Dynamic closure code for non-nullary constructors only
- ; whenC (not (isNullaryRepDataCon data_con))
+ -- Dynamic closure code for non-nullary constructors only
+ ; whenC (not (isNullaryRepDataCon data_con))
(emit_info dyn_info_tbl tickyEnterDynCon)
- -- Dynamic-Closure first, to reduce forward references
+ -- Dynamic-Closure first, to reduce forward references
; emit_info sta_info_tbl tickyEnterStaticCon }
---------------------------------------------------------------
--- Stuff to support splitting
+-- Stuff to support splitting
---------------------------------------------------------------
-- If we're splitting the object, we need to externalise all the
@@ -269,17 +262,17 @@ cgDataCon data_con
maybeExternaliseId :: DynFlags -> Id -> FCode Id
maybeExternaliseId dflags id
- | dopt Opt_SplitObjs dflags, -- Externalise the name for -split-objs
+ | dopt Opt_SplitObjs dflags, -- Externalise the name for -split-objs
isInternalName name = do { mod <- getModuleName
- ; returnFC (setIdName id (externalise mod)) }
- | otherwise = returnFC id
+ ; returnFC (setIdName id (externalise mod)) }
+ | otherwise = returnFC id
where
externalise mod = mkExternalName uniq mod new_occ loc
name = idName id
uniq = nameUnique name
new_occ = mkLocalOcc uniq (nameOccName name)
loc = nameSrcSpan name
- -- We want to conjure up a name that can't clash with any
- -- existing name. So we generate
- -- Mod_$L243foo
- -- where 243 is the unique.
+ -- We want to conjure up a name that can't clash with any
+ -- existing name. So we generate
+ -- Mod_$L243foo
+ -- where 243 is the unique.