diff options
| author | Manuel M T Chakravarty <chak@cse.unsw.edu.au> | 2011-10-31 17:37:26 +1100 |
|---|---|---|
| committer | Manuel M T Chakravarty <chak@cse.unsw.edu.au> | 2011-10-31 19:50:40 +1100 |
| commit | c439818a1ac494baeed5706922c4292e44cdaa49 (patch) | |
| tree | da5abe1635bf63defb54e3ba81550ca14cac9d85 /compiler/vectorise/Vectorise.hs | |
| parent | f05b36dc618ef52c7420b993a46e5d0a0d04e269 (diff) | |
| download | haskell-c439818a1ac494baeed5706922c4292e44cdaa49.tar.gz | |
VECTORISE pragmas for type classes and instances
* Frontend support (not yet used in the vectoriser)
Diffstat (limited to 'compiler/vectorise/Vectorise.hs')
| -rw-r--r-- | compiler/vectorise/Vectorise.hs | 16 |
1 files changed, 13 insertions, 3 deletions
diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs index daa2ed0725..aad504fc7d 100644 --- a/compiler/vectorise/Vectorise.hs +++ b/compiler/vectorise/Vectorise.hs @@ -62,6 +62,8 @@ vectoriseIO hsc_env guts -- vectModule :: ModGuts -> VM ModGuts vectModule guts@(ModGuts { mg_tcs = tycons + , mg_clss = classes + , mg_insts = insts , mg_binds = binds , mg_fam_insts = fam_insts , mg_vect_decls = vect_decls @@ -75,16 +77,24 @@ vectModule guts@(ModGuts { mg_tcs = tycons -- bindings for dfuns and family instances of the classes -- and type families used in the DPH library to represent -- array types. - ; (tycons', new_fam_insts, tc_binds) <- vectTypeEnv tycons [vd - | vd@(VectType _ _ _) <- vect_decls] + ; (new_tycons, new_fam_insts, tc_binds) <- vectTypeEnv tycons [vd + | vd@(VectType _ _ _) <- vect_decls] + ; let new_classes = [] -- !!!FIXME + new_insts = [] + -- !!!we need to compute an extended 'mg_inst_env' as well!!! + + -- Family instance environment for /all/ home-package modules including those instances + -- generated by 'vectTypeEnv'. ; (_, fam_inst_env) <- readGEnv global_fam_inst_env -- Vectorise all the top level bindings and VECTORISE declarations on imported identifiers ; binds_top <- mapM vectTopBind binds ; binds_imp <- mapM vectImpBind [imp_id | Vect imp_id _ <- vect_decls, isGlobalId imp_id] - ; return $ guts { mg_tcs = tycons' + ; return $ guts { mg_tcs = tycons ++ new_tycons + , mg_clss = classes ++ new_classes + , mg_insts = insts ++ new_insts , mg_binds = Rec tc_binds : (binds_top ++ binds_imp) , mg_fam_inst_env = fam_inst_env , mg_fam_insts = fam_insts ++ new_fam_insts |