[commit: ghc] master: Renaming and comments in CorePrep (623b8e4)
git at git.haskell.org
git at git.haskell.org
Wed Nov 2 16:51:00 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/623b8e44b1647083ff5d85ef40b7cf88870acef5/ghc
>---------------------------------------------------------------
commit 623b8e44b1647083ff5d85ef40b7cf88870acef5
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Wed Nov 2 16:48:38 2016 +0000
Renaming and comments in CorePrep
In particular I renamed
'triv' to 'arg'
CpeTriv to CpeArg
in Note [CorePrep invariants], with knock on consequences.
This is groundwork for the fix to Trac #11158
>---------------------------------------------------------------
623b8e44b1647083ff5d85ef40b7cf88870acef5
compiler/coreSyn/CorePrep.hs | 46 ++++++++++++++++++++++----------------------
1 file changed, 23 insertions(+), 23 deletions(-)
diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs
index 510b178..efcf0d3 100644
--- a/compiler/coreSyn/CorePrep.hs
+++ b/compiler/coreSyn/CorePrep.hs
@@ -127,17 +127,17 @@ when type erasure is done for conversion to STG, we don't end up with
any trivial or useless bindings.
-Invariants
-~~~~~~~~~~
+Note [CorePrep invariants]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
Here is the syntax of the Core produced by CorePrep:
Trivial expressions
- triv ::= lit | var
- | triv ty | /\a. triv
- | truv co | /\c. triv | triv |> co
+ arg ::= lit | var
+ | arg ty | /\a. arg
+ | truv co | /\c. arg | arg |> co
Applications
- app ::= lit | var | app triv | app ty | app co | app |> co
+ app ::= lit | var | app arg | app ty | app co | app |> co
Expressions
body ::= app
@@ -153,7 +153,7 @@ We define a synonym for each of these non-terminals. Functions
with the corresponding name produce a result in that syntax.
-}
-type CpeTriv = CoreExpr -- Non-terminal 'triv'
+type CpeArg = CoreExpr -- Non-terminal 'arg'
type CpeApp = CoreExpr -- Non-terminal 'app'
type CpeBody = CoreExpr -- Non-terminal 'body'
type CpeRhs = CoreExpr -- Non-terminal 'rhs'
@@ -649,9 +649,9 @@ rhsToBody expr = return (emptyFloats, expr)
-- CpeApp: produces a result satisfying CpeApp
-- ---------------------------------------------------------------------------
-data CpeArg = CpeArg CoreArg
- | CpeCast Coercion
- | CpeTick (Tickish Id)
+data ArgInfo = CpeApp CoreArg
+ | CpeCast Coercion
+ | CpeTick (Tickish Id)
{- Note [runRW arg]
~~~~~~~~~~~~~~~~~~~
@@ -674,16 +674,16 @@ cpeApp top_env expr
where
-- We have a nested data structure of the form
-- e `App` a1 `App` a2 ... `App` an, convert it into
- -- (e, [CpeArg a1, CpeArg a2, ..., CpeArg an], depth)
- -- We use 'CpeArg' because we may also need to
+ -- (e, [CpeApp a1, CpeApp a2, ..., CpeApp an], depth)
+ -- We use 'ArgInfo' because we may also need to
-- record casts and ticks. Depth counts the number
-- of arguments that would consume strictness information
-- (so, no type or coercion arguments.)
- collect_args :: CoreExpr -> (CoreExpr, [CpeArg], Int)
+ collect_args :: CoreExpr -> (CoreExpr, [ArgInfo], Int)
collect_args e = go e [] 0
where
go (App fun arg) as depth
- = go fun (CpeArg arg : as)
+ = go fun (CpeApp arg : as)
(if isTyCoArg arg then depth else depth + 1)
go (Cast fun co) as depth
= go fun (CpeCast co : as) depth
@@ -695,10 +695,10 @@ cpeApp top_env expr
cpe_app :: CorePrepEnv
-> CoreExpr
- -> [CpeArg]
+ -> [ArgInfo]
-> Int
-> UniqSM (Floats, CpeRhs)
- cpe_app env (Var f) (CpeArg Type{} : CpeArg arg : args) depth
+ cpe_app env (Var f) (CpeApp Type{} : CpeApp arg : args) depth
| f `hasKey` lazyIdKey -- Replace (lazy a) with a, and
|| f `hasKey` noinlineIdKey -- Replace (noinline a) with a
-- Consider the code:
@@ -716,13 +716,13 @@ cpeApp top_env expr
-- rather than the far superior "f x y". Test case is par01.
= let (terminal, args', depth') = collect_args arg
in cpe_app env terminal (args' ++ args) (depth + depth' - 1)
- cpe_app env (Var f) [CpeArg _runtimeRep at Type{}, CpeArg _type at Type{}, CpeArg arg] 1
+ cpe_app env (Var f) [CpeApp _runtimeRep at Type{}, CpeApp _type at Type{}, CpeApp arg] 1
| f `hasKey` runRWKey
-- Replace (runRW# f) by (f realWorld#), beta reducing if possible (this
-- is why we return a CorePrepEnv as well)
= case arg of
Lam s body -> cpe_app (extendCorePrepEnv env s realWorldPrimId) body [] 0
- _ -> cpe_app env arg [CpeArg (Var realWorldPrimId)] 1
+ _ -> cpe_app env arg [CpeApp (Var realWorldPrimId)] 1
cpe_app env (Var v) args depth
= do { v1 <- fiddleCCall v
; let e2 = lookupCorePrepEnv env v1
@@ -773,7 +773,7 @@ cpeApp top_env expr
-- all of which are used to possibly saturate this application if it
-- has a constructor or primop at the head.
rebuild_app
- :: [CpeArg] -- The arguments (inner to outer)
+ :: [ArgInfo] -- The arguments (inner to outer)
-> CpeApp
-> Type
-> Floats
@@ -783,11 +783,11 @@ cpeApp top_env expr
MASSERT(null ss) -- make sure we used all the strictness info
return (app, floats)
rebuild_app (a : as) fun' fun_ty floats ss = case a of
- CpeArg arg@(Type arg_ty) ->
+ CpeApp arg@(Type arg_ty) ->
rebuild_app as (App fun' arg) (piResultTy fun_ty arg_ty) floats ss
- CpeArg arg@(Coercion {}) ->
+ CpeApp arg@(Coercion {}) ->
rebuild_app as (App fun' arg) (funResultTy fun_ty) floats ss
- CpeArg arg -> do
+ CpeApp arg -> do
let (ss1, ss_rest) -- See Note [lazyId magic] in MkId
= case (ss, isLazyExpr arg) of
(_ : ss_rest, True) -> (topDmd, ss_rest)
@@ -817,7 +817,7 @@ isLazyExpr _ = False
-- This is where we arrange that a non-trivial argument is let-bound
cpeArg :: CorePrepEnv -> Demand
- -> CoreArg -> Type -> UniqSM (Floats, CpeTriv)
+ -> CoreArg -> Type -> UniqSM (Floats, CpeArg)
cpeArg env dmd arg arg_ty
= do { (floats1, arg1) <- cpeRhsE env arg -- arg1 can be a lambda
; (floats2, arg2) <- if want_float floats1 arg1
More information about the ghc-commits
mailing list