diff options
| author | Luke Maurer <maurerl@cs.uoregon.edu> | 2017-02-01 11:56:01 -0500 |
|---|---|---|
| committer | David Feuer <David.Feuer@gmail.com> | 2017-02-01 13:44:52 -0500 |
| commit | 8d5cf8bf584fd4849917c29d82dcf46ee75dd035 (patch) | |
| tree | 9d1b012562fd7ec1d1089b7d87e061884ba71f1c /compiler/iface/TcIface.hs | |
| parent | 4fa439e3ee2822f893bd364a6cbfe410a0c1e29f (diff) | |
| download | haskell-8d5cf8bf584fd4849917c29d82dcf46ee75dd035.tar.gz | |
Join points
This major patch implements Join Points, as described in
https://ghc.haskell.org/trac/ghc/wiki/SequentCore. You have
to read that page, and especially the paper it links to, to
understand what's going on; but it is very cool.
It's Luke Maurer's work, but done in close collaboration with Simon PJ.
This Phab is a squash-merge of wip/join-points branch of
http://github.com/lukemaurer/ghc. There are many, many interdependent
changes.
Reviewers: goldfire, mpickering, bgamari, simonmar, dfeuer, austin
Subscribers: simonpj, dfeuer, mpickering, Mikolaj, thomie
Differential Revision: https://phabricator.haskell.org/D2853
Diffstat (limited to 'compiler/iface/TcIface.hs')
| -rw-r--r-- | compiler/iface/TcIface.hs | 13 |
1 files changed, 9 insertions, 4 deletions
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index e08a3d71f6..f6a4f41965 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -1367,12 +1367,13 @@ tcIfaceExpr (IfaceCase scrut case_bndr alts) = do alts' <- mapM (tcIfaceAlt scrut' tc_app) alts return (Case scrut' case_bndr' (coreAltsType alts') alts') -tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info) rhs) body) +tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body) = do { name <- newIfaceName (mkVarOccFS fs) ; ty' <- tcIfaceType ty ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} name ty' info ; let id = mkLocalIdOrCoVarWithInfo name ty' id_info + `asJoinId_maybe` tcJoinInfo ji ; rhs' <- tcIfaceExpr rhs ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body) ; return (Let (NonRec id rhs') body') } @@ -1384,11 +1385,11 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body) ; body' <- tcIfaceExpr body ; return (Let (Rec pairs') body') } } where - tc_rec_bndr (IfLetBndr fs ty _) + tc_rec_bndr (IfLetBndr fs ty _ ji) = do { name <- newIfaceName (mkVarOccFS fs) ; ty' <- tcIfaceType ty - ; return (mkLocalIdOrCoVar name ty') } - tc_pair (IfLetBndr _ _ info, rhs) id + ; return (mkLocalIdOrCoVar name ty' `asJoinId_maybe` tcJoinInfo ji) } + tc_pair (IfLetBndr _ _ info _, rhs) id = do { rhs' <- tcIfaceExpr rhs ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} (idName id) (idType id) info @@ -1509,6 +1510,10 @@ tcIdInfo ignore_prags name ty info = do | otherwise = info ; return (info1 `setUnfoldingInfo` unf) } +tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity +tcJoinInfo (IfaceJoinPoint ar) = Just ar +tcJoinInfo IfaceNotJoinPoint = Nothing + tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding tcUnfolding name _ info (IfCoreUnfold stable if_expr) = do { dflags <- getDynFlags |