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