projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
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
f01fb6e
..
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,
-- 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,
mkHsWrap, mkLHsWrap, mkHsWrapCoI, mkLHsWrapCoI,
coiToHsWrapper, mkHsDictLet,
mkHsOpApp, mkHsDo, mkHsWrapPat, mkHsWrapPatCoI,
@@
-28,7
+28,7
@@
module HsUtils(
mkLHsTupleExpr, mkLHsVarTuple, missingTupArg,
-- Bindigns
mkLHsTupleExpr, mkLHsVarTuple, missingTupArg,
-- Bindigns
- mkFunBind, mkVarBind, mkHsVarBind, mk_easy_FunBind, mk_FunBind,
+ mkFunBind, mkVarBind, mkHsVarBind, mk_easy_FunBind,
-- Literals
mkHsIntegral, mkHsFractional, mkHsIsString, mkHsString,
-- Literals
mkHsIntegral, mkHsFractional, mkHsIsString, mkHsString,
@@
-60,7
+60,7
@@
module HsUtils(
collectLStmtBinders, collectStmtBinders,
collectSigTysFromPats, collectSigTysFromPat,
collectLStmtBinders, collectStmtBinders,
collectSigTysFromPats, collectSigTysFromPat,
- hsTyClDeclBinders, hsTyClDeclsBinders, hsConDeclsBinders,
+ hsTyClDeclBinders, hsTyClDeclsBinders,
hsForeignDeclsBinders, hsGroupBinders
) where
hsForeignDeclsBinders, hsGroupBinders
) where
@@
-81,7
+81,6
@@
import NameSet
import BasicTypes
import SrcLoc
import FastString
import BasicTypes
import SrcLoc
import FastString
-import Outputable
import Util
import Bag
\end{code}
import Util
import Bag
\end{code}
@@
-206,6
+205,9
@@
noRebindableInfo = error "noRebindableInfo" -- Just another placeholder;
mkHsDo ctxt stmts body = HsDo ctxt stmts body placeHolderType
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
mkNPat lit neg = NPat lit neg noSyntaxExpr
mkNPlusKPat id lit = NPlusKPat id lit noSyntaxExpr noSyntaxExpr
@@
-226,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
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 }
mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
@@
-330,7
+332,7
@@
nlList :: [LHsExpr id] -> LHsExpr id
nlHsLam match = noLoc (HsLam (mkMatchGroup [match]))
nlHsPar e = noLoc (HsPar e)
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)
nlHsCase expr matches = noLoc (HsCase expr (mkMatchGroup matches))
nlList exprs = noLoc (ExplicitList placeHolderType exprs)
@@
-394,17
+396,6
@@
mk_easy_FunBind loc fun pats expr
= L loc $ mkFunBind (L loc fun) [mkMatch pats expr emptyLocalBinds]
------------
= L loc $ mkFunBind (L loc fun) [mkMatch pats expr emptyLocalBinds]
------------
-mk_FunBind :: SrcSpan -> id
- -> [([LPat id], LHsExpr id)]
- -> LHsBind id
-
-mk_FunBind _ _ [] = panic "TcGenDeriv:mk_FunBind"
-mk_FunBind loc fun pats_and_exprs
- = L loc $ mkFunBind (L loc fun) matches
- where
- matches = [mkMatch p e emptyLocalBinds | (p,e) <-pats_and_exprs]
-
-------------
mkMatch :: [LPat id] -> LHsExpr id -> HsLocalBinds id -> LMatch id
mkMatch pats expr binds
= noLoc (Match (map paren pats) Nothing
mkMatch :: [LPat id] -> LHsExpr id -> HsLocalBinds id -> LMatch id
mkMatch pats expr binds
= noLoc (Match (map paren pats) Nothing
@@
-517,8
+508,6
@@
collect_lpat (L _ pat) bndrs
= go pat
where
go (VarPat var) = var : 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
go (WildPat _) = bndrs
go (LazyPat pat) = collect_lpat pat bndrs
go (BangPat pat) = collect_lpat pat bndrs
@@
-583,9
+572,10
@@
hsForeignDeclsBinders :: [LForeignDecl Name] -> [Name]
hsForeignDeclsBinders foreign_decls
= [n | L _ (ForeignImport (L _ n) _ _) <- foreign_decls]
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
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.
hsTyClDeclBinders :: Eq name => Located (TyClDecl name) -> [Located name]
-- ^ Returns all the /binding/ names of the decl, along with their SrcLocs.