- ppr sty EmptyBinds = ppNil
- ppr sty (ThenBinds binds1 binds2)
- = ppAbove (ppr sty binds1) (ppr sty binds2)
- ppr sty (SingleBind bind) = ppr sty bind
- ppr sty (BindWith bind sigs)
- = ppAbove (if null sigs
- then ppNil
- else ppAboves (map (ppr sty) sigs))
- (ppr sty bind)
- ppr sty (AbsBinds tyvars dictvars local_pairs dict_binds val_binds)
- = ppAbove (ppSep [ppPStr SLIT("AbsBinds"),
- ppBesides[ppLbrack, interpp'SP sty tyvars, ppRbrack],
- ppBesides[ppLbrack, interpp'SP sty dictvars, ppRbrack],
- ppBesides[ppLbrack, interpp'SP sty local_pairs, ppRbrack]])
- (ppNest 4 (ppAbove (ppAboves (map (ppr sty) dict_binds)) (ppr sty val_binds)))
-\end{code}
-
-%************************************************************************
-%* *
-\subsection{@Sig@: type signatures and value-modifying user pragmas}
-%* *
-%************************************************************************
-
-It is convenient to lump ``value-modifying'' user-pragmas (e.g.,
-``specialise this function to these four types...'') in with type
-signatures. Then all the machinery to move them into place, etc.,
-serves for both.
-
-\begin{code}
-data Sig name
- = Sig name -- a bog-std type signature
- (HsType name)
- SrcLoc
-
- | ClassOpSig name -- class-op sigs have different pragmas
- (HsType name)
- (ClassOpPragmas name) -- only interface ones have pragmas
- SrcLoc
-
- | 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
- SrcLoc
-
- | DeforestSig name -- Deforest using this function definition
- SrcLoc
-
- | MagicUnfoldingSig
- name -- Associate the "name"d function with
- FAST_STRING -- the compiler-builtin unfolding (known
- SrcLoc -- by the String name)
-\end{code}
-
-\begin{code}
-instance (NamedThing name, Outputable name) => Outputable (Sig name) where
- ppr sty (Sig var ty _)
- = ppHang (ppCat [pprNonSym sty var, ppPStr SLIT("::")])
- 4 (ppr sty ty)
-
- ppr sty (ClassOpSig var ty pragmas _)
- = ppHang (ppCat [ppr sty (getOccName var), ppPStr SLIT("::")])
- 4 (ppHang (ppr sty ty)
- 4 (ifnotPprForUser sty (ppr sty pragmas)))
-
- ppr sty (DeforestSig var _)
- = ppHang (ppCat [ppStr "{-# DEFOREST", pprNonSym sty var])
- 4 (ppStr "#-}")
-
- ppr sty (SpecSig var ty using _)
- = ppHang (ppCat [ppPStr SLIT("{-# SPECIALIZE"), pprNonSym sty var, ppPStr SLIT("::")])
- 4 (ppCat [ppr sty ty, pp_using using, ppPStr SLIT("#-}")])
- where
- pp_using Nothing = ppNil
- pp_using (Just me) = ppCat [ppChar '=', ppr sty me]
-
- ppr sty (InlineSig var _)
- = ppCat [ppPStr SLIT("{-# INLINE"), pprNonSym sty var, ppPStr SLIT("#-}")]
-
- ppr sty (MagicUnfoldingSig var str _)
- = ppCat [ppPStr SLIT("{-# MAGIC_UNFOLDING"), pprNonSym sty var, ppPStr str, ppPStr SLIT("#-}")]
-\end{code}
-
-%************************************************************************
-%* *
-\subsection{Binding: @Bind@}
-%* *
-%************************************************************************
-
-\begin{code}
-data Bind tyvar uvar id pat -- binders and bindees
- = EmptyBind -- because it's convenient when parsing signatures
- | NonRecBind (MonoBinds tyvar uvar id pat)
- | RecBind (MonoBinds tyvar uvar id pat)
-\end{code}
-
-\begin{code}
-nullBind :: Bind tyvar uvar id pat -> Bool
-
-nullBind EmptyBind = True
-nullBind (NonRecBind bs) = nullMonoBinds bs
-nullBind (RecBind bs) = nullMonoBinds bs
-\end{code}
-
-\begin{code}
-bindIsRecursive :: Bind tyvar uvar id pat -> Bool
-
-bindIsRecursive EmptyBind = False
-bindIsRecursive (NonRecBind _) = False
-bindIsRecursive (RecBind _) = True
-\end{code}
-
-\begin{code}
-instance (NamedThing id, Outputable id, Outputable pat,
- Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
- Outputable (Bind tyvar uvar id pat) where
- ppr sty EmptyBind = ppNil
- ppr sty (NonRecBind binds)
- = ppAbove (ifnotPprForUser sty (ppStr "{- nonrec -}"))
- (ppr sty binds)
- ppr sty (RecBind binds)
- = ppAbove (ifnotPprForUser sty (ppStr "{- rec -}"))
- (ppr sty binds)