X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FNormalize.hs;h=a5b2a9474d290dbb7fb6d0804c7f3c6622fb41b7;hb=d54117f6de8d00fe0ce7552c905cf197678d7ed7;hp=fa6ae8c25f9f387fdcdea2b8708329463e2e6cd3;hpb=2e46e22eb0971c345e592314bd33729902e94d21;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/Normalize.hs" "b/c\316\273ash/CLasH/Normalize.hs" index fa6ae8c..a5b2a94 100644 --- "a/c\316\273ash/CLasH/Normalize.hs" +++ "b/c\316\273ash/CLasH/Normalize.hs" @@ -48,13 +48,20 @@ import CLasH.Utils.Pretty -- η abstraction -------------------------------- eta, etatop :: Transform +-- Don't apply to expressions that are applied, since that would cause +-- us to apply to our own result indefinitely. +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 -etatop = notappargs ("eta", eta) +etatop = everywhere ("eta", eta) -------------------------------- -- β-reduction