Commit 82ac7ff3 authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.

Fixed reading and generating VectInfo as well as naming of vectorised versions...

Fixed reading and generating VectInfo as well as naming of vectorised versions of imported identifiers
parent 1df6309b
......@@ -11,15 +11,15 @@ the keys.
\begin{code}
module Module
(
-- * The ModuleName type
ModuleName,
pprModuleName,
moduleNameFS,
moduleNameString,
moduleNameSlashes,
mkModuleName,
mkModuleNameFS,
stableModuleNameCmp,
-- * The ModuleName type
ModuleName,
pprModuleName,
moduleNameFS,
moduleNameString,
moduleNameSlashes, moduleNameColons,
mkModuleName,
mkModuleNameFS,
stableModuleNameCmp,
-- * The PackageId type
PackageId,
......@@ -205,10 +205,17 @@ mkModuleName s = ModuleName (mkFastString s)
mkModuleNameFS :: FastString -> ModuleName
mkModuleNameFS s = ModuleName s
-- | Returns the string version of the module name, with dots replaced by slashes
-- |Returns the string version of the module name, with dots replaced by slashes.
--
moduleNameSlashes :: ModuleName -> String
moduleNameSlashes = dots_to_slashes . moduleNameString
where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
-- |Returns the string version of the module name, with dots replaced by underscores.
--
moduleNameColons :: ModuleName -> String
moduleNameColons = dots_to_colons . moduleNameString
where dots_to_colons = map (\c -> if c == '.' then ':' else c)
\end{code}
%************************************************************************
......
......@@ -42,6 +42,7 @@ module Name (
mkFCallName, mkIPName,
mkTickBoxOpName,
mkExternalName, mkWiredInName,
mkLocalisedOccName,
-- ** Manipulating and deconstructing 'Name's
nameUnique, setNameUnique,
......@@ -326,6 +327,18 @@ localiseName :: Name -> Name
localiseName n = n { n_sort = Internal }
\end{code}
\begin{code}
-- |Create a localised variant of a name.
--
-- If the name is external, encode the original's module name to disambiguate.
--
mkLocalisedOccName :: (Maybe String -> OccName -> OccName) -> Name -> OccName
mkLocalisedOccName mk_occ name = mk_occ origin (nameOccName name)
where
origin | isExternalName name = Just (moduleNameColons . moduleName . nameModule $ name)
| otherwise = Nothing
\end{code}
%************************************************************************
%* *
\subsection{Hashing and comparison}
......
......@@ -541,14 +541,12 @@ isDerivedOccName occ =
\begin{code}
mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkGenDefMethodOcc,
mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkDictOcc,
mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
mkGenD, mkGenR, mkGenRCo,
mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc,
mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
mkPDataTyConOcc, mkPDataDataConOcc, mkPReprTyConOcc, mkPADFunOcc
mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkDictOcc,
mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
mkGenD, mkGenR, mkGenRCo,
mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc,
mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc
:: OccName -> OccName
-- These derived variables have a prefix that no Haskell value could have
......@@ -598,18 +596,24 @@ mkDataTOcc = mk_simple_deriv varName "$t"
mkDataCOcc = mk_simple_deriv varName "$c"
-- Vectorisation
mkVectOcc = mk_simple_deriv varName "$v_"
mkVectTyConOcc = mk_simple_deriv tcName ":V_"
mkVectDataConOcc = mk_simple_deriv dataName ":VD_"
mkVectIsoOcc = mk_simple_deriv varName "$VI_"
mkPDataTyConOcc = mk_simple_deriv tcName ":VP_"
mkPDataDataConOcc = mk_simple_deriv dataName ":VPD_"
mkPReprTyConOcc = mk_simple_deriv tcName ":VR_"
mkPADFunOcc = mk_simple_deriv varName "$PA_"
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_"
mk_simple_deriv :: NameSpace -> String -> OccName -> OccName
mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
mk_simple_deriv_with :: NameSpace -> String -> Maybe String -> OccName -> OccName
mk_simple_deriv_with sp px Nothing occ = mk_deriv sp px (occNameString occ)
mk_simple_deriv_with sp px (Just with) occ = mk_deriv sp (px ++ with ++ "_") (occNameString occ)
-- Data constructor workers are made by setting the name space
-- of the data constructor OccName (which should be a DataName)
-- to VarName
......
......@@ -722,7 +722,7 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
}
where
vectVarMapping name
= do { vName <- lookupOrig mod (mkVectOcc (nameOccName name))
= do { vName <- lookupOrig mod (mkLocalisedOccName mkVectOcc name)
; var <- forkM (text ("vect var") <+> ppr name) $
tcIfaceExtId name
; vVar <- forkM (text ("vect vVar") <+> ppr vName) $
......@@ -730,9 +730,9 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
; return (var, (var, vVar))
}
vectTyConMapping name
= do { vName <- lookupOrig mod (mkVectTyConOcc (nameOccName name))
; paName <- lookupOrig mod (mkPADFunOcc (nameOccName name))
; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
= do { vName <- lookupOrig mod (mkLocalisedOccName mkVectTyConOcc name)
; paName <- lookupOrig mod (mkLocalisedOccName mkPADFunOcc name)
; isoName <- lookupOrig mod (mkLocalisedOccName mkVectIsoOcc name)
-- FIXME: we will need to use tcIfaceTyCon/tcIfaceExtId on some of these (but depends
-- on how we exactly define the 'VECTORISE type' pragma to work)
; let { tycon = lookupTyCon name
......@@ -748,8 +748,8 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
)
}
vectTyConReuseMapping scalarNames name
= do { paName <- lookupOrig mod (mkPADFunOcc (nameOccName name))
; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
= do { paName <- lookupOrig mod (mkLocalisedOccName mkPADFunOcc name)
; isoName <- lookupOrig mod (mkLocalisedOccName mkVectIsoOcc name)
; tycon <- forkM (text ("vect reuse tycon") <+> ppr name) $
tcIfaceTyCon (IfaceTc name) -- somewhat naughty for wired in tycons, but ok
; if name `elemNameSet` scalarNames
......@@ -773,7 +773,7 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
}}
vectDataConMapping datacon
= do { let name = dataConName datacon
; vName <- lookupOrig mod (mkVectDataConOcc (nameOccName name))
; vName <- lookupOrig mod (mkLocalisedOccName mkVectDataConOcc name)
; let vDataCon = lookupDataCon vName
; return (name, (datacon, vDataCon))
}
......
......@@ -1889,6 +1889,17 @@ concatVectInfo = foldr plusVectInfo noVectInfo
noIfaceVectInfo :: IfaceVectInfo
noIfaceVectInfo = IfaceVectInfo [] [] [] [] []
instance Outputable VectInfo where
ppr info = vcat
[ ptext (sLit "variables :") <+> ppr (vectInfoVar info)
, ptext (sLit "tycons :") <+> ppr (vectInfoTyCon info)
, ptext (sLit "datacons :") <+> ppr (vectInfoDataCon info)
, ptext (sLit "PA dfuns :") <+> ppr (vectInfoPADFun info)
, ptext (sLit "iso :") <+> ppr (vectInfoIso info)
, ptext (sLit "scalar vars :") <+> ppr (vectInfoScalarVars info)
, ptext (sLit "scalar tycons :") <+> ppr (vectInfoScalarTyCons info)
]
\end{code}
%************************************************************************
......
......@@ -217,9 +217,10 @@ RecompilationAvoidance commentary:
First we figure out which Ids are "external" Ids. An
"external" Id is one that is visible from outside the compilation
unit. These are
a) the user exported ones
b) ones mentioned in the unfoldings, workers,
or rules of externally-visible ones
a) the user exported ones
b) ones mentioned in the unfoldings, workers,
rules of externally-visible ones ,
or vectorised versions of externally-visible ones
While figuring out which Ids are external, we pick a "tidy" OccName
for each one. That is, we make its OccName distinct from the other
......@@ -286,35 +287,38 @@ RHSs, so that they print nicely in interfaces.
\begin{code}
tidyProgram :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails)
tidyProgram hsc_env (ModGuts { mg_module = mod, mg_exports = exports,
mg_types = type_env,
mg_insts = insts, mg_fam_insts = fam_insts,
mg_binds = binds,
mg_rules = imp_rules,
mg_vect_info = vect_info,
mg_anns = anns,
mg_deps = deps,
mg_foreign = foreign_stubs,
mg_hpc_info = hpc_info,
mg_modBreaks = modBreaks })
= do { let { dflags = hsc_dflags hsc_env
; omit_prags = dopt Opt_OmitInterfacePragmas dflags
; expose_all = dopt Opt_ExposeAllUnfoldings dflags
; th = xopt Opt_TemplateHaskell dflags
tidyProgram hsc_env (ModGuts { mg_module = mod
, mg_exports = exports
, mg_types = type_env
, mg_insts = insts
, mg_fam_insts = fam_insts
, mg_binds = binds
, mg_rules = imp_rules
, mg_vect_info = vect_info
, mg_anns = anns
, mg_deps = deps
, mg_foreign = foreign_stubs
, mg_hpc_info = hpc_info
, mg_modBreaks = modBreaks
})
= do { let { dflags = hsc_dflags hsc_env
; omit_prags = dopt Opt_OmitInterfacePragmas dflags
; expose_all = dopt Opt_ExposeAllUnfoldings dflags
; th = xopt Opt_TemplateHaskell dflags
}
; showPass dflags CoreTidy
; showPass dflags CoreTidy
; let { implicit_binds = getImplicitBinds type_env }
; let { implicit_binds = getImplicitBinds type_env }
; (unfold_env, tidy_occ_env)
<- chooseExternalIds hsc_env mod omit_prags expose_all
binds implicit_binds imp_rules
binds implicit_binds imp_rules (vectInfoVar vect_info)
; let { ext_rules = findExternalRules omit_prags binds imp_rules unfold_env }
-- Glom together imp_rules and rules currently attached to binders
-- Then pick just the ones we need to expose
-- See Note [Which rules to expose]
-- Glom together imp_rules and rules currently attached to binders
-- Then pick just the ones we need to expose
-- See Note [Which rules to expose]
; let { (tidy_env, tidy_binds)
= tidyTopBinds hsc_env unfold_env tidy_occ_env binds }
......@@ -498,20 +502,22 @@ tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar = vars
, vectInfoScalarVars = tidy_scalarVars
}
where
tidy_vars = mkVarEnv
$ map tidy_var_mapping
$ varEnvElts vars
tidy_pas = mapNameEnv tidy_snd_var pas
-- we only export mappings whose co-domain is exported (otherwise, the iface is inconsistent)
tidy_vars = mkVarEnv [ (tidy_var, (tidy_var, tidy_var_v))
| (var, var_v) <- varEnvElts vars
, let tidy_var = lookup_var var
tidy_var_v = lookup_var var_v
, isExportedId tidy_var_v
]
tidy_pas = mapNameEnv tidy_snd_var pas
tidy_isos = mapNameEnv tidy_snd_var isos
tidy_var_mapping (from, to) = (from', (from', lookup_var to))
where from' = lookup_var from
tidy_snd_var (x, var) = (x, lookup_var var)
tidy_scalarVars = mkVarSet
$ map lookup_var
$ varSetElems scalarVars
tidy_scalarVars = mkVarSet [ lookup_var var
| var <- varSetElems scalarVars
, isGlobalId var || isExportedId var]
lookup_var var = lookupWithDefaultVarEnv var_env var var
\end{code}
......@@ -602,13 +608,14 @@ type UnfoldEnv = IdEnv (Name{-new name-}, Bool {-show unfolding-})
chooseExternalIds :: HscEnv
-> Module
-> Bool -> Bool
-> [CoreBind]
-> [CoreBind]
-> [CoreRule]
-> [CoreBind]
-> [CoreRule]
-> VarEnv (Var, Var)
-> IO (UnfoldEnv, TidyOccEnv)
-- Step 1 from the notes above
-- Step 1 from the notes above
chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_rules
chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_rules vect_vars
= do { (unfold_env1,occ_env1) <- search init_work_list emptyVarEnv init_occ_env
; let internal_ids = filter (not . (`elemVarEnv` unfold_env1)) binders
; tidy_internal internal_ids unfold_env1 occ_env1 }
......@@ -627,11 +634,13 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_
init_ext_ids = sortBy (compare `on` getOccName) $
filter is_external binders
-- An Id should be external if either (a) it is exported or
-- (b) it appears in the RHS of a local rule for an imported Id.
-- An Id should be external if either (a) it is exported,
-- (b) it appears in the RHS of a local rule for an imported Id, or
-- (c) it is the vectorised version of an imported Id
-- See Note [Which rules to expose]
is_external id = isExportedId id || id `elemVarSet` rule_rhs_vars
rule_rhs_vars = foldr (unionVarSet . ruleRhsFreeVars) emptyVarSet imp_id_rules
is_external id = isExportedId id || id `elemVarSet` rule_rhs_vars || id `elemVarSet` vect_var_vs
rule_rhs_vars = foldr (unionVarSet . ruleRhsFreeVars) emptyVarSet imp_id_rules
vect_var_vs = mkVarSet [var_v | (var, var_v) <- nameEnvElts vect_vars, isGlobalId var]
binders = bindersOfBinds binds
implicit_binders = bindersOfBinds implicit_binds
......
......@@ -25,7 +25,6 @@ import CoreSyn
import CoreMonad ( CoreM, getHscEnv )
import Type
import Id
import OccName
import DynFlags
import BasicTypes ( isStrongLoopBreaker )
import Outputable
......@@ -250,7 +249,7 @@ vectTopBinder var inline expr
-- Make the vectorised version of binding's name, and set the unfolding used for inlining
; var' <- liftM (`setIdUnfoldingLazily` unfolding)
$ cloneId mkVectOcc var vty
$ mkVectId var vty
-- Add the mapping between the plain and vectorised name to the state.
; defGlobalVar var var'
......
......@@ -35,15 +35,16 @@ import HscTypes hiding ( MonadThings(..) )
import DynFlags
import MonadUtils (liftIO)
import TyCon
import Var
import VarSet
import VarEnv
import Var
import Id
import DsMonad
import ErrUtils
import Outputable
import FastString
import Control.Monad
import VarSet
-- |Run a vectorisation computation.
--
......@@ -53,10 +54,20 @@ initV :: HscEnv
-> VM a
-> IO (Maybe (VectInfo, a))
initV hsc_env guts info thing_inside
= do { (_, Just r) <- initDs hsc_env (mg_module guts) (mg_rdr_env guts) (mg_types guts) go
; return r
= do { (_, Just res) <- initDs hsc_env (mg_module guts) (mg_rdr_env guts) (mg_types guts) go
; dumpIfVtTrace "Incoming VectInfo" (ppr info)
; case res of
Nothing
-> dumpIfVtTrace "Vectorisation FAILED!" empty
Just (info', _)
-> dumpIfVtTrace "Outgoing VectInfo" (ppr info')
; return res
}
where
dumpIfVtTrace = dumpIfSet_dyn (hsc_dflags hsc_env) Opt_D_dump_vt_trace
go
= do { -- pick a DPH backend
; dflags <- getDOptsDs
......@@ -114,9 +125,12 @@ builtins f = VM $ \bi genv lenv -> return (Yes genv lenv (`f` bi))
-- Var ------------------------------------------------------------------------
-- | Lookup the vectorised and\/or lifted versions of this variable.
-- If it's in the global environment we get the vectorised version.
-- If it's in the local environment we get both the vectorised and lifted version.
-- |Lookup the vectorised, and if local, also the lifted versions of a variable.
--
-- * If it's in the global environment we get the vectorised version.
-- * If it's in the local environment we get both the vectorised and lifted version.
--
lookupVar :: Var -> VM (Scope Var (Var, Var))
lookupVar v
= do r <- readLEnv $ \env -> lookupVarEnv (local_vars env) v
......@@ -144,13 +158,16 @@ dumpVar var
-- Global scalars --------------------------------------------------------------
-- |Mark the given variable as scalar — i.e., executing the associated code does not involve any
-- parallel array computations.
--
addGlobalScalar :: Var -> VM ()
addGlobalScalar var
addGlobalScalar var
= do { traceVt "addGlobalScalar" (ppr var)
; updGEnv $ \env -> env{global_scalar_vars = extendVarSet (global_scalar_vars env) var}
}
-- Primitives -----------------------------------------------------------------
lookupPrimPArray :: TyCon -> VM (Maybe TyCon)
......
-- |Computations in the vectorisation monad concerned with naming and fresh variable generation.
-- | Computations in the vectorisation monad concerned with naming
-- and fresh variable generation.
module Vectorise.Monad.Naming
( cloneName
, cloneId
, cloneVar
, newExportedVar
, newLocalVar
, newLocalVars
, newDummyVar
, newTyVar)
where
( mkLocalisedName
, mkVectId
, cloneVar
, newExportedVar
, newLocalVar
, newLocalVars
, newDummyVar
, newTyVar
) where
import Vectorise.Monad.Base
import DsMonad
......@@ -20,38 +20,43 @@ import Name
import SrcLoc
import Id
import FastString
import Control.Monad
-- Naming ---------------------------------------------------------------------
-- | Clone a name, using the provide function to transform its `OccName`.
cloneName :: (OccName -> OccName) -> Name -> VM Name
cloneName mk_occ name = liftM make (liftDs newUnique)
where
occ_name = mk_occ (nameOccName name)
make u | isExternalName name = mkExternalName u (nameModule name)
occ_name
(nameSrcSpan name)
| otherwise = mkSystemName u occ_name
import Control.Monad
-- | Clone an `Id`, using the provided function to transform its `OccName`.
cloneId :: (OccName -> OccName) -> Id -> Type -> VM Id
cloneId mk_occ id ty
= do
name <- cloneName mk_occ (getName id)
let id' | isExportedId id = Id.mkExportedLocalId name ty
| otherwise = Id.mkLocalId name ty
return id'
-- Naming ---------------------------------------------------------------------
-- | Make a fresh instance of this var, with a new unique.
-- |Create a localised variant of a name, using the provided function to transform its `OccName`.
--
-- If the name external, encode the orignal name's module into the new 'OccName'. The result is
-- always an internal system name.
--
mkLocalisedName :: (Maybe String -> OccName -> OccName) -> Name -> VM Name
mkLocalisedName mk_occ name = liftM make (liftDs newUnique)
where
occ_name = mkLocalisedOccName mk_occ name
make u = mkSystemName u occ_name
-- |Produce the vectorised variant of an `Id` with the given type.
--
-- Force the new name to be a system name and, if the original was an external name, disambiguate
-- the new name with the module name of the original.
--
mkVectId :: Id -> Type -> VM Id
mkVectId id ty
= do { name <- mkLocalisedName mkVectOcc (getName id)
; let id' | isExportedId id = Id.mkExportedLocalId name ty
| otherwise = Id.mkLocalId name ty
; return id'
}
-- |Make a fresh instance of this var, with a new unique.
--
cloneVar :: Var -> VM Var
cloneVar var = liftM (setIdUnique var) (liftDs newUnique)
-- | Make a fresh exported variable with the given type.
-- |Make a fresh exported variable with the given type.
--
newExportedVar :: OccName -> Type -> VM Var
newExportedVar occ_name ty
= do mod <- liftDs getModuleDs
......@@ -61,30 +66,29 @@ newExportedVar occ_name ty
return $ Id.mkExportedLocalId name ty
-- | Make a fresh local variable with the given type.
-- The variable's name is formed using the given string as the prefix.
-- |Make a fresh local variable with the given type.
-- The variable's name is formed using the given string as the prefix.
--
newLocalVar :: FastString -> Type -> VM Var
newLocalVar fs ty
= do u <- liftDs newUnique
return $ mkSysLocal fs u ty
-- | Make several fresh local varaiables with the given types.
-- The variable's names are formed using the given string as the prefix.
-- |Make several fresh local variables with the given types.
-- The variable's names are formed using the given string as the prefix.
--
newLocalVars :: FastString -> [Type] -> VM [Var]
newLocalVars fs = mapM (newLocalVar fs)
-- | Make a new local dummy variable.
-- |Make a new local dummy variable.
--
newDummyVar :: Type -> VM Var
newDummyVar = newLocalVar (fsLit "vv")
-- | Make a fresh type variable with the given kind.
-- The variable's name is formed using the given string as the prefix.
-- |Make a fresh type variable with the given kind.
-- The variable's name is formed using the given string as the prefix.
--
newTyVar :: FastString -> Kind -> VM Var
newTyVar fs k
= do u <- liftDs newUnique
return $ mkTyVar (mkSysTvName u fs) k
......@@ -30,7 +30,6 @@ import DataCon
import TyCon
import Type
import FamInstEnv
import OccName
import Id
import MkId
import NameEnv
......@@ -248,7 +247,7 @@ vectDataConWorkers orig_tc vect_tc arr_tc
liftM (mkLams (tyvars ++ args) . vectorised)
$ buildClosures tyvars [] arg_tys res_ty mk_body
raw_worker <- cloneId mkVectOcc orig_worker (exprType body)
raw_worker <- mkVectId orig_worker (exprType body)
let vect_worker = raw_worker `setIdUnfolding`
mkInlineUnfolding (Just arity) body
defGlobalVar orig_worker vect_worker
......
module Vectorise.Type.PADict
(buildPADict)
where
( buildPADict
) where
import Vectorise.Monad
import Vectorise.Builtins
import Vectorise.Type.Repr
import Vectorise.Type.PRepr( buildPAScAndMethods )
import Vectorise.Type.PRepr ( buildPAScAndMethods )
import Vectorise.Utils
import BasicTypes
......@@ -21,17 +22,17 @@ import Name
-- import FastString
-- import Outputable
-- debug = False
-- dtrace s x = if debug then pprTrace "Vectoris.Type.PADict" s x else x
-- 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.
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.
-> VM Var -- ^ name of the top-level dictionary function.
:: 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.
-> VM Var -- ^ name of the top-level dictionary function.
-- Recall the definition:
-- class class PR (PRepr a) => PA a where
......@@ -51,9 +52,9 @@ buildPADict
buildPADict vect_tc prepr_tc arr_tc repr
= polyAbstract tvs $ \args -> -- The args are the dictionaries we lambda
-- abstract over; and they are put in the
-- envt, so when we need a (PA a) we can
-- find it in the envt
-- abstract over; and they are put in the
-- envt, so when we need a (PA a) we can
-- find it in the envt
do -- Get ids for each of the methods in the dictionary, including superclass
method_ids <- mapM (method args) buildPAScAndMethods
......@@ -67,7 +68,7 @@ buildPADict vect_tc prepr_tc arr_tc repr
-- Build the type of the dictionary function.
pa_cls <- builtin paClass
let dfun_ty = mkForAllTys tvs
$ mkFunTys (map varType args)
$ mkFunTys (map varType args)
(PredTy $ ClassP pa_cls [inst_ty])
-- Set the unfolding for the inliner.
......@@ -85,7 +86,8 @@ buildPADict vect_tc prepr_tc arr_tc repr
arg_tys = mkTyVarTys tvs
inst_ty = mkTyConApp vect_tc arg_tys
dfun_name = mkPADFunOcc (getOccName vect_tc)
vect_tc_name = getName vect_tc
dfun_name = mkLocalisedOccName mkPADFunOcc vect_tc_name
method args (name, build)
= localV
......
module Vectorise.Type.PData
(buildPDataTyCon)
where
(buildPDataTyCon