%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[HsBinds]{Abstract syntax: top-level bindings and signatures}
GRHSs, pprPatBind )
import {-# SOURCE #-} HsPat ( LPat )
-import HsTypes ( LHsType, PostTcType )
-import PprCore ( {- instances -} )
-import Coercion ( Coercion )
-import Type ( Type, pprParendType )
-import Name ( Name )
-import NameSet ( NameSet, elemNameSet )
-import BasicTypes ( IPName, RecFlag(..), InlineSpec(..), Fixity )
+import HsTypes
+import PprCore
+import Coercion
+import Type
+import Name
+import NameSet
+import BasicTypes
import Outputable
-import SrcLoc ( Located(..), SrcSpan, unLoc )
-import Util ( sortLe )
-import Var ( TyVar, DictId, Id, Var )
-import Bag ( Bag, emptyBag, isEmptyBag, bagToList, unionBags, unionManyBags )
+import SrcLoc
+import Util
+import Var
+import Bag
\end{code}
%************************************************************************
-- type Int -> forall a'. a' -> a'
-- Notice that the coercion captures the free a'.
- bind_fvs :: NameSet -- After the renamer, this contains a superset of the
+ bind_fvs :: NameSet, -- After the renamer, this contains a superset of the
-- Names of the other binders in this binding group that
-- are free in the RHS of the defn
-- Before renaming, and after typechecking,
-- the field is unused; it's just an error thunk
+
+ fun_tick :: Maybe Int -- This is the (optional) module-local tick number.
}
| PatBind { -- The pattern is never a simple variable;
ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss }) = pprPatBind pat grhss
ppr_monobind (VarBind { var_id = var, var_rhs = rhs }) = ppr var <+> equals <+> pprExpr (unLoc rhs)
-ppr_monobind (FunBind { fun_id = fun, fun_matches = matches }) = pprFunBind (unLoc fun) matches
+ppr_monobind (FunBind { fun_id = fun,
+ fun_matches = matches,
+ fun_tick = tick }) =
+ (case tick of
+ Nothing -> empty
+ Just t -> text "-- tick id = " <> ppr t
+ ) $$ pprFunBind (unLoc fun) matches
-- ToDo: print infix if appropriate
ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_dicts = dictvars,
\begin{code}
type LSig name = Located (Sig name)
-data Sig name
- = TypeSig (Located name) -- A bog-std type signature
+data Sig name -- Signatures and pragmas
+ = -- An ordinary type signature
+ -- f :: Num a => a -> a
+ TypeSig (Located name) -- A bog-std type signature
(LHsType name)
- | SpecSig (Located name) -- Specialise a function or datatype ...
- (LHsType name) -- ... to these types
- InlineSpec
+ -- An ordinary fixity declaration
+ -- infixl *** 8
+ | FixSig (FixitySig name) -- Fixity declaration
+ -- An inline pragma
+ -- {#- INLINE f #-}
| InlineSig (Located name) -- Function name
InlineSpec
+ -- A specialisation pragma
+ -- {-# SPECIALISE f :: Int -> Int #-}
+ | SpecSig (Located name) -- Specialise a function or datatype ...
+ (LHsType name) -- ... to these types
+ InlineSpec
+
+ -- 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
- | FixSig (FixitySig name) -- Fixity declaration
type LFixitySig name = Located (FixitySig name)
data FixitySig name = FixitySig (Located name) Fixity
Just n -> n `elemNameSet` ns
sigName :: LSig name -> Maybe name
-sigName (L _ sig) = f sig
- where
- f (TypeSig n _) = Just (unLoc n)
- f (SpecSig n _ _) = Just (unLoc n)
- f (InlineSig n _) = Just (unLoc n)
- f (FixSig (FixitySig n _)) = Just (unLoc n)
- f other = Nothing
+sigName (L _ sig) = sigNameNoLoc sig
+
+sigNameNoLoc :: Sig name -> Maybe name
+sigNameNoLoc (TypeSig n _) = Just (unLoc n)
+sigNameNoLoc (SpecSig n _ _) = Just (unLoc n)
+sigNameNoLoc (InlineSig n _) = Just (unLoc n)
+sigNameNoLoc (FixSig (FixitySig n _)) = Just (unLoc n)
+sigNameNoLoc other = Nothing
isFixityLSig :: LSig name -> Bool
isFixityLSig (L _ (FixSig {})) = True