Show number of transformations per function.

[matthijs/master-project/cλash.git] / cλash / CLasH / Normalize.hs

diff --git a/cλash/CLasH/Normalize.hs b/cλash/CLasH/Normalize.hs
index 0d352761dbafec889da2345d1b82bc9dab0b4542..2b5c8999147c03662ff5bf806cab27af9e992ff3 100644 (file)
--- a/cλash/CLasH/Normalize.hs
+++ b/cλash/CLasH/Normalize.hs
@@ -13,32 +13,28 @@ import qualified List
 import qualified "transformers" Control.Monad.Trans as Trans
 import qualified Control.Monad as Monad
 import qualified Control.Monad.Trans.Writer as Writer
 import qualified "transformers" Control.Monad.Trans as Trans
 import qualified Control.Monad as Monad
 import qualified Control.Monad.Trans.Writer as Writer

-import qualified Data.Map as Map
+import qualified Data.Accessor.Monad.Trans.State as MonadState

 import qualified Data.Monoid as Monoid
 import qualified Data.Monoid as Monoid

-import Data.Accessor
+import qualified Data.Map as Map

 
 -- GHC API
 import CoreSyn
 
 -- GHC API
 import CoreSyn

-import qualified UniqSupply

 import qualified CoreUtils
 import qualified Type
 import qualified CoreUtils
 import qualified Type

-import qualified TcType
-import qualified Name

 import qualified Id
 import qualified Var
 import qualified Id
 import qualified Var

+import qualified Name

 import qualified VarSet
 import qualified VarSet

-import qualified NameSet

 import qualified CoreFVs
 import qualified CoreFVs

-import qualified CoreUtils
+import qualified Class

 import qualified MkCore
 import qualified MkCore

-import qualified HscTypes

 import Outputable ( showSDoc, ppr, nest )
 
 -- Local imports
 import CLasH.Normalize.NormalizeTypes
 import CLasH.Translator.TranslatorTypes
 import CLasH.Normalize.NormalizeTools
 import Outputable ( showSDoc, ppr, nest )
 
 -- Local imports
 import CLasH.Normalize.NormalizeTypes
 import CLasH.Translator.TranslatorTypes
 import CLasH.Normalize.NormalizeTools

-import CLasH.VHDL.VHDLTypes
+import CLasH.VHDL.Constants (builtinIds)

 import qualified CLasH.Utils as Utils
 import CLasH.Utils.Core.CoreTools
 import CLasH.Utils.Core.BinderTools
 import qualified CLasH.Utils as Utils
 import CLasH.Utils.Core.CoreTools
 import CLasH.Utils.Core.BinderTools


@@ -49,16 +45,22 @@ import CLasH.Utils.Pretty
 --------------------------------
 
 --------------------------------
 --------------------------------
 
 --------------------------------

--- η abstraction
+-- η expansion

 --------------------------------
 --------------------------------

+-- Make sure all parameters to the normalized functions are named by top
+-- level lambda expressions. For this we apply η expansion to the
+-- function body (possibly enclosed in some lambda abstractions) while
+-- it has a function type. Eventually this will result in a function
+-- body consisting of a bunch of nested lambdas containing a
+-- non-function value (e.g., a complete application).

 eta, etatop :: Transform
 eta, etatop :: Transform

-eta expr | is_fun expr && not (is_lam expr) = do
+eta c expr | is_fun expr && not (is_lam expr) && all (== LambdaBody) c = do

   let arg_ty = (fst . Type.splitFunTy . CoreUtils.exprType) expr
   id <- Trans.lift $ mkInternalVar "param" arg_ty
   change (Lam id (App expr (Var id)))
 -- Leave all other expressions unchanged
   let arg_ty = (fst . Type.splitFunTy . CoreUtils.exprType) expr
   id <- Trans.lift $ mkInternalVar "param" arg_ty
   change (Lam id (App expr (Var id)))
 -- Leave all other expressions unchanged

-eta e = return e
-etatop = notappargs ("eta", eta)
+eta c e = return e
+etatop = everywhere ("eta", eta)

 
 --------------------------------
 -- β-reduction
 
 --------------------------------
 -- β-reduction


@@ -66,17 +68,17 @@ etatop = notappargs ("eta", eta)
 beta, betatop :: Transform
 -- Substitute arg for x in expr. For value lambda's, also clone before
 -- substitution.
 beta, betatop :: Transform
 -- Substitute arg for x in expr. For value lambda's, also clone before
 -- substitution.

-beta (App (Lam x expr) arg) | CoreSyn.isTyVar x = setChanged >> substitute x arg expr
-                            | otherwise      = setChanged >> substitute_clone x arg expr
+beta c (App (Lam x expr) arg) | CoreSyn.isTyVar x = setChanged >> substitute x arg c expr
+                              | otherwise         = setChanged >> substitute_clone x arg c expr

 -- Propagate the application into the let
 -- Propagate the application into the let

-beta (App (Let binds expr) arg) = change $ Let binds (App expr arg)
+beta c (App (Let binds expr) arg) = change $ Let binds (App expr arg)

 -- Propagate the application into each of the alternatives
 -- Propagate the application into each of the alternatives

-beta (App (Case scrut b ty alts) arg) = change $ Case scrut b ty' alts'
+beta c (App (Case scrut b ty alts) arg) = change $ Case scrut b ty' alts'

   where 
     alts' = map (\(con, bndrs, expr) -> (con, bndrs, (App expr arg))) alts
     ty' = CoreUtils.applyTypeToArg ty arg
 -- Leave all other expressions unchanged
   where 
     alts' = map (\(con, bndrs, expr) -> (con, bndrs, (App expr arg))) alts
     ty' = CoreUtils.applyTypeToArg ty arg
 -- Leave all other expressions unchanged

-beta expr = return expr
+beta c expr = return expr

 -- Perform this transform everywhere
 betatop = everywhere ("beta", beta)
 
 -- Perform this transform everywhere
 betatop = everywhere ("beta", beta)
 


@@ -85,12 +87,12 @@ betatop = everywhere ("beta", beta)
 --------------------------------
 -- Try to move casts as much downward as possible.
 castprop, castproptop :: Transform
 --------------------------------
 -- Try to move casts as much downward as possible.
 castprop, castproptop :: Transform

-castprop (Cast (Let binds expr) ty) = change $ Let binds (Cast expr ty)
-castprop expr@(Cast (Case scrut b _ alts) ty) = change (Case scrut b ty alts')
+castprop c (Cast (Let binds expr) ty) = change $ Let binds (Cast expr ty)
+castprop c expr@(Cast (Case scrut b _ alts) ty) = change (Case scrut b ty alts')

   where
     alts' = map (\(con, bndrs, expr) -> (con, bndrs, (Cast expr ty))) alts
 -- Leave all other expressions unchanged
   where
     alts' = map (\(con, bndrs, expr) -> (con, bndrs, (Cast expr ty))) alts
 -- Leave all other expressions unchanged

-castprop expr = return expr
+castprop c expr = return expr

 -- Perform this transform everywhere
 castproptop = everywhere ("castprop", castprop)
 
 -- Perform this transform everywhere
 castproptop = everywhere ("castprop", castprop)
 


@@ -99,7 +101,7 @@ castproptop = everywhere ("castprop", castprop)
 -- perhaps for others as well.
 --------------------------------
 castsimpl, castsimpltop :: Transform
 -- perhaps for others as well.
 --------------------------------
 castsimpl, castsimpltop :: Transform

-castsimpl expr@(Cast val ty) = do
+castsimpl c expr@(Cast val ty) = do

   -- Don't extract values that are already simpl
   local_var <- Trans.lift $ is_local_var val
   -- Don't extract values that are not representable, to prevent loops with
   -- Don't extract values that are already simpl
   local_var <- Trans.lift $ is_local_var val
   -- Don't extract values that are not representable, to prevent loops with


@@ -114,45 +116,50 @@ castsimpl expr@(Cast val ty) = do
     else
       return expr
 -- Leave all other expressions unchanged
     else
       return expr
 -- Leave all other expressions unchanged

-castsimpl expr = return expr
+castsimpl c expr = return expr

 -- Perform this transform everywhere
 castsimpltop = everywhere ("castsimpl", castsimpl)
 
 -- Perform this transform everywhere
 castsimpltop = everywhere ("castsimpl", castsimpl)
 

-

 --------------------------------
 --------------------------------

--- Lambda simplication
+-- Ensure that a function that just returns another function (or rather,
+-- another top-level binder) is still properly normalized. This is a temporary
+-- solution, we should probably integrate this pass with lambdasimpl and
+-- letsimpl instead.

 --------------------------------
 --------------------------------

--- Ensure that a lambda always evaluates to a let expressions or a simple
--- variable reference.
-lambdasimpl, lambdasimpltop :: Transform
--- Don't simplify a lambda that evaluates to let, since this is already
--- normal form (and would cause infinite loops).
-lambdasimpl expr@(Lam _ (Let _ _)) = return expr
--- Put the of a lambda in its own binding, but not when the expression is
--- already a local variable, or not representable (to prevent loops with
--- inlinenonrep).
-lambdasimpl expr@(Lam bndr res) = do
-  repr <- isRepr res
-  local_var <- Trans.lift $ is_local_var res
+retvalsimpl c expr@(Let (Rec binds) body) | all (== LambdaBody) c = do
+  -- Don't extract values that are already a local variable, to prevent
+  -- loops with ourselves.
+  local_var <- Trans.lift $ is_local_var body
+  -- Don't extract values that are not representable, to prevent loops with
+  -- inlinenonrep
+  repr <- isRepr body
+  if not local_var && repr
+    then do
+      id <- Trans.lift $ mkBinderFor body "res" 
+      change $ Let (Rec ((id, body):binds)) (Var id)
+    else
+      return expr
+
+retvalsimpl c expr | all (== LambdaBody) c && not (is_lam expr) && not (is_let expr) = do
+  local_var <- Trans.lift $ is_local_var expr
+  repr <- isRepr expr

   if not local_var && repr
     then do
   if not local_var && repr
     then do

-      id <- Trans.lift $ mkBinderFor res "res"
-      change $ Lam bndr (Let (NonRec id res) (Var id))
+      id <- Trans.lift $ mkBinderFor expr "res" 
+      change $ Let (Rec [(id, expr)]) (Var id)

     else
     else

-      -- If the result is already a local var or not representable, don't
-      -- extract it.

       return expr
 
 -- Leave all other expressions unchanged
       return expr
 
 -- Leave all other expressions unchanged

-lambdasimpl expr = return expr
+retvalsimpl c expr = return expr

 -- Perform this transform everywhere
 -- Perform this transform everywhere

-lambdasimpltop = everywhere ("lambdasimpl", lambdasimpl)
+retvalsimpltop = everywhere ("retvalsimpl", retvalsimpl)

 
 --------------------------------
 -- let derecursification
 --------------------------------
 letderec, letderectop :: Transform
 
 --------------------------------
 -- let derecursification
 --------------------------------
 letderec, letderectop :: Transform

-letderec expr@(Let (Rec binds) res) = case liftable of
+letderec c expr@(Let (Rec binds) res) = case liftable of

   -- Nothing is liftable, just return
   [] -> return expr
   -- Something can be lifted, generate a new let expression
   -- Nothing is liftable, just return
   [] -> return expr
   -- Something can be lifted, generate a new let expression


@@ -168,37 +175,10 @@ letderec expr@(Let (Rec binds) res) = case liftable of
     -- single bind recursive let.
     canlift (bndr, e) = not $ expr_uses_binders bndrs e
 -- Leave all other expressions unchanged
     -- single bind recursive let.
     canlift (bndr, e) = not $ expr_uses_binders bndrs e
 -- Leave all other expressions unchanged

-letderec expr = return expr
+letderec c expr = return expr

 -- Perform this transform everywhere
 letderectop = everywhere ("letderec", letderec)
 
 -- Perform this transform everywhere
 letderectop = everywhere ("letderec", letderec)
 

---------------------------------
--- let simplification
---------------------------------
-letsimpl, letsimpltop :: Transform
--- Don't simplify a let that evaluates to another let, since this is already
--- normal form (and would cause infinite loops with letflat below).
-letsimpl expr@(Let _ (Let _ _)) = return expr
--- Put the "in ..." value of a let in its own binding, but not when the
--- expression is already a local variable, or not representable (to prevent loops with inlinenonrep).
-letsimpl expr@(Let binds res) = do
-  repr <- isRepr res
-  local_var <- Trans.lift $ is_local_var res
-  if not local_var && repr
-    then do
-      -- If the result is not a local var already (to prevent loops with
-      -- ourselves), extract it.
-      id <- Trans.lift $ mkBinderFor res "foo"
-      change $ Let binds (Let (NonRec id  res) (Var id))
-    else
-      -- If the result is already a local var, don't extract it.
-      return expr
-
--- Leave all other expressions unchanged
-letsimpl expr = return expr
--- Perform this transform everywhere
-letsimpltop = everywhere ("letsimpl", letsimpl)
-

 --------------------------------
 -- let flattening
 --------------------------------
 --------------------------------
 -- let flattening
 --------------------------------


@@ -209,9 +189,9 @@ letsimpltop = everywhere ("letsimpl", letsimpl)
 -- let b' = expr' in (let b = res' in res)
 letflat, letflattop :: Transform
 -- Turn a nonrec let that binds a let into two nested lets.
 -- let b' = expr' in (let b = res' in res)
 letflat, letflattop :: Transform
 -- Turn a nonrec let that binds a let into two nested lets.

-letflat (Let (NonRec b (Let binds  res')) res) = 
+letflat c (Let (NonRec b (Let binds  res')) res) = 

   change $ Let binds (Let (NonRec b res') res)
   change $ Let binds (Let (NonRec b res') res)

-letflat (Let (Rec binds) expr) = do
+letflat c (Let (Rec binds) expr) = do

   -- Flatten each binding.
   binds' <- Utils.concatM $ Monad.mapM flatbind binds
   -- Return the new let. We don't use change here, since possibly nothing has
   -- Flatten each binding.
   binds' <- Utils.concatM $ Monad.mapM flatbind binds
   -- Return the new let. We don't use change here, since possibly nothing has


@@ -226,7 +206,7 @@ letflat (Let (Rec binds) expr) = do
     flatbind (b, Let (NonRec b' expr') expr) = change [(b, expr), (b', expr')]
     flatbind (b, expr) = return [(b, expr)]
 -- Leave all other expressions unchanged
     flatbind (b, Let (NonRec b' expr') expr) = change [(b, expr), (b', expr')]
     flatbind (b, expr) = return [(b, expr)]
 -- Leave all other expressions unchanged

-letflat expr = return expr
+letflat c expr = return expr

 -- Perform this transform everywhere
 letflattop = everywhere ("letflat", letflat)
 
 -- Perform this transform everywhere
 letflattop = everywhere ("letflat", letflat)
 


@@ -235,9 +215,9 @@ letflattop = everywhere ("letflat", letflat)
 --------------------------------
 -- Remove empty (recursive) lets
 letremove, letremovetop :: Transform
 --------------------------------
 -- Remove empty (recursive) lets
 letremove, letremovetop :: Transform

-letremove (Let (Rec []) res) = change $ res
+letremove c (Let (Rec []) res) = change res

 -- Leave all other expressions unchanged
 -- Leave all other expressions unchanged

-letremove expr = return expr
+letremove c expr = return expr

 -- Perform this transform everywhere
 letremovetop = everywhere ("letremove", letremove)
 
 -- Perform this transform everywhere
 letremovetop = everywhere ("letremove", letremove)
 


@@ -252,12 +232,12 @@ letremovesimpletop = everywhere ("letremovesimple", inlinebind (\(b, e) -> Trans
 -- Unused let binding removal
 --------------------------------
 letremoveunused, letremoveunusedtop :: Transform
 -- Unused let binding removal
 --------------------------------
 letremoveunused, letremoveunusedtop :: Transform

-letremoveunused expr@(Let (NonRec b bound) res) = do
+letremoveunused c expr@(Let (NonRec b bound) res) = do

   let used = expr_uses_binders [b] res
   if used
     then return expr
     else change res
   let used = expr_uses_binders [b] res
   if used
     then return expr
     else change res

-letremoveunused expr@(Let (Rec binds) res) = do
+letremoveunused c expr@(Let (Rec binds) res) = do

   -- Filter out all unused binds.
   let binds' = filter dobind binds
   -- Only set the changed flag if binds got removed
   -- Filter out all unused binds.
   let binds' = filter dobind binds
   -- Only set the changed flag if binds got removed


@@ -268,7 +248,7 @@ letremoveunused expr@(Let (Rec binds) res) = do
       -- expressions
       dobind (bndr, _) = any (expr_uses_binders [bndr]) (res:bound_exprs)
 -- Leave all other expressions unchanged
       -- expressions
       dobind (bndr, _) = any (expr_uses_binders [bndr]) (res:bound_exprs)
 -- Leave all other expressions unchanged

-letremoveunused expr = return expr
+letremoveunused c expr = return expr

 letremoveunusedtop = everywhere ("letremoveunused", letremoveunused)
 
 {-
 letremoveunusedtop = everywhere ("letremoveunused", letremoveunused)
 
 {-


@@ -279,7 +259,7 @@ letremoveunusedtop = everywhere ("letremoveunused", letremoveunused)
 -- TODO: We would very much like to use GHC's CSE module for this, but that
 -- doesn't track if something changed or not, so we can't use it properly.
 letmerge, letmergetop :: Transform
 -- TODO: We would very much like to use GHC's CSE module for this, but that
 -- doesn't track if something changed or not, so we can't use it properly.
 letmerge, letmergetop :: Transform

-letmerge expr@(Let _ _) = do
+letmerge c expr@(Let _ _) = do

   let (binds, res) = flattenLets expr
   binds' <- domerge binds
   return $ mkNonRecLets binds' res
   let (binds, res) = flattenLets expr
   binds' <- domerge binds
   return $ mkNonRecLets binds' res


@@ -300,73 +280,202 @@ letmerge expr@(Let _ _) = do
       -- Different expressions? Don't change
       | otherwise = return (b2, e2)
 -- Leave all other expressions unchanged
       -- Different expressions? Don't change
       | otherwise = return (b2, e2)
 -- Leave all other expressions unchanged

-letmerge expr = return expr
+letmerge c expr = return expr

 letmergetop = everywhere ("letmerge", letmerge)
 -}
 
 --------------------------------
 letmergetop = everywhere ("letmerge", letmerge)
 -}
 
 --------------------------------

--- Function inlining
+-- Non-representable binding inlining

 --------------------------------
 --------------------------------

--- Remove a = B bindings, with B :: a -> b, or B :: forall x . T, from let
--- expressions everywhere. This means that any value that still needs to be
--- applied to something else (polymorphic values need to be applied to a
--- Type) will be inlined, and will eventually be applied to all their
--- arguments.
+-- Remove a = B bindings, with B of a non-representable type, from let
+-- expressions everywhere. This means that any value that we can't generate a
+-- signal for, will be inlined and hopefully turned into something we can
+-- represent.

 --
 -- This is a tricky function, which is prone to create loops in the
 -- transformations. To fix this, we make sure that no transformation will
 --
 -- This is a tricky function, which is prone to create loops in the
 -- transformations. To fix this, we make sure that no transformation will

--- create a new let binding with a function type. These other transformations
--- will just not work on those function-typed values at first, but the other
--- transformations (in particular β-reduction) should make sure that the type
--- of those values eventually becomes primitive.
+-- create a new let binding with a non-representable type. These other
+-- transformations will just not work on those function-typed values at first,
+-- but the other transformations (in particular β-reduction) should make sure
+-- that the type of those values eventually becomes representable.

 inlinenonreptop :: Transform
 inlinenonreptop = everywhere ("inlinenonrep", inlinebind ((Monad.liftM not) . isRepr . snd))
 
 inlinenonreptop :: Transform
 inlinenonreptop = everywhere ("inlinenonrep", inlinebind ((Monad.liftM not) . isRepr . snd))
 

+--------------------------------
+-- Top level function inlining
+--------------------------------
+-- This transformation inlines simple top level bindings. Simple
+-- currently means that the body is only a single application (though
+-- the complexity of the arguments is not currently checked) or that the
+-- normalized form only contains a single binding. This should catch most of the
+-- cases where a top level function is created that simply calls a type class
+-- method with a type and dictionary argument, e.g.
+--   fromInteger = GHC.Num.fromInteger (SizedWord D8) $dNum
+-- which is later called using simply
+--   fromInteger (smallInteger 10)
+--
+-- These useless wrappers are created by GHC automatically. If we don't
+-- inline them, we get loads of useless components cluttering the
+-- generated VHDL.
+--
+-- Note that the inlining could also inline simple functions defined by
+-- the user, not just GHC generated functions. It turns out to be near
+-- impossible to reliably determine what functions are generated and
+-- what functions are user-defined. Instead of guessing (which will
+-- inline less than we want) we will just inline all simple functions.
+--
+-- Only functions that are actually completely applied and bound by a
+-- variable in a let expression are inlined. These are the expressions
+-- that will eventually generate instantiations of trivial components.
+-- By not inlining any other reference, we also prevent looping problems
+-- with funextract and inlinedict.

 inlinetoplevel, inlinetopleveltop :: Transform
 inlinetoplevel, inlinetopleveltop :: Transform

--- Any system name is candidate for inlining. Never inline user-defined
--- functions, to preserve structure.
-inlinetoplevel expr@(Var f) | not $ isUserDefined f = do
-  norm <- isNormalizeable f
-  -- See if this is a top level binding for which we have a body
-  body_maybe <- Trans.lift $ getGlobalBind f
-  if norm && Maybe.isJust body_maybe
-    then do
-      -- Get the normalized version
-      norm <- Trans.lift $ getNormalized f
-      if needsInline norm 
-        then do
-          -- Regenerate all uniques in the to-be-inlined expression
-          norm_uniqued <- Trans.lift $ genUniques norm
-          change norm_uniqued
-        else
-          return expr
-    else
-      -- No body or not normalizeable.
-      return expr
+inlinetoplevel (LetBinding:_) expr | not (is_fun expr) =
+  case collectArgs expr of
+       (Var f, args) -> do
+         body_maybe <- needsInline f
+         case body_maybe of
+               Just body -> do
+                       -- Regenerate all uniques in the to-be-inlined expression
+                       body_uniqued <- Trans.lift $ genUniques body
+                       -- And replace the variable reference with the unique'd body.
+                       change (mkApps body_uniqued args)
+                       -- No need to inline
+               Nothing -> return expr
+       -- This is not an application of a binder, leave it unchanged.
+       _ -> return expr
+

 -- Leave all other expressions unchanged
 -- Leave all other expressions unchanged

-inlinetoplevel expr = return expr
+inlinetoplevel c expr = return expr

 inlinetopleveltop = everywhere ("inlinetoplevel", inlinetoplevel)
 inlinetopleveltop = everywhere ("inlinetoplevel", inlinetoplevel)

+  
+-- | Does the given binder need to be inlined? If so, return the body to
+-- be used for inlining.
+needsInline :: CoreBndr -> TransformMonad (Maybe CoreExpr)
+needsInline f = do
+  body_maybe <- Trans.lift $ getGlobalBind f
+  case body_maybe of
+    -- No body available?
+    Nothing -> return Nothing
+    Just body -> case CoreSyn.collectArgs body of
+      -- The body is some (top level) binder applied to 0 or more
+      -- arguments. That should be simple enough to inline.
+      (Var f, args) -> return $ Just body
+      -- Body is more complicated, try normalizing it
+      _ -> do
+        norm_maybe <- Trans.lift $ getNormalized_maybe f
+        case norm_maybe of
+          -- Noth normalizeable
+          Nothing -> return Nothing 
+          Just norm -> case splitNormalized norm of
+            -- The function has just a single binding, so that's simple
+            -- enough to inline.
+            (args, [bind], res) -> return $ Just norm
+            -- More complicated function, don't inline
+            _ -> return Nothing
+            
+--------------------------------
+-- Dictionary inlining
+--------------------------------
+-- Inline all top level dictionaries, that are in a position where
+-- classopresolution can actually resolve them. This makes this
+-- transformation look similar to classoperesolution below, but we'll
+-- keep them separated for clarity. By not inlining other dictionaries,
+-- we prevent expression sizes exploding when huge type level integer
+-- dictionaries are inlined which can never be expanded (in casts, for
+-- example).
+inlinedict c expr@(App (App (Var sel) ty) (Var dict)) | not is_builtin && is_classop = do
+  body_maybe <- Trans.lift $ getGlobalBind dict
+  case body_maybe of
+    -- No body available (no source available, or a local variable /
+    -- argument)
+    Nothing -> return expr
+    Just body -> change (App (App (Var sel) ty) body)
+  where
+    -- Is this a builtin function / method?
+    is_builtin = elem (Name.getOccString sel) builtinIds
+    -- Are we dealing with a class operation selector?
+    is_classop = Maybe.isJust (Id.isClassOpId_maybe sel)

 
 

-needsInline :: CoreExpr -> Bool
-needsInline expr = case splitNormalized expr of
-  -- Inline any function that only has a single definition, it is probably
-  -- simple enough. This might inline some stuff that it shouldn't though it
-  -- will never inline user-defined functions (inlinetoplevel only tries
-  -- system names) and inlining should never break things.
-  (args, [bind], res) -> True
-  _ -> False
+-- Leave all other expressions unchanged
+inlinedict c expr = return expr
+inlinedicttop = everywhere ("inlinedict", inlinedict)
+
+--------------------------------
+-- ClassOp resolution
+--------------------------------
+-- Resolves any class operation to the actual operation whenever
+-- possible. Class methods (as well as parent dictionary selectors) are
+-- special "functions" that take a type and a dictionary and evaluate to
+-- the corresponding method. A dictionary is nothing more than a
+-- special dataconstructor applied to the type the dictionary is for,
+-- each of the superclasses and all of the class method definitions for
+-- that particular type. Since dictionaries all always inlined (top
+-- levels dictionaries are inlined by inlinedict, local dictionaries are
+-- inlined by inlinenonrep), we will eventually have something like:
+--
+--   baz
+--     @ CLasH.HardwareTypes.Bit
+--     (D:Baz @ CLasH.HardwareTypes.Bit bitbaz)
+--
+-- Here, baz is the method selector for the baz method, while
+-- D:Baz is the dictionary constructor for the Baz and bitbaz is the baz
+-- method defined in the Baz Bit instance declaration.
+--
+-- To resolve this, we can look at the ClassOp IdInfo from the baz Id,
+-- which contains the Class it is defined for. From the Class, we can
+-- get a list of all selectors (both parent class selectors as well as
+-- method selectors). Since the arguments to D:Baz (after the type
+-- argument) correspond exactly to this list, we then look up baz in
+-- that list and replace the entire expression by the corresponding 
+-- argument to D:Baz.
+--
+-- We don't resolve methods that have a builtin translation (such as
+-- ==), since the actual implementation is not always (easily)
+-- translateable. For example, when deriving ==, GHC generates code
+-- using $con2tag functions to translate a datacon to an int and compare
+-- that with GHC.Prim.==# . Better to avoid that for now.
+classopresolution, classopresolutiontop :: Transform
+classopresolution c expr@(App (App (Var sel) ty) dict) | not is_builtin =
+  case Id.isClassOpId_maybe sel of
+    -- Not a class op selector
+    Nothing -> return expr
+    Just cls -> case collectArgs dict of
+      (_, []) -> return expr -- Dict is not an application (e.g., not inlined yet)
+      (Var dictdc, (ty':selectors)) | not (Maybe.isJust (Id.isDataConId_maybe dictdc)) -> return expr -- Dictionary is not a datacon yet (but e.g., a top level binder)
+                                | tyargs_neq ty ty' -> error $ "Normalize.classopresolution: Applying class selector to dictionary without matching type?\n" ++ pprString expr
+                                | otherwise ->
+        let selector_ids = Class.classSelIds cls in
+        -- Find the selector used in the class' list of selectors
+        case List.elemIndex sel selector_ids of
+          Nothing -> error $ "Normalize.classopresolution: Selector not found in class' selector list? This should not happen!\nExpression: " ++ pprString expr ++ "\nClass: " ++ show cls ++ "\nSelectors: " ++ show selector_ids
+          -- Get the corresponding argument from the dictionary
+          Just n -> change (selectors!!n)
+      (_, _) -> return expr -- Not applying a variable? Don't touch
+  where
+    -- Compare two type arguments, returning True if they are _not_
+    -- equal
+    tyargs_neq (Type ty1) (Type ty2) = not $ Type.coreEqType ty1 ty2
+    tyargs_neq _ _ = True
+    -- Is this a builtin function / method?
+    is_builtin = elem (Name.getOccString sel) builtinIds
+
+-- Leave all other expressions unchanged
+classopresolution c expr = return expr
+-- Perform this transform everywhere
+classopresolutiontop = everywhere ("classopresolution", classopresolution)

 
 --------------------------------
 -- Scrutinee simplification
 --------------------------------
 scrutsimpl,scrutsimpltop :: Transform
 -- Don't touch scrutinees that are already simple
 
 --------------------------------
 -- Scrutinee simplification
 --------------------------------
 scrutsimpl,scrutsimpltop :: Transform
 -- Don't touch scrutinees that are already simple

-scrutsimpl expr@(Case (Var _) _ _ _) = return expr
+scrutsimpl c expr@(Case (Var _) _ _ _) = return expr

 -- Replace all other cases with a let that binds the scrutinee and a new
 -- simple scrutinee, but only when the scrutinee is representable (to prevent
 -- loops with inlinenonrep, though I don't think a non-representable scrutinee
 -- will be supported anyway...) 
 -- Replace all other cases with a let that binds the scrutinee and a new
 -- simple scrutinee, but only when the scrutinee is representable (to prevent
 -- loops with inlinenonrep, though I don't think a non-representable scrutinee
 -- will be supported anyway...) 

-scrutsimpl expr@(Case scrut b ty alts) = do
+scrutsimpl c expr@(Case scrut b ty alts) = do

   repr <- isRepr scrut
   if repr
     then do
   repr <- isRepr scrut
   if repr
     then do


@@ -375,10 +484,35 @@ scrutsimpl expr@(Case scrut b ty alts) = do
     else
       return expr
 -- Leave all other expressions unchanged
     else
       return expr
 -- Leave all other expressions unchanged

-scrutsimpl expr = return expr
+scrutsimpl c expr = return expr

 -- Perform this transform everywhere
 scrutsimpltop = everywhere ("scrutsimpl", scrutsimpl)
 
 -- Perform this transform everywhere
 scrutsimpltop = everywhere ("scrutsimpl", scrutsimpl)
 

+--------------------------------
+-- Scrutinee binder removal
+--------------------------------
+-- A case expression can have an extra binder, to which the scrutinee is bound
+-- after bringing it to WHNF. This is used for forcing evaluation of strict
+-- arguments. Since strictness does not matter for us (rather, everything is
+-- sort of strict), this binder is ignored when generating VHDL, and must thus
+-- be wild in the normal form.
+scrutbndrremove, scrutbndrremovetop :: Transform
+-- If the scrutinee is already simple, and the bndr is not wild yet, replace
+-- all occurences of the binder with the scrutinee variable.
+scrutbndrremove c (Case (Var scrut) bndr ty alts) | bndr_used = do
+    alts' <- mapM subs_bndr alts
+    change $ Case (Var scrut) wild ty alts'
+  where
+    is_used (_, _, expr) = expr_uses_binders [bndr] expr
+    bndr_used = or $ map is_used alts
+    subs_bndr (con, bndrs, expr) = do
+      expr' <- substitute bndr (Var scrut) c expr
+      return (con, bndrs, expr')
+    wild = MkCore.mkWildBinder (Id.idType bndr)
+-- Leave all other expressions unchanged
+scrutbndrremove c expr = return expr
+scrutbndrremovetop = everywhere ("scrutbndrremove", scrutbndrremove)
+

 --------------------------------
 -- Case binder wildening
 --------------------------------
 --------------------------------
 -- Case binder wildening
 --------------------------------


@@ -386,24 +520,27 @@ casesimpl, casesimpltop :: Transform
 -- This is already a selector case (or, if x does not appear in bndrs, a very
 -- simple case statement that will be removed by caseremove below). Just leave
 -- it be.
 -- This is already a selector case (or, if x does not appear in bndrs, a very
 -- simple case statement that will be removed by caseremove below). Just leave
 -- it be.

-casesimpl expr@(Case scrut b ty [(con, bndrs, Var x)]) = return expr
+casesimpl c expr@(Case scrut b ty [(con, bndrs, Var x)]) = return expr

 -- Make sure that all case alternatives have only wild binders and simple
 -- expressions.
 -- This is done by creating a new let binding for each non-wild binder, which
 -- is bound to a new simple selector case statement and for each complex
 -- expression. We do this only for representable types, to prevent loops with
 -- inlinenonrep.
 -- Make sure that all case alternatives have only wild binders and simple
 -- expressions.
 -- This is done by creating a new let binding for each non-wild binder, which
 -- is bound to a new simple selector case statement and for each complex
 -- expression. We do this only for representable types, to prevent loops with
 -- inlinenonrep.

-casesimpl expr@(Case scrut b ty alts) = do
+casesimpl c expr@(Case scrut bndr ty alts) | not bndr_used = do

   (bindingss, alts') <- (Monad.liftM unzip) $ mapM doalt alts
   let bindings = concat bindingss
   -- Replace the case with a let with bindings and a case
   (bindingss, alts') <- (Monad.liftM unzip) $ mapM doalt alts
   let bindings = concat bindingss
   -- Replace the case with a let with bindings and a case

-  let newlet = mkNonRecLets bindings (Case scrut b ty alts')
+  let newlet = mkNonRecLets bindings (Case scrut bndr ty alts')

   -- If there are no non-wild binders, or this case is already a simple
   -- selector (i.e., a single alt with exactly one binding), already a simple
   -- selector altan no bindings (i.e., no wild binders in the original case),
   -- don't change anything, otherwise, replace the case.
   if null bindings then return expr else change newlet 
   where
   -- If there are no non-wild binders, or this case is already a simple
   -- selector (i.e., a single alt with exactly one binding), already a simple
   -- selector altan no bindings (i.e., no wild binders in the original case),
   -- don't change anything, otherwise, replace the case.
   if null bindings then return expr else change newlet 
   where

+  -- Check if the scrutinee binder is used
+  is_used (_, _, expr) = expr_uses_binders [bndr] expr
+  bndr_used = or $ map is_used alts

   -- Generate a single wild binder, since they are all the same
   wild = MkCore.mkWildBinder
   -- Wilden the binders of one alt, producing a list of bindings as a
   -- Generate a single wild binder, since they are all the same
   wild = MkCore.mkWildBinder
   -- Wilden the binders of one alt, producing a list of bindings as a


@@ -416,7 +553,7 @@ casesimpl expr@(Case scrut b ty alts) = do
     -- Extract a complex expression, if possible. For this we check if any of
     -- the new list of bndrs are used by expr. We can't use free_vars here,
     -- since that looks at the old bndrs.
     -- Extract a complex expression, if possible. For this we check if any of
     -- the new list of bndrs are used by expr. We can't use free_vars here,
     -- since that looks at the old bndrs.

-    let uses_bndrs = not $ VarSet.isEmptyVarSet $ CoreFVs.exprSomeFreeVars (`elem` newbndrs) $ expr
+    let uses_bndrs = not $ VarSet.isEmptyVarSet $ CoreFVs.exprSomeFreeVars (`elem` newbndrs) expr

     (exprbinding_maybe, expr') <- doexpr expr uses_bndrs
     -- Create a new alternative
     let newalt = (con, newbndrs, expr')
     (exprbinding_maybe, expr') <- doexpr expr uses_bndrs
     -- Create a new alternative
     let newalt = (con, newbndrs, expr')


@@ -467,12 +604,12 @@ casesimpl expr@(Case scrut b ty alts) = do
             id <- Trans.lift $ mkBinderFor expr "caseval"
             -- We don't flag a change here, since casevalsimpl will do that above
             -- based on Just we return here.
             id <- Trans.lift $ mkBinderFor expr "caseval"
             -- We don't flag a change here, since casevalsimpl will do that above
             -- based on Just we return here.

-            return $ (Just (id, expr), Var id)
+            return (Just (id, expr), Var id)

           else
             -- Don't simplify anything else
             return (Nothing, expr)
 -- Leave all other expressions unchanged
           else
             -- Don't simplify anything else
             return (Nothing, expr)
 -- Leave all other expressions unchanged

-casesimpl expr = return expr
+casesimpl c expr = return expr

 -- Perform this transform everywhere
 casesimpltop = everywhere ("casesimpl", casesimpl)
 
 -- Perform this transform everywhere
 casesimpltop = everywhere ("casesimpl", casesimpl)
 


@@ -483,11 +620,11 @@ casesimpltop = everywhere ("casesimpl", casesimpl)
 -- binders.
 caseremove, caseremovetop :: Transform
 -- Replace a useless case by the value of its single alternative
 -- binders.
 caseremove, caseremovetop :: Transform
 -- Replace a useless case by the value of its single alternative

-caseremove (Case scrut b ty [(con, bndrs, expr)]) | not usesvars = change expr
+caseremove c (Case scrut b ty [(con, bndrs, expr)]) | not usesvars = change expr

     -- Find if any of the binders are used by expr
     -- Find if any of the binders are used by expr

-    where usesvars = (not . VarSet.isEmptyVarSet . (CoreFVs.exprSomeFreeVars (`elem` bndrs))) expr
+    where usesvars = (not . VarSet.isEmptyVarSet . (CoreFVs.exprSomeFreeVars (`elem` b:bndrs))) expr

 -- Leave all other expressions unchanged
 -- Leave all other expressions unchanged

-caseremove expr = return expr
+caseremove c expr = return expr

 -- Perform this transform everywhere
 caseremovetop = everywhere ("caseremove", caseremove)
 
 -- Perform this transform everywhere
 caseremovetop = everywhere ("caseremove", caseremove)
 


@@ -498,7 +635,7 @@ caseremovetop = everywhere ("caseremove", caseremove)
 appsimpl, appsimpltop :: Transform
 -- Simplify all representable arguments. Do this by introducing a new Let
 -- that binds the argument and passing the new binder in the application.
 appsimpl, appsimpltop :: Transform
 -- Simplify all representable arguments. Do this by introducing a new Let
 -- that binds the argument and passing the new binder in the application.

-appsimpl expr@(App f arg) = do
+appsimpl c expr@(App f arg) = do

   -- Check runtime representability
   repr <- isRepr arg
   local_var <- Trans.lift $ is_local_var arg
   -- Check runtime representability
   repr <- isRepr arg
   local_var <- Trans.lift $ is_local_var arg


@@ -509,7 +646,7 @@ appsimpl expr@(App f arg) = do
     else -- Leave non-representable arguments unchanged
       return expr
 -- Leave all other expressions unchanged
     else -- Leave non-representable arguments unchanged
       return expr
 -- Leave all other expressions unchanged

-appsimpl expr = return expr
+appsimpl c expr = return expr

 -- Perform this transform everywhere
 appsimpltop = everywhere ("appsimpl", appsimpl)
 
 -- Perform this transform everywhere
 appsimpltop = everywhere ("appsimpl", appsimpl)
 


@@ -523,7 +660,7 @@ argprop, argproptop :: Transform
 -- Transform any application of a named function (i.e., skip applications of
 -- lambda's). Also skip applications that have arguments with free type
 -- variables, since we can't inline those.
 -- Transform any application of a named function (i.e., skip applications of
 -- lambda's). Also skip applications that have arguments with free type
 -- variables, since we can't inline those.

-argprop expr@(App _ _) | is_var fexpr = do
+argprop c expr@(App _ _) | is_var fexpr = do

   -- Find the body of the function called
   body_maybe <- Trans.lift $ getGlobalBind f
   case body_maybe of
   -- Find the body of the function called
   body_maybe <- Trans.lift $ getGlobalBind f
   case body_maybe of


@@ -541,6 +678,12 @@ argprop expr@(App _ _) | is_var fexpr = do
           let newbody = MkCore.mkCoreLams newparams (MkCore.mkCoreApps body oldargs)
           -- Create a new function with the same name but a new body
           newf <- Trans.lift $ mkFunction f newbody
           let newbody = MkCore.mkCoreLams newparams (MkCore.mkCoreApps body oldargs)
           -- Create a new function with the same name but a new body
           newf <- Trans.lift $ mkFunction f newbody

+
+          Trans.lift $ MonadState.modify tsInitStates (\ismap ->
+            let init_state_maybe = Map.lookup f ismap in
+            case init_state_maybe of
+              Nothing -> ismap
+              Just init_state -> Map.insert newf init_state ismap)

           -- Replace the original application with one of the new function to the
           -- new arguments.
           change $ MkCore.mkCoreApps (Var newf) newargs
           -- Replace the original application with one of the new function to the
           -- new arguments.
           change $ MkCore.mkCoreApps (Var newf) newargs


@@ -565,7 +708,7 @@ argprop expr@(App _ _) | is_var fexpr = do
     doarg arg = do
       repr <- isRepr arg
       bndrs <- Trans.lift getGlobalBinders
     doarg arg = do
       repr <- isRepr arg
       bndrs <- Trans.lift getGlobalBinders

-      let interesting var = Var.isLocalVar var && (not $ var `elem` bndrs)
+      let interesting var = Var.isLocalVar var && (var `notElem` bndrs)

       if not repr && not (is_var arg && interesting (exprToVar arg)) && not (has_free_tyvars arg) 
         then do
           -- Propagate all complex arguments that are not representable, but not
       if not repr && not (is_var arg && interesting (exprToVar arg)) && not (has_free_tyvars arg) 
         then do
           -- Propagate all complex arguments that are not representable, but not


@@ -581,17 +724,25 @@ argprop expr@(App _ _) | is_var fexpr = do
           let free_vars = VarSet.varSetElems $ CoreFVs.exprSomeFreeVars interesting arg
           -- Mark the current expression as changed
           setChanged
           let free_vars = VarSet.varSetElems $ CoreFVs.exprSomeFreeVars interesting arg
           -- Mark the current expression as changed
           setChanged

+          -- TODO: Clone the free_vars (and update references in arg), since
+          -- this might cause conflicts if two arguments that are propagated
+          -- share a free variable. Also, we are now introducing new variables
+          -- into a function that are not fresh, which violates the binder
+          -- uniqueness invariant.

           return (map Var free_vars, free_vars, arg)
         else do
           -- Representable types will not be propagated, and arguments with free
           -- type variables will be propagated later.
           return (map Var free_vars, free_vars, arg)
         else do
           -- Representable types will not be propagated, and arguments with free
           -- type variables will be propagated later.

+          -- Note that we implicitly remove any type variables in the type of
+          -- the original argument by using the type of the actual argument
+          -- for the new formal parameter.

           -- TODO: preserve original naming?
           id <- Trans.lift $ mkBinderFor arg "param"
           -- Just pass the original argument to the new function, which binds it
           -- to a new id and just pass that new id to the old function body.
           return ([arg], [id], mkReferenceTo id) 
 -- Leave all other expressions unchanged
           -- TODO: preserve original naming?
           id <- Trans.lift $ mkBinderFor arg "param"
           -- Just pass the original argument to the new function, which binds it
           -- to a new id and just pass that new id to the old function body.
           return ([arg], [id], mkReferenceTo id) 
 -- Leave all other expressions unchanged

-argprop expr = return expr
+argprop c expr = return expr

 -- Perform this transform everywhere
 argproptop = everywhere ("argprop", argprop)
 
 -- Perform this transform everywhere
 argproptop = everywhere ("argprop", argprop)
 


@@ -604,7 +755,7 @@ argproptop = everywhere ("argprop", argprop)
 -- apply map to a lambda expression This will not conflict with inlinenonrep,
 -- since that only inlines local let bindings, not top level bindings.
 funextract, funextracttop :: Transform
 -- apply map to a lambda expression This will not conflict with inlinenonrep,
 -- since that only inlines local let bindings, not top level bindings.
 funextract, funextracttop :: Transform

-funextract expr@(App _ _) | is_var fexpr = do
+funextract c expr@(App _ _) | is_var fexpr = do

   body_maybe <- Trans.lift $ getGlobalBind f
   case body_maybe of
     -- We don't have a function body for f, so we can perform this transform.
   body_maybe <- Trans.lift $ getGlobalBind f
   case body_maybe of
     -- We don't have a function body for f, so we can perform this transform.


@@ -642,29 +793,10 @@ funextract expr@(App _ _) | is_var fexpr = do
     doarg arg = return arg
 
 -- Leave all other expressions unchanged
     doarg arg = return arg
 
 -- Leave all other expressions unchanged

-funextract expr = return expr
+funextract c expr = return expr

 -- Perform this transform everywhere
 funextracttop = everywhere ("funextract", funextract)
 
 -- Perform this transform everywhere
 funextracttop = everywhere ("funextract", funextract)
 

---------------------------------
--- Ensure that a function that just returns another function (or rather,
--- another top-level binder) is still properly normalized. This is a temporary
--- solution, we should probably integrate this pass with lambdasimpl and
--- letsimpl instead.
---------------------------------
-simplrestop expr@(Lam _ _) = return expr
-simplrestop expr@(Let _ _) = return expr
-simplrestop expr = do
-  local_var <- Trans.lift $ is_local_var expr
-  -- Don't extract values that are not representable, to prevent loops with
-  -- inlinenonrep
-  repr <- isRepr expr
-  if local_var || not repr
-    then
-      return expr
-    else do
-      id <- Trans.lift $ mkBinderFor expr "res" 
-      change $ Let (NonRec id expr) (Var id)

 --------------------------------
 -- End of transformations
 --------------------------------
 --------------------------------
 -- End of transformations
 --------------------------------


@@ -673,22 +805,43 @@ simplrestop expr = do
 
 
 -- What transforms to run?
 
 
 -- What transforms to run?

-transforms = [inlinetopleveltop, argproptop, funextracttop, etatop, betatop, castproptop, letremovesimpletop, letderectop, letremovetop, letsimpltop, letflattop, scrutsimpltop, casesimpltop, caseremovetop, inlinenonreptop, appsimpltop, letremoveunusedtop, castsimpltop, lambdasimpltop, simplrestop]
+transforms = [inlinedicttop, inlinetopleveltop, classopresolutiontop, argproptop, funextracttop, etatop, betatop, castproptop, letremovesimpletop, letderectop, letremovetop, retvalsimpltop, letflattop, scrutsimpltop, scrutbndrremovetop, casesimpltop, caseremovetop, inlinenonreptop, appsimpltop, letremoveunusedtop, castsimpltop]

 
 

--- | Returns the normalized version of the given function.
+-- | Returns the normalized version of the given function, or an error
+-- if it is not a known global binder.

 getNormalized ::
   CoreBndr -- ^ The function to get
   -> TranslatorSession CoreExpr -- The normalized function body
 getNormalized ::
   CoreBndr -- ^ The function to get
   -> TranslatorSession CoreExpr -- The normalized function body

-
-getNormalized bndr = Utils.makeCached bndr tsNormalized $ do
-  if is_poly (Var bndr)
-    then
-      -- This should really only happen at the top level... TODO: Give
-      -- a different error if this happens down in the recursion.
-      error $ "\nNormalize.normalizeBind: Function " ++ show bndr ++ " is polymorphic, can't normalize"
-    else do
-      expr <- getBinding bndr
-      normalizeExpr (show bndr) expr
+getNormalized bndr = do
+  norm <- getNormalized_maybe bndr
+  return $ Maybe.fromMaybe
+    (error $ "Normalize.getNormalized: Unknown or non-representable function requested: " ++ show bndr)
+    norm
+
+-- | Returns the normalized version of the given function, or Nothing
+-- when the binder is not a known global binder or is not normalizeable.
+getNormalized_maybe ::
+  CoreBndr -- ^ The function to get
+  -> TranslatorSession (Maybe CoreExpr) -- The normalized function body
+
+getNormalized_maybe bndr = do
+    expr_maybe <- getGlobalBind bndr
+    normalizeable <- isNormalizeable' bndr
+    if not normalizeable || Maybe.isNothing expr_maybe
+      then
+        -- Binder not normalizeable or not found
+        return Nothing
+      else if is_poly (Var bndr)
+        then
+          -- This should really only happen at the top level... TODO: Give
+          -- a different error if this happens down in the recursion.
+          error $ "\nNormalize.normalizeBind: Function " ++ show bndr ++ " is polymorphic, can't normalize"
+        else do
+          -- Binder found and is monomorphic. Normalize the expression
+          -- and cache the result.
+          normalized <- Utils.makeCached bndr tsNormalized $ 
+            normalizeExpr (show bndr) (Maybe.fromJust expr_maybe)
+          return (Just normalized)

 
 -- | Normalize an expression
 normalizeExpr ::
 
 -- | Normalize an expression
 normalizeExpr ::


@@ -697,24 +850,16 @@ normalizeExpr ::
   -> TranslatorSession CoreSyn.CoreExpr -- ^ The normalized expression
 
 normalizeExpr what expr = do
   -> TranslatorSession CoreSyn.CoreExpr -- ^ The normalized expression
 
 normalizeExpr what expr = do

+      startcount <- MonadState.get tsTransformCounter 

       expr_uniqued <- genUniques expr
       -- Normalize this expression
       trace (what ++ " before normalization:\n\n" ++ showSDoc ( ppr expr_uniqued ) ++ "\n") $ return ()
       expr' <- dotransforms transforms expr_uniqued
       expr_uniqued <- genUniques expr
       -- Normalize this expression
       trace (what ++ " before normalization:\n\n" ++ showSDoc ( ppr expr_uniqued ) ++ "\n") $ return ()
       expr' <- dotransforms transforms expr_uniqued

+      endcount <- MonadState.get tsTransformCounter 

       trace ("\n" ++ what ++ " after normalization:\n\n" ++ showSDoc ( ppr expr')) $ return ()
       trace ("\n" ++ what ++ " after normalization:\n\n" ++ showSDoc ( ppr expr')) $ return ()

+      trace ("\nNeeded " ++ show (endcount - startcount) ++ " transformations to normalize " ++ what) $ return ()

       return expr'
 
       return expr'
 

--- | Get the value that is bound to the given binder at top level. Fails when
---   there is no such binding.
-getBinding ::
-  CoreBndr -- ^ The binder to get the expression for
-  -> TranslatorSession CoreExpr -- ^ The value bound to the binder
-
-getBinding bndr = Utils.makeCached bndr tsBindings $ do
-  -- If the binding isn't in the "cache" (bindings map), then we can't create
-  -- it out of thin air, so return an error.
-  error $ "Normalize.getBinding: Unknown function requested: " ++ show bndr
-

 -- | Split a normalized expression into the argument binders, top level
 --   bindings and the result binder.
 splitNormalized ::
 -- | Split a normalized expression into the argument binders, top level
 --   bindings and the result binder.
 splitNormalized ::