tcg_anns = anns,
tcg_binds = binds,
tcg_imp_specs = imp_specs,
- tcg_ev_binds = ev_binds,
- tcg_fords = fords,
- tcg_rules = rules,
- tcg_insts = insts,
- tcg_fam_insts = fam_insts,
- tcg_hpc = other_hpc_info })
+ tcg_ev_binds = ev_binds,
+ tcg_fords = fords,
+ tcg_rules = rules,
+ tcg_vects = vects,
+ tcg_insts = insts,
+ tcg_fam_insts = fam_insts,
+ tcg_hpc = other_hpc_info })
= do { let dflags = hsc_dflags hsc_env
; showPass dflags "Desugar"
<- case target of
HscNothing ->
return (emptyMessages,
- Just ([], nilOL, [], NoStubs, hpcInfo, emptyModBreaks))
+ Just ([], nilOL, [], [], NoStubs, hpcInfo, emptyModBreaks))
_ -> do
(binds_cvr,ds_hpc_info, modBreaks)
<- if (opt_Hpc
(typeEnvTyCons type_env) binds
else return (binds, hpcInfo, emptyModBreaks)
initDs hsc_env mod rdr_env type_env $ do
- do { ds_ev_binds <- dsEvBinds ev_binds
- ; core_prs <- dsTopLHsBinds auto_scc binds_cvr
+ do { ds_ev_binds <- dsEvBinds ev_binds
+ ; core_prs <- dsTopLHsBinds auto_scc binds_cvr
; (spec_prs, spec_rules) <- dsImpSpecs imp_specs
- ; (ds_fords, foreign_prs) <- dsForeigns fords
- ; rules <- mapMaybeM dsRule rules
- ; return ( ds_ev_binds
+ ; (ds_fords, foreign_prs) <- dsForeigns fords
+ ; ds_rules <- mapMaybeM dsRule rules
+ ; ds_vects <- mapM dsVect vects
+ ; let hpc_init
+ | opt_Hpc = hpcInitCode mod ds_hpc_info
+ | otherwise = empty
+ ; return ( ds_ev_binds
, foreign_prs `appOL` core_prs `appOL` spec_prs
- , spec_rules ++ rules
- , ds_fords, ds_hpc_info, modBreaks) }
+ , spec_rules ++ ds_rules, ds_vects
+ , ds_fords `appendStubC` hpc_init
+ , ds_hpc_info, modBreaks) }
- ; case mb_res of {
- Nothing -> return (msgs, Nothing) ;
- Just (ds_ev_binds, all_prs, all_rules, ds_fords,ds_hpc_info, modBreaks) -> do
+ ; case mb_res of {
+ Nothing -> return (msgs, Nothing) ;
+ Just (ds_ev_binds, all_prs, all_rules, ds_vects, ds_fords,ds_hpc_info, modBreaks) -> do
{ -- Add export flags to bindings
keep_alive <- readIORef keep_var
mg_foreign = ds_fords,
mg_hpc_info = ds_hpc_info,
mg_modBreaks = modBreaks,
+ mg_vect_decls = ds_vects,
mg_vect_info = noVectInfo
}
; return (msgs, Just mod_guts)
Nor do we want to warn of conversion identities on the LHS;
the rule is precisly to optimise them:
{-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-}
+
+
+%************************************************************************
+%* *
+%* Desugaring vectorisation declarations
+%* *
+%************************************************************************
+
+\begin{code}
+dsVect :: LVectDecl Id -> DsM CoreVect
+dsVect (L loc (HsVect v rhs))
+ = putSrcSpanDs loc $
+ do { rhs' <- fmapMaybeM dsLExpr rhs
+ ; return $ Vect (unLoc v) rhs'
+ }
+-- dsVect (L loc (HsVect v Nothing))
+-- = return $ Vect v Nothing
+-- dsVect (L loc (HsVect v (Just rhs)))
+-- = putSrcSpanDs loc $
+-- do { rhs' <- dsLExpr rhs
+-- ; return $ Vect v (Just rhs')
+-- }
+\end{code}