diff options
| author | Roman Leshchinskiy <rl@cse.unsw.edu.au> | 2007-08-23 01:53:51 +0000 |
|---|---|---|
| committer | Roman Leshchinskiy <rl@cse.unsw.edu.au> | 2007-08-23 01:53:51 +0000 |
| commit | 097ce0211ba8fc7aef8cd7fefc33f21f92e559ea (patch) | |
| tree | 694a6eb99745cc809a504c5f55f764378f45064d | |
| parent | f8b36ae46b5ee5aa13ca8a6fdb901d92249d147b (diff) | |
| download | haskell-097ce0211ba8fc7aef8cd7fefc33f21f92e559ea.tar.gz | |
Initialise PR dictionaries in vectorisation monad
| -rw-r--r-- | compiler/vectorise/VectBuiltIn.hs | 45 | ||||
| -rw-r--r-- | compiler/vectorise/VectMonad.hs | 2 |
2 files changed, 34 insertions, 13 deletions
diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs index 7a96e2573b..e6c65ac87e 100644 --- a/compiler/vectorise/VectBuiltIn.hs +++ b/compiler/vectorise/VectBuiltIn.hs @@ -1,6 +1,6 @@ module VectBuiltIn ( Builtins(..), - initBuiltins, initBuiltinTyCons, initBuiltinPAs + initBuiltins, initBuiltinTyCons, initBuiltinPAs, initBuiltinPRs ) where #include "HsVersions.h" @@ -124,32 +124,51 @@ initBuiltinTyCons builtinTyCons :: [(Name, DsM TyCon)] builtinTyCons = [(tyConName funTyCon, dsLookupTyCon closureTyConName)] -initBuiltinPAs :: DsM [(Name, Var)] -initBuiltinPAs +initBuiltinDicts :: [(Name, Module, FastString)] -> DsM [(Name, Var)] +initBuiltinDicts ps = do - pas <- zipWithM lookupExternalVar mods fss - return $ zip tcs pas + dicts <- zipWithM lookupExternalVar mods fss + return $ zip tcs dicts where - (tcs, mods, fss) = unzip3 builtinPAs + (tcs, mods, fss) = unzip3 ps + +initBuiltinPAs = initBuiltinDicts builtinPAs builtinPAs :: [(Name, Module, FastString)] builtinPAs = [ - mk closureTyConName nDP_CLOSURE FSLIT("dPA_Clo") - , mk (tyConName unitTyCon) nDP_PARRAY FSLIT("dPA_Unit") + mk closureTyConName nDP_CLOSURE FSLIT("dPA_Clo") + , mk unitTyConName nDP_PARRAY FSLIT("dPA_Unit") - , temporary intTyConName FSLIT("dPA_Int") + , mk intTyConName nDP_INSTANCES FSLIT("dPA_Int") ] ++ tups where mk name mod fs = (name, mod, fs) - temporary name fs = (name, nDP_INSTANCES, fs) - tups = map mk_tup [2..3] - mk_tup n = temporary (tyConName $ tupleTyCon Boxed n) - (mkFastString $ "dPA_" ++ show n) + mk_tup n = mk (tyConName $ tupleTyCon Boxed n) + nDP_INSTANCES + (mkFastString $ "dPA_" ++ show n) + +initBuiltinPRs = initBuiltinDicts builtinPRs + +builtinPRs :: [(Name, Module, FastString)] +builtinPRs = [ + mk (tyConName unitTyCon) nDP_PARRAY FSLIT("dPR_Unit") + , mk ndpCrossTyConName nDP_PARRAY FSLIT("dPR_Cross") + , mk ndpPlusTyConName nDP_PARRAY FSLIT("dPR_Plus") + , mk embedTyConName nDP_PARRAY FSLIT("dPR_Embed") + , mk closureTyConName nDP_CLOSURE FSLIT("dPR_Clo") + + -- temporary + , mk intTyConName nDP_INSTANCES FSLIT("dPR_Int") + ] + where + mk name mod fs = (name, mod, fs) lookupExternalVar :: Module -> FastString -> DsM Var lookupExternalVar mod fs = dsLookupGlobalId =<< lookupOrig mod (mkVarOccFS fs) +unitTyConName = tyConName unitTyCon + diff --git a/compiler/vectorise/VectMonad.hs b/compiler/vectorise/VectMonad.hs index 11f7b53cc0..6bc2f4d656 100644 --- a/compiler/vectorise/VectMonad.hs +++ b/compiler/vectorise/VectMonad.hs @@ -454,6 +454,7 @@ initV hsc_env guts info p builtins <- initBuiltins builtin_tycons <- initBuiltinTyCons builtin_pas <- initBuiltinPAs + builtin_prs <- initBuiltinPRs eps <- ioToIOEnv $ hscEPS hsc_env let famInstEnvs = (eps_fam_inst_env eps, mg_fam_inst_env guts) @@ -461,6 +462,7 @@ initV hsc_env guts info p let genv = extendTyConsEnv builtin_tycons . extendPAFunsEnv builtin_pas + . setPRFunsEnv builtin_prs $ initGlobalEnv info instEnvs famInstEnvs r <- runVM p builtins genv emptyLocalEnv |