X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=clash%2FCLasH%2FNormalize.hs;h=4ce4ffa53b4b189b4f7983968f5aac0a18c47ad8;hb=a2b8cfae9cad1ad7040993f7f2458dd73fb968cd;hp=c27e93eb7803c0c4604492308cbccd9fadbc2864;hpb=04f836932ad17dd557af0ba388a12d2b74c1e7d7;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/clash/CLasH/Normalize.hs b/clash/CLasH/Normalize.hs
index c27e93e..4ce4ffa 100644
--- a/clash/CLasH/Normalize.hs
+++ b/clash/CLasH/Normalize.hs
@@ -216,10 +216,15 @@ needsInline f = do
 -- body consisting of a bunch of nested lambdas containing a
 -- non-function value (e.g., a complete application).
 eta :: Transform
-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)))
+eta (AppFirst:_) expr = return expr
+-- Also don't apply to arguments, since this can cause loops with
+-- funextract. This isn't the proper solution, but due to an
+-- implementation bug in notappargs, this is how it used to work so far.
+eta (AppSecond:_) expr = return expr
+eta c expr | is_fun expr && not (is_lam expr) = 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
 eta c e = return e
 
@@ -375,7 +380,7 @@ funextract c expr@(App _ _) | is_var fexpr = do
     -- We could use is_applicable here instead of is_fun, but I think
     -- arguments to functions could only have forall typing when existential
     -- typing is enabled. Not sure, though.
-    doarg arg | not (is_simple arg) && is_fun arg = do
+    doarg arg | not (is_simple arg) && is_fun arg && not (has_free_tyvars arg) = do
       -- Create a new top level binding that binds the argument. Its body will
       -- be extended with lambda expressions, to take any free variables used
       -- by the argument expression.
@@ -947,7 +952,7 @@ letmerge c expr = return expr
 -- What transforms to run?
 transforms = [ ("inlinedict", inlinedict)
              , ("inlinetoplevel", inlinetoplevel)
-             , ("inlinenonrepresult", inlinenonrepresult)
+             -- , ("inlinenonrepresult", inlinenonrepresult)
              , ("knowncase", knowncase)
              , ("classopresolution", classopresolution)
              , ("argprop", argprop)