[project @ 2001-04-30 10:51:18 by simonpj]

[ghc-hetmet.git] / ghc / compiler / rename / RnBinds.lhs

diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs
index 1da2f9c..7b2cf88 100644 (file)
--- a/ghc/compiler/rename/RnBinds.lhs
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -32,7 +32,7 @@ import RnEnv          ( bindLocatedLocalsRn, lookupBndrRn,
                        )
 import CmdLineOpts     ( DynFlag(..) )
 import Digraph         ( stronglyConnComp, SCC(..) )
-import Name            ( OccName, Name, nameOccName, nameSrcLoc )
+import Name            ( Name, nameOccName, nameSrcLoc )
 import NameSet
 import RdrName         ( RdrName, rdrNameOcc )
 import BasicTypes      ( RecFlag(..) )
@@ -167,16 +167,16 @@ rnTopMonoBinds mbinds sigs
        bndr_name_set = mkNameSet binder_names
     in
     renameSigsFVs (okBindSig bndr_name_set) sigs       `thenRn` \ (siglist, sig_fvs) ->
-    doptRn Opt_WarnMissingSigs                         `thenRn` \ warnMissing ->
-    let
-       type_sig_vars   = [n | Sig n _ _ <- siglist]
-       un_sigd_binders | warnMissing = nameSetToList (delListFromNameSet 
-                                                          bndr_name_set type_sig_vars)
-                       | otherwise   = []
-    in
-    mapRn_ missingSigWarn un_sigd_binders      `thenRn_`
 
-    rn_mono_binds siglist mbinds                  `thenRn` \ (final_binds, bind_fvs) ->
+    ifOptRn Opt_WarnMissingSigs (
+       let
+           type_sig_vars   = [n | Sig n _ _ <- siglist]
+           un_sigd_binders = nameSetToList (delListFromNameSet bndr_name_set type_sig_vars)
+       in
+        mapRn_ missingSigWarn un_sigd_binders
+    )                                          `thenRn_`
+
+    rn_mono_binds siglist mbinds               `thenRn` \ (final_binds, bind_fvs) ->
     returnRn (final_binds, bind_fvs `plusFV` sig_fvs)
   where
     binder_rdr_names = collectMonoBinders mbinds
@@ -237,7 +237,7 @@ rnMonoBinds mbinds sigs     thing_inside -- Non-empty monobinds
     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) ->
+    thing_inside binds                            `thenRn` \ (result,result_fvs) ->
     let
        all_fvs        = result_fvs `plusFV` bind_fvs `plusFV` sig_fvs
        unused_binders = nameSetToList (binder_set `minusNameSet` all_fvs)
@@ -263,8 +263,8 @@ This is done {\em either} by pass 3 (for the top-level bindings),
 \begin{code}
 rn_mono_binds :: [RenamedSig]          -- Signatures attached to this group
              -> RdrNameMonoBinds       
-             -> RnMS (RenamedHsBinds,  -- 
-                        FreeVars)      -- Free variables
+             -> RnMS (RenamedHsBinds,  -- Dependency analysed
+                      FreeVars)        -- Free variables
 
 rn_mono_binds siglist mbinds
   =
@@ -385,7 +385,7 @@ rnMethodBinds gen_tyvars (FunMonoBind name inf matches locn)
     returnRn (FunMonoBind sel_name inf new_matches locn, fvs `addOneFV` sel_name)
   where
        -- Gruesome; bring into scope the correct members of the generic type variables
-       -- See comments in RnSource.rnDecl(ClassDecl)
+       -- See comments in RnSource.rnSourceDecl(ClassDecl)
     rn_match match@(Match _ (TypePatIn ty : _) _ _)
        = extendTyVarEnvFVRn gen_tvs (rnMatch match)
        where
@@ -524,6 +524,9 @@ renameSig (SpecInstSig ty src_loc)
     rnHsType (text "A SPECIALISE instance pragma") ty `thenRn` \ new_ty ->
     returnRn (SpecInstSig new_ty src_loc)
 
+renameSig (InlineInstSig p src_loc)
+  = returnRn (InlineInstSig p src_loc)
+
 renameSig (SpecSig v ty src_loc)
   = pushSrcLocRn src_loc $
     lookupSigOccRn v                   `thenRn` \ new_v ->