[project @ 2003-11-17 14:41:58 by simonmar]

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

diff --git a/ghc/compiler/rename/RnTypes.lhs b/ghc/compiler/rename/RnTypes.lhs
index 4b6f799..cc0f0f3 100644 (file)
--- a/ghc/compiler/rename/RnTypes.lhs
+++ b/ghc/compiler/rename/RnTypes.lhs
@@ -5,8 +5,8 @@
 
 \begin{code}
 module RnTypes ( rnHsType, rnContext, 
-                rnHsSigType, rnHsTypeFVs, rnHsSigTypeFVs, 
-                rnPat, rnPats, rnPatsAndThen,  -- Here because it's not part 
+                rnHsSigType, rnHsTypeFVs,
+                rnPat, rnPatsAndThen,  -- Here because it's not part 
                 rnOverLit, litFVs,             -- of any mutual recursion      
                 precParseErr, sectionPrecErr, dupFieldErr, patSigErr, checkTupSize
   ) where
@@ -57,11 +57,6 @@ rnHsTypeFVs doc_str ty
   = rnHsType doc_str ty                `thenM` \ ty' ->
     returnM (ty', extractHsTyNames ty')
 
-rnHsSigTypeFVs :: SDoc -> RdrNameHsType -> RnM (RenamedHsType, FreeVars)
-rnHsSigTypeFVs doc_str ty
-  = rnHsSigType doc_str ty     `thenM` \ ty' ->
-    returnM (ty', extractHsTyNames ty')
-
 rnHsSigType :: SDoc -> RdrNameHsType -> RnM RenamedHsType
        -- rnHsSigType is used for source-language type signatures,
        -- which use *implicit* universal quantification.
@@ -75,7 +70,7 @@ want a gratuitous knot.
 \begin{code}
 rnHsType :: SDoc -> RdrNameHsType -> RnM RenamedHsType
 
-rnHsType doc (HsForAllTy Nothing ctxt ty)
+rnHsType doc (HsForAllTy Implicit _ ctxt ty)
        -- Implicit quantifiction in source code (no kinds on tyvars)
        -- Given the signature  C => T  we universally quantify 
        -- over FV(T) \ {in-scope-tyvars} 
@@ -89,9 +84,9 @@ rnHsType doc (HsForAllTy Nothing ctxt ty)
        --      class C a where { op :: a -> a }
        forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env)) mentioned
     in
-    rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
+    rnForAll doc Implicit (map UserTyVar forall_tyvars) ctxt ty
 
-rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
+rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau)
        -- Explicit quantification.
        -- Check that the forall'd tyvars are actually 
        -- mentioned in the type, and produce a warning if not
@@ -103,7 +98,7 @@ rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
        warn_guys = filter (`notElem` mentioned) forall_tyvar_names
     in
     mappM_ (forAllWarn doc tau) warn_guys      `thenM_`
-    rnForAll doc forall_tyvars ctxt tau
+    rnForAll doc Explicit forall_tyvars ctxt tau
 
 rnHsType doc (HsTyVar tyvar)
   = lookupOccRn tyvar          `thenM` \ tyvar' ->
@@ -167,11 +162,22 @@ rnHsTypes doc tys = mappM (rnHsType doc) tys
 
 
 \begin{code}
-rnForAll doc forall_tyvars ctxt ty
+rnForAll doc exp [] [] ty = rnHsType doc ty
+       -- One reason for this case is that a type like Int#
+       -- starts of as (HsForAllTy Nothing [] Int), in case
+       -- there is some quantification.  Now that we have quantified
+       -- and discovered there are no type variables, it's nicer to turn
+       -- it into plain Int.  If it were Int# instead of Int, we'd actually
+       -- get an error, because the body of a genuine for-all is
+       -- of kind *.
+
+rnForAll doc exp forall_tyvars ctxt ty
   = bindTyVarsRn doc forall_tyvars     $ \ new_tyvars ->
     rnContext doc ctxt                 `thenM` \ new_ctxt ->
     rnHsType doc ty                    `thenM` \ new_ty ->
-    returnM (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty)
+    returnM (HsForAllTy exp new_tyvars new_ctxt new_ty)
+       -- Retain the same implicit/explicit flag as before
+       -- so that we can later print it correctly
 \end{code}