Commit 623b8e44 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

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
parent 13508bad
......@@ -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@Type{}, CpeArg _type@Type{}, CpeArg arg] 1
cpe_app env (Var f) [CpeApp _runtimeRep@Type{}, CpeApp _type@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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment