[project @ 1999-04-27 17:33:49 by sof]
[ghc-hetmet.git] / ghc / compiler / rename / RnBinds.lhs
index cd04844..22e583b 100644 (file)
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \section[RnBinds]{Renaming and dependency analysis of bindings}
 
@@ -11,8 +11,9 @@ they may be affected by renaming (which isn't fully worked out yet).
 \begin{code}
 module RnBinds (
        rnTopBinds, rnTopMonoBinds,
-       rnMethodBinds,
-       rnBinds, rnMonoBinds
+       rnMethodBinds, renameSigs,
+       rnBinds,
+       unknownSigErr
    ) where
 
 #include "HsVersions.h"
@@ -20,26 +21,28 @@ module RnBinds (
 import {-# SOURCE #-} RnSource ( rnHsSigType )
 
 import HsSyn
+import HsBinds         ( sigsForMe )
 import RdrHsSyn
 import RnHsSyn
 import RnMonad
-import RnExpr          ( rnMatch, rnGRHSsAndBinds, rnPat, checkPrecMatch )
-import RnEnv           ( bindLocatedLocalsRn, lookupBndrRn, lookupOccRn, 
-                         newLocalNames, isUnboundName, warnUnusedBinds
+import RnExpr          ( rnMatch, rnGRHSs, rnPat, checkPrecMatch )
+import RnEnv           ( bindLocatedLocalsRn, lookupBndrRn, lookupOccRn, lookupGlobalOccRn,
+                         isUnboundName, warnUnusedLocalBinds,
+                         FreeVars, emptyFVs, plusFV, plusFVs, unitFV,
+                         failUnboundNameErrRn
                        )
-import CmdLineOpts     ( opt_SigsRequired )
+import CmdLineOpts     ( opt_WarnMissingSigs )
 import Digraph         ( stronglyConnComp, SCC(..) )
-import Name            ( OccName(..), Provenance, 
-                         Name, isExportedName,
-                         NameSet(..), emptyNameSet, mkNameSet, unionNameSets, 
-                         minusNameSet, unionManyNameSets, elemNameSet, unitNameSet, nameSetToList
-                       )
+import Name            ( OccName, Name, nameOccName )
+import NameSet
+import RdrName         ( RdrName, rdrNameOcc  )
 import BasicTypes      ( RecFlag(..), TopLevelFlag(..) )
-import Util            ( thenCmp, removeDups, panic, panic#, assertPanic )
-import UniqSet         ( UniqSet )
+import Util            ( thenCmp, removeDups )
+import List            ( partition )
 import ListSetOps      ( minusList )
 import Bag             ( bagToList )
-import UniqFM          ( UniqFM )
+import FiniteMap       ( emptyFM, addListToFM, lookupFM )
+import Maybe           ( isJust )
 import Outputable
 \end{code}
 
@@ -158,29 +161,34 @@ it expects the global environment to contain bindings for the binders
 contains bindings for the binders of this particular binding.
 
 \begin{code}
-rnTopBinds    :: RdrNameHsBinds -> RnMS s RenamedHsBinds
+rnTopBinds    :: RdrNameHsBinds -> RnMS s (RenamedHsBinds, FreeVars)
 
-rnTopBinds EmptyBinds                    = returnRn EmptyBinds
+rnTopBinds EmptyBinds                    = returnRn (EmptyBinds, emptyFVs)
 rnTopBinds (MonoBind bind sigs _)        = rnTopMonoBinds bind sigs
   -- The parser doesn't produce other forms
 
 
 rnTopMonoBinds EmptyMonoBinds sigs 
-  = returnRn EmptyBinds
+  = returnRn (EmptyBinds, emptyFVs)
 
 rnTopMonoBinds mbinds sigs
  =  mapRn lookupBndrRn binder_rdr_names        `thenRn` \ binder_names ->
     let
-       binder_set       = mkNameSet binder_names
-       exported_binders = mkNameSet (filter isExportedName binder_names)
-    in
-    rn_mono_binds TopLevel
-                 binder_set mbinds sigs                `thenRn` \ (new_binds, fv_set) ->
-    let
-       unused_binders = binder_set `minusNameSet` (fv_set `unionNameSets` exported_binders)
+       binder_set = mkNameSet binder_names
+
+       binder_occ_fm = addListToFM emptyFM (map (\ x -> (nameOccName x,x)) binder_names)
+
+          -- the names appearing in the sigs have to be bound by 
+          -- this group's binders.
+       lookup_occ_rn_sig rdr_name = 
+           case lookupFM binder_occ_fm (rdrNameOcc rdr_name) of
+             Nothing -> failUnboundNameErrRn rdr_name
+             Just x  -> returnRn x
     in
-    warnUnusedBinds unused_binders     `thenRn_`
-    returnRn new_binds
+    renameSigs opt_WarnMissingSigs binder_set lookup_occ_rn_sig sigs
+                                               `thenRn` \ (siglist, sig_fvs) ->
+    rn_mono_binds siglist mbinds               `thenRn` \ (final_binds, bind_fvs) ->
+    returnRn (final_binds, bind_fvs `plusFV` sig_fvs)
   where
     binder_rdr_names = map fst (bagToList (collectMonoBinders mbinds))
 \end{code}
@@ -207,7 +215,8 @@ rnBinds (MonoBind bind sigs _) thing_inside = rnMonoBinds bind sigs thing_inside
   -- the parser doesn't produce other forms
 
 
-rnMonoBinds :: RdrNameMonoBinds -> [RdrNameSig]
+rnMonoBinds :: RdrNameMonoBinds 
+            -> [RdrNameSig]
            -> (RenamedHsBinds -> RnMS s (result, FreeVars))
            -> RnMS s (result, FreeVars)
 
@@ -217,22 +226,49 @@ rnMonoBinds mbinds sigs   thing_inside -- Non-empty monobinds
   =    -- Extract all the binders in this group,
        -- and extend current scope, inventing new names for the new binders
        -- This also checks that the names form a set
-    bindLocatedLocalsRn (text "binding group") mbinders_w_srclocs              $ \ new_mbinders ->
+    bindLocatedLocalsRn (text "a binding group") mbinders_w_srclocs            $ \ new_mbinders ->
+    let
+       binder_set  = mkNameSet new_mbinders
+
+          -- Weed out the fixity declarations that do not
+          -- apply to any of the binders in this group.
+       (sigs_for_me, fixes_not_for_me) = partition forLocalBind sigs
+
+       forLocalBind (FixSig sig@(FixitySig name _ _ )) =
+           isJust (lookupFM binder_occ_fm (rdrNameOcc name))
+       forLocalBind _ = True
+
+       binder_occ_fm = addListToFM emptyFM (map (\ x -> (nameOccName x,x)) new_mbinders)
+
+          -- the names appearing in the sigs have to be bound by 
+          -- this group's binders.
+       lookup_occ_rn_sig rdr_name = 
+           case lookupFM binder_occ_fm (rdrNameOcc rdr_name) of
+             Nothing -> failUnboundNameErrRn rdr_name
+             Just x  -> returnRn x
+    in
+       --
+       -- Report the fixity declarations in this group that 
+       -- don't refer to any of the group's binders.
+       --
+    mapRn_ (unknownSigErr) fixes_not_for_me     `thenRn_`
+    renameSigs False binder_set lookup_occ_rn_sig sigs_for_me
+                                                   `thenRn` \ (siglist, sig_fvs) ->
     let
-       binder_set = mkNameSet new_mbinders
+       fixity_sigs = [(name,sig) | FixSig sig@(FixitySig name _ _) <- siglist ]
     in
-    rn_mono_binds NotTopLevel
-                 binder_set mbinds sigs        `thenRn` \ (binds,bind_fvs) ->
+       -- Install the fixity declarations that do apply here and go.
+    extendFixityEnv  fixity_sigs (
+      rn_mono_binds siglist mbinds )       `thenRn` \ (binds, bind_fvs) ->
 
        -- Now do the "thing inside", and deal with the free-variable calculations
     thing_inside binds                                 `thenRn` \ (result,result_fvs) ->
     let
-       all_fvs        = result_fvs  `unionNameSets` bind_fvs
-       net_fvs        = all_fvs `minusNameSet` binder_set
-       unused_binders = binder_set `minusNameSet` all_fvs
+       all_fvs        = result_fvs `plusFV` bind_fvs `plusFV` sig_fvs
+       unused_binders = nameSetToList (binder_set `minusNameSet` all_fvs)
     in
-    warnUnusedBinds unused_binders     `thenRn_`
-    returnRn (result, net_fvs)
+    warnUnusedLocalBinds unused_binders        `thenRn_`
+    returnRn (result, delListFromNameSet all_fvs new_mbinders)
   where
     mbinders_w_srclocs = bagToList (collectMonoBinders mbinds)
 \end{code}
@@ -244,34 +280,32 @@ rnMonoBinds mbinds sigs   thing_inside -- Non-empty monobinds
 %*                                                                     *
 %************************************************************************
 
-@rnMonoBinds@ is used by *both* top-level and nested bindings.  It
+@rn_mono_binds@ is used by *both* top-level and nested bindings.  It
 assumes that all variables bound in this group are already in scope.
 This is done *either* by pass 3 (for the top-level bindings), *or* by
-@rnNestedMonoBinds@ (for the nested ones).
+@rnMonoBinds@ (for the nested ones).
 
 \begin{code}
-rn_mono_binds :: TopLevelFlag
-             -> NameSet                -- Binders of this group
+rn_mono_binds :: [RenamedSig]          -- Signatures attached to this group
              -> RdrNameMonoBinds       
-             -> [RdrNameSig]           -- Signatures attached to this group
              -> RnMS s (RenamedHsBinds,        -- 
                         FreeVars)      -- Free variables
 
-rn_mono_binds top_lev binders mbinds sigs
+rn_mono_binds siglist mbinds
   =
         -- Rename the bindings, returning a MonoBindsInfo
         -- which is a list of indivisible vertices so far as
         -- the strongly-connected-components (SCC) analysis is concerned
-    rnBindSigs top_lev binders sigs    `thenRn` \ siglist ->
-    flattenMonoBinds siglist mbinds    `thenRn` \ mbinds_info ->
+    flattenMonoBinds siglist mbinds            `thenRn` \ mbinds_info ->
 
         -- Do the SCC analysis
-    let edges      = mkEdges (mbinds_info `zip` [(0::Int)..])
+    let 
+        edges      = mkEdges (mbinds_info `zip` [(0::Int)..])
        scc_result  = stronglyConnComp edges
        final_binds = foldr1 ThenBinds (map reconstructCycle scc_result)
 
         -- Deal with bound and free-var calculation
-       rhs_fvs = unionManyNameSets [fvs | (_,fvs,_,_) <- mbinds_info]
+       rhs_fvs = plusFVs [fvs | (_,fvs,_,_) <- mbinds_info]
     in
     returnRn (final_binds, rhs_fvs)
 \end{code}
@@ -279,6 +313,9 @@ rn_mono_binds top_lev binders mbinds sigs
 @flattenMonoBinds@ is ever-so-slightly magical in that it sticks
 unique ``vertex tags'' on its output; minor plumbing required.
 
+Sigh - need to pass along the signatures for the group of bindings,
+in case any of them 
+
 \begin{code}
 flattenMonoBinds :: [RenamedSig]               -- Signatures
                 -> RdrNameMonoBinds
@@ -291,77 +328,75 @@ flattenMonoBinds sigs (AndMonoBinds bs1 bs2)
     flattenMonoBinds sigs bs2  `thenRn` \ flat2 ->
     returnRn (flat1 ++ flat2)
 
-flattenMonoBinds sigs (PatMonoBind pat grhss_and_binds locn)
+flattenMonoBinds sigs (PatMonoBind pat grhss locn)
   = pushSrcLocRn locn                  $
-    rnPat pat                          `thenRn` \ pat' ->
-    rnGRHSsAndBinds grhss_and_binds    `thenRn` \ (grhss_and_binds', fvs) ->
+    rnPat pat                          `thenRn` \ (pat', pat_fvs) ->
 
         -- Find which things are bound in this group
     let
        names_bound_here = mkNameSet (collectPatBinders pat')
-       sigs_for_me      = filter ((`elemNameSet` names_bound_here) . sig_name) sigs
-       sigs_fvs         = foldr sig_fv emptyNameSet sigs_for_me
+       sigs_for_me      = sigsForMe (`elemNameSet` names_bound_here) sigs
+       sigs_fvs         = foldr sig_fv emptyFVs sigs_for_me
     in
+    rnGRHSs grhss                      `thenRn` \ (grhss', fvs) ->
     returnRn 
        [(names_bound_here,
-         fvs `unionNameSets` sigs_fvs,
-         PatMonoBind pat' grhss_and_binds' locn,
+         fvs `plusFV` sigs_fvs `plusFV` pat_fvs,
+         PatMonoBind pat' grhss' locn,
          sigs_for_me
         )]
 
 flattenMonoBinds sigs (FunMonoBind name inf matches locn)
-  = pushSrcLocRn locn                           $
-    mapRn (checkPrecMatch inf name) matches    `thenRn_`
-    lookupBndrRn name                          `thenRn` \ name' ->
-    mapAndUnzipRn rnMatch matches              `thenRn` \ (new_matches, fv_lists) ->
+  = pushSrcLocRn locn                                  $
+    lookupBndrRn name                                  `thenRn` \ new_name ->
     let
-       fvs         = unionManyNameSets fv_lists
-       sigs_for_me = filter ((name' ==) . sig_name) sigs
-       sigs_fvs    = foldr sig_fv emptyNameSet sigs_for_me
+       sigs_for_me = sigsForMe (new_name ==) sigs
+       sigs_fvs    = foldr sig_fv emptyFVs sigs_for_me
     in
+    mapAndUnzipRn rnMatch matches                      `thenRn` \ (new_matches, fv_lists) ->
+    mapRn_ (checkPrecMatch inf new_name) new_matches   `thenRn_`
     returnRn
-      [(unitNameSet name',
-       fvs `unionNameSets` sigs_fvs,
-       FunMonoBind name' inf new_matches locn,
+      [(unitNameSet new_name,
+       plusFVs fv_lists `plusFV` sigs_fvs,
+       FunMonoBind new_name inf new_matches locn,
        sigs_for_me
        )]
 \end{code}
 
 
-@rnMethodBinds@ is used for the method bindings of an instance
+@rnMethodBinds@ is used for the method bindings of a class and an instance
 declaration.   like @rnMonoBinds@ but without dependency analysis.
 
 \begin{code}
-rnMethodBinds :: RdrNameMonoBinds -> RnMS s RenamedMonoBinds
+rnMethodBinds :: RdrNameMonoBinds -> RnMS s (RenamedMonoBinds, FreeVars)
 
-rnMethodBinds EmptyMonoBinds = returnRn EmptyMonoBinds
+rnMethodBinds EmptyMonoBinds = returnRn (EmptyMonoBinds, emptyFVs)
 
 rnMethodBinds (AndMonoBinds mb1 mb2)
-  = andRn AndMonoBinds (rnMethodBinds mb1)
-                      (rnMethodBinds mb2)
+  = rnMethodBinds mb1  `thenRn` \ (mb1', fvs1) ->
+    rnMethodBinds mb2  `thenRn` \ (mb2', fvs2) ->
+    returnRn (mb1' `AndMonoBinds` mb2', fvs1 `plusFV` fvs2)
 
-rnMethodBinds (FunMonoBind occname inf matches locn)
-  = pushSrcLocRn locn                             $
-    mapRn (checkPrecMatch inf occname) matches `thenRn_`
+rnMethodBinds (FunMonoBind name inf matches locn)
+  = pushSrcLocRn locn                                  $
 
-    newLocalNames [(occname, locn)]            `thenRn` \ [op_name] ->
-       -- Make a fresh local for the bound variable; it must be different
-       -- to occurrences of the same thing on the LHS, which refer to the global
-       -- selectors.
+    lookupGlobalOccRn name                             `thenRn` \ sel_name -> 
+       -- We use the selector name as the binder
 
-    mapAndUnzipRn rnMatch matches              `thenRn` \ (new_matches, _) ->
-    returnRn (FunMonoBind op_name inf new_matches locn)
+    mapAndUnzipRn rnMatch matches                      `thenRn` \ (new_matches, fvs_s) ->
+    mapRn_ (checkPrecMatch inf sel_name) new_matches   `thenRn_`
+    returnRn (FunMonoBind sel_name inf new_matches locn, plusFVs fvs_s)
 
-rnMethodBinds (PatMonoBind (VarPatIn occname) grhss_and_binds locn)
+rnMethodBinds (PatMonoBind (VarPatIn name) grhss locn)
   = pushSrcLocRn locn                  $
-    newLocalNames [(occname, locn)]    `thenRn` \ [op_name] ->
-    rnGRHSsAndBinds grhss_and_binds    `thenRn` \ (grhss_and_binds', _) ->
-    returnRn (PatMonoBind (VarPatIn op_name) grhss_and_binds' locn)
+    lookupGlobalOccRn name                     `thenRn` \ sel_name -> 
+    rnGRHSs grhss                      `thenRn` \ (grhss', fvs) ->
+    returnRn (PatMonoBind (VarPatIn sel_name) grhss' locn, fvs)
 
 -- Can't handle method pattern-bindings which bind multiple methods.
 rnMethodBinds mbind@(PatMonoBind other_pat _ locn)
   = pushSrcLocRn locn  $
-    failWithRn EmptyMonoBinds (methodBindErr mbind)
+    failWithRn (EmptyMonoBinds, emptyFVs) (methodBindErr mbind)
 \end{code}
 
 \begin{code}
@@ -370,7 +405,10 @@ rnMethodBinds mbind@(PatMonoBind other_pat _ locn)
 -- acct in the dependency analysis (or we get an
 -- unexpected out-of-scope error)! WDP 95/07
 
-sig_fv (SpecSig _ _ (Just blah) _) acc = acc `unionNameSets` (unitNameSet blah)
+-- This is only necessary for the dependency analysis.  The free vars
+-- of the types in the signatures is gotten from renameSigs
+
+sig_fv (SpecSig _ _ (Just blah) _) acc = acc `plusFV` unitFV blah
 sig_fv _                          acc = acc
 \end{code}
 
@@ -437,75 +475,97 @@ mkEdges flat_info
 %*                                                                     *
 %************************************************************************
 
-@rnBindSigs@ checks for: (a)~more than one sig for one thing;
+@renameSigs@ checks for: (a)~more than one sig for one thing;
 (b)~signatures given for things not bound here; (c)~with suitably
 flaggery, that all top-level things have type signatures.
 
+At the moment we don't gather free-var info from the types in
+signatures.  We'd only need this if we wanted to report unused tyvars.
+
 \begin{code}
-rnBindSigs :: TopLevelFlag
-          -> NameSet                   -- Set of names bound in this group
-          -> [RdrNameSig]
-          -> RnMS s [RenamedSig]                -- List of Sig constructors
+renameSigs ::  Bool                    -- True => warn if (required) type signatures are missing.
+           -> NameSet                  -- Set of names bound in this group
+           -> (RdrName -> RnMS s Name)
+           -> [RdrNameSig]
+           -> RnMS s ([RenamedSig], FreeVars)           -- List of Sig constructors
 
-rnBindSigs top_lev binders sigs
+renameSigs sigs_required binders lookup_occ_nm sigs
   =     -- Rename the signatures
-    mapRn renameSig sigs       `thenRn` \ sigs' ->
+    mapAndUnzipRn (renameSig lookup_occ_nm) sigs       `thenRn` \ (sigs', fvs_s) ->
 
        -- Check for (a) duplicate signatures
        --           (b) signatures for things not in this group
        --           (c) optionally, bindings with no signature
     let
-       (goodies, dups) = removeDups cmp_sig (filter (not.isUnboundName.sig_name) sigs')
-       not_this_group  = filter (\sig -> not (sig_name sig `elemNameSet` binders)) goodies
-       type_sig_vars   = [n | Sig n _ _ <- goodies]
-       sigs_required   = case top_lev of {TopLevel -> opt_SigsRequired; NotTopLevel -> False}
+       (goodies, dups) = removeDups cmp_sig (sigsForMe (not . isUnboundName) sigs')
+       not_this_group  = sigsForMe (not . (`elemNameSet` binders)) goodies
+       type_sig_vars   = [n | Sig n _ _     <- goodies]
        un_sigd_binders | sigs_required = nameSetToList binders `minusList` type_sig_vars
                        | otherwise     = []
     in
-    mapRn dupSigDeclErr dups                           `thenRn_`
-    mapRn unknownSigErr not_this_group                 `thenRn_`
-    mapRn (addErrRn.missingSigErr) un_sigd_binders     `thenRn_`
-
-    returnRn sigs' -- bad ones and all:
-                  -- we need bindings of *some* sort for every name
-
+    mapRn_ dupSigDeclErr dups                          `thenRn_`
+    mapRn_ unknownSigErr not_this_group                        `thenRn_`
+    mapRn_ (addWarnRn.missingSigWarn) un_sigd_binders  `thenRn_`
+    returnRn (sigs', plusFVs fvs_s)    
+               -- bad ones and all:
+               -- we need bindings of *some* sort for every name
+
+-- We use lookupOccRn in the signatures, which is a little bit unsatisfactory
+-- because this won't work for:
+--     instance Foo T where
+--       {-# INLINE op #-}
+--       Baz.op = ...
+-- We'll just rename the INLINE prag to refer to whatever other 'op'
+-- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
+-- Doesn't seem worth much trouble to sort this.
+
+renameSig lookup_occ_nm (Sig v ty src_loc)
+  = pushSrcLocRn src_loc $
+    lookup_occ_nm v                            `thenRn` \ new_v ->
+    rnHsSigType (quotes (ppr v)) ty            `thenRn` \ (new_ty,fvs) ->
+    returnRn (Sig new_v new_ty src_loc, fvs)
 
-renameSig (Sig v ty src_loc)
+renameSig _ (SpecInstSig ty src_loc)
   = pushSrcLocRn src_loc $
-    lookupBndrRn v                             `thenRn` \ new_v ->
-    rnHsSigType (quotes (ppr v)) ty            `thenRn` \ new_ty ->
-    returnRn (Sig new_v new_ty src_loc)
+    rnHsSigType (text "A SPECIALISE instance pragma") ty       `thenRn` \ (new_ty, fvs) ->
+    returnRn (SpecInstSig new_ty src_loc, fvs)
 
-renameSig (SpecSig v ty using src_loc)
+renameSig lookup_occ_nm (SpecSig v ty using src_loc)
   = pushSrcLocRn src_loc $
-    lookupBndrRn v                     `thenRn` \ new_v ->
-    rnHsSigType (quotes (ppr v)) ty    `thenRn` \ new_ty ->
-    rn_using using                     `thenRn` \ new_using ->
-    returnRn (SpecSig new_v new_ty new_using src_loc)
+    lookup_occ_nm v                    `thenRn` \ new_v ->
+    rnHsSigType (quotes (ppr v)) ty    `thenRn` \ (new_ty,fvs1) ->
+    rn_using using                     `thenRn` \ (new_using,fvs2) ->
+    returnRn (SpecSig new_v new_ty new_using src_loc, fvs1 `plusFV` fvs2)
   where
-    rn_using Nothing  = returnRn Nothing
+    rn_using Nothing  = returnRn (Nothing, emptyFVs)
     rn_using (Just x) = lookupOccRn x `thenRn` \ new_x ->
-                       returnRn (Just new_x)
+                       returnRn (Just new_x, unitFV new_x)
+
+renameSig lookup_occ_nm (InlineSig v src_loc)
+  = pushSrcLocRn src_loc $
+    lookup_occ_nm v            `thenRn` \ new_v ->
+    returnRn (InlineSig new_v src_loc, emptyFVs)
 
-renameSig (InlineSig v src_loc)
+renameSig lookup_occ_nm (FixSig (FixitySig v fix src_loc))
   = pushSrcLocRn src_loc $
-    lookupBndrRn v             `thenRn` \ new_v ->
-    returnRn (InlineSig new_v src_loc)
+    lookup_occ_nm v            `thenRn` \ new_v ->
+    returnRn (FixSig (FixitySig new_v fix src_loc), emptyFVs)
 
-renameSig (MagicUnfoldingSig v str src_loc)
+renameSig lookup_occ_nm (NoInlineSig v src_loc)
   = pushSrcLocRn src_loc $
-    lookupBndrRn v             `thenRn` \ new_v ->
-    returnRn (MagicUnfoldingSig new_v str src_loc)
+    lookup_occ_nm v            `thenRn` \ new_v ->
+    returnRn (NoInlineSig new_v src_loc, emptyFVs)
 \end{code}
 
 Checking for distinct signatures; oh, so boring
 
 \begin{code}
 cmp_sig :: RenamedSig -> RenamedSig -> Ordering
-cmp_sig (Sig n1 _ _)              (Sig n2 _ _)           = n1 `compare` n2
-cmp_sig (InlineSig n1 _)          (InlineSig n2 _)       = n1 `compare` n2
-cmp_sig (MagicUnfoldingSig n1 _ _) (MagicUnfoldingSig n2 _ _) = n1 `compare` n2
-cmp_sig (SpecSig n1 ty1 _ _)       (SpecSig n2 ty2 _ _)
+cmp_sig (Sig n1 _ _)        (Sig n2 _ _)         = n1 `compare` n2
+cmp_sig (InlineSig n1 _)     (InlineSig n2 _)    = n1 `compare` n2
+cmp_sig (NoInlineSig n1 _)   (NoInlineSig n2 _)          = n1 `compare` n2
+cmp_sig (SpecInstSig ty1 _)  (SpecInstSig ty2 _)  = cmpHsType compare ty1 ty2
+cmp_sig (SpecSig n1 ty1 _ _) (SpecSig n2 ty2 _ _) 
   = -- may have many specialisations for one value;
        -- but not ones that are exactly the same...
        thenCmp (n1 `compare` n2) (cmpHsType compare ty1 ty2)
@@ -517,14 +577,10 @@ cmp_sig other_1 other_2                                   -- Tags *must* be different
 sig_tag (Sig n1 _ _)              = (ILIT(1) :: FAST_INT)
 sig_tag (SpecSig n1 _ _ _)        = ILIT(2)
 sig_tag (InlineSig n1 _)          = ILIT(3)
-sig_tag (MagicUnfoldingSig n1 _ _) = ILIT(4)
+sig_tag (NoInlineSig n1 _)        = ILIT(4)
+sig_tag (SpecInstSig _ _)         = ILIT(5)
+sig_tag (FixSig _)                = ILIT(6)
 sig_tag _                         = panic# "tag(RnBinds)"
-
-sig_name (Sig        n _ _)       = n
-sig_name (ClassOpSig n _ _ _)     = n
-sig_name (SpecSig    n _ _ _)     = n
-sig_name (InlineSig  n     _)     = n  
-sig_name (MagicUnfoldingSig n _ _) = n
 \end{code}
 
 %************************************************************************
@@ -536,27 +592,30 @@ sig_name (MagicUnfoldingSig n _ _) = n
 \begin{code}
 dupSigDeclErr (sig:sigs)
   = pushSrcLocRn loc $
-    addErrRn (sep [ptext SLIT("more than one"), 
-                  ptext what_it_is, ptext SLIT("given for"), 
-                  quotes (ppr (sig_name sig))])
+    addErrRn (sep [ptext SLIT("Duplicate"),
+                  ptext what_it_is <> colon,
+                  ppr sig])
   where
     (what_it_is, loc) = sig_doc sig
 
 unknownSigErr sig
   = pushSrcLocRn loc $
-    addErrRn (sep [ptext flavour, ptext SLIT("but no definition for"),
-                  quotes (ppr (sig_name sig))])
+    addErrRn (sep [ptext SLIT("Misplaced"),
+                  ptext what_it_is <> colon,
+                  ppr sig])
   where
-    (flavour, loc) = sig_doc sig
+    (what_it_is, loc) = sig_doc sig
 
-sig_doc (Sig        _ _ loc)       = (SLIT("type signature"),loc)
-sig_doc (ClassOpSig _ _ _ loc)             = (SLIT("class-method type signature"), loc)
-sig_doc (SpecSig    _ _ _ loc)             = (SLIT("SPECIALIZE pragma"),loc)
-sig_doc (InlineSig  _     loc)             = (SLIT("INLINE pragma"),loc)
-sig_doc (MagicUnfoldingSig _ _ loc) = (SLIT("MAGIC_UNFOLDING pragma"),loc)
+sig_doc (Sig        _ _ loc)        = (SLIT("type signature"),loc)
+sig_doc (ClassOpSig _ _ _ loc)              = (SLIT("class-method type signature"), loc)
+sig_doc (SpecSig    _ _ _ loc)              = (SLIT("SPECIALISE pragma"),loc)
+sig_doc (InlineSig  _     loc)              = (SLIT("INLINE pragma"),loc)
+sig_doc (NoInlineSig  _   loc)              = (SLIT("NOINLINE pragma"),loc)
+sig_doc (SpecInstSig _ loc)         = (SLIT("SPECIALISE instance pragma"),loc)
+sig_doc (FixSig (FixitySig _ _ loc)) = (SLIT("fixity declaration"), loc)
 
-missingSigErr var
-  = sep [ptext SLIT("Definition but no type signature for"), quotes (ppr var)]
+missingSigWarn var
+  = sep [ptext SLIT("definition but no type signature for"), quotes (ppr var)]
 
 methodBindErr mbind
  =  hang (ptext SLIT("Can't handle multiple methods defined by one pattern binding"))