[project @ 2002-05-27 15:28:07 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 1ec05fa..af0f982 100644 (file)
--- a/ghc/compiler/rename/RnBinds.lhs
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -26,8 +26,8 @@ import RnHsSyn
 import RnMonad
 import RnTypes         ( rnHsSigType, rnHsType )
 import RnExpr          ( rnMatch, rnGRHSs, rnPat, checkPrecMatch )
-import RnEnv           ( bindLocatedLocalsRn, lookupBndrRn, 
-                         lookupGlobalOccRn, lookupSigOccRn,
+import RnEnv           ( bindLocatedLocalsRn, lookupBndrRn, lookupInstDeclBndr,
+                         lookupSigOccRn, bindPatSigTyVars, extendNestedFixityEnv,
                          warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
                        )
 import CmdLineOpts     ( DynFlag(..) )
@@ -162,7 +162,8 @@ rnTopBinds (MonoBind bind sigs _)     = rnTopMonoBinds bind sigs
 
 
 rnTopMonoBinds mbinds sigs
- =  mapRn lookupBndrRn binder_rdr_names                `thenRn` \ binder_names ->
+ =  mapRn lookupBndrRn binder_rdr_names                         `thenRn` \ binder_names ->
+    bindPatSigTyVars (collectSigTysFromMonoBinds mbinds) $ 
     let
        bndr_name_set = mkNameSet binder_names
     in
@@ -217,7 +218,8 @@ 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 doc mbinders_w_srclocs $ \ new_mbinders ->
+    bindLocatedLocalsRn doc mbinders_w_srclocs                 $ \ new_mbinders ->
+    bindPatSigTyVars (collectSigTysFromMonoBinds mbinds)       $ 
     let
        binder_set = mkNameSet new_mbinders
     in
@@ -231,7 +233,7 @@ rnMonoBinds mbinds sigs     thing_inside -- Non-empty monobinds
     let
        fixity_sigs = [(name,sig) | FixSig sig@(FixitySig name _ _) <- siglist ]
     in
-    extendFixityEnv fixity_sigs $
+    extendNestedFixityEnv fixity_sigs $
 
     rn_mono_binds siglist mbinds          `thenRn` \ (binds, bind_fvs) ->
 
@@ -365,21 +367,22 @@ in many ways the @op@ in an instance decl is just like an occurrence, not
 a binder.
 
 \begin{code}
-rnMethodBinds :: [Name]                        -- Names for generic type variables
+rnMethodBinds :: Name                  -- Class name
+             -> [Name]                 -- Names for generic type variables
              -> RdrNameMonoBinds
              -> RnMS (RenamedMonoBinds, FreeVars)
 
-rnMethodBinds gen_tyvars EmptyMonoBinds = returnRn (EmptyMonoBinds, emptyFVs)
+rnMethodBinds cls gen_tyvars EmptyMonoBinds = returnRn (EmptyMonoBinds, emptyFVs)
 
-rnMethodBinds gen_tyvars (AndMonoBinds mb1 mb2)
-  = rnMethodBinds gen_tyvars mb1       `thenRn` \ (mb1', fvs1) ->
-    rnMethodBinds gen_tyvars mb2       `thenRn` \ (mb2', fvs2) ->
+rnMethodBinds cls gen_tyvars (AndMonoBinds mb1 mb2)
+  = rnMethodBinds cls gen_tyvars mb1   `thenRn` \ (mb1', fvs1) ->
+    rnMethodBinds cls gen_tyvars mb2   `thenRn` \ (mb2', fvs2) ->
     returnRn (mb1' `AndMonoBinds` mb2', fvs1 `plusFV` fvs2)
 
-rnMethodBinds gen_tyvars (FunMonoBind name inf matches locn)
+rnMethodBinds cls gen_tyvars (FunMonoBind name inf matches locn)
   = pushSrcLocRn locn                                  $
 
-    lookupGlobalOccRn name                             `thenRn` \ sel_name -> 
+    lookupInstDeclBndr cls name                                `thenRn` \ sel_name -> 
        -- We use the selector name as the binder
 
     mapFvRn rn_match matches                           `thenRn` \ (new_matches, fvs) ->
@@ -388,7 +391,7 @@ rnMethodBinds gen_tyvars (FunMonoBind name inf matches locn)
   where
        -- Gruesome; bring into scope the correct members of the generic type variables
        -- See comments in RnSource.rnSourceDecl(ClassDecl)
-    rn_match match@(Match _ (TypePatIn ty : _) _ _)
+    rn_match match@(Match (TypePatIn ty : _) _ _)
        = extendTyVarEnvFVRn gen_tvs (rnMatch (FunRhs name) match)
        where
          tvs     = map rdrNameOcc (extractHsTyRdrNames ty)
@@ -398,7 +401,7 @@ rnMethodBinds gen_tyvars (FunMonoBind name inf matches locn)
        
 
 -- Can't handle method pattern-bindings which bind multiple methods.
-rnMethodBinds gen_tyvars mbind@(PatMonoBind other_pat _ locn)
+rnMethodBinds cls gen_tyvars mbind@(PatMonoBind other_pat _ locn)
   = pushSrcLocRn locn  $
     failWithRn (EmptyMonoBinds, emptyFVs) (methodBindErr mbind)
 \end{code}
@@ -537,15 +540,10 @@ renameSig (FixSig (FixitySig v fix src_loc))
     lookupSigOccRn v           `thenRn` \ new_v ->
     returnRn (FixSig (FixitySig new_v fix src_loc))
 
-renameSig (InlineSig v p src_loc)
+renameSig (InlineSig b v p src_loc)
   = pushSrcLocRn src_loc $
     lookupSigOccRn v           `thenRn` \ new_v ->
-    returnRn (InlineSig new_v p src_loc)
-
-renameSig (NoInlineSig v p src_loc)
-  = pushSrcLocRn src_loc $
-    lookupSigOccRn v           `thenRn` \ new_v ->
-    returnRn (NoInlineSig new_v p src_loc)
+    returnRn (InlineSig b new_v p src_loc)
 \end{code}
 
 
@@ -558,14 +556,14 @@ renameSig (NoInlineSig v p src_loc)
 \begin{code}
 dupSigDeclErr sig
   = pushSrcLocRn loc $
-    addErrRn (sep [ptext SLIT("Duplicate") <+> ptext what_it_is <> colon,
+    addErrRn (sep [ptext SLIT("Duplicate") <+> what_it_is <> colon,
                   ppr sig])
   where
     (what_it_is, loc) = hsSigDoc sig
 
 unknownSigErr sig
   = pushSrcLocRn loc $
-    addErrRn (sep [ptext SLIT("Misplaced") <+> ptext what_it_is <> colon,
+    addErrRn (sep [ptext SLIT("Misplaced") <+> what_it_is <> colon,
                   ppr sig])
   where
     (what_it_is, loc) = hsSigDoc sig