Commit 0bb6887b authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au
Browse files

Associate vectorised tycons with their PA dfuns

parent fe5405d4
......@@ -21,7 +21,7 @@ module VectMonad (
lookupVar, defGlobalVar,
lookupTyCon, defTyCon,
lookupDataCon, defDataCon,
lookupTyConPA, defTyConPA, defTyConRdrPAs,
lookupTyConPA, defTyConPA, defTyConPAs, defTyConRdrPAs,
lookupTyVarPA, defLocalTyVar, defLocalTyVarWithPA, localTyVars,
{-lookupInst,-} lookupFamInst
......@@ -408,6 +408,11 @@ defTyConPA :: TyCon -> Var -> VM ()
defTyConPA tc pa = updGEnv $ \env ->
env { global_pa_funs = extendNameEnv (global_pa_funs env) (tyConName tc) pa }
defTyConPAs :: [(TyCon, Var)] -> VM ()
defTyConPAs ps = updGEnv $ \env ->
env { global_pa_funs = extendNameEnvList (global_pa_funs env)
[(tyConName tc, pa) | (tc, pa) <- ps] }
defTyConRdrPAs :: [(Name, RdrName)] -> VM ()
defTyConRdrPAs ps
= do
......
......@@ -98,7 +98,9 @@ vectTypeEnv env
vect_tcs = keep_tcs ++ new_tcs
parr_tcs <- zipWithM buildPArrayTyCon orig_tcs vect_tcs
pa_insts <- sequence $ zipWith3 buildPAInstance orig_tcs vect_tcs parr_tcs
dfuns <- mapM mkPADFun vect_tcs
defTyConPAs (zip vect_tcs dfuns)
-- pa_insts <- sequence $ zipWith3 buildPAInstance orig_tcs vect_tcs parr_tcs
let all_new_tcs = new_tcs ++ parr_tcs
......@@ -359,6 +361,10 @@ buildPArrayDataCon orig_name vect_tc repr_tc
types = [ty | dc <- tyConDataCons vect_tc
, ty <- dataConRepArgTys dc]
mkPADFun :: TyCon -> VM Var
mkPADFun vect_tc
= newExportedVar (mkPADFunOcc $ getOccName vect_tc) =<< paDFunType vect_tc
buildPAInstance :: TyCon -> TyCon -> TyCon -> VM PAInstance
buildPAInstance orig_tc vect_tc arr_tc
= do
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment