projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Added a VECTORISE pragma
[ghc-hetmet.git]
/
compiler
/
hsSyn
/
HsUtils.lhs
diff --git
a/compiler/hsSyn/HsUtils.lhs
b/compiler/hsSyn/HsUtils.lhs
index
ea24327
..
bf75f4c
100644
(file)
--- a/
compiler/hsSyn/HsUtils.lhs
+++ b/
compiler/hsSyn/HsUtils.lhs
@@
-18,9
+18,9
@@
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,
mkHsWrap, mkLHsWrap, mkHsWrapCoI, mkLHsWrapCoI,
- coiToHsWrapper, mkHsDictLet,
+ coiToHsWrapper, mkHsLams, mkHsDictLet,
mkHsOpApp, mkHsDo, mkHsWrapPat, mkHsWrapPatCoI,
nlHsTyApp, nlHsVar, nlHsLit, nlHsApp, nlHsApps, nlHsIntLit, nlHsVarApps,
mkHsOpApp, mkHsDo, mkHsWrapPat, mkHsWrapPatCoI,
nlHsTyApp, nlHsVar, nlHsLit, nlHsApp, nlHsApps, nlHsIntLit, nlHsVarApps,
@@
-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
@@
-159,8
+159,11
@@
mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches))
mkMatchGroup :: [LMatch id] -> MatchGroup id
mkMatchGroup matches = MatchGroup matches placeHolderType
mkMatchGroup :: [LMatch id] -> MatchGroup id
mkMatchGroup matches = MatchGroup matches placeHolderType
+mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr Id -> LHsExpr Id
+mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars <.> mkWpLams dicts) expr
+
mkHsDictLet :: TcEvBinds -> LHsExpr Id -> LHsExpr Id
mkHsDictLet :: TcEvBinds -> LHsExpr Id -> LHsExpr Id
-mkHsDictLet ev_binds expr = mkLHsWrap (WpLet ev_binds) expr
+mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr
mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id
-- Used for constructing dictionary terms etc, so no locations
mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id
-- Used for constructing dictionary terms etc, so no locations
@@
-205,6
+208,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
@@
-225,7
+231,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 }
@@
-329,7
+335,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)
@@
-505,8
+511,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
@@
-571,9
+575,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.