Commit e194712d authored by benl's avatar benl

Merge /Users/benl/devel/ghc/ghc-head-devel

Conflicts:
	compiler/vectorise/Vectorise/Type/PRepr.hs
parents ed4252cf 71fee325
......@@ -67,7 +67,8 @@ module OccName (
mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
mkInstTyCoOcc, mkEqPredCoOcc,
mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
mkPDataTyConOcc, mkPDataDataConOcc,
mkPDataTyConOcc, mkPDataDataConOcc,
mkPDatasTyConOcc, mkPDatasDataConOcc,
mkPReprTyConOcc,
mkPADFunOcc,
......@@ -638,16 +639,21 @@ mkDataTOcc = mk_simple_deriv varName "$t"
mkDataCOcc = mk_simple_deriv varName "$c"
-- Vectorisation
mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc, mkPADFunOcc, mkPReprTyConOcc,
mkPDataTyConOcc, mkPDataDataConOcc :: Maybe String -> OccName -> OccName
mkVectOcc = mk_simple_deriv_with varName "$v"
mkVectTyConOcc = mk_simple_deriv_with tcName "V:"
mkVectDataConOcc = mk_simple_deriv_with dataName "VD:"
mkVectIsoOcc = mk_simple_deriv_with varName "$vi"
mkPADFunOcc = mk_simple_deriv_with varName "$pa"
mkPReprTyConOcc = mk_simple_deriv_with tcName "VR:"
mkPDataTyConOcc = mk_simple_deriv_with tcName "VP:"
mkPDataDataConOcc = mk_simple_deriv_with dataName "VPD:"
mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
mkPADFunOcc, mkPReprTyConOcc,
mkPDataTyConOcc, mkPDataDataConOcc,
mkPDatasTyConOcc, mkPDatasDataConOcc
:: Maybe String -> OccName -> OccName
mkVectOcc = mk_simple_deriv_with varName "$v"
mkVectTyConOcc = mk_simple_deriv_with tcName "V:"
mkVectDataConOcc = mk_simple_deriv_with dataName "VD:"
mkVectIsoOcc = mk_simple_deriv_with varName "$vi"
mkPADFunOcc = mk_simple_deriv_with varName "$pa"
mkPReprTyConOcc = mk_simple_deriv_with tcName "VR:"
mkPDataTyConOcc = mk_simple_deriv_with tcName "VP:"
mkPDatasTyConOcc = mk_simple_deriv_with tcName "VPs:"
mkPDataDataConOcc = mk_simple_deriv_with dataName "VPD:"
mkPDatasDataConOcc = mk_simple_deriv_with dataName "VPDs:"
mk_simple_deriv :: NameSpace -> String -> OccName -> OccName
mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
......
......@@ -23,7 +23,9 @@ module DsMonad (
getDOptsDs, getGhcModeDs, doptDs, woptDs,
dsLookupGlobal, dsLookupGlobalId, dsDPHBuiltin, dsLookupTyCon, dsLookupDataCon,
PArrBuiltin(..), dsLookupDPHRdrEnv, dsInitPArrBuiltin,
PArrBuiltin(..),
dsLookupDPHRdrEnv, dsLookupDPHRdrEnv_maybe,
dsInitPArrBuiltin,
DsMetaEnv, DsMetaVal(..), dsLookupMetaEnv, dsExtendMetaEnv,
......@@ -63,6 +65,7 @@ import FastString
import Maybes
import Data.IORef
import Control.Monad
\end{code}
%************************************************************************
......@@ -414,20 +417,29 @@ dsLookupDataCon name
\end{code}
\begin{code}
-- Look up a name exported by 'Data.Array.Parallel.Prim' or 'Data.Array.Parallel.Prim'.
--
-- |Lookup a name exported by 'Data.Array.Parallel.Prim' or 'Data.Array.Parallel.Prim'.
-- Panic if there isn't one, or if it is defined multiple times.
dsLookupDPHRdrEnv :: OccName -> DsM Name
dsLookupDPHRdrEnv occ
= liftM (fromMaybe (pprPanic nameNotFound (ppr occ)))
$ dsLookupDPHRdrEnv_maybe occ
where nameNotFound = "Name not found in 'Data.Array.Parallel' or 'Data.Array.Parallel.Prim':"
-- |Lookup a name exported by 'Data.Array.Parallel.Prim' or 'Data.Array.Parallel.Prim',
-- returning `Nothing` if it's not defined. Panic if it's defined multiple times.
dsLookupDPHRdrEnv_maybe :: OccName -> DsM (Maybe Name)
dsLookupDPHRdrEnv_maybe occ
= do { env <- ds_dph_env <$> getGblEnv
; let gres = lookupGlobalRdrEnv env occ
; case gres of
[] -> pprPanic nameNotFound (ppr occ)
[gre] -> return $ gre_name gre
[] -> return $ Nothing
[gre] -> return $ Just $ gre_name gre
_ -> pprPanic multipleNames (ppr occ)
}
where
nameNotFound = "Name not found in 'Data.Array.Parallel' or 'Data.Array.Parallel.Prim':"
multipleNames = "Multiple definitions in 'Data.Array.Parallel' and 'Data.Array.Parallel.Prim':"
where multipleNames = "Multiple definitions in 'Data.Array.Parallel' and 'Data.Array.Parallel.Prim':"
-- Populate 'ds_parr_bi' from 'ds_dph_env'.
--
......
......@@ -473,11 +473,11 @@ Library
Vectorise.Utils.PADict
Vectorise.Utils.Poly
Vectorise.Utils
Vectorise.Generic.Description
Vectorise.Generic.PAMethods
Vectorise.Generic.PADict
Vectorise.Generic.PData
Vectorise.Type.Env
Vectorise.Type.Repr
Vectorise.Type.PData
Vectorise.Type.PRepr
Vectorise.Type.PADict
Vectorise.Type.Type
Vectorise.Type.TyConDecl
Vectorise.Type.Classify
......
......@@ -73,6 +73,7 @@ data Builtins
{ parrayTyCon :: TyCon -- ^ PArray
, parray_PrimTyCons :: NameEnv TyCon -- ^ PArray_Int# etc.
, pdataTyCon :: TyCon -- ^ PData
, pdatasTyCon :: TyCon -- ^ PDatas
, prClass :: Class -- ^ PR
, prTyCon :: TyCon -- ^ PR
, preprTyCon :: TyCon -- ^ PRepr
......@@ -96,6 +97,7 @@ data Builtins
, sumTyCons :: Array Int TyCon -- ^ Sum2 .. Sum3
, wrapTyCon :: TyCon -- ^ Wrap
, pvoidVar :: Var -- ^ pvoid
, pvoidsVar :: Var -- ^ pvoids
, closureTyCon :: TyCon -- ^ :->
, closureVar :: Var -- ^ closure
, liftedClosureVar :: Var -- ^ liftedClosure
......@@ -118,19 +120,19 @@ parray_PrimTyCon :: TyCon -> Builtins -> TyCon
parray_PrimTyCon tc bi = lookupEnvBuiltin "parray_PrimTyCon" (parray_PrimTyCons bi) (tyConName tc)
selTy :: Int -> Builtins -> Type
selTy = indexBuiltin "selTy" selTys
selTy = indexBuiltin "selTy" selTys
selReplicate :: Int -> Builtins -> CoreExpr
selReplicate = indexBuiltin "selReplicate" selReplicates
selReplicate = indexBuiltin "selReplicate" selReplicates
selTags :: Int -> Builtins -> CoreExpr
selTags = indexBuiltin "selTags" selTagss
selTags = indexBuiltin "selTags" selTagss
selElements :: Int -> Int -> Builtins -> CoreExpr
selElements i j = indexBuiltin "selElements" selElementss (i, j)
sumTyCon :: Int -> Builtins -> TyCon
sumTyCon = indexBuiltin "sumTyCon" sumTyCons
sumTyCon = indexBuiltin "sumTyCon" sumTyCons
prodTyCon :: Int -> Builtins -> TyCon
prodTyCon n _
......@@ -171,8 +173,8 @@ scalarZip = indexBuiltin "scalarZip" scalarZips
closureCtrFun :: Int -> Builtins -> Var
closureCtrFun = indexBuiltin "closureCtrFun" closureCtrFuns
-- Get an element from one of the arrays of `Builtins`. Panic if the indexed thing is not in the array.
--
-- | Get an element from one of the arrays of `Builtins`.
-- Panic if the indexed thing is not in the array.
indexBuiltin :: (Ix i, Outputable i)
=> String -- ^ Name of the selector we've used, for panic messages.
-> (Builtins -> Array i a) -- ^ Field selector for the `Builtins`.
......@@ -192,8 +194,8 @@ indexBuiltin fn f i bi
, text "and ask what you can do to help (it might involve some GHC hacking)."])
where xs = f bi
-- Get an entry from one of a 'NameEnv' of `Builtins`. Panic if the named item is not in the array.
--
-- | Get an entry from one of a 'NameEnv' of `Builtins`. Panic if the named item is not in the array.
lookupEnvBuiltin :: String -- Function name for error messages
-> NameEnv a -- Name environment
-> Name -- Index into the name environment
......
......@@ -36,17 +36,19 @@ initBuiltins
; let parray_PrimTyCons = mkNameEnv (zip aLL_DPH_PRIM_TYCONS parray_tcs)
-- 'PData': type family mapping array element types to array representation types
; pdataTyCon <- externalTyCon (fsLit "PData")
-- Not all backends use `PDatas`.
; pdataTyCon <- externalTyCon (fsLit "PData")
; pdatasTyCon <- externalTyCon (fsLit "PDatas")
-- 'PR': class of basic array operators operating on 'PData' types
; prClass <- externalClass (fsLit "PR")
; prClass <- externalClass (fsLit "PR")
; let prTyCon = classTyCon prClass
-- 'PRepr': type family mapping element types to representation types
; preprTyCon <- externalTyCon (fsLit "PRepr")
-- 'PA': class of basic operations on arrays (parametrised by the element type)
; paClass <- externalClass (fsLit "PA")
; paClass <- externalClass (fsLit "PA")
; let paTyCon = classTyCon paClass
[paDataCon] = tyConDataCons paTyCon
paPRSel = classSCSelId paClass 0
......@@ -75,34 +77,35 @@ initBuiltins
; scalarClass <- externalClass (fsLit "Scalar")
-- N-ary maps ('zipWith' family)
; scalar_map <- externalVar (fsLit "scalar_map")
; scalar_zip2 <- externalVar (fsLit "scalar_zipWith")
; scalar_zips <- mapM externalVar (numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS)
; let scalarZips = listArray (1, mAX_DPH_SCALAR_ARGS) (scalar_map : scalar_zip2 : scalar_zips)
; scalar_map <- externalVar (fsLit "scalar_map")
; scalar_zip2 <- externalVar (fsLit "scalar_zipWith")
; scalar_zips <- mapM externalVar (numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS)
; let scalarZips = listArray (1, mAX_DPH_SCALAR_ARGS) (scalar_map : scalar_zip2 : scalar_zips)
-- Types and functions for generic type representations
; voidTyCon <- externalTyCon (fsLit "Void")
; voidVar <- externalVar (fsLit "void")
; fromVoidVar <- externalVar (fsLit "fromVoid")
; sum_tcs <- mapM externalTyCon (numbered "Sum" 2 mAX_DPH_SUM)
; let sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs
; wrapTyCon <- externalTyCon (fsLit "Wrap")
; pvoidVar <- externalVar (fsLit "pvoid")
; voidTyCon <- externalTyCon (fsLit "Void")
; voidVar <- externalVar (fsLit "void")
; fromVoidVar <- externalVar (fsLit "fromVoid")
; sum_tcs <- mapM externalTyCon (numbered "Sum" 2 mAX_DPH_SUM)
; let sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs
; wrapTyCon <- externalTyCon (fsLit "Wrap")
; pvoidVar <- externalVar (fsLit "pvoid")
; pvoidsVar <- externalVar (fsLit "pvoids")
-- Types and functions for closure conversion
; closureTyCon <- externalTyCon (fsLit ":->")
; closureVar <- externalVar (fsLit "closure")
; liftedClosureVar <- externalVar (fsLit "liftedClosure")
; applyVar <- externalVar (fsLit "$:")
; liftedApplyVar <- externalVar (fsLit "liftedApply")
; closureVar <- externalVar (fsLit "closure")
; liftedClosureVar <- externalVar (fsLit "liftedClosure")
; applyVar <- externalVar (fsLit "$:")
; liftedApplyVar <- externalVar (fsLit "liftedApply")
; closures <- mapM externalVar (numbered "closure" 1 mAX_DPH_SCALAR_ARGS)
; let closureCtrFuns = listArray (1, mAX_DPH_COMBINE) closures
-- Types and functions for selectors
; sel_tys <- mapM externalType (numbered "Sel" 2 mAX_DPH_SUM)
; sel_replicates <- mapM externalFun (numbered_hash "replicateSel" 2 mAX_DPH_SUM)
; sel_tags <- mapM externalFun (numbered "tagsSel" 2 mAX_DPH_SUM)
; sel_elements <- mapM mk_elements [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]]
; sel_tys <- mapM externalType (numbered "Sel" 2 mAX_DPH_SUM)
; sel_replicates <- mapM externalFun (numbered_hash "replicateSel" 2 mAX_DPH_SUM)
; sel_tags <- mapM externalFun (numbered "tagsSel" 2 mAX_DPH_SUM)
; sel_elements <- mapM mk_elements [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]]
; let selTys = listArray (2, mAX_DPH_SUM) sel_tys
selReplicates = listArray (2, mAX_DPH_SUM) sel_replicates
selTagss = listArray (2, mAX_DPH_SUM) sel_tags
......@@ -115,6 +118,7 @@ initBuiltins
{ parrayTyCon = parrayTyCon
, parray_PrimTyCons = parray_PrimTyCons
, pdataTyCon = pdataTyCon
, pdatasTyCon = pdatasTyCon
, preprTyCon = preprTyCon
, prClass = prClass
, prTyCon = prTyCon
......@@ -138,6 +142,7 @@ initBuiltins
, sumTyCons = sumTyCons
, wrapTyCon = wrapTyCon
, pvoidVar = pvoidVar
, pvoidsVar = pvoidsVar
, closureTyCon = closureTyCon
, closureVar = closureVar
, liftedClosureVar = liftedClosureVar
......@@ -181,7 +186,7 @@ initBuiltinVars (Builtins { })
preludeDataCons :: [(DataCon, FastString)]
preludeDataCons
= [mk_tup n (mkFastString $ "tup" ++ show n) | n <- [2..3]]
= [mk_tup n (mkFastString $ "tup" ++ show n) | n <- [2..5]]
where
mk_tup n name = (tupleCon BoxedTuple n, name)
......@@ -199,32 +204,32 @@ initBuiltinTyCons bi
: []
-- Auxilliary look up functions ----------------
-- Auxilliary look up functions -----------------------------------------------
-- Lookup a variable given its name and the module that contains it.
--
-- |Lookup a variable given its name and the module that contains it.
externalVar :: FastString -> DsM Var
externalVar fs = dsLookupDPHRdrEnv (mkVarOccFS fs) >>= dsLookupGlobalId
-- Like `externalVar` but wrap the `Var` in a `CoreExpr`.
--
-- |Like `externalVar` but wrap the `Var` in a `CoreExpr`.
externalFun :: FastString -> DsM CoreExpr
externalFun fs = Var <$> externalVar fs
-- Lookup a 'TyCon' in 'Data.Array.Parallel.Prim', given its name.
--
-- |Lookup a 'TyCon' in 'Data.Array.Parallel.Prim', given its name.
-- Panic if there isn't one.
externalTyCon :: FastString -> DsM TyCon
externalTyCon fs = dsLookupDPHRdrEnv (mkTcOccFS fs) >>= dsLookupTyCon
-- Lookup some `Type` in 'Data.Array.Parallel.Prim', given its name.
--
-- |Lookup some `Type` in 'Data.Array.Parallel.Prim', given its name.
externalType :: FastString -> DsM Type
externalType fs
= do tycon <- externalTyCon fs
return $ mkTyConApp tycon []
-- Lookup a 'Class' in 'Data.Array.Parallel.Prim', given its name.
--
-- |Lookup a 'Class' in 'Data.Array.Parallel.Prim', given its name.
externalClass :: FastString -> DsM Class
externalClass fs
= do { tycon <- dsLookupDPHRdrEnv (mkClsOccFS fs) >>= dsLookupTyCon
......
-- | 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.
--
module Vectorise.Generic.Description (
CompRepr (..), ProdRepr (..), ConRepr (..), SumRepr (..),
tyConRepr, sumReprType, conReprType, prodReprType, compReprType, compOrigType
) where
import Vectorise.Utils
import Vectorise.Monad
import Vectorise.Builtins
import CoreSyn
import DataCon
import TyCon
import Type
import Control.Monad
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 type has no data constructors.
EmptySum
-- | Data type has a single constructor.
| UnarySum ConRepr
-- | Data type has multiple constructors.
| Sum { -- | Representation tycon for the sum (eg Sum2)
repr_sum_tc :: TyCon
-- | PData version of the sum tycon (eg PDataSum2)
-- This TyCon doesn't appear explicitly in the source program.
-- See Note [PData TyCons].
, repr_psum_tc :: TyCon
-- | PDatas version of the sum tycon (eg PDatasSum2)
, repr_psums_tc :: TyCon
-- | Type of the selector (eg Sel2)
, repr_sel_ty :: Type
-- | Type of each data constructor.
, repr_con_tys :: [Type]
-- | Generic representation types of each data constructor.
, repr_cons :: [ConRepr]
}
-- | Describes the representation type of a data constructor.
data ConRepr
= ConRepr
{ repr_dc :: DataCon
, 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
-- together into a generic product type.
data ProdRepr
= -- | Data constructor has no fields.
EmptyProd
-- | Data constructor has a single field.
| UnaryProd CompRepr
-- | Data constructor has several fields.
| Prod { -- | Representation tycon for the product (eg Tuple2)
repr_tup_tc :: TyCon
-- | PData version of the product tycon (eg PDataTuple2)
, repr_ptup_tc :: TyCon
-- | PDatas version of the product tycon (eg PDatasTuple2s)
-- Not all lifted backends use `PDatas`.
, repr_ptups_tc :: TyCon
-- | Types of each field.
, repr_comp_tys :: [Type]
-- | Generic representation types for each field.
, repr_comps :: [CompRepr]
}
-- | Describes the representation type of a data constructor field.
data CompRepr
= Keep Type
CoreExpr -- PR dictionary for the type
| Wrap Type
-------------------------------------------------------------------------------
-- | Determine the generic representation of a data type, given its tycon.
-- The `TyCon` contains a description of the whole data type.
tyConRepr :: TyCon -> VM SumRepr
tyConRepr tc
= sum_repr (tyConDataCons tc)
where
-- Build the representation type for a data type with the given constructors.
-- The representation types for each individual constructor are bundled
-- together into a generic sum type.
sum_repr :: [DataCon] -> VM SumRepr
sum_repr [] = return EmptySum
sum_repr [con] = liftM UnarySum (con_repr con)
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
sel_ty <- builtin (selTy arity)
return $ Sum
{ repr_sum_tc = sum_tc
, repr_psum_tc = psum_tc
, repr_psums_tc = psums_tc
, repr_sel_ty = sel_ty
, repr_con_tys = tys
, repr_cons = rs
}
-- Build the representation type for a single data constructor.
con_repr con = liftM (ConRepr con) (prod_repr (dataConRepArgTys con))
-- Build the representation type for the fields of a data constructor.
-- The representation types for each individual field are bundled
-- together into a generic product type.
prod_repr :: [Type] -> VM ProdRepr
prod_repr [] = return EmptyProd
prod_repr [ty] = liftM UnaryProd (comp_repr ty)
prod_repr tys
= do let arity = length tys
rs <- mapM comp_repr tys
tys' <- mapM compReprType rs
-- Get the Prod \/ Tuple tycon of this arity (eg Tuple2)
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
{ 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.
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.
conReprType :: ConRepr -> VM Type
conReprType (ConRepr _ r) = prodReprType r
-- | 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.
compReprType :: CompRepr -> VM Type
compReprType (Keep ty _) = return ty
compReprType (Wrap ty)
= do wrap_tc <- builtin wrapTyCon
return $ mkTyConApp wrap_tc [ty]
-- Yield the original component type of a data constructor component representation.
compOrigType :: CompRepr -> Type
compOrigType (Keep ty _) = ty
compOrigType (Wrap ty) = ty
-- Outputable instances -------------------------------------------------------
instance Outputable SumRepr where
ppr ss
= case ss of
EmptySum
-> text "EmptySum"
UnarySum con
-> sep [text "UnarySum", ppr con]
Sum sumtc psumtc psumstc selty contys cons
-> text "Sum" $+$ braces (nest 4
$ sep [ text "repr_sum_tc = " <> ppr sumtc
, text "repr_psum_tc = " <> ppr psumtc
, text "repr_psums_tc = " <> ppr psumstc
, text "repr_sel_ty = " <> ppr selty
, text "repr_con_tys = " <> ppr contys
, text "repr_cons = " <> ppr cons])
instance Outputable ConRepr where
ppr (ConRepr dc pr)
= text "ConRepr" $+$ braces (nest 4
$ sep [ text "repr_dc = " <> ppr dc
, text "repr_prod = " <> ppr pr])
instance Outputable ProdRepr where
ppr ss
= 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]
instance Outputable CompRepr where
ppr ss
= case ss of
Keep t ce
-> text "Keep" $+$ sep [ppr t, ppr ce]
Wrap t
-> sep [text "Wrap", ppr t]
-- Notes ----------------------------------------------------------------------
{-
Note [PData TyCons]
~~~~~~~~~~~~~~~~~~~
When PData is a type family, the compiler generates a type constructor for each
instance, which is named after the family and instance type. This type
constructor does not appear in the source program. Rather, it is implicitly
defined by the data instance. For example with:

data family PData a
data instance PData (Sum2 a b)
= PSum2 U.Sel2
(PData a)
(PData b)
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
module Vectorise.Type.PADict
module Vectorise.Generic.PADict
( buildPADict
) where
import Vectorise.Monad
import Vectorise.Builtins
import Vectorise.Type.Repr
import Vectorise.Type.PRepr ( buildPAScAndMethods )
import Vectorise.Generic.Description
import Vectorise.Generic.PAMethods ( buildPAScAndMethods )
import Vectorise.Utils
import BasicTypes
......@@ -20,21 +20,12 @@ import Id
import Var
import Name
-- debug = False
-- dtrace s x = if debug then pprTrace "Vectoris.Type.PADict" s x else x
-- |Build the PA dictionary function for some type and hoist it to top level.
--
-- The PA dictionary holds fns that convert values to and from their vectorised representations.
-- The PA dictionary holds fns that convert values to and from their vectorised representations.
--
buildPADict
:: TyCon -- ^ tycon of the type being vectorised.
-> TyCon -- ^ tycon of the type used for the vectorised representation.
-> TyCon -- ^ PRepr instance tycon
-> SumRepr -- ^ representation used for the type being vectorised.