[project @ 2001-03-06 10:13:35 by simonmar]

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

diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs
index 34a84cc..f55f082 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.41 2000/07/14 08:14:53 simonpj Exp $
+% $Id: CgClosure.lhs,v 1.45 2001/03/06 10:13:35 simonmar Exp $
 %
 \section[CgClosure]{Code generation for closures}
 
@@ -57,8 +57,7 @@ import Outputable
 
 import Name             ( nameOccName )
 import OccName          ( occNameFS )
-
-getWrapperArgTypeCategories = panic "CgClosure.getWrapperArgTypeCategories (ToDo)"
+import FastTypes       ( iBox )
 \end{code}
 
 %********************************************************
@@ -80,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)
@@ -114,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}
 
 %********************************************************
@@ -191,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 (
@@ -539,7 +537,7 @@ argSatisfactionCheck closure_info arg_regs
 
         getSpRelOffset 0       `thenFC` \ (SpRel sp) ->
        let
-           off = I# sp
+           off     = iBox sp
            rel_arg = mkIntCLit off
        in
        ASSERT(off /= 0)
@@ -744,43 +742,3 @@ chooseDynCostCentres ccs args fvs body
 
 
 
-========================================================================
-OLD CODE THAT EMITTED INFORMATON FOR QUANTITATIVE ANALYSIS
-
-It's pretty wierd, so I've nuked it for now.  SLPJ Nov 96
-
-\begin{pseudocode}
-getWrapperArgTypeCategories
-       :: Type                         -- wrapper's type
-       -> StrictnessInfo bdee          -- strictness info about its args
-       -> Maybe String
-
-getWrapperArgTypeCategories _ NoStrictnessInfo     = Nothing
-getWrapperArgTypeCategories _ BottomGuaranteed
-  = trace "getWrapperArgTypeCategories:BottomGuaranteed!" Nothing  -- wrong
-getWrapperArgTypeCategories _ (StrictnessInfo [] _) = Nothing
-
-getWrapperArgTypeCategories ty (StrictnessInfo arg_info _)
-  = Just (mkWrapperArgTypeCategories ty arg_info)
-
-mkWrapperArgTypeCategories
-       :: Type         -- wrapper's type
-       -> [Demand]     -- info about its arguments
-       -> String       -- a string saying lots about the args
-
-mkWrapperArgTypeCategories wrapper_ty wrap_info
-  = case (splitFunTy_maybe wrapper_ty) of { Just (arg_tys,_) ->
-    map do_one (wrap_info `zip` (map showTypeCategory arg_tys)) }
-  where
-    -- ToDo: this needs FIXING UP (it was a hack anyway...)
-    do_one (WwPrim, _) = 'P'
-    do_one (WwEnum, _) = 'E'
-    do_one (WwStrict, arg_ty_char) = arg_ty_char
-    do_one (WwUnpack _ _ _, arg_ty_char)
-      = if arg_ty_char `elem` "CIJFDTS"
-       then toLower arg_ty_char
-       else if arg_ty_char == '+' then 't'
-       else trace ("mkWrapp..:funny char:"++[arg_ty_char]) '-'
-    do_one (other_wrap_info, _) = '-'
-\end{pseudocode}
-