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 casewild, casewildtop :: Transform
 202 -- Make sure that all case alternatives have only wild binders, except for
 203 -- simple selector cases (e.g., case x of (a, ) -> a). This is done by
 204 -- creating a new let binding for each non-wild binder, which is bound to a
 205 -- new simple selector case statement. We do this only for binders with a
 206 -- representable type, to prevent loops with inlinenonrep.
 207 casewild expr@(Case scrut b ty alts) = do
 208   (bindingss, alts') <- (Monad.liftM unzip) $ mapM doalt alts
 209   let bindings = concat bindingss
 210   -- Replace the case with a let with bindings and a case
 211   let newlet = (Let (Rec bindings) (Case scrut b ty alts'))
 212   -- If there are no non-wild binders, or this case is already a simple
 213   -- selector (i.e., a single alt with exactly one binding), already a simple
 214   -- selector altan no bindings (i.e., no wild binders in the original case),
 215   -- don't change anything, otherwise, replace the case.
 216   if null bindings || length alts == 1 && length bindings == 1 then return expr else change newlet
 217   where
 218   -- Generate a single wild binder, since they are all the same
 219   wild = MkCore.mkWildBinder
 220   -- Wilden the binders of one alt, producing a list of bindings as a
 221   -- sideeffect.
 222   doalt :: CoreAlt -> TransformMonad ([(CoreBndr, CoreExpr)], CoreAlt)
 223   doalt (con, bndrs, expr) = do
 224     bindings_maybe <- Monad.zipWithM mkextracts bndrs [0..]
 225     let bindings = Maybe.catMaybes bindings_maybe
 226     -- We replace the binders with wild binders only. We can leave expr
 227     -- unchanged, since the new bindings bind the same vars as the original
 228     -- did.
 229     let newalt = (con, wildbndrs, expr)
 230     return (bindings, newalt)
 231     where
 232       -- Make all binders wild
 233       wildbndrs = map (\bndr -> MkCore.mkWildBinder (Id.idType bndr)) bndrs
 234       -- A set of all the binders that are used by the expression
 235       free_vars = CoreFVs.exprSomeFreeVars (`elem` bndrs) expr
 236       -- Creates a case statement to retrieve the ith element from the scrutinee
 237       -- and binds that to b.
 238       mkextracts :: CoreBndr -> Int -> TransformMonad (Maybe (CoreBndr, CoreExpr))
 239       mkextracts b i = do
 240         repr <- isRepr (Var b)
 241         -- Is b wild (e.g., not a free var of expr. Since b is only in scope
 242         -- in expr, this means that b is unused if expr does not use it.)
 243         let wild = not (VarSet.elemVarSet b free_vars)
 244         -- Create a new binding for any representable binder that is not
 245         -- already wild.
 246         if (not wild) && repr
 247           then do
 248             -- Create on new binder that will actually capture a value in this
 249             -- case statement, and return it.
 250             let bty = (Id.idType b)
 251             id <- mkInternalVar "sel" bty
 252             let binders = take i wildbndrs ++ [id] ++ drop (i+1) wildbndrs
 253             return $ Just (b, Case scrut b bty [(con, binders, Var id)])
 254           else
 255             return Nothing
 256 -- Leave all other expressions unchanged
 257 casewild expr = return expr
 258 -- Perform this transform everywhere
 259 casewildtop = everywhere ("casewild", casewild)
 260
 261 --------------------------------
 262 -- Case value simplification
 263 --------------------------------
 264 casevalsimpl, casevalsimpltop :: Transform
 265 casevalsimpl expr@(Case scrut b ty alts) = do
 266   -- Try to simplify each alternative, resulting in an optional binding and a
 267   -- new alternative.
 268   (bindings_maybe, alts') <- (Monad.liftM unzip) $ mapM doalt alts
 269   let bindings = Maybe.catMaybes bindings_maybe
 270   -- Create a new let around the case, that binds of the cases values.
 271   let newlet = Let (Rec bindings) (Case scrut b ty alts')
 272   -- If there were no values that needed and allowed simplification, don't
 273   -- change the case.
 274   if null bindings then return expr else change newlet
 275   where
 276     doalt :: CoreAlt -> TransformMonad (Maybe (CoreBndr, CoreExpr), CoreAlt)
 277     -- Don't simplify values that are already simple
 278     doalt alt@(con, bndrs, Var _) = return (Nothing, alt)
 279     -- Simplify each alt by creating a new id, binding the case value to it and
 280     -- replacing the case value with that id. Only do this when the case value
 281     -- does not use any of the binders bound by this alternative, for that would
 282     -- cause those binders to become unbound when moving the value outside of
 283     -- the case statement. Also, don't create a binding for non-representable
 284     -- expressions, to prevent loops with inlinenonrep.
 285     doalt alt@(con, bndrs, expr) = do
 286       repr <- isRepr expr
 287       -- Find if any of the binders are used by expr
 288       let usesvars = (not . VarSet.isEmptyVarSet . (CoreFVs.exprSomeFreeVars (`elem` bndrs))) expr
 289       if (not usesvars && repr)
 290         then do
 291           id <- mkInternalVar "caseval" (CoreUtils.exprType expr)
 292           -- We don't flag a change here, since casevalsimpl will do that above
 293           -- based on Just we return here.
 294           return $ (Just (id, expr), (con, bndrs, Var id))
 295         else
 296           -- Don't simplify anything else
 297           return (Nothing, alt)
 298 -- Leave all other expressions unchanged
 299 casevalsimpl expr = return expr
 300 -- Perform this transform everywhere
 301 casevalsimpltop = everywhere ("casevalsimpl", casevalsimpl)
 302
 303 --------------------------------
 304 -- Case removal
 305 --------------------------------
 306 -- Remove case statements that have only a single alternative and only wild
 307 -- binders.
 308 caseremove, caseremovetop :: Transform
 309 -- Replace a useless case by the value of its single alternative
 310 caseremove (Case scrut b ty [(con, bndrs, expr)]) | not usesvars = change expr
 311     -- Find if any of the binders are used by expr
 312     where usesvars = (not . VarSet.isEmptyVarSet . (CoreFVs.exprSomeFreeVars (`elem` bndrs))) expr
 313 -- Leave all other expressions unchanged
 314 caseremove expr = return expr
 315 -- Perform this transform everywhere
 316 caseremovetop = everywhere ("caseremove", caseremove)
 317
 318 --------------------------------
 319 -- Argument extraction
 320 --------------------------------
 321 -- Make sure that all arguments of a representable type are simple variables.
 322 appsimpl, appsimpltop :: Transform
 323 -- Simplify all representable arguments. Do this by introducing a new Let
 324 -- that binds the argument and passing the new binder in the application.
 325 appsimpl expr@(App f arg) = do
 326   -- Check runtime representability
 327   repr <- isRepr arg
 328   local_var <- Trans.lift $ is_local_var arg
 329   if repr && not local_var
 330     then do -- Extract representable arguments
 331       id <- mkInternalVar "arg" (CoreUtils.exprType arg)
 332       change $ Let (Rec [(id, arg)]) (App f (Var id))
 333     else -- Leave non-representable arguments unchanged
 334       return expr
 335 -- Leave all other expressions unchanged
 336 appsimpl expr = return expr
 337 -- Perform this transform everywhere
 338 appsimpltop = everywhere ("appsimpl", appsimpl)
 339
 340 --------------------------------
 341 -- Function-typed argument propagation
 342 --------------------------------
 343 -- Remove all applications to function-typed arguments, by duplication the
 344 -- function called with the function-typed parameter replaced by the free
 345 -- variables of the argument passed in.
 346 argprop, argproptop :: Transform
 347 -- Transform any application of a named function (i.e., skip applications of
 348 -- lambda's). Also skip applications that have arguments with free type
 349 -- variables, since we can't inline those.
 350 argprop expr@(App _ _) | is_var fexpr = do
 351   -- Find the body of the function called
 352   body_maybe <- Trans.lift $ getGlobalBind f
 353   case body_maybe of
 354     Just body -> do
 355       -- Process each of the arguments in turn
 356       (args', changed) <- Writer.listen $ mapM doarg args
 357       -- See if any of the arguments changed
 358       case Monoid.getAny changed of
 359         True -> do
 360           let (newargs', newparams', oldargs) = unzip3 args'
 361           let newargs = concat newargs'
 362           let newparams = concat newparams'
 363           -- Create a new body that consists of a lambda for all new arguments and
 364           -- the old body applied to some arguments.
 365           let newbody = MkCore.mkCoreLams newparams (MkCore.mkCoreApps body oldargs)
 366           -- Create a new function with the same name but a new body
 367           newf <- mkFunction f newbody
 368           -- Replace the original application with one of the new function to the
 369           -- new arguments.
 370           change $ MkCore.mkCoreApps (Var newf) newargs
 371         False ->
 372           -- Don't change the expression if none of the arguments changed
 373           return expr
 374
 375     -- If we don't have a body for the function called, leave it unchanged (it
 376     -- should be a primitive function then).
 377     Nothing -> return expr
 378   where
 379     -- Find the function called and the arguments
 380     (fexpr, args) = collectArgs expr
 381     Var f = fexpr
 382
 383     -- Process a single argument and return (args, bndrs, arg), where args are
 384     -- the arguments to replace the given argument in the original
 385     -- application, bndrs are the binders to include in the top-level lambda
 386     -- in the new function body, and arg is the argument to apply to the old
 387     -- function body.
 388     doarg :: CoreExpr -> TransformMonad ([CoreExpr], [CoreBndr], CoreExpr)
 389     doarg arg = do
 390       repr <- isRepr arg
 391       bndrs <- Trans.lift getGlobalBinders
 392       let interesting var = Var.isLocalVar var && (not $ var `elem` bndrs)
 393       if not repr && not (is_var arg && interesting (exprToVar arg)) && not (has_free_tyvars arg)
 394         then do
 395           -- Propagate all complex arguments that are not representable, but not
 396           -- arguments with free type variables (since those would require types
 397           -- not known yet, which will always be known eventually).
 398           -- Find interesting free variables, each of which should be passed to
 399           -- the new function instead of the original function argument.
 400           --
 401           -- Interesting vars are those that are local, but not available from the
 402           -- top level scope (functions from this module are defined as local, but
 403           -- they're not local to this function, so we can freely move references
 404           -- to them into another function).
 405           let free_vars = VarSet.varSetElems $ CoreFVs.exprSomeFreeVars interesting arg
 406           -- Mark the current expression as changed
 407           setChanged
 408           return (map Var free_vars, free_vars, arg)
 409         else do
 410           -- Representable types will not be propagated, and arguments with free
 411           -- type variables will be propagated later.
 412           -- TODO: preserve original naming?
 413           id <- mkBinderFor arg "param"
 414           -- Just pass the original argument to the new function, which binds it
 415           -- to a new id and just pass that new id to the old function body.
 416           return ([arg], [id], mkReferenceTo id)
 417 -- Leave all other expressions unchanged
 418 argprop expr = return expr
 419 -- Perform this transform everywhere
 420 argproptop = everywhere ("argprop", argprop)
 421
 422 --------------------------------
 423 -- Function-typed argument extraction
 424 --------------------------------
 425 -- This transform takes any function-typed argument that cannot be propagated
 426 -- (because the function that is applied to it is a builtin function), and
 427 -- puts it in a brand new top level binder. This allows us to for example
 428 -- apply map to a lambda expression This will not conflict with inlinenonrep,
 429 -- since that only inlines local let bindings, not top level bindings.
 430 funextract, funextracttop :: Transform
 431 funextract expr@(App _ _) | is_var fexpr = do
 432   body_maybe <- Trans.lift $ getGlobalBind f
 433   case body_maybe of
 434     -- We don't have a function body for f, so we can perform this transform.
 435     Nothing -> do
 436       -- Find the new arguments
 437       args' <- mapM doarg args
 438       -- And update the arguments. We use return instead of changed, so the
 439       -- changed flag doesn't get set if none of the args got changed.
 440       return $ MkCore.mkCoreApps fexpr args'
 441     -- We have a function body for f, leave this application to funprop
 442     Just _ -> return expr
 443   where
 444     -- Find the function called and the arguments
 445     (fexpr, args) = collectArgs expr
 446     Var f = fexpr
 447     -- Change any arguments that have a function type, but are not simple yet
 448     -- (ie, a variable or application). This means to create a new function
 449     -- for map (\f -> ...) b, but not for map (foo a) b.
 450     --
 451     -- We could use is_applicable here instead of is_fun, but I think
 452     -- arguments to functions could only have forall typing when existential
 453     -- typing is enabled. Not sure, though.
 454     doarg arg | not (is_simple arg) && is_fun arg = do
 455       -- Create a new top level binding that binds the argument. Its body will
 456       -- be extended with lambda expressions, to take any free variables used
 457       -- by the argument expression.
 458       let free_vars = VarSet.varSetElems $ CoreFVs.exprFreeVars arg
 459       let body = MkCore.mkCoreLams free_vars arg
 460       id <- mkBinderFor body "fun"
 461       Trans.lift $ addGlobalBind id body
 462       -- Replace the argument with a reference to the new function, applied to
 463       -- all vars it uses.
 464       change $ MkCore.mkCoreApps (Var id) (map Var free_vars)
 465     -- Leave all other arguments untouched
 466     doarg arg = return arg
 467
 468 -- Leave all other expressions unchanged
 469 funextract expr = return expr
 470 -- Perform this transform everywhere
 471 funextracttop = everywhere ("funextract", funextract)
 472
 473 --------------------------------
 474 -- End of transformations
 475 --------------------------------
 476
 477
 478
 479
 480 -- What transforms to run?
 481 transforms = [argproptop, funextracttop, etatop, betatop, castproptop, letremovetop, letrectop, letsimpltop, letflattop, casewildtop, scrutsimpltop, casevalsimpltop, caseremovetop, inlinenonreptop, appsimpltop]
 482
 483 -- Turns the given bind into VHDL
 484 normalizeModule ::
 485   HscTypes.HscEnv
 486   -> UniqSupply.UniqSupply -- ^ A UniqSupply we can use
 487   -> [(CoreBndr, CoreExpr)]  -- ^ All bindings we know (i.e., in the current module)
 488   -> [CoreExpr]
 489   -> [CoreBndr]  -- ^ The bindings to generate VHDL for (i.e., the top level bindings)
 490   -> [Bool] -- ^ For each of the bindings to generate VHDL for, if it is stateful
 491   -> ([(CoreBndr, CoreExpr)], [(CoreBndr, CoreExpr)], TypeState) -- ^ The resulting VHDL
 492
 493 normalizeModule env uniqsupply bindings testexprs generate_for statefuls = runTransformSession env uniqsupply $ do
 494   testbinds <- mapM (\x -> do { v <- mkBinderFor' x "test" ; return (v,x) } ) testexprs
 495   let testbinders = (map fst testbinds)
 496   -- Put all the bindings in this module in the tsBindings map
 497   putA tsBindings (Map.fromList (bindings ++ testbinds))
 498   -- (Recursively) normalize each of the requested bindings
 499   mapM normalizeBind (generate_for ++ testbinders)
 500   -- Get all initial bindings and the ones we produced
 501   bindings_map <- getA tsBindings
 502   let bindings = Map.assocs bindings_map
 503   normalized_binders' <- getA tsNormalized
 504   let normalized_binders = VarSet.delVarSetList normalized_binders' testbinders
 505   let ret_testbinds = zip testbinders (Maybe.catMaybes $ map (\x -> lookup x bindings) testbinders)
 506   let ret_binds = filter ((`VarSet.elemVarSet` normalized_binders) . fst) bindings
 507   typestate <- getA tsType
 508   -- But return only the normalized bindings
 509   return $ (ret_binds, ret_testbinds, typestate)
 510
 511 normalizeBind :: CoreBndr -> TransformSession ()
 512 normalizeBind bndr =
 513   -- Don't normalize global variables, these should be either builtin
 514   -- functions or data constructors.
 515   Monad.when (Var.isLocalId bndr) $ do
 516     -- Skip binders that have a polymorphic type, since it's impossible to
 517     -- create polymorphic hardware.
 518     if is_poly (Var bndr)
 519       then
 520         -- This should really only happen at the top level... TODO: Give
 521         -- a different error if this happens down in the recursion.
 522         error $ "\nNormalize.normalizeBind: Function " ++ show bndr ++ " is polymorphic, can't normalize"
 523       else do
 524         normalized_funcs <- getA tsNormalized
 525         -- See if this function was normalized already
 526         if VarSet.elemVarSet bndr normalized_funcs
 527           then
 528             -- Yup, don't do it again
 529             return ()
 530           else do
 531             -- Nope, note that it has been and do it.
 532             modA tsNormalized (flip VarSet.extendVarSet bndr)
 533             expr_maybe <- getGlobalBind bndr
 534             case expr_maybe of
 535               Just expr -> do
 536                 -- Introduce an empty Let at the top level, so there will always be
 537                 -- a let in the expression (none of the transformations will remove
 538                 -- the last let).
 539                 let expr' = Let (Rec []) expr
 540                 -- Normalize this expression
 541                 trace ("Transforming " ++ (show bndr) ++ "\nBefore:\n\n" ++ showSDoc ( ppr expr' ) ++ "\n") $ return ()
 542                 expr' <- dotransforms transforms expr'
 543                 trace ("\nAfter:\n\n" ++ showSDoc ( ppr expr')) $ return ()
 544                 -- And store the normalized version in the session
 545                 modA tsBindings (Map.insert bndr expr')
 546                 -- Find all vars used with a function type. All of these should be global
 547                 -- binders (i.e., functions used), since any local binders with a function
 548                 -- type should have been inlined already.
 549                 bndrs <- getGlobalBinders
 550                 let used_funcs_set = CoreFVs.exprSomeFreeVars (\v -> not (Id.isDictId v) && v `elem` bndrs) expr'
 551                 let used_funcs = VarSet.varSetElems used_funcs_set
 552                 -- Process each of the used functions recursively
 553                 mapM normalizeBind used_funcs
 554                 return ()
 555               -- We don't have a value for this binder. This really shouldn't
 556               -- happen for local id's...
 557               Nothing -> error $ "\nNormalize.normalizeBind: No value found for binder " ++ pprString bndr ++ "? This should not happen!"