cλash/CLasH/Normalize.hs

   1 {-# LANGUAGE PackageImports #-}
   2 --
   3 -- Functions to bring a Core expression in normal form. This module provides a
   4 -- top level function "normalize", and defines the actual transformation passes that
   5 -- are performed.
   6 --
   7 module CLasH.Normalize (getNormalized, normalizeExpr) where
   8
   9 -- Standard modules
  10 import Debug.Trace
  11 import qualified Maybe
  12 import qualified "transformers" Control.Monad.Trans as Trans
  13 import qualified Control.Monad as Monad
  14 import qualified Control.Monad.Trans.Writer as Writer
  15 import qualified Data.Map as Map
  16 import qualified Data.Monoid as Monoid
  17 import Data.Accessor
  18
  19 -- GHC API
  20 import CoreSyn
  21 import qualified UniqSupply
  22 import qualified CoreUtils
  23 import qualified Type
  24 import qualified TcType
  25 import qualified Id
  26 import qualified Var
  27 import qualified VarSet
  28 import qualified NameSet
  29 import qualified CoreFVs
  30 import qualified CoreUtils
  31 import qualified MkCore
  32 import qualified HscTypes
  33 import Outputable ( showSDoc, ppr, nest )
  34
  35 -- Local imports
  36 import CLasH.Normalize.NormalizeTypes
  37 import CLasH.Translator.TranslatorTypes
  38 import CLasH.Normalize.NormalizeTools
  39 import CLasH.VHDL.VHDLTypes
  40 import qualified CLasH.Utils as Utils
  41 import CLasH.Utils.Core.CoreTools
  42 import CLasH.Utils.Core.BinderTools
  43 import CLasH.Utils.Pretty
  44
  45 --------------------------------
  46 -- Start of transformations
  47 --------------------------------
  48
  49 --------------------------------
  50 -- η abstraction
  51 --------------------------------
  52 eta, etatop :: Transform
  53 eta expr | is_fun expr && not (is_lam expr) = do
  54   let arg_ty = (fst . Type.splitFunTy . CoreUtils.exprType) expr
  55   id <- Trans.lift $ mkInternalVar "param" arg_ty
  56   change (Lam id (App expr (Var id)))
  57 -- Leave all other expressions unchanged
  58 eta e = return e
  59 etatop = notappargs ("eta", eta)
  60
  61 --------------------------------
  62 -- β-reduction
  63 --------------------------------
  64 beta, betatop :: Transform
  65 -- Substitute arg for x in expr
  66 beta (App (Lam x expr) arg) = change $ substitute [(x, arg)] expr
  67 -- Propagate the application into the let
  68 beta (App (Let binds expr) arg) = change $ Let binds (App expr arg)
  69 -- Propagate the application into each of the alternatives
  70 beta (App (Case scrut b ty alts) arg) = change $ Case scrut b ty' alts'
  71   where
  72     alts' = map (\(con, bndrs, expr) -> (con, bndrs, (App expr arg))) alts
  73     ty' = CoreUtils.applyTypeToArg ty arg
  74 -- Leave all other expressions unchanged
  75 beta expr = return expr
  76 -- Perform this transform everywhere
  77 betatop = everywhere ("beta", beta)
  78
  79 --------------------------------
  80 -- Cast propagation
  81 --------------------------------
  82 -- Try to move casts as much downward as possible.
  83 castprop, castproptop :: Transform
  84 castprop (Cast (Let binds expr) ty) = change $ Let binds (Cast expr ty)
  85 castprop expr@(Cast (Case scrut b _ alts) ty) = change (Case scrut b ty alts')
  86   where
  87     alts' = map (\(con, bndrs, expr) -> (con, bndrs, (Cast expr ty))) alts
  88 -- Leave all other expressions unchanged
  89 castprop expr = return expr
  90 -- Perform this transform everywhere
  91 castproptop = everywhere ("castprop", castprop)
  92
  93 --------------------------------
  94 -- Cast simplification. Mostly useful for state packing and unpacking, but
  95 -- perhaps for others as well.
  96 --------------------------------
  97 castsimpl, castsimpltop :: Transform
  98 castsimpl expr@(Cast val ty) = do
  99   -- Don't extract values that are already simpl
 100   local_var <- Trans.lift $ is_local_var val
 101   -- Don't extract values that are not representable, to prevent loops with
 102   -- inlinenonrep
 103   repr <- isRepr val
 104   if (not local_var) && repr
 105     then do
 106       -- Generate a binder for the expression
 107       id <- Trans.lift $ mkBinderFor val "castval"
 108       -- Extract the expression
 109       change $ Let (Rec [(id, val)]) (Cast (Var id) ty)
 110     else
 111       return expr
 112 -- Leave all other expressions unchanged
 113 castsimpl expr = return expr
 114 -- Perform this transform everywhere
 115 castsimpltop = everywhere ("castsimpl", castsimpl)
 116
 117 --------------------------------
 118 -- let recursification
 119 --------------------------------
 120 letrec, letrectop :: Transform
 121 letrec (Let (NonRec b expr) res) = change $ Let (Rec [(b, expr)]) res
 122 -- Leave all other expressions unchanged
 123 letrec expr = return expr
 124 -- Perform this transform everywhere
 125 letrectop = everywhere ("letrec", letrec)
 126
 127 --------------------------------
 128 -- let simplification
 129 --------------------------------
 130 letsimpl, letsimpltop :: Transform
 131 -- Put the "in ..." value of a let in its own binding, but not when the
 132 -- expression is already a local variable, or not representable (to prevent loops with inlinenonrep).
 133 letsimpl expr@(Let (Rec binds) res) = do
 134   repr <- isRepr res
 135   local_var <- Trans.lift $ is_local_var res
 136   if not local_var && repr
 137     then do
 138       -- If the result is not a local var already (to prevent loops with
 139       -- ourselves), extract it.
 140       id <- Trans.lift $ mkInternalVar "foo" (CoreUtils.exprType res)
 141       let bind = (id, res)
 142       change $ Let (Rec (bind:binds)) (Var id)
 143     else
 144       -- If the result is already a local var, don't extract it.
 145       return expr
 146
 147 -- Leave all other expressions unchanged
 148 letsimpl expr = return expr
 149 -- Perform this transform everywhere
 150 letsimpltop = everywhere ("letsimpl", letsimpl)
 151
 152 --------------------------------
 153 -- let flattening
 154 --------------------------------
 155 letflat, letflattop :: Transform
 156 letflat (Let (Rec binds) expr) = do
 157   -- Turn each binding into a list of bindings (possibly containing just one
 158   -- element, of course)
 159   bindss <- Monad.mapM flatbind binds
 160   -- Concat all the bindings
 161   let binds' = concat bindss
 162   -- Return the new let. We don't use change here, since possibly nothing has
 163   -- changed. If anything has changed, flatbind has already flagged that
 164   -- change.
 165   return $ Let (Rec binds') expr
 166   where
 167     -- Turns a binding of a let into a multiple bindings, or any other binding
 168     -- into a list with just that binding
 169     flatbind :: (CoreBndr, CoreExpr) -> TransformMonad [(CoreBndr, CoreExpr)]
 170     flatbind (b, Let (Rec binds) expr) = change ((b, expr):binds)
 171     flatbind (b, expr) = return [(b, expr)]
 172 -- Leave all other expressions unchanged
 173 letflat expr = return expr
 174 -- Perform this transform everywhere
 175 letflattop = everywhere ("letflat", letflat)
 176
 177 --------------------------------
 178 -- Simple let binding removal
 179 --------------------------------
 180 -- Remove a = b bindings from let expressions everywhere
 181 letremovetop :: Transform
 182 letremovetop = everywhere ("letremove", inlinebind (\(b, e) -> Trans.lift $ is_local_var e))
 183
 184 --------------------------------
 185 -- Unused let binding removal
 186 --------------------------------
 187 letremoveunused, letremoveunusedtop :: Transform
 188 letremoveunused expr@(Let (Rec binds) res) = do
 189   -- Filter out all unused binds.
 190   let binds' = filter dobind binds
 191   -- Only set the changed flag if binds got removed
 192   changeif (length binds' /= length binds) (Let (Rec binds') res)
 193     where
 194       bound_exprs = map snd binds
 195       -- For each bind check if the bind is used by res or any of the bound
 196       -- expressions
 197       dobind (bndr, _) = any (expr_uses_binders [bndr]) (res:bound_exprs)
 198 -- Leave all other expressions unchanged
 199 letremoveunused expr = return expr
 200 letremoveunusedtop = everywhere ("letremoveunused", letremoveunused)
 201
 202 --------------------------------
 203 -- Identical let binding merging
 204 --------------------------------
 205 -- Merge two bindings in a let if they are identical
 206 -- TODO: We would very much like to use GHC's CSE module for this, but that
 207 -- doesn't track if something changed or not, so we can't use it properly.
 208 letmerge, letmergetop :: Transform
 209 letmerge expr@(Let (Rec binds) res) = do
 210   binds' <- domerge binds
 211   return (Let (Rec binds') res)
 212   where
 213     domerge :: [(CoreBndr, CoreExpr)] -> TransformMonad [(CoreBndr, CoreExpr)]
 214     domerge [] = return []
 215     domerge (e:es) = do
 216       es' <- mapM (mergebinds e) es
 217       es'' <- domerge es'
 218       return (e:es'')
 219
 220     -- Uses the second bind to simplify the second bind, if applicable.
 221     mergebinds :: (CoreBndr, CoreExpr) -> (CoreBndr, CoreExpr) -> TransformMonad (CoreBndr, CoreExpr)
 222     mergebinds (b1, e1) (b2, e2)
 223       -- Identical expressions? Replace the second binding with a reference to
 224       -- the first binder.
 225       | CoreUtils.cheapEqExpr e1 e2 = change $ (b2, Var b1)
 226       -- Different expressions? Don't change
 227       | otherwise = return (b2, e2)
 228 -- Leave all other expressions unchanged
 229 letmerge expr = return expr
 230 letmergetop = everywhere ("letmerge", letmerge)
 231
 232 --------------------------------
 233 -- Function inlining
 234 --------------------------------
 235 -- Remove a = B bindings, with B :: a -> b, or B :: forall x . T, from let
 236 -- expressions everywhere. This means that any value that still needs to be
 237 -- applied to something else (polymorphic values need to be applied to a
 238 -- Type) will be inlined, and will eventually be applied to all their
 239 -- arguments.
 240 --
 241 -- This is a tricky function, which is prone to create loops in the
 242 -- transformations. To fix this, we make sure that no transformation will
 243 -- create a new let binding with a function type. These other transformations
 244 -- will just not work on those function-typed values at first, but the other
 245 -- transformations (in particular β-reduction) should make sure that the type
 246 -- of those values eventually becomes primitive.
 247 inlinenonreptop :: Transform
 248 inlinenonreptop = everywhere ("inlinenonrep", inlinebind ((Monad.liftM not) . isRepr . snd))
 249
 250 --------------------------------
 251 -- Scrutinee simplification
 252 --------------------------------
 253 scrutsimpl,scrutsimpltop :: Transform
 254 -- Don't touch scrutinees that are already simple
 255 scrutsimpl expr@(Case (Var _) _ _ _) = return expr
 256 -- Replace all other cases with a let that binds the scrutinee and a new
 257 -- simple scrutinee, but only when the scrutinee is representable (to prevent
 258 -- loops with inlinenonrep, though I don't think a non-representable scrutinee
 259 -- will be supported anyway...)
 260 scrutsimpl expr@(Case scrut b ty alts) = do
 261   repr <- isRepr scrut
 262   if repr
 263     then do
 264       id <- Trans.lift $ mkInternalVar "scrut" (CoreUtils.exprType scrut)
 265       change $ Let (Rec [(id, scrut)]) (Case (Var id) b ty alts)
 266     else
 267       return expr
 268 -- Leave all other expressions unchanged
 269 scrutsimpl expr = return expr
 270 -- Perform this transform everywhere
 271 scrutsimpltop = everywhere ("scrutsimpl", scrutsimpl)
 272
 273 --------------------------------
 274 -- Case binder wildening
 275 --------------------------------
 276 casesimpl, casesimpltop :: Transform
 277 -- This is already a selector case (or, if x does not appear in bndrs, a very
 278 -- simple case statement that will be removed by caseremove below). Just leave
 279 -- it be.
 280 casesimpl expr@(Case scrut b ty [(con, bndrs, Var x)]) = return expr
 281 -- Make sure that all case alternatives have only wild binders and simple
 282 -- expressions.
 283 -- This is done by creating a new let binding for each non-wild binder, which
 284 -- is bound to a new simple selector case statement and for each complex
 285 -- expression. We do this only for representable types, to prevent loops with
 286 -- inlinenonrep.
 287 casesimpl expr@(Case scrut b ty alts) = do
 288   (bindingss, alts') <- (Monad.liftM unzip) $ mapM doalt alts
 289   let bindings = concat bindingss
 290   -- Replace the case with a let with bindings and a case
 291   let newlet = (Let (Rec bindings) (Case scrut b ty alts'))
 292   -- If there are no non-wild binders, or this case is already a simple
 293   -- selector (i.e., a single alt with exactly one binding), already a simple
 294   -- selector altan no bindings (i.e., no wild binders in the original case),
 295   -- don't change anything, otherwise, replace the case.
 296   if null bindings then return expr else change newlet
 297   where
 298   -- Generate a single wild binder, since they are all the same
 299   wild = MkCore.mkWildBinder
 300   -- Wilden the binders of one alt, producing a list of bindings as a
 301   -- sideeffect.
 302   doalt :: CoreAlt -> TransformMonad ([(CoreBndr, CoreExpr)], CoreAlt)
 303   doalt (con, bndrs, expr) = do
 304     -- Make each binder wild, if possible
 305     bndrs_res <- Monad.zipWithM dobndr bndrs [0..]
 306     let (newbndrs, bindings_maybe) = unzip bndrs_res
 307     -- Extract a complex expression, if possible. For this we check if any of
 308     -- the new list of bndrs are used by expr. We can't use free_vars here,
 309     -- since that looks at the old bndrs.
 310     let uses_bndrs = not $ VarSet.isEmptyVarSet $ CoreFVs.exprSomeFreeVars (`elem` newbndrs) $ expr
 311     (exprbinding_maybe, expr') <- doexpr expr uses_bndrs
 312     -- Create a new alternative
 313     let newalt = (con, newbndrs, expr')
 314     let bindings = Maybe.catMaybes (exprbinding_maybe : bindings_maybe)
 315     return (bindings, newalt)
 316     where
 317       -- Make wild alternatives for each binder
 318       wildbndrs = map (\bndr -> MkCore.mkWildBinder (Id.idType bndr)) bndrs
 319       -- A set of all the binders that are used by the expression
 320       free_vars = CoreFVs.exprSomeFreeVars (`elem` bndrs) expr
 321       -- Look at the ith binder in the case alternative. Return a new binder
 322       -- for it (either the same one, or a wild one) and optionally a let
 323       -- binding containing a case expression.
 324       dobndr :: CoreBndr -> Int -> TransformMonad (CoreBndr, Maybe (CoreBndr, CoreExpr))
 325       dobndr b i = do
 326         repr <- isRepr (Var b)
 327         -- Is b wild (e.g., not a free var of expr. Since b is only in scope
 328         -- in expr, this means that b is unused if expr does not use it.)
 329         let wild = not (VarSet.elemVarSet b free_vars)
 330         -- Create a new binding for any representable binder that is not
 331         -- already wild and is representable (to prevent loops with
 332         -- inlinenonrep).
 333         if (not wild) && repr
 334           then do
 335             -- Create on new binder that will actually capture a value in this
 336             -- case statement, and return it.
 337             let bty = (Id.idType b)
 338             id <- Trans.lift $ mkInternalVar "sel" bty
 339             let binders = take i wildbndrs ++ [id] ++ drop (i+1) wildbndrs
 340             let caseexpr = Case scrut b bty [(con, binders, Var id)]
 341             return (wildbndrs!!i, Just (b, caseexpr))
 342           else
 343             -- Just leave the original binder in place, and don't generate an
 344             -- extra selector case.
 345             return (b, Nothing)
 346       -- Process the expression of a case alternative. Accepts an expression
 347       -- and whether this expression uses any of the binders in the
 348       -- alternative. Returns an optional new binding and a new expression.
 349       doexpr :: CoreExpr -> Bool -> TransformMonad (Maybe (CoreBndr, CoreExpr), CoreExpr)
 350       doexpr expr uses_bndrs = do
 351         local_var <- Trans.lift $ is_local_var expr
 352         repr <- isRepr expr
 353         -- Extract any expressions that do not use any binders from this
 354         -- alternative, is not a local var already and is representable (to
 355         -- prevent loops with inlinenonrep).
 356         if (not uses_bndrs) && (not local_var) && repr
 357           then do
 358             id <- Trans.lift $ mkInternalVar "caseval" (CoreUtils.exprType expr)
 359             -- We don't flag a change here, since casevalsimpl will do that above
 360             -- based on Just we return here.
 361             return $ (Just (id, expr), Var id)
 362           else
 363             -- Don't simplify anything else
 364             return (Nothing, expr)
 365 -- Leave all other expressions unchanged
 366 casesimpl expr = return expr
 367 -- Perform this transform everywhere
 368 casesimpltop = everywhere ("casesimpl", casesimpl)
 369
 370 --------------------------------
 371 -- Case removal
 372 --------------------------------
 373 -- Remove case statements that have only a single alternative and only wild
 374 -- binders.
 375 caseremove, caseremovetop :: Transform
 376 -- Replace a useless case by the value of its single alternative
 377 caseremove (Case scrut b ty [(con, bndrs, expr)]) | not usesvars = change expr
 378     -- Find if any of the binders are used by expr
 379     where usesvars = (not . VarSet.isEmptyVarSet . (CoreFVs.exprSomeFreeVars (`elem` bndrs))) expr
 380 -- Leave all other expressions unchanged
 381 caseremove expr = return expr
 382 -- Perform this transform everywhere
 383 caseremovetop = everywhere ("caseremove", caseremove)
 384
 385 --------------------------------
 386 -- Argument extraction
 387 --------------------------------
 388 -- Make sure that all arguments of a representable type are simple variables.
 389 appsimpl, appsimpltop :: Transform
 390 -- Simplify all representable arguments. Do this by introducing a new Let
 391 -- that binds the argument and passing the new binder in the application.
 392 appsimpl expr@(App f arg) = do
 393   -- Check runtime representability
 394   repr <- isRepr arg
 395   local_var <- Trans.lift $ is_local_var arg
 396   if repr && not local_var
 397     then do -- Extract representable arguments
 398       id <- Trans.lift $ mkInternalVar "arg" (CoreUtils.exprType arg)
 399       change $ Let (Rec [(id, arg)]) (App f (Var id))
 400     else -- Leave non-representable arguments unchanged
 401       return expr
 402 -- Leave all other expressions unchanged
 403 appsimpl expr = return expr
 404 -- Perform this transform everywhere
 405 appsimpltop = everywhere ("appsimpl", appsimpl)
 406
 407 --------------------------------
 408 -- Function-typed argument propagation
 409 --------------------------------
 410 -- Remove all applications to function-typed arguments, by duplication the
 411 -- function called with the function-typed parameter replaced by the free
 412 -- variables of the argument passed in.
 413 argprop, argproptop :: Transform
 414 -- Transform any application of a named function (i.e., skip applications of
 415 -- lambda's). Also skip applications that have arguments with free type
 416 -- variables, since we can't inline those.
 417 argprop expr@(App _ _) | is_var fexpr = do
 418   -- Find the body of the function called
 419   body_maybe <- Trans.lift $ getGlobalBind f
 420   case body_maybe of
 421     Just body -> do
 422       -- Process each of the arguments in turn
 423       (args', changed) <- Writer.listen $ mapM doarg args
 424       -- See if any of the arguments changed
 425       case Monoid.getAny changed of
 426         True -> do
 427           let (newargs', newparams', oldargs) = unzip3 args'
 428           let newargs = concat newargs'
 429           let newparams = concat newparams'
 430           -- Create a new body that consists of a lambda for all new arguments and
 431           -- the old body applied to some arguments.
 432           let newbody = MkCore.mkCoreLams newparams (MkCore.mkCoreApps body oldargs)
 433           -- Create a new function with the same name but a new body
 434           newf <- Trans.lift $ mkFunction f newbody
 435           -- Replace the original application with one of the new function to the
 436           -- new arguments.
 437           change $ MkCore.mkCoreApps (Var newf) newargs
 438         False ->
 439           -- Don't change the expression if none of the arguments changed
 440           return expr
 441
 442     -- If we don't have a body for the function called, leave it unchanged (it
 443     -- should be a primitive function then).
 444     Nothing -> return expr
 445   where
 446     -- Find the function called and the arguments
 447     (fexpr, args) = collectArgs expr
 448     Var f = fexpr
 449
 450     -- Process a single argument and return (args, bndrs, arg), where args are
 451     -- the arguments to replace the given argument in the original
 452     -- application, bndrs are the binders to include in the top-level lambda
 453     -- in the new function body, and arg is the argument to apply to the old
 454     -- function body.
 455     doarg :: CoreExpr -> TransformMonad ([CoreExpr], [CoreBndr], CoreExpr)
 456     doarg arg = do
 457       repr <- isRepr arg
 458       bndrs <- Trans.lift getGlobalBinders
 459       let interesting var = Var.isLocalVar var && (not $ var `elem` bndrs)
 460       if not repr && not (is_var arg && interesting (exprToVar arg)) && not (has_free_tyvars arg)
 461         then do
 462           -- Propagate all complex arguments that are not representable, but not
 463           -- arguments with free type variables (since those would require types
 464           -- not known yet, which will always be known eventually).
 465           -- Find interesting free variables, each of which should be passed to
 466           -- the new function instead of the original function argument.
 467           --
 468           -- Interesting vars are those that are local, but not available from the
 469           -- top level scope (functions from this module are defined as local, but
 470           -- they're not local to this function, so we can freely move references
 471           -- to them into another function).
 472           let free_vars = VarSet.varSetElems $ CoreFVs.exprSomeFreeVars interesting arg
 473           -- Mark the current expression as changed
 474           setChanged
 475           return (map Var free_vars, free_vars, arg)
 476         else do
 477           -- Representable types will not be propagated, and arguments with free
 478           -- type variables will be propagated later.
 479           -- TODO: preserve original naming?
 480           id <- Trans.lift $ mkBinderFor arg "param"
 481           -- Just pass the original argument to the new function, which binds it
 482           -- to a new id and just pass that new id to the old function body.
 483           return ([arg], [id], mkReferenceTo id)
 484 -- Leave all other expressions unchanged
 485 argprop expr = return expr
 486 -- Perform this transform everywhere
 487 argproptop = everywhere ("argprop", argprop)
 488
 489 --------------------------------
 490 -- Function-typed argument extraction
 491 --------------------------------
 492 -- This transform takes any function-typed argument that cannot be propagated
 493 -- (because the function that is applied to it is a builtin function), and
 494 -- puts it in a brand new top level binder. This allows us to for example
 495 -- apply map to a lambda expression This will not conflict with inlinenonrep,
 496 -- since that only inlines local let bindings, not top level bindings.
 497 funextract, funextracttop :: Transform
 498 funextract expr@(App _ _) | is_var fexpr = do
 499   body_maybe <- Trans.lift $ getGlobalBind f
 500   case body_maybe of
 501     -- We don't have a function body for f, so we can perform this transform.
 502     Nothing -> do
 503       -- Find the new arguments
 504       args' <- mapM doarg args
 505       -- And update the arguments. We use return instead of changed, so the
 506       -- changed flag doesn't get set if none of the args got changed.
 507       return $ MkCore.mkCoreApps fexpr args'
 508     -- We have a function body for f, leave this application to funprop
 509     Just _ -> return expr
 510   where
 511     -- Find the function called and the arguments
 512     (fexpr, args) = collectArgs expr
 513     Var f = fexpr
 514     -- Change any arguments that have a function type, but are not simple yet
 515     -- (ie, a variable or application). This means to create a new function
 516     -- for map (\f -> ...) b, but not for map (foo a) b.
 517     --
 518     -- We could use is_applicable here instead of is_fun, but I think
 519     -- arguments to functions could only have forall typing when existential
 520     -- typing is enabled. Not sure, though.
 521     doarg arg | not (is_simple arg) && is_fun arg = do
 522       -- Create a new top level binding that binds the argument. Its body will
 523       -- be extended with lambda expressions, to take any free variables used
 524       -- by the argument expression.
 525       let free_vars = VarSet.varSetElems $ CoreFVs.exprFreeVars arg
 526       let body = MkCore.mkCoreLams free_vars arg
 527       id <- Trans.lift $ mkBinderFor body "fun"
 528       Trans.lift $ addGlobalBind id body
 529       -- Replace the argument with a reference to the new function, applied to
 530       -- all vars it uses.
 531       change $ MkCore.mkCoreApps (Var id) (map Var free_vars)
 532     -- Leave all other arguments untouched
 533     doarg arg = return arg
 534
 535 -- Leave all other expressions unchanged
 536 funextract expr = return expr
 537 -- Perform this transform everywhere
 538 funextracttop = everywhere ("funextract", funextract)
 539
 540 --------------------------------
 541 -- End of transformations
 542 --------------------------------
 543
 544
 545
 546
 547 -- What transforms to run?
 548 transforms = [argproptop, funextracttop, etatop, betatop, castproptop, letremovetop, letrectop, letsimpltop, letflattop, scrutsimpltop, casesimpltop, caseremovetop, inlinenonreptop, appsimpltop, letmergetop, letremoveunusedtop, castsimpltop]
 549
 550 -- | Returns the normalized version of the given function.
 551 getNormalized ::
 552   CoreBndr -- ^ The function to get
 553   -> TranslatorSession CoreExpr -- The normalized function body
 554
 555 getNormalized bndr = Utils.makeCached bndr tsNormalized $ do
 556   if is_poly (Var bndr)
 557     then
 558       -- This should really only happen at the top level... TODO: Give
 559       -- a different error if this happens down in the recursion.
 560       error $ "\nNormalize.normalizeBind: Function " ++ show bndr ++ " is polymorphic, can't normalize"
 561     else do
 562       expr <- getBinding bndr
 563       normalizeExpr (show bndr) expr
 564
 565 -- | Normalize an expression
 566 normalizeExpr ::
 567   String -- ^ What are we normalizing? For debug output only.
 568   -> CoreSyn.CoreExpr -- ^ The expression to normalize
 569   -> TranslatorSession CoreSyn.CoreExpr -- ^ The normalized expression
 570
 571 normalizeExpr what expr = do
 572       -- Introduce an empty Let at the top level, so there will always be
 573       -- a let in the expression (none of the transformations will remove
 574       -- the last let).
 575       let expr' = Let (Rec []) expr
 576       -- Normalize this expression
 577       trace ("Transforming " ++ what ++ "\nBefore:\n\n" ++ showSDoc ( ppr expr' ) ++ "\n") $ return ()
 578       expr'' <- dotransforms transforms expr'
 579       trace ("\nAfter:\n\n" ++ showSDoc ( ppr expr'')) $ return ()
 580       return expr''
 581
 582 -- | Get the value that is bound to the given binder at top level. Fails when
 583 --   there is no such binding.
 584 getBinding ::
 585   CoreBndr -- ^ The binder to get the expression for
 586   -> TranslatorSession CoreExpr -- ^ The value bound to the binder
 587
 588 getBinding bndr = Utils.makeCached bndr tsBindings $ do
 589   -- If the binding isn't in the "cache" (bindings map), then we can't create
 590   -- it out of thin air, so return an error.
 591   error $ "Normalize.getBinding: Unknown function requested: " ++ show bndr