projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Added a VECTORISE pragma
[ghc-hetmet.git]
/
compiler
/
hsSyn
/
HsBinds.lhs
diff --git
a/compiler/hsSyn/HsBinds.lhs
b/compiler/hsSyn/HsBinds.lhs
index
0615cbe
..
e080bee
100644
(file)
--- a/
compiler/hsSyn/HsBinds.lhs
+++ b/
compiler/hsSyn/HsBinds.lhs
@@
-155,6
+155,7
@@
data HsBindLR idL idR
abs_ev_binds :: TcEvBinds, -- Evidence bindings
abs_binds :: LHsBinds idL -- Typechecked user bindings
}
abs_ev_binds :: TcEvBinds, -- Evidence bindings
abs_binds :: LHsBinds idL -- Typechecked user bindings
}
+
deriving (Data, Typeable)
-- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
--
deriving (Data, Typeable)
-- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
--
@@
-245,6
+246,13
@@
plusHsValBinds (ValBindsIn ds1 sigs1) (ValBindsIn ds2 sigs2)
= ValBindsIn (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
plusHsValBinds (ValBindsOut ds1 sigs1) (ValBindsOut ds2 sigs2)
= ValBindsOut (ds1 ++ ds2) (sigs1 ++ sigs2)
= ValBindsIn (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
plusHsValBinds (ValBindsOut ds1 sigs1) (ValBindsOut ds2 sigs2)
= ValBindsOut (ds1 ++ ds2) (sigs1 ++ sigs2)
+
+getTypeSigNames :: HsValBinds a -> NameSet
+-- Get the names that have a user type sig
+getTypeSigNames (ValBindsIn {})
+ = panic "getTypeSigNames"
+getTypeSigNames (ValBindsOut _ sigs)
+ = mkNameSet [unLoc n | L _ (TypeSig n _) <- sigs]
\end{code}
What AbsBinds means
\end{code}
What AbsBinds means
@@
-288,11
+296,12
@@
ppr_monobind (FunBind { fun_id = fun, fun_infix = inf,
= pprTicks empty (case tick of
Nothing -> empty
Just t -> text "-- tick id = " <> ppr t)
= pprTicks empty (case tick of
Nothing -> empty
Just t -> text "-- tick id = " <> ppr t)
+ $$ ifPprDebug (pprBndr LetBind (unLoc fun))
$$ pprFunBind (unLoc fun) inf matches
$$ ifPprDebug (ppr wrap)
$$ pprFunBind (unLoc fun) inf matches
$$ ifPprDebug (ppr wrap)
-ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
- , abs_exports = exports, abs_binds = val_binds
+ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
+ , abs_exports = exports, abs_binds = val_binds
, abs_ev_binds = ev_binds })
= sep [ptext (sLit "AbsBinds"),
brackets (interpp'SP tyvars),
, abs_ev_binds = ev_binds })
= sep [ptext (sLit "AbsBinds"),
brackets (interpp'SP tyvars),
@@
-307,7
+316,7
@@
ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
where
ppr_exp (tvs, gbl, lcl, prags)
= vcat [ppr gbl <+> ptext (sLit "<=") <+> ppr tvs <+> ppr lcl,
where
ppr_exp (tvs, gbl, lcl, prags)
= vcat [ppr gbl <+> ptext (sLit "<=") <+> ppr tvs <+> ppr lcl,
- nest 2 (pprTcSpecPrags gbl prags)]
+ nest 2 (pprTcSpecPrags prags)]
\end{code}
\end{code}
@@
-439,7
+448,7
@@
data EvTerm
| EvCast EvVar Coercion -- d |> co
| EvDFunApp DFunId -- Dictionary instance application
| EvCast EvVar Coercion -- d |> co
| EvDFunApp DFunId -- Dictionary instance application
- [Type] [EvVar]
+ [Type] [EvVar]
| EvSuperClass DictId Int -- n'th superclass. Used for both equalities and
-- dictionaries, even though the former have no
| EvSuperClass DictId Int -- n'th superclass. Used for both equalities and
-- dictionaries, even though the former have no
@@
-566,8
+575,7
@@
instance Outputable EvTerm where
ppr (EvCast v co) = ppr v <+> (ptext (sLit "`cast`")) <+> pprParendType co
ppr (EvCoercion co) = ppr co
ppr (EvSuperClass d n) = ptext (sLit "sc") <> parens (ppr (d,n))
ppr (EvCast v co) = ppr v <+> (ptext (sLit "`cast`")) <+> pprParendType co
ppr (EvCoercion co) = ppr co
ppr (EvSuperClass d n) = ptext (sLit "sc") <> parens (ppr (d,n))
- ppr (EvDFunApp df tys ts) = ppr df <+> sep [ char '@' <> ppr tys
- , ppr ts ]
+ ppr (EvDFunApp df tys ts) = ppr df <+> sep [ char '@' <> ppr tys, ppr ts ]
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-613,10
+621,10
@@
data Sig name -- Signatures and pragmas
-- If it's just defaultInlinePragma, then we said
-- SPECIALISE, not SPECIALISE_INLINE
-- If it's just defaultInlinePragma, then we said
-- SPECIALISE, not SPECIALISE_INLINE
- -- A specialisation pragma for instance declarations only
- -- {-# SPECIALISE instance Eq [Int] #-}
- | SpecInstSig (LHsType name) -- (Class tys); should be a specialisation of the
- -- current instance decl
+ -- A specialisation pragma for instance declarations only
+ -- {-# SPECIALISE instance Eq [Int] #-}
+ | SpecInstSig (LHsType name) -- (Class tys); should be a specialisation of the
+ -- current instance decl
deriving (Data, Typeable)
deriving (Data, Typeable)
@@
-628,11
+636,14
@@
data FixitySig name = FixitySig (Located name) Fixity
data TcSpecPrags
= IsDefaultMethod -- Super-specialised: a default method should
-- be macro-expanded at every call site
data TcSpecPrags
= IsDefaultMethod -- Super-specialised: a default method should
-- be macro-expanded at every call site
- | SpecPrags [Located TcSpecPrag]
+ | SpecPrags [LTcSpecPrag]
deriving (Data, Typeable)
deriving (Data, Typeable)
+type LTcSpecPrag = Located TcSpecPrag
+
data TcSpecPrag
= SpecPrag
data TcSpecPrag
= SpecPrag
+ Id -- The Id to be specialised
HsWrapper -- An wrapper, that specialises the polymorphic function
InlinePragma -- Inlining spec for the specialised function
deriving (Data, Typeable)
HsWrapper -- An wrapper, that specialises the polymorphic function
InlinePragma -- Inlining spec for the specialised function
deriving (Data, Typeable)
@@
-768,14
+779,11
@@
pprSpec var pp_ty inl = ptext (sLit "SPECIALIZE") <+> pp_inl <+> pprVarSig var p
pp_inl | isDefaultInlinePragma inl = empty
| otherwise = ppr inl
pp_inl | isDefaultInlinePragma inl = empty
| otherwise = ppr inl
-pprTcSpecPrags :: Outputable id => id -> TcSpecPrags -> SDoc
-pprTcSpecPrags _ IsDefaultMethod = ptext (sLit "<default method>")
-pprTcSpecPrags gbl (SpecPrags ps) = vcat (map (pprSpecPrag gbl) ps)
-
-pprSpecPrag :: Outputable id => id -> Located TcSpecPrag -> SDoc
-pprSpecPrag var (L _ (SpecPrag _expr inl)) = pprSpec var (ptext (sLit "<type>")) inl
+pprTcSpecPrags :: TcSpecPrags -> SDoc
+pprTcSpecPrags IsDefaultMethod = ptext (sLit "<default method>")
+pprTcSpecPrags (SpecPrags ps) = vcat (map (ppr . unLoc) ps)
instance Outputable TcSpecPrag where
instance Outputable TcSpecPrag where
- ppr (SpecPrag _ p) = ptext (sLit "SpecPrag") <+> ppr p
+ ppr (SpecPrag var _ inl) = pprSpec var (ptext (sLit "<type>")) inl
\end{code}
\end{code}