Two new warnings: arity differing from demand type, and strict IDs at top level

[ghc-hetmet.git] / compiler / hsSyn / HsBinds.lhs

diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs
index ebac06f..0942703 100644 (file)
--- a/compiler/hsSyn/HsBinds.lhs
+++ b/compiler/hsSyn/HsBinds.lhs
@@ -87,11 +87,13 @@ data HsBind id
                                -- 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;
@@ -238,7 +240,13 @@ ppr_monobind :: OutputableBndr id => HsBind id -> SDoc
 
 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, 
@@ -375,21 +383,32 @@ serves for both.
 \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