Skip to content
Browse files

Float coercions out of lets

Note [Float coercions]
~~~~~~~~~~~~~~~~~~~~~~
When we find the binding
	x = e `cast` co
we'd like to transform it to
	x' = e
	x = x `cast` co		-- A trivial binding
There's a chance that e will be a constructor application or function, or something
like that, so moving the coerion to the usage site may well cancel the coersions
and lead to further optimisation.  Example:

     data family T a :: *
     data instance T Int = T Int

     foo :: Int -> Int -> Int
     foo m n = ...
        where
          x = T m
          go 0 = 0
          go n = case x of { T m -> go (n-m) }
		-- This case should optimise
  • Loading branch information...
1 parent aae14ad commit b041525cb968351c4b790639820e99a9d232ea0c simonpj@microsoft.com committed Oct 5, 2006
Showing with 37 additions and 3 deletions.
  1. +37 −3 compiler/simplCore/Simplify.lhs
View
40 compiler/simplCore/Simplify.lhs
@@ -1152,7 +1152,6 @@ N Y Non-top-level and non-recursive, Bind args of lifted type, or
Y Y Non-top-level, non-recursive, Bind all args
and strict (demanded)
-
For example, given
x = MkC (y div# z)
@@ -1165,13 +1164,42 @@ because the (y div# z) can't float out of the let. But if it was
a *strict* let, then it would be a good thing to do. Hence the
context information.
+Note [Float coercions]
+~~~~~~~~~~~~~~~~~~~~~~
+When we find the binding
+ x = e `cast` co
+we'd like to transform it to
+ x' = e
+ x = x `cast` co -- A trivial binding
+There's a chance that e will be a constructor application or function, or something
+like that, so moving the coerion to the usage site may well cancel the coersions
+and lead to further optimisation. Example:
+
+ data family T a :: *
+ data instance T Int = T Int
+
+ foo :: Int -> Int -> Int
+ foo m n = ...
+ where
+ x = T m
+ go 0 = 0
+ go n = case x of { T m -> go (n-m) }
+ -- This case should optimise
+
\begin{code}
mkAtomicArgsE :: SimplEnv
- -> Bool -- A strict binding
- -> OutExpr -- The rhs
+ -> Bool -- A strict binding
+ -> OutExpr -- The rhs
-> (SimplEnv -> OutExpr -> SimplM FloatsWithExpr)
+ -- Consumer for the simpler rhs
-> SimplM FloatsWithExpr
+mkAtomicArgsE env is_strict (Cast rhs co) thing_inside
+ -- Note [Float coersions]
+ = do { id <- newId FSLIT("a") (exprType rhs)
+ ; completeNonRecX env False id id rhs $ \ env ->
+ thing_inside env (Cast (Var id) co) }
+
mkAtomicArgsE env is_strict rhs thing_inside
| (Var fun, args) <- collectArgs rhs, -- It's an application
isDataConWorkId fun || valArgCount args < idArity fun -- And it's a constructor or PAP
@@ -1204,6 +1232,12 @@ mkAtomicArgs :: Bool -- OK to float unlifted args
OutExpr) -- things that need case-binding,
-- if the strict-binding flag is on
+mkAtomicArgs ok_float_unlifted (Cast rhs co)
+ -- Note [Float coersions]
+ = do { id <- newId FSLIT("a") (exprType rhs)
+ ; (binds, rhs') <- mkAtomicArgs ok_float_unlifted rhs
+ ; return (binds `snocOL` (id, rhs'), Cast (Var id) co) }
+
mkAtomicArgs ok_float_unlifted rhs
| (Var fun, args) <- collectArgs rhs, -- It's an application
isDataConWorkId fun || valArgCount args < idArity fun -- And it's a constructor or PAP

0 comments on commit b041525

Please sign in to comment.
Something went wrong with that request. Please try again.