projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Removed warnings, made Haddock happy, added examples in documentation
[ghc-hetmet.git]
/
compiler
/
codeGen
/
StgCmmBind.hs
diff --git
a/compiler/codeGen/StgCmmBind.hs
b/compiler/codeGen/StgCmmBind.hs
index
0467678
..
a78abc7
100644
(file)
--- a/
compiler/codeGen/StgCmmBind.hs
+++ b/
compiler/codeGen/StgCmmBind.hs
@@
-84,7
+84,7
@@
cgTopRhsClosure id ccs _ upd_flag srt args body = do
(_, _, fv_details) = mkVirtHeapOffsets (isLFThunk lf_info)
(addIdReps [])
-- Don't drop the non-void args until the closure info has been made
(_, _, fv_details) = mkVirtHeapOffsets (isLFThunk lf_info)
(addIdReps [])
-- Don't drop the non-void args until the closure info has been made
- ; forkClosureBody (closureCodeBody True id closure_info ccs srt_info
+ ; forkClosureBody (closureCodeBody True id closure_info ccs
(nonVoidIds args) (length args) body fv_details)
; pprTrace "arity for" (ppr id <+> ppr (length args) <+> ppr args) $
(nonVoidIds args) (length args) body fv_details)
; pprTrace "arity for" (ppr id <+> ppr (length args) <+> ppr args) $
@@
-293,7
+293,7
@@
mkRhsClosure bndr cc _ fvs upd_flag srt args body
-- forkClosureBody: (a) ensure that bindings in here are not seen elsewhere
-- (b) ignore Sequel from context; use empty Sequel
-- And compile the body
-- forkClosureBody: (a) ensure that bindings in here are not seen elsewhere
-- (b) ignore Sequel from context; use empty Sequel
-- And compile the body
- closureCodeBody False bndr closure_info cc c_srt (nonVoidIds args)
+ closureCodeBody False bndr closure_info cc (nonVoidIds args)
(length args) body fv_details
-- BUILD THE OBJECT
(length args) body fv_details
-- BUILD THE OBJECT
@@
-361,7
+361,6
@@
closureCodeBody :: Bool -- whether this is a top-level binding
-> Id -- the closure's name
-> ClosureInfo -- Lots of information about this closure
-> CostCentreStack -- Optional cost centre attached to closure
-> Id -- the closure's name
-> ClosureInfo -- Lots of information about this closure
-> CostCentreStack -- Optional cost centre attached to closure
- -> C_SRT
-> [NonVoid Id] -- incoming args to the closure
-> Int -- arity, including void args
-> StgExpr
-> [NonVoid Id] -- incoming args to the closure
-> Int -- arity, including void args
-> StgExpr
@@
-381,12
+380,12
@@
closureCodeBody :: Bool -- whether this is a top-level binding
argSatisfactionCheck (by calling fetchAndReschedule).
There info if Node points to closure is available. -- HWL -}
argSatisfactionCheck (by calling fetchAndReschedule).
There info if Node points to closure is available. -- HWL -}
-closureCodeBody top_lvl bndr cl_info cc srt args arity body fv_details
+closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
| length args == 0 -- No args i.e. thunk
= emitClosureProcAndInfoTable top_lvl bndr cl_info [] $
| length args == 0 -- No args i.e. thunk
= emitClosureProcAndInfoTable top_lvl bndr cl_info [] $
- (\ (node, _) -> thunkCode cl_info fv_details cc srt node arity body)
+ (\ (node, _) -> thunkCode cl_info fv_details cc node arity body)
-closureCodeBody top_lvl bndr cl_info cc srt args arity body fv_details
+closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
= ASSERT( length args > 0 )
do { -- Allocate the global ticky counter,
-- and establish the ticky-counter
= ASSERT( length args > 0 )
do { -- Allocate the global ticky counter,
-- and establish the ticky-counter
@@
-407,7
+406,7
@@
closureCodeBody top_lvl bndr cl_info cc srt args arity body fv_details
; granYield arg_regs node_points
-- Main payload
; granYield arg_regs node_points
-- Main payload
- ; entryHeapCheck node arity arg_regs srt $ do
+ ; entryHeapCheck node arity arg_regs $ do
{ enterCostCentre cl_info cc body
; fv_bindings <- mapM bind_fv fv_details
; load_fvs node lf_info fv_bindings -- Load free vars out of closure *after*
{ enterCostCentre cl_info cc body
; fv_bindings <- mapM bind_fv fv_details
; load_fvs node lf_info fv_bindings -- Load free vars out of closure *after*
@@
-454,15
+453,15
@@
mkSlowEntryCode _ [] = panic "entering a closure with no arguments?"
-----------------------------------------
thunkCode :: ClosureInfo -> [(NonVoid Id, VirtualHpOffset)] -> CostCentreStack ->
-----------------------------------------
thunkCode :: ClosureInfo -> [(NonVoid Id, VirtualHpOffset)] -> CostCentreStack ->
- C_SRT -> LocalReg -> Int -> StgExpr -> FCode ()
-thunkCode cl_info fv_details cc srt node arity body
+ LocalReg -> Int -> StgExpr -> FCode ()
+thunkCode cl_info fv_details cc node arity body
= do { let node_points = nodeMustPointToIt (closureLFInfo cl_info)
; tickyEnterThunk cl_info
; ldvEnterClosure cl_info -- NB: Node always points when profiling
; granThunk node_points
-- Heap overflow check
= do { let node_points = nodeMustPointToIt (closureLFInfo cl_info)
; tickyEnterThunk cl_info
; ldvEnterClosure cl_info -- NB: Node always points when profiling
; granThunk node_points
-- Heap overflow check
- ; entryHeapCheck node arity [] srt $ do
+ ; entryHeapCheck node arity [] $ do
{ -- Overwrite with black hole if necessary
-- but *after* the heap-overflow check
whenC (blackHoleOnEntry cl_info && node_points)
{ -- Overwrite with black hole if necessary
-- but *after* the heap-overflow check
whenC (blackHoleOnEntry cl_info && node_points)