Do dependency analysis when kind-checking type declarations

[ghc-hetmet.git] / compiler / hsSyn / HsUtils.lhs

diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index ea24327..3ef4bff 100644 (file)
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -18,7 +18,7 @@ module HsUtils(
   -- Terms
   mkHsPar, mkHsApp, mkHsConApp, mkSimpleHsAlt,
   mkSimpleMatch, unguardedGRHSs, unguardedRHS, 
-  mkMatchGroup, mkMatch, mkHsLam,
+  mkMatchGroup, mkMatch, mkHsLam, mkHsIf,
   mkHsWrap, mkLHsWrap, mkHsWrapCoI, mkLHsWrapCoI,
   coiToHsWrapper, mkHsDictLet,
   mkHsOpApp, mkHsDo, mkHsWrapPat, mkHsWrapPatCoI,
@@ -60,7 +60,7 @@ module HsUtils(
   collectLStmtBinders, collectStmtBinders,
   collectSigTysFromPats, collectSigTysFromPat,
 
-  hsTyClDeclBinders, hsTyClDeclsBinders, hsConDeclsBinders, 
+  hsTyClDeclBinders, hsTyClDeclsBinders, 
   hsForeignDeclsBinders, hsGroupBinders
   ) where
 
@@ -205,6 +205,9 @@ noRebindableInfo = error "noRebindableInfo"         -- Just another placeholder;
 
 mkHsDo ctxt stmts body = HsDo ctxt stmts body placeHolderType
 
+mkHsIf :: LHsExpr id -> LHsExpr id -> LHsExpr id -> HsExpr id
+mkHsIf c a b = HsIf (Just noSyntaxExpr) c a b
+
 mkNPat lit neg     = NPat lit neg noSyntaxExpr
 mkNPlusKPat id lit = NPlusKPat id lit noSyntaxExpr noSyntaxExpr
 
@@ -225,7 +228,7 @@ mkBindStmt pat expr = BindStmt pat expr noSyntaxExpr noSyntaxExpr
 emptyRecStmt = RecStmt { recS_stmts = [], recS_later_ids = [], recS_rec_ids = []
                        , recS_ret_fn = noSyntaxExpr, recS_mfix_fn = noSyntaxExpr
                       , recS_bind_fn = noSyntaxExpr
-                       , recS_rec_rets = [], recS_dicts = emptyTcEvBinds }
+                       , recS_rec_rets = [] }
 
 mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
 
@@ -329,7 +332,7 @@ nlList   :: [LHsExpr id] -> LHsExpr id
 
 nlHsLam        match           = noLoc (HsLam (mkMatchGroup [match]))
 nlHsPar e              = noLoc (HsPar e)
-nlHsIf cond true false = noLoc (HsIf cond true false)
+nlHsIf cond true false = noLoc (mkHsIf cond true false)
 nlHsCase expr matches  = noLoc (HsCase expr (mkMatchGroup matches))
 nlList exprs           = noLoc (ExplicitList placeHolderType exprs)
 
@@ -505,8 +508,6 @@ collect_lpat (L _ pat) bndrs
   = go pat
   where
     go (VarPat var)              = var : bndrs
-    go (VarPatOut var _)         = var : bndrs
-       -- See Note [Dictionary binders in ConPatOut]
     go (WildPat _)               = bndrs
     go (LazyPat pat)             = collect_lpat pat bndrs
     go (BangPat pat)             = collect_lpat pat bndrs
@@ -571,9 +572,10 @@ hsForeignDeclsBinders :: [LForeignDecl Name] -> [Name]
 hsForeignDeclsBinders foreign_decls
   = [n | L _ (ForeignImport (L _ n) _ _) <- foreign_decls]
 
-hsTyClDeclsBinders :: [Located (TyClDecl Name)] -> [Located (InstDecl Name)] -> [Name]
+hsTyClDeclsBinders :: [[LTyClDecl Name]] -> [Located (InstDecl Name)] -> [Name]
 hsTyClDeclsBinders tycl_decls inst_decls
-  = [n | d <- instDeclATs inst_decls ++ tycl_decls, L _ n <- hsTyClDeclBinders d]
+  = [n | d <- instDeclATs inst_decls ++ concat tycl_decls
+       , L _ n <- hsTyClDeclBinders d]
 
 hsTyClDeclBinders :: Eq name => Located (TyClDecl name) -> [Located name]
 -- ^ Returns all the /binding/ names of the decl, along with their SrcLocs.