Inline all simple top level functions, not just compiler-generated ones.
[matthijs/master-project/cλash.git] / cλash / CLasH / Normalize.hs
index c761433551412714f8c8e58e0451005aa31db5cb..89b5a8118691d99d9eb63077be7f761734478146 100644 (file)
@@ -327,35 +327,35 @@ inlinenonreptop = everywhere ("inlinenonrep", inlinebind ((Monad.liftM not) . is
 --------------------------------
 -- Top level function inlining
 --------------------------------
--- This transformation inlines top level bindings that have been generated by
--- the compiler and are really simple. Really simple currently means that the
--- normalized form only contains a single binding, which catches most of the
+-- 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)
--- By inlining such calls to simple, compiler generated functions, we prevent
--- huge amounts of trivial components in the VHDL output, which the user never
--- wanted. We never inline user-defined functions, since we want to preserve
--- all structure defined by the user. Currently this includes all functions
--- that were created by funextract, since we would get loops otherwise.
+--
+-- 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.
---
--- Note that "defined by the compiler" isn't completely watertight, since GHC
--- doesn't seem to set all those names as "system names", we apply some
--- guessing here.
 inlinetoplevel, inlinetopleveltop :: Transform
 inlinetoplevel (LetBinding:_) expr =
   case collectArgs expr of
-       -- Any system name is candidate for inlining. Never inline
-       -- user-defined functions, to preserve structure.
-       (Var f, args) | not $ isUserDefined f -> do
+       (Var f, args) -> do
          body_maybe <- needsInline f
          case body_maybe of
                Just body -> do
@@ -400,13 +400,25 @@ needsInline f = do
 --------------------------------
 -- Dictionary inlining
 --------------------------------
--- Inline all top level dictionaries, so we can use them to resolve
--- class methods based on the dictionary passed. 
-inlinedict c expr@(Var f) | Id.isDictId f = do
-  body_maybe <- Trans.lift $ getGlobalBind f
+-- 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 body
+    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)
 
 -- Leave all other expressions unchanged
 inlinedict c expr = return expr