IMP_Ubiq()
-- friends:
-import HsCore ( UnfoldingCoreExpr )
-import HsTypes ( MonoType )
+import HsTypes ( HsType )
-- others:
import IdInfo
+import SpecEnv ( SpecEnv )
import Outputable ( Outputable(..) )
import Pretty
\end{code}
+All the pragma stuff has changed. Here are some placeholders!
+
+\begin{code}
+data GenPragmas name = NoGenPragmas
+data DataPragmas name = NoDataPragmas
+data InstancePragmas name = NoInstancePragmas
+data ClassOpPragmas name = NoClassOpPragmas
+data ClassPragmas name = NoClassPragmas
+
+noClassPragmas = NoClassPragmas
+isNoClassPragmas NoClassPragmas = True
+
+noDataPragmas = NoDataPragmas
+isNoDataPragmas NoDataPragmas = True
+
+noGenPragmas = NoGenPragmas
+isNoGenPragmas NoGenPragmas = True
+
+noInstancePragmas = NoInstancePragmas
+isNoInstancePragmas NoInstancePragmas = True
+
+noClassOpPragmas = NoClassOpPragmas
+isNoClassOpPragmas NoClassOpPragmas = True
+
+instance Outputable name => Outputable (ClassPragmas name) where
+ ppr sty NoClassPragmas = empty
+
+instance Outputable name => Outputable (ClassOpPragmas name) where
+ ppr sty NoClassOpPragmas = empty
+
+instance Outputable name => Outputable (InstancePragmas name) where
+ ppr sty NoInstancePragmas = empty
+
+instance Outputable name => Outputable (GenPragmas name) where
+ ppr sty NoGenPragmas = empty
+\end{code}
+
+========================= OLD CODE SCEDULED FOR DELETION SLPJ Nov 96 ==============
+
+\begin{code}
+{- COMMENTED OUT
+
Certain pragmas expect to be pinned onto certain constructs.
Pragma types may be parameterised, just as with any other
\begin{code}
data DataPragmas name
= NoDataPragmas
- | DataPragmas [[Maybe (MonoType name)]] -- types to which specialised
+ | DataPragmas [[Maybe (HsType name)]] -- types to which specialised
noDataPragmas = NoDataPragmas
-
isNoDataPragmas NoDataPragmas = True
-isNoDataPragmas _ = False
\end{code}
These are {\em general} things you can know about any value:
DeforestInfo -- deforest info
(ImpStrictness name) -- strictness, worker-wrapper
(ImpUnfolding name) -- unfolding (maybe)
- [([Maybe (MonoType name)], -- Specialisations: types to which spec'd;
+ [([Maybe (HsType name)], -- Specialisations: types to which spec'd;
Int, -- # dicts to ignore
GenPragmas name)] -- Gen info about the spec'd version
| SpecialisedInstancePragma
(GenPragmas name) -- for its "dfun"
- [([Maybe (MonoType name)], -- specialised instance; type...
+ [([Maybe (HsType name)], -- specialised instance; type...
Int, -- #dicts to ignore
InstancePragmas name)] -- (no SpecialisedInstancePragma please!)
Some instances for printing (just for debugging, really)
\begin{code}
instance Outputable name => Outputable (ClassPragmas name) where
- ppr sty NoClassPragmas = ppNil
+ ppr sty NoClassPragmas = empty
ppr sty (SuperDictPragmas sdsel_prags)
- = ppAbove (ppStr "{-superdict pragmas-}")
+ = ($$) (ptext SLIT("{-superdict pragmas-}"))
(ppr sty sdsel_prags)
instance Outputable name => Outputable (ClassOpPragmas name) where
- ppr sty NoClassOpPragmas = ppNil
+ ppr sty NoClassOpPragmas = empty
ppr sty (ClassOpPragmas op_prags defm_prags)
- = ppAbove (ppCat [ppStr "{-meth-}", ppr sty op_prags])
- (ppCat [ppStr "{-defm-}", ppr sty defm_prags])
+ = ($$) (hsep [ptext SLIT("{-meth-}"), ppr sty op_prags])
+ (hsep [ptext SLIT("{-defm-}"), ppr sty defm_prags])
instance Outputable name => Outputable (InstancePragmas name) where
- ppr sty NoInstancePragmas = ppNil
+ ppr sty NoInstancePragmas = empty
ppr sty (SimpleInstancePragma dfun_pragmas)
- = ppCat [ppStr "{-dfun-}", ppr sty dfun_pragmas]
+ = hsep [ptext SLIT("{-dfun-}"), ppr sty dfun_pragmas]
ppr sty (ConstantInstancePragma dfun_pragmas name_pragma_pairs)
- = ppAbove (ppCat [ppStr "{-constm-}", ppr sty dfun_pragmas])
- (ppAboves (map pp_pair name_pragma_pairs))
+ = ($$) (hsep [ptext SLIT("{-constm-}"), ppr sty dfun_pragmas])
+ (vcat (map pp_pair name_pragma_pairs))
where
pp_pair (n, prags)
- = ppCat [ppr sty n, ppEquals, ppr sty prags]
+ = hsep [ppr sty n, equals, ppr sty prags]
ppr sty (SpecialisedInstancePragma dfun_pragmas spec_pragma_info)
- = ppAbove (ppCat [ppStr "{-spec'd-}", ppr sty dfun_pragmas])
- (ppAboves (map pp_info spec_pragma_info))
+ = ($$) (hsep [ptext SLIT("{-spec'd-}"), ppr sty dfun_pragmas])
+ (vcat (map pp_info spec_pragma_info))
where
pp_info (ty_maybes, num_dicts, prags)
- = ppBesides [ppLbrack, ppInterleave ppSP (map pp_ty ty_maybes), ppRbrack,
- ppLparen, ppInt num_dicts, ppRparen, ppEquals, ppr sty prags]
- pp_ty Nothing = ppStr "_N_"
+ = hcat [brackets (hsep (map pp_ty ty_maybes)),
+ parens (int num_dicts), equals, ppr sty prags]
+ pp_ty Nothing = ptext SLIT("_N_")
pp_ty (Just t)= ppr sty t
instance Outputable name => Outputable (GenPragmas name) where
- ppr sty NoGenPragmas = ppNil
+ ppr sty NoGenPragmas = empty
ppr sty (GenPragmas arity_maybe upd_maybe def strictness unfolding specs)
- = ppCat [pp_arity arity_maybe, pp_upd upd_maybe, -- ToDo: print def?
+ = hsep [pp_arity arity_maybe, pp_upd upd_maybe, -- ToDo: print def?
pp_str strictness, pp_unf unfolding,
pp_specs specs]
where
- pp_arity Nothing = ppNil
- pp_arity (Just i) = ppBeside (ppStr "ARITY=") (ppInt i)
+ pp_arity Nothing = empty
+ pp_arity (Just i) = (<>) (ptext SLIT("ARITY=")) (int i)
- pp_upd Nothing = ppNil
- pp_upd (Just u) = ppInfo sty id u
+ pp_upd Nothing = empty
+ pp_upd (Just u) = ppUpdateInfo sty u
- pp_str NoImpStrictness = ppNil
+ pp_str NoImpStrictness = empty
pp_str (ImpStrictness is_bot demands wrkr_prags)
- = ppBesides [ppStr "IS_BOT=", ppr sty is_bot,
- ppStr "STRICTNESS=", ppStr (showList demands ""),
- ppStr " {", ppr sty wrkr_prags, ppStr "}"]
+ = hcat [ptext SLIT("IS_BOT="), ppr sty is_bot,
+ ptext SLIT("STRICTNESS="), text (showList demands ""),
+ ptext SLIT(" {"), ppr sty wrkr_prags, char '}']
- pp_unf NoImpUnfolding = ppStr "NO_UNFOLDING"
- pp_unf (ImpMagicUnfolding m) = ppBeside (ppStr "MAGIC=") (ppPStr m)
- pp_unf (ImpUnfolding g core) = ppBeside (ppStr "UNFOLD=") (ppr sty core)
+ pp_unf NoImpUnfolding = ptext SLIT("NO_UNFOLDING")
+ pp_unf (ImpMagicUnfolding m) = (<>) (ptext SLIT("MAGIC=")) (ptext m)
+ pp_unf (ImpUnfolding g core) = (<>) (ptext SLIT("UNFOLD=")) (ppr sty core)
- pp_specs [] = ppNil
+ pp_specs [] = empty
pp_specs specs
- = ppBesides [ppStr "SPECS=[", ppInterleave ppSP (map pp_spec specs), ppStr "]"]
+ = hcat [ptext SLIT("SPECS=["), hsep (map pp_spec specs), char ']']
where
pp_spec (ty_maybes, num_dicts, gprags)
- = ppCat [ppLbrack, ppInterleave ppSP (map pp_MaB ty_maybes), ppRbrack, ppInt num_dicts, ppr sty gprags]
+ = hsep [brackets (hsep (map pp_MaB ty_maybes)), int num_dicts, ppr sty gprags]
- pp_MaB Nothing = ppStr "_N_"
+ pp_MaB Nothing = ptext SLIT("_N_")
pp_MaB (Just x) = ppr sty x
\end{code}
+
+
+\begin{code}
+-}
+\end{code}
projects / ghc-hetmet.git / blobdiff