[project @ 2001-05-01 09:16:55 by qrczak]

[ghc-hetmet.git] / ghc / compiler / codeGen / CgClosure.lhs

diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs
index 5fba8c0..bf29d79 100644 (file)
--- a/ghc/compiler/codeGen/CgClosure.lhs
+++ b/ghc/compiler/codeGen/CgClosure.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgClosure.lhs,v 1.43 2000/11/06 08:15:21 simonpj Exp $
+% $Id: CgClosure.lhs,v 1.46 2001/03/22 03:51:08 hwloidl Exp $
 %
 \section[CgClosure]{Code generation for closures}
 
@@ -79,9 +79,13 @@ cgTopRhsClosure :: Id
                -> FCode (Id, CgIdInfo)
 
 cgTopRhsClosure id ccs binder_info args body lf_info
-  =    -- LAY OUT THE OBJECT
+  = 
+    -- LAY OUT THE OBJECT
     let
-       closure_info = layOutStaticNoFVClosure name lf_info
+       name          = idName id
+       closure_info  = layOutStaticNoFVClosure name lf_info
+       closure_label = mkClosureLabel name
+       cg_id_info    = stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info
     in
 
        -- BUILD THE OBJECT (IF NECESSARY)
@@ -113,10 +117,7 @@ cgTopRhsClosure id ccs binder_info args body lf_info
     ) `thenC`
 
     returnFC (id, cg_id_info)
-  where
-    name         = idName id
-    closure_label = mkClosureLabel name
-    cg_id_info    = stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info
+
 \end{code}
 
 %********************************************************
@@ -190,21 +191,19 @@ cgRhsClosure binder cc binder_info fvs args body lf_info
                         then fvs `minusList` [binder]
                         else fvs
     in
-    mapFCs getCAddrModeAndInfo reduced_fvs     `thenFC` \ amodes_and_info ->
+    mapFCs getCAddrModeAndInfo reduced_fvs     `thenFC` \ fvs_w_amodes_and_info ->
     let
-       fvs_w_amodes_and_info         = reduced_fvs `zip` amodes_and_info
-
        closure_info :: ClosureInfo
-       bind_details :: [((Id, (CAddrMode, LambdaFormInfo)), VirtualHeapOffset)]
+       bind_details :: [((Id, CAddrMode, LambdaFormInfo), VirtualHeapOffset)]
 
        (closure_info, bind_details)
          = layOutDynClosure (idName binder) get_kind fvs_w_amodes_and_info lf_info
 
-       bind_fv ((id, (_, lf_info)), offset) = bindNewToNode id offset lf_info
+       bind_fv ((id, _, lf_info), offset) = bindNewToNode id offset lf_info
 
-       amodes_w_offsets = [(amode,offset) | ((_, (amode,_)), offset) <- bind_details]
+       amodes_w_offsets = [(amode,offset) | ((_,amode,_), offset) <- bind_details]
 
-       get_kind (id, amode_and_info) = idPrimRep id
+       get_kind (id, _, _) = idPrimRep id
     in
        -- BUILD ITS INFO TABLE AND CODE
     forkClosureBody (
@@ -321,12 +320,7 @@ closureCodeBody binder_info closure_info cc all_args body
        --
        arg_regs = case entry_conv of
                DirectEntry lbl arity regs -> regs
-               other                      -> trace ("*** closureCodeBody:arg_regs " ++ (pprHWL entry_conv) ++ "(HWL ignored; no args passed in regs)") []
-
-        pprHWL :: EntryConvention -> String    
-        pprHWL (ViaNode) = "ViaNode"
-        pprHWL (StdEntry cl) = "StdEntry"
-        pprHWL (DirectEntry cl i l) = "DirectEntry"
+               other                      -> []  -- "(HWL ignored; no args passed in regs)"
 
        num_arg_regs = length arg_regs