Remove some files I accidentally added.

[ghc-hetmet.git] / compiler / types / Generics.lhs

diff --git a/compiler/types/Generics.lhs b/compiler/types/Generics.lhs
index f8d30fd..b17670d 100644 (file)
--- a/compiler/types/Generics.lhs
+++ b/compiler/types/Generics.lhs
@@ -26,7 +26,7 @@ import PrelNames
 import TcEnv (tcLookupTyCon)
 import TcRnMonad (TcM, newUnique)
 import HscTypes
-       
+
 import SrcLoc
 import Bag
 import Outputable 
@@ -111,6 +111,7 @@ tc_mkRep0Ty tycon metaDts =
     c1 <- tcLookupTyCon c1TyConName
     s1 <- tcLookupTyCon s1TyConName
     rec0 <- tcLookupTyCon rec0TyConName
+    par0 <- tcLookupTyCon par0TyConName
     u1 <- tcLookupTyCon u1TyConName
     v1 <- tcLookupTyCon v1TyConName
     plus <- tcLookupTyCon sumTyConName
@@ -119,6 +120,7 @@ tc_mkRep0Ty tycon metaDts =
     let mkSum' a b = mkTyConApp plus  [a,b]
         mkProd a b = mkTyConApp times [a,b]
         mkRec0 a   = mkTyConApp rec0  [a]
+        mkPar0 a   = mkTyConApp par0  [a]
         mkD    a   = mkTyConApp d1    [metaDTyCon, sumP (tyConDataCons a)]
         mkC  i d a = mkTyConApp c1    [d, prod i (dataConOrigArgTys a)]
         mkS    d a = mkTyConApp s1    [d, a]
@@ -136,7 +138,11 @@ tc_mkRep0Ty tycon metaDts =
                         foldBal mkProd [ arg d a 
                                        | (d,a) <- zip (metaSTyCons !! i) l ]
         
-        arg d t = mkS d (mkRec0 t)
+        arg d t = mkS d (recOrPar t (getTyVar_maybe t))
+        -- Argument is not a type variable, use Rec0
+        recOrPar t Nothing  = mkRec0 t
+        -- Argument is a type variable, use Par0
+        recOrPar t (Just _) = mkPar0 t
         
         metaDTyCon  = mkTyConTy (metaD metaDts)
         metaCTyCons = map mkTyConTy (metaC metaDts)
@@ -318,9 +324,9 @@ genLR_E i n e
 --------------------------------------------------------------------------------
 
 -- Build a product expression
-mkProd_E :: US                   -- Base for unique names
-              -> [RdrName]       -- List of variables matched on the lhs
-              -> LHsExpr RdrName -- Resulting product expression
+mkProd_E :: US             -- Base for unique names
+        -> [RdrName]       -- List of variables matched on the lhs
+        -> LHsExpr RdrName -- Resulting product expression
 mkProd_E _ []   = mkM1_E (nlHsVar u1DataCon_RDR)
 mkProd_E _ vars = mkM1_E (foldBal prod appVars)
                    -- These M1s are meta-information for the constructor
@@ -328,7 +334,6 @@ mkProd_E _ vars = mkM1_E (foldBal prod appVars)
     appVars = map wrapArg_E vars
     prod a b = prodDataCon_RDR `nlHsApps` [a,b]
 
--- TODO: Produce a P0 when v is a parameter
 wrapArg_E :: RdrName -> LHsExpr RdrName
 wrapArg_E v = mkM1_E (k1DataCon_RDR `nlHsVarApps` [v])
               -- This M1 is meta-information for the selector
@@ -344,7 +349,6 @@ mkProd_P _ vars = mkM1_P (foldBal prod appVars)
     appVars = map wrapArg_P vars
     prod a b = prodDataCon_RDR `nlConPat` [a,b]
     
--- TODO: Produce a P0 when v is a parameter
 wrapArg_P :: RdrName -> LPat RdrName
 wrapArg_P v = mkM1_P (k1DataCon_RDR `nlConVarPat` [v])
               -- This M1 is meta-information for the selector