diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2016-11-02 16:48:38 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2016-11-02 16:50:28 +0000 |
commit | 623b8e44b1647083ff5d85ef40b7cf88870acef5 (patch) | |
tree | 3f402ca7e2c487aff281c199a8e53227626d0211 /compiler/coreSyn/CorePrep.hs | |
parent | 13508bad4810d4fa8581afbcb4f41c97fe4c92e2 (diff) | |
download | haskell-623b8e44b1647083ff5d85ef40b7cf88870acef5.tar.gz |
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
Diffstat (limited to 'compiler/coreSyn/CorePrep.hs')
-rw-r--r-- | compiler/coreSyn/CorePrep.hs | 46 |
1 files changed, 23 insertions, 23 deletions
diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 510b178b8b..efcf0d3b3a 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@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 |