Remove the hasGenerics field of TyCon, improve the way the Generics flags is handled...

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

diff --git a/compiler/types/Generics.lhs b/compiler/types/Generics.lhs
index e354d9f..6aebe4c 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 
@@ -42,18 +42,24 @@ import FastString
 %************************************************************************
 
 \begin{code}
-canDoGenerics :: ThetaType -> [DataCon] -> Bool
+canDoGenerics :: TyCon -> Bool
 -- Called on source-code data types, to see if we should generate
--- generic functions for them.  (This info is recorded in the interface file for
--- imported data types.)
-
-canDoGenerics stupid_theta data_cs
-  =  not (any bad_con data_cs)         -- See comment below
-  
-  -- && not (null data_cs)     -- No values of the type
-  -- JPM: we now support empty datatypes
-  
-     && null stupid_theta -- We do not support datatypes with context (for now)
+-- generic functions for them.
+
+canDoGenerics tycon
+  =  let result = not (any bad_con (tyConDataCons tycon))      -- See comment below
+                  -- We do not support datatypes with context (for now)
+                  && null (tyConStupidTheta tycon)
+{-
+                  -- Primitives are (probably) not representable either
+                  && not (isPrimTyCon tycon)
+                  -- Foreigns are (probably) not representable either
+                  && not (isForeignTyCon tycon)
+-}
+                  -- We don't like type families
+                  && not (isFamilyTyCon tycon)
+
+     in {- pprTrace "canDoGenerics" (ppr (tycon,result)) -} result
   where
     bad_con dc = any bad_arg_type (dataConOrigArgTys dc) || not (isVanillaDataCon dc)
        -- If any of the constructor has an unboxed type as argument,
@@ -65,8 +71,6 @@ canDoGenerics stupid_theta data_cs
 
        -- Nor if the args are polymorphic types (I don't think)
     bad_arg_type ty = isUnLiftedType ty || not (isTauTy ty)
-  -- JPM: TODO: I'm not sure I know what isTauTy checks for, so I'm leaving it
-       -- like this for now...
 \end{code}
 
 %************************************************************************
@@ -138,11 +142,11 @@ tc_mkRep0Ty tycon metaDts =
                         foldBal mkProd [ arg d a 
                                        | (d,a) <- zip (metaSTyCons !! i) l ]
         
-        arg d t = trace (showPpr t) $ mkS d (recOrPar t (getTyVar_maybe t))
+        arg d t = mkS d (recOrPar t (getTyVar_maybe t))
         -- Argument is not a type variable, use Rec0
-        recOrPar t Nothing  = trace "Rec0" $ mkRec0 t
+        recOrPar t Nothing  = mkRec0 t
         -- Argument is a type variable, use Par0
-        recOrPar t (Just _) = trace "Par0" $ mkPar0 t
+        recOrPar t (Just _) = mkPar0 t
         
         metaDTyCon  = mkTyConTy (metaD metaDts)
         metaCTyCons = map mkTyConTy (metaC metaDts)
@@ -334,7 +338,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
@@ -350,7 +353,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