[project @ 2002-02-11 08:20:38 by chak]

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

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 04531ed..539a81e 100644 (file)
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -11,21 +11,20 @@ module RnHsSyn where
 import HsSyn
 import HsCore
 import Class           ( FunDep, DefMeth(..) )
-import TysWiredIn      ( tupleTyCon, listTyCon, charTyCon )
+import TysWiredIn      ( tupleTyCon, listTyCon, parrTyCon, charTyCon )
 import Name            ( Name, getName, isTyVarName )
 import NameSet
 import BasicTypes      ( Boxity )
-import Maybes          ( orElse )
 import Outputable
 \end{code}
 
 
 \begin{code}
+type RenamedHsDecl             = HsDecl                Name RenamedPat
 type RenamedArithSeqInfo       = ArithSeqInfo          Name RenamedPat
 type RenamedClassOpSig         = Sig                   Name
 type RenamedConDecl            = ConDecl               Name
 type RenamedContext            = HsContext             Name
-type RenamedHsDecl             = HsDecl                Name RenamedPat
 type RenamedRuleDecl           = RuleDecl              Name RenamedPat
 type RenamedTyClDecl           = TyClDecl              Name RenamedPat
 type RenamedDefaultDecl                = DefaultDecl           Name
@@ -34,8 +33,8 @@ type RenamedGRHS              = GRHS                  Name RenamedPat
 type RenamedGRHSs              = GRHSs                 Name RenamedPat
 type RenamedHsBinds            = HsBinds               Name RenamedPat
 type RenamedHsExpr             = HsExpr                Name RenamedPat
-type RenamedHsModule           = HsModule              Name RenamedPat
 type RenamedInstDecl           = InstDecl              Name RenamedPat
+type RenamedMatchContext       = HsMatchContext        Name
 type RenamedMatch              = Match                 Name RenamedPat
 type RenamedMonoBinds          = MonoBinds             Name RenamedPat
 type RenamedPat                        = InPat                 Name
@@ -57,9 +56,10 @@ type RenamedDeprecation              = DeprecDecl            Name
 These free-variable finders returns tycons and classes too.
 
 \begin{code}
-charTyCon_name, listTyCon_name :: Name
+charTyCon_name, listTyCon_name, parrTyCon_name :: Name
 charTyCon_name    = getName charTyCon
 listTyCon_name    = getName listTyCon
+parrTyCon_name    = getName parrTyCon
 
 tupleTyCon_name :: Boxity -> Int -> Name
 tupleTyCon_name boxity n = getName (tupleTyCon boxity n)
@@ -76,6 +76,7 @@ extractHsTyNames ty
   where
     get (HsAppTy ty1 ty2)      = get ty1 `unionNameSets` get ty2
     get (HsListTy ty)          = unitNameSet listTyCon_name `unionNameSets` get ty
+    get (HsPArrTy ty)          = unitNameSet parrTyCon_name `unionNameSets` get ty
     get (HsTupleTy con tys)    = hsTupConFVs con `unionNameSets` extractHsTyNames_s tys
     get (HsFunTy ty1 ty2)      = get ty1 `unionNameSets` get ty2
     get (HsPredTy p)          = extractHsPredTyNames p
@@ -97,9 +98,9 @@ extractHsCtxtTyNames ctxt = foldr (unionNameSets . extractHsPredTyNames) emptyNa
 
 -- You don't import or export implicit parameters,
 -- so don't mention the IP names
-extractHsPredTyNames (HsPClass cls tys)
+extractHsPredTyNames (HsClassP cls tys)
   = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
-extractHsPredTyNames (HsPIParam n ty)
+extractHsPredTyNames (HsIParam n ty)
   = extractHsTyNames ty
 \end{code}
 
@@ -115,20 +116,23 @@ In all cases this is set up for interface-file declarations:
        - for class decls we ignore the bindings
        - for instance decls likewise, plus the pragmas
        - for rule decls, we ignore HsRules
+        - for data decls, we ignore derivings
 
        *** See "THE NAMING STORY" in HsDecls ****
 
 \begin{code}
 tyClDeclFVs :: RenamedTyClDecl -> NameSet
+tyClDeclFVs (ForeignType {})
+  = emptyFVs
+
 tyClDeclFVs (IfaceSig {tcdType = ty, tcdIdInfo = id_infos})
   = extractHsTyNames ty                        `plusFV` 
     plusFVs (map hsIdInfoFVs id_infos)
 
-tyClDeclFVs (TyData {tcdCtxt = context, tcdTyVars = tyvars, tcdCons = condecls, tcdDerivs = derivings})
+tyClDeclFVs (TyData {tcdCtxt = context, tcdTyVars = tyvars, tcdCons = condecls})
   = delFVs (map hsTyVarName tyvars) $
-    extractHsCtxtTyNames context       `plusFV`
-    plusFVs (map conDeclFVs condecls)  `plusFV`
-    mkNameSet (derivings `orElse` [])
+    extractHsCtxtTyNames context               `plusFV`
+    plusFVs (map conDeclFVs condecls)
 
 tyClDeclFVs (TySynonym {tcdTyVars = tyvars, tcdSynRhs = ty})
   = delFVs (map hsTyVarName tyvars) (extractHsTyNames ty)
@@ -166,7 +170,8 @@ instDeclFVs (InstDecl inst_ty _ _ maybe_dfun _)
 
 ----------------
 ruleDeclFVs (HsRule _ _ _ _ _ _) = emptyFVs
-ruleDeclFVs (IfaceRule _ vars _ args rhs _)
+ruleDeclFVs (IfaceRuleOut _ _)  = emptyFVs
+ruleDeclFVs (IfaceRule _ _ vars _ args rhs _)
   = delFVs (map ufBinderName vars) $
     ufExprFVs rhs `plusFV` plusFVs (map ufExprFVs args)
 
@@ -191,7 +196,7 @@ hsIdInfoFVs other        = emptyFVs
 ufExprFVs (UfVar n)      = unitFV n
 ufExprFVs (UfLit l)      = emptyFVs
 ufExprFVs (UfLitLit l ty) = extractHsTyNames ty
-ufExprFVs (UfCCall cc ty) = extractHsTyNames ty
+ufExprFVs (UfFCall cc ty) = extractHsTyNames ty
 ufExprFVs (UfType ty)     = extractHsTyNames ty
 ufExprFVs (UfTuple tc es) = hsTupConFVs tc `plusFV` plusFVs (map ufExprFVs es)
 ufExprFVs (UfLam v e)     = ufBndrFVs v (ufExprFVs e)
@@ -233,8 +238,8 @@ maybeGenericMatch :: RenamedMatch -> Maybe (RenamedHsType, RenamedMatch)
   -- Tells whether a Match is for a generic definition
   -- and extract the type from a generic match and put it at the front
 
-maybeGenericMatch (Match tvs (TypePatIn ty : pats) sig_ty grhss)
-  = Just (ty, Match tvs pats sig_ty grhss)
+maybeGenericMatch (Match (TypePatIn ty : pats) sig_ty grhss)
+  = Just (ty, Match pats sig_ty grhss)
 
 maybeGenericMatch other_match = Nothing
 \end{code}