--others:
import Id ( Id )
-import Name ( OccName, NamedThing(..) )
+import NameSet ( NameSet, nameSetToList )
import BasicTypes ( RecFlag(..), Fixity )
import Outputable
import Bag
\end{code}
\begin{code}
-instance (Outputable pat, NamedThing id, Outputable id) =>
+instance (Outputable pat, Outputable id) =>
Outputable (HsBinds id pat) where
ppr binds = ppr_binds binds
SrcLoc
| FunMonoBind id
- Bool -- True => infix declaration
+ Bool -- True => infix declaration
[Match id pat]
SrcLoc
| CoreMonoBind id -- TRANSLATION
CoreExpr -- No zonking; this is a final CoreExpr with Ids and Types!
- | AbsBinds -- Binds abstraction; TRANSLATION
- [TyVar] -- Type variables
- [id] -- Dicts
- [([TyVar], id, id)] -- (type variables, polymorphic, momonmorphic) triples
+ | AbsBinds -- Binds abstraction; TRANSLATION
+ [TyVar] -- Type variables
+ [id] -- Dicts
+ [([TyVar], id, id)] -- (type variables, polymorphic, momonmorphic) triples
+ NameSet -- Set of *polymorphic* variables that have an INLINE pragma
(MonoBinds id pat) -- The "business end"
-- Creates bindings for *new* (polymorphic, overloaded) locals
\end{code}
\begin{code}
-instance (NamedThing id, Outputable id, Outputable pat) =>
+instance (Outputable id, Outputable pat) =>
Outputable (MonoBinds id pat) where
ppr mbind = ppr_monobind mbind
+ppr_monobind :: (Outputable id, Outputable pat) => MonoBinds id pat -> SDoc
ppr_monobind EmptyMonoBinds = empty
ppr_monobind (AndMonoBinds binds1 binds2)
- = ($$) (ppr_monobind binds1) (ppr_monobind binds2)
+ = ppr_monobind binds1 $$ ppr_monobind binds2
ppr_monobind (PatMonoBind pat grhss locn)
= sep [ppr pat, nest 4 (pprGRHSs False grhss)]
ppr_monobind (CoreMonoBind name expr)
= sep [ppr name <+> equals, nest 4 (ppr expr)]
-ppr_monobind (AbsBinds tyvars dictvars exports val_binds)
- = ($$) (sep [ptext SLIT("AbsBinds"),
- brackets (interpp'SP tyvars),
- brackets (interpp'SP dictvars),
- brackets (interpp'SP exports)])
- (nest 4 (ppr val_binds))
+ppr_monobind (AbsBinds tyvars dictvars exports inlines val_binds)
+ = sep [ptext SLIT("AbsBinds"),
+ brackets (interpp'SP tyvars),
+ brackets (interpp'SP dictvars),
+ brackets (sep (punctuate comma (map ppr exports))),
+ brackets (interpp'SP (nameSetToList inlines))]
+ $$
+ nest 4 (ppr val_binds)
\end{code}
%************************************************************************
| SpecSig name -- specialise a function or datatype ...
(HsType name) -- ... to these types
- (Maybe name) -- ... maybe using this as the code for it
SrcLoc
| InlineSig name -- INLINE f
where
sig_for_me (Sig n _ _) = f n
sig_for_me (ClassOpSig n _ _ _) = f n
- sig_for_me (SpecSig n _ _ _) = f n
+ sig_for_me (SpecSig n _ _) = f n
sig_for_me (InlineSig n _) = f n
sig_for_me (NoInlineSig n _) = f n
sig_for_me (SpecInstSig _ _) = False
sig_for_me (FixSig (FixitySig n _ _)) = f n
-nonFixitySigs :: [Sig name] -> [Sig name]
-nonFixitySigs sigs = filter not_fix sigs
- where
- not_fix (FixSig _) = False
- not_fix other = True
+isFixitySig :: Sig name -> Bool
+isFixitySig (FixSig _) = True
+isFixitySig _ = False
+
+isClassOpSig :: Sig name -> Bool
+isClassOpSig (ClassOpSig _ _ _ _) = True
+isClassOpSig _ = False
\end{code}
\begin{code}
-instance (NamedThing name, Outputable name) => Outputable (Sig name) where
+instance (Outputable name) => Outputable (Sig name) where
ppr sig = ppr_sig sig
instance Outputable name => Outputable (FixitySig name) where
= sep [ppr var <+> dcolon, nest 4 (ppr ty)]
ppr_sig (ClassOpSig var _ ty _)
- = sep [ppr (getOccName var) <+> dcolon, nest 4 (ppr ty)]
+ = sep [ppr var <+> dcolon, nest 4 (ppr ty)]
-ppr_sig (SpecSig var ty using _)
+ppr_sig (SpecSig var ty _)
= sep [ hsep [text "{-# SPECIALIZE", ppr var, dcolon],
- nest 4 (hsep [ppr ty, pp_using using, text "#-}"])
+ nest 4 (ppr ty <+> text "#-}")
]
- where
- pp_using Nothing = empty
- pp_using (Just me) = hsep [char '=', ppr me]
ppr_sig (InlineSig var _)
= hsep [text "{-# INLINE", ppr var, text "#-}"]