[project @ 2000-03-02 15:36:46 by panne]

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

diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs
index c29ecd9..d06319d 100644 (file)
--- a/ghc/compiler/rename/RnBinds.lhs
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -519,6 +519,8 @@ renameSigs sigs_required binders lookup_occ_nm sigs
 -- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
 -- Doesn't seem worth much trouble to sort this.
 
+renameSig :: (RdrName -> RnMS Name) -> Sig RdrName -> RnMS (Sig Name, FreeVars)
+
 renameSig lookup_occ_nm (Sig v ty src_loc)
   = pushSrcLocRn src_loc $
     lookup_occ_nm v                            `thenRn` \ new_v ->
@@ -536,29 +538,60 @@ renameSig lookup_occ_nm (SpecSig v ty src_loc)
     rnHsSigType (quotes (ppr v)) ty    `thenRn` \ (new_ty,fvs) ->
     returnRn (SpecSig new_v new_ty src_loc, fvs `addOneFV` new_v)
 
-renameSig lookup_occ_nm (InlineSig v src_loc)
+renameSig lookup_occ_nm (FixSig (FixitySig v fix src_loc))
   = pushSrcLocRn src_loc $
     lookup_occ_nm v            `thenRn` \ new_v ->
-    returnRn (InlineSig new_v src_loc, unitFV new_v)
+    returnRn (FixSig (FixitySig new_v fix src_loc), unitFV new_v)
 
-renameSig lookup_occ_nm (FixSig (FixitySig v fix src_loc))
+renameSig lookup_occ_nm (DeprecSig (Deprecation ie txt) src_loc)
+  = pushSrcLocRn src_loc $
+    renameIE lookup_occ_nm ie  `thenRn` \ (new_ie, fvs) ->
+    returnRn (DeprecSig (Deprecation new_ie txt) src_loc, fvs)
+
+renameSig lookup_occ_nm (InlineSig v p src_loc)
   = pushSrcLocRn src_loc $
     lookup_occ_nm v            `thenRn` \ new_v ->
-    returnRn (FixSig (FixitySig new_v fix src_loc), unitFV new_v)
+    returnRn (InlineSig new_v p src_loc, unitFV new_v)
 
-renameSig lookup_occ_nm (NoInlineSig v src_loc)
+renameSig lookup_occ_nm (NoInlineSig v p src_loc)
   = pushSrcLocRn src_loc $
     lookup_occ_nm v            `thenRn` \ new_v ->
-    returnRn (NoInlineSig new_v src_loc, unitFV new_v)
+    returnRn (NoInlineSig new_v p src_loc, unitFV new_v)
+\end{code}
+
+\begin{code}
+renameIE :: (RdrName -> RnMS Name) -> IE RdrName -> RnMS (IE Name, FreeVars)
+renameIE lookup_occ_nm (IEVar v)
+  = lookup_occ_nm v            `thenRn` \ new_v ->
+    returnRn (IEVar new_v, unitFV new_v)
+
+renameIE lookup_occ_nm (IEThingAbs v)
+  = lookup_occ_nm v            `thenRn` \ new_v ->
+    returnRn (IEThingAbs new_v, unitFV new_v)
+
+renameIE lookup_occ_nm (IEThingAll v)
+  = lookup_occ_nm v            `thenRn` \ new_v ->
+    returnRn (IEThingAll new_v, unitFV new_v)
+
+renameIE lookup_occ_nm (IEThingWith v vs)
+  = lookup_occ_nm v            `thenRn` \ new_v ->
+    mapRn lookup_occ_nm vs     `thenRn` \ new_vs ->
+    returnRn (IEThingWith new_v new_vs, plusFVs [ unitFV x | x <- new_v:new_vs ])
+
+renameIE lookup_occ_nm (IEModuleContents m)
+  = returnRn (IEModuleContents m, 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 (NoInlineSig n1 _)   (NoInlineSig n2 _)          = n1 `compare` n2
+cmp_sig (Sig n1 _ _)         (Sig n2 _ _)         = n1 `compare` n2
+cmp_sig (DeprecSig (Deprecation ie1 _) _)
+        (DeprecSig (Deprecation ie2 _) _)         = cmp_ie ie1 ie2
+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;
@@ -569,12 +602,21 @@ cmp_sig other_1 other_2                                   -- Tags *must* be different
   | (sig_tag other_1) _LT_ (sig_tag other_2) = LT 
   | otherwise                               = GT
 
+cmp_ie :: IE Name -> IE Name -> Ordering
+cmp_ie (IEVar            n1  ) (IEVar            n2  ) = n1 `compare` n2
+cmp_ie (IEThingAbs       n1  ) (IEThingAbs       n2  ) = n1 `compare` n2
+cmp_ie (IEThingAll       n1  ) (IEThingAll       n2  ) = n1 `compare` n2
+-- Hmmm...
+cmp_ie (IEThingWith      n1 _) (IEThingWith      n2 _) = n1 `compare` n2
+cmp_ie (IEModuleContents _   ) (IEModuleContents _   ) = EQ
+
 sig_tag (Sig n1 _ _)              = (ILIT(1) :: FAST_INT)
 sig_tag (SpecSig n1 _ _)          = ILIT(2)
-sig_tag (InlineSig n1 _)          = ILIT(3)
-sig_tag (NoInlineSig n1 _)        = ILIT(4)
+sig_tag (InlineSig n1 _ _)        = ILIT(3)
+sig_tag (NoInlineSig n1 _ _)      = ILIT(4)
 sig_tag (SpecInstSig _ _)         = ILIT(5)
 sig_tag (FixSig _)                = ILIT(6)
+sig_tag (DeprecSig _ _)                   = ILIT(7)
 sig_tag _                         = panic# "tag(RnBinds)"
 \end{code}
 
@@ -601,12 +643,13 @@ unknownSigErr 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 (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 (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)
+sig_doc (DeprecSig _ loc)            = (SLIT("DEPRECATED pragma"), loc)
 
 missingSigWarn var
   = sep [ptext SLIT("definition but no type signature for"), quotes (ppr var)]