[project @ 1996-06-05 06:44:31 by partain]

[ghc-hetmet.git] / ghc / compiler / stranal / WwLib.lhs

diff --git a/ghc/compiler/stranal/WwLib.lhs b/ghc/compiler/stranal/WwLib.lhs
index 4d1fa7a..4f68efb 100644 (file)
--- a/ghc/compiler/stranal/WwLib.lhs
+++ b/ghc/compiler/stranal/WwLib.lhs
@@ -12,21 +12,20 @@ module WwLib (
        mkWwBodies, mAX_WORKER_ARGS
     ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
 import CoreSyn
-import Id              ( idType, mkSysLocal )
+import Id              ( idType, mkSysLocal, dataConArgTys )
 import IdInfo          ( mkStrictnessInfo, nonAbsentArgs, Demand(..) )
-import PrelInfo                ( aBSENT_ERROR_ID )
+import PrelVals                ( aBSENT_ERROR_ID )
 import SrcLoc          ( mkUnknownSrcLoc )
-import Type            ( isPrimType, mkTyVarTys, mkFunTys, maybeAppDataTyCon )
+import Type            ( isPrimType, mkTyVarTys, mkForAllTys, mkFunTys,
+                         maybeAppDataTyConExpandingDicts
+                       )
 import UniqSupply      ( returnUs, thenUs, thenMaybeUs,
                          getUniques, UniqSM(..)
                        )
 import Util            ( zipWithEqual, assertPanic, panic )
-
-quantifyTy = panic "WwLib.quantifyTy"
-getInstantiatedDataConSig = panic "WwLib.getInstantiatedDataConSig"
 \end{code}
 
 %************************************************************************
@@ -225,9 +224,8 @@ mkWwBodies body_ty tyvars args arg_infos
                        )
 
        worker_ty_w_hole = \ body_ty ->
-                               snd (quantifyTy tyvars (
+                               mkForAllTys tyvars $
                                mkFunTys (map idType work_args) body_ty
-                          ))
     in
     returnUs (Just (wrapper_w_hole, worker_w_hole, wrkr_strictness, worker_ty_w_hole))
   where
@@ -311,8 +309,9 @@ mk_ww_arg_processing (arg : args) (WwLazy True : infos) max_extra_args
 mk_ww_arg_processing (arg : args) (WwUnpack cmpnt_infos : infos) max_extra_args
   | new_max_extra_args > 0     -- Check that we are prepared to add arguments
   =    -- this is the complicated one.
-    --pprTrace "Unpack; num_wrkr_args=" (ppCat [ppInt num_wrkr_args, ppStr "; new_max=", ppInt new_num_wrkr_args, ppStr "; arg=", ppr PprDebug arg, ppr PprDebug (WwUnpack cmpnt_infos)]) (
-    case maybeAppDataTyCon arg_ty of
+    --pprTrace "Unpack; num_wrkr_args=" (ppCat [ppInt num_wrkr_args, ppStr "; new_max=", ppInt new_num_wrkr_args, ppStr "; arg=", ppr PprDebug arg, ppr PprDebug (WwUnpack cmpnt_infos)]) $
+
+    case (maybeAppDataTyConExpandingDicts arg_ty) of
 
          Nothing         ->       -- Not a data type
                                   panic "mk_ww_arg_processing: not datatype"
@@ -327,13 +326,12 @@ mk_ww_arg_processing (arg : args) (WwUnpack cmpnt_infos : infos) max_extra_args
                        -- The main event: a single-constructor data type
 
            let
-               (_,inst_con_arg_tys,_)
-                 = getInstantiatedDataConSig data_con tycon_arg_tys
+               inst_con_arg_tys = dataConArgTys data_con tycon_arg_tys
            in
            getUniques (length inst_con_arg_tys)    `thenUs` \ uniqs ->
 
            let
-               unpk_args = zipWithEqual
+               unpk_args = zipWithEqual "mk_ww_arg_processing"
                             (\ u t -> mkSysLocal SLIT("upk") u t mkUnknownSrcLoc)
                             uniqs inst_con_arg_tys
            in
@@ -353,7 +351,6 @@ mk_ww_arg_processing (arg : args) (WwUnpack cmpnt_infos : infos) max_extra_args
              work_args_info,
              \ hole -> work_rest (mk_pk_let arg data_con tycon_arg_tys unpk_args hole)
            ))
-    --)
   where
     arg_ty = idType arg