[project @ 2005-01-27 10:44:00 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 3d88d32..291a65e 100644 (file)
--- a/ghc/compiler/rename/RnBinds.lhs
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -27,7 +27,7 @@ import RnExpr         ( rnMatchGroup, rnMatch, rnGRHSs, checkPrecMatch )
 import RnEnv           ( bindLocatedLocalsRn, lookupLocatedBndrRn, 
                          lookupLocatedInstDeclBndr,
                          lookupLocatedSigOccRn, bindPatSigTyVars, bindPatSigTyVarsFV,
-                         bindLocalFixities,
+                         bindLocalFixities, bindSigTyVarsFV, 
                          warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
                        )
 import CmdLineOpts     ( DynFlag(..) )
@@ -162,12 +162,25 @@ rnTopBinds :: LHsBinds RdrName
 -- the top level scope resolution does that
 
 rnTopBinds mbinds sigs
- =  bindPatSigTyVars (collectSigTysFromHsBinds (bagToList mbinds)) $ \ _ -> 
-       -- Hmm; by analogy with Ids, this doesn't look right
-       -- Top-level bound type vars should really scope over 
-       -- everything, but we only scope them over the other bindings
-
-    rnBinds TopLevel mbinds sigs
+ =  do { is_boot <- tcIsHsBoot
+       ; if is_boot then
+               rnHsBoot mbinds sigs
+         else  bindPatSigTyVars (collectSigTysFromHsBinds (bagToList mbinds)) $ \ _ -> 
+                       -- Hmm; by analogy with Ids, this doesn't look right
+                       -- Top-level bound type vars should really scope over 
+                       -- everything, but we only scope them over the other bindings
+               rnBinds TopLevel mbinds sigs }
+
+rnHsBoot :: LHsBinds RdrName
+          -> [LSig RdrName]
+          -> RnM ([HsBindGroup Name], DefUses)
+-- A hs-boot file has no bindings. 
+-- Return a single HsBindGroup with empty binds and renamed signatures
+rnHsBoot mbinds sigs
+  = do { checkErr (isEmptyLHsBinds mbinds) (bindsInHsBootFile mbinds)
+       ; sigs' <- renameSigs sigs
+       ; return ([HsBindGroup emptyLHsBinds sigs' NonRecursive], 
+                 usesOnly (hsSigsFVs sigs')) }
 \end{code}
 
 
@@ -298,7 +311,9 @@ mkBindVertex sigs (L loc (PatBind pat grhss ty))
        names_bound_here = mkNameSet (collectPatBinders pat')
     in
     sigsForMe names_bound_here sigs    `thenM` \ sigs_for_me ->
-    rnGRHSs PatBindRhs grhss           `thenM` \ (grhss', fvs) ->
+    bindSigTyVarsFV sigs_for_me (
+        rnGRHSs PatBindRhs grhss
+    )                                  `thenM` \ (grhss', fvs) ->
     returnM 
        (names_bound_here, fvs `plusFV` pat_fvs,
          L loc (PatBind pat' grhss' ty), sigs_for_me
@@ -312,7 +327,9 @@ mkBindVertex sigs (L loc (FunBind name inf matches))
        names_bound_here = unitNameSet plain_name
     in
     sigsForMe names_bound_here sigs                    `thenM` \ sigs_for_me ->
-    rnMatchGroup (FunRhs plain_name) matches           `thenM` \ (new_matches, fvs) ->
+    bindSigTyVarsFV sigs_for_me (
+       rnMatchGroup (FunRhs plain_name) matches
+    )                                                  `thenM` \ (new_matches, fvs) ->
     checkPrecMatch inf plain_name new_matches          `thenM_`
     returnM
       (unitNameSet plain_name, fvs,
@@ -478,7 +495,7 @@ checkSigs ok_sig sigs
 -- Doesn't seem worth much trouble to sort this.
 
 renameSigs :: [LSig RdrName] -> RnM [LSig Name]
-renameSigs sigs = mappM (wrapLocM renameSig) (filter (not . isFixitySig . unLoc) sigs)
+renameSigs sigs = mappM (wrapLocM renameSig) (filter (not . isFixityLSig) sigs)
        -- Remove fixity sigs which have been dealt with already
 
 renameSig :: Sig RdrName -> RnM (Sig Name)
@@ -532,5 +549,9 @@ missingSigWarn var
 
 methodBindErr mbind
  =  hang (ptext SLIT("Pattern bindings (except simple variables) not allowed in instance declarations"))
-       4 (ppr mbind)
+       2 (ppr mbind)
+
+bindsInHsBootFile mbinds
+  = hang (ptext SLIT("Bindings in hs-boot files are not allowed"))
+       2 (ppr mbinds)
 \end{code}