Add kind equalities to GHC.
[ghc.git] / compiler / vectorise / Vectorise / Generic / Description.hs
index d0d4469..78a8f2c 100644 (file)
@@ -1,16 +1,20 @@
-
--- | Compute a description of the generic representation that we use for 
---   a user defined data type.
+-- |Compute a description of the generic representation that we use for a user defined data type.
 --
---   During vectorisation, we generate a PRepr and PA instance for each user defined
---   data type. The PA dictionary contains methods to convert the user type to and
---   from our generic representation. This module computes a description of what
---   that generic representation is.
+-- During vectorisation, we generate a PRepr and PA instance for each user defined
+-- data type. The PA dictionary contains methods to convert the user type to and
+-- from our generic representation. This module computes a description of what
+-- that generic representation is.
 --
-module Vectorise.Generic.Description ( 
-  CompRepr (..), ProdRepr (..), ConRepr (..), SumRepr (..),
-  tyConRepr, sumReprType, conReprType, prodReprType, compReprType, compOrigType
-) where
+module Vectorise.Generic.Description
+  ( CompRepr(..)
+  , ProdRepr(..)
+  , ConRepr(..)
+  , SumRepr(..)
+  , tyConRepr
+  , sumReprType
+  , compOrigType
+  )
+where
 
 import Vectorise.Utils
 import Vectorise.Monad
@@ -27,7 +31,7 @@ import Outputable
 -- | Describes the generic representation of a data type.
 --   If the data type has multiple constructors then we bundle them
 --   together into a generic sum type.
-data SumRepr 
+data SumRepr
         =  -- | Data type has no data constructors.
            EmptySum
 
@@ -53,7 +57,7 @@ data SumRepr
                , repr_sels_ty   :: Type
 
                -- | Function to get the length of a Sels of this type.
-               , repr_selsLength_v :: CoreExpr 
+               , repr_selsLength_v :: CoreExpr
 
                -- | Type of each data constructor.
                , repr_con_tys   :: [Type]
@@ -64,16 +68,16 @@ data SumRepr
 
 
 -- | Describes the representation type of a data constructor.
-data ConRepr  
-        = ConRepr 
+data ConRepr
+        = ConRepr
                 { repr_dc       :: DataCon
-                , repr_prod     :: ProdRepr 
+                , repr_prod     :: ProdRepr
                 }
 
 -- | Describes the representation type of the fields \/ components of a constructor.
---   If the data constructor has multiple fields then we bundle them 
+--   If the data constructor has multiple fields then we bundle them
 --   together into a generic product type.
-data ProdRepr 
+data ProdRepr
         = -- | Data constructor has no fields.
           EmptyProd
 
@@ -108,10 +112,10 @@ data CompRepr
 
 -------------------------------------------------------------------------------
 
--- | Determine the generic representation of a data type, given its tycon.
---   The `TyCon` contains a description of the whole data type.
+-- |Determine the generic representation of a data type, given its tycon.
+--
 tyConRepr :: TyCon -> VM SumRepr
-tyConRepr tc 
+tyConRepr tc
   = sum_repr (tyConDataCons tc)
   where
     -- Build the representation type for a data type with the given constructors.
@@ -120,23 +124,22 @@ tyConRepr tc
     sum_repr :: [DataCon] -> VM SumRepr
     sum_repr []    = return EmptySum
     sum_repr [con] = liftM UnarySum (con_repr con)
-    sum_repr cons  
+    sum_repr cons
      = do  let arity    = length cons
            rs           <- mapM con_repr cons
            tys          <- mapM conReprType rs
 
            -- Get the 'Sum' tycon of this arity (eg Sum2).
            sum_tc       <- builtin (sumTyCon arity)
-           
+
            -- Get the 'PData' and 'PDatas' tycons for the sum.
-           let sumapp   = mkTyConApp sum_tc tys
-           psum_tc      <- liftM fst $ pdataReprTyCon  sumapp
-           psums_tc     <- liftM fst $ pdatasReprTyCon sumapp
-           
+           psum_tc      <- pdataReprTyConExact  sum_tc
+           psums_tc     <- pdatasReprTyConExact sum_tc
+
            sel_ty       <- builtin (selTy      arity)
            sels_ty      <- builtin (selsTy     arity)
            selsLength_v <- builtin (selsLength arity)
-           return $ Sum 
+           return $ Sum
                   { repr_sum_tc         = sum_tc
                   , repr_psum_tc        = psum_tc
                   , repr_psums_tc       = psums_tc
@@ -156,7 +159,7 @@ tyConRepr tc
     prod_repr :: [Type] -> VM ProdRepr
     prod_repr []   = return EmptyProd
     prod_repr [ty] = liftM UnaryProd (comp_repr ty)
-    prod_repr tys  
+    prod_repr tys
      = do  let arity    = length tys
            rs           <- mapM comp_repr tys
            tys'         <- mapM compReprType rs
@@ -165,53 +168,50 @@ tyConRepr tc
            tup_tc       <- builtin (prodTyCon arity)
 
            -- Get the 'PData' and 'PDatas' tycons for the product.
-           let prodapp  = mkTyConApp tup_tc tys'
-           ptup_tc      <- liftM fst $ pdataReprTyCon  prodapp
-           ptups_tc     <- liftM fst $ pdatasReprTyCon prodapp
-           
-           return $ Prod 
+           ptup_tc      <- pdataReprTyConExact  tup_tc
+           ptups_tc     <- pdatasReprTyConExact tup_tc
+
+           return $ Prod
                   { repr_tup_tc   = tup_tc
                   , repr_ptup_tc  = ptup_tc
                   , repr_ptups_tc = ptups_tc
                   , repr_comp_tys = tys'
                   , repr_comps    = rs
                   }
-    
+
     -- Build the representation type for a single data constructor field.
     comp_repr ty = liftM (Keep ty) (prDictOfReprType ty)
                    `orElseV` return (Wrap ty)
 
-
--- | Yield the type of this sum representation.
+-- |Yield the type of this sum representation.
+--
 sumReprType :: SumRepr -> VM Type
 sumReprType EmptySum     = voidType
 sumReprType (UnarySum r) = conReprType r
 sumReprType (Sum { repr_sum_tc  = sum_tc, repr_con_tys = tys })
   = return $ mkTyConApp sum_tc tys
 
-
--- | Yield the type of this constructor representation.
+-- Yield the type of this constructor representation.
+--
 conReprType :: ConRepr -> VM Type
 conReprType (ConRepr _ r) = prodReprType r
 
-
--- | Yield the type of of this product representation.
+-- Yield the type of of this product representation.
+--
 prodReprType :: ProdRepr -> VM Type
 prodReprType EmptyProd     = voidType
 prodReprType (UnaryProd r) = compReprType r
 prodReprType (Prod { repr_tup_tc = tup_tc, repr_comp_tys = tys })
   = return $ mkTyConApp tup_tc tys
 
-
--- | Yield the type of this data constructor field \/ component representation.
+-- Yield the type of this data constructor field \/ component representation.
+--
 compReprType :: CompRepr -> VM Type
 compReprType (Keep ty _) = return ty
-compReprType (Wrap ty)
-  = do  wrap_tc <- builtin wrapTyCon
-        return $ mkTyConApp wrap_tc [ty]
-       
+compReprType (Wrap ty)   = mkWrapType ty
 
--- Yield the original component type of a data constructor component representation.
+-- |Yield the original component type of a data constructor component representation.
+--
 compOrigType :: CompRepr -> Type
 compOrigType (Keep ty _) = ty
 compOrigType (Wrap ty)   = ty
@@ -228,7 +228,7 @@ instance Outputable SumRepr where
          -> sep [text "UnarySum", ppr con]
 
         Sum sumtc psumtc psumstc selty selsty selsLength contys cons
-         -> text "Sum" $+$ braces (nest 4 
+         -> text "Sum" $+$ braces (nest 4
                 $ sep   [ text "repr_sum_tc       = " <> ppr sumtc
                         , text "repr_psum_tc      = " <> ppr psumtc
                         , text "repr_psums_tc     = " <> ppr psumstc
@@ -251,10 +251,10 @@ instance Outputable ProdRepr where
   = case ss of
         EmptyProd
          -> text "EmptyProd"
-         
+
         UnaryProd cr
          -> sep [text "UnaryProd", ppr cr]
-         
+
         Prod tuptcs ptuptcs ptupstcs comptys comps
          -> sep [text "Prod", ppr tuptcs, ppr ptuptcs, ppr ptupstcs, ppr comptys, ppr comps]
 
@@ -264,7 +264,7 @@ instance Outputable CompRepr where
   = case ss of
         Keep t ce
          -> text "Keep" $+$ sep [ppr t, ppr ce]
-        
+
         Wrap t
          -> sep [text "Wrap", ppr t]
 
@@ -288,4 +288,5 @@ defined by the data instance. For example with:
 The type constructor corresponding to the instance will be named 'PDataSum2',
 and this is what we will get in the repr_psum_tc field of SumRepr.Sum.
 
--}
\ No newline at end of file
+-}
+