Fix bug with eta reduction rewrite rule

Author: Unisay

flake.nix

@@ -65,6 +65,12 @@
                   yamlfmt
                 ];
               };
+
+              crossPlatforms =
+                p:
+                pkgs.lib.optionals pkgs.stdenv.hostPlatform.isx86_64 (
+                  pkgs.lib.optionals pkgs.stdenv.hostPlatform.isLinux [ p.musl64 ]
+                );
             };
           })
         ];

lib/Language/PureScript/Backend/IR/Optimizer.hs

@@ -171,6 +171,13 @@ idempotently = fix $ \i f a →
   let a' = f a
    in if a' == a then a else i f a'
 
+--         if a' == a
+--           then tr "FIXPOINT" a a
+--           else tr "RETRYING" a' (i f a')
+--  where
+--   tr ∷ Show x ⇒ String → x → y → y
+--   tr l x y = trace ("\n\n" <> l <> "\n" <> (toString . pShow) x <> "\n") y
+
 optimizeModule ∷ UberModule → UberModule
 optimizeModule UberModule {..} =
   UberModule
@@ -271,8 +278,9 @@ betaReduce =
 etaReduce ∷ RewriteRule Ann
 etaReduce =
   pure . \case
-    Abs _ (ParamNamed _ _param) (App _ m (Ref _ (Local _) 0)) →
-      Rewritten Recurse m
+    Abs _ (ParamNamed _ param) (App _ m (Ref _ (Local param') 0))
+      | param == param' →
+          Rewritten Recurse m
     _ → NoChange
 
 betaReduceUnusedParams ∷ RewriteRule Ann

test/ps/output/Golden.Bug2.Test/corefn.json

@@ -0,0 +1 @@
+{"builtWith":"0.15.15","comments":[],"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[3,19],"start":[3,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[3,19],"start":[3,1]}},"argument":"f","body":{"annotation":{"meta":null,"sourceSpan":{"end":[3,19],"start":[3,1]}},"argument":"a","body":{"annotation":{"meta":null,"sourceSpan":{"end":[3,19],"start":[3,1]}},"argument":"b","body":{"abstraction":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[3,15],"start":[3,14]}},"type":"Var","value":{"identifier":"f","sourcePos":[3,1]}},"annotation":{"meta":null,"sourceSpan":{"end":[3,17],"start":[3,14]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[3,17],"start":[3,16]}},"type":"Var","value":{"identifier":"b","sourcePos":[3,1]}},"type":"App"},"annotation":{"meta":null,"sourceSpan":{"end":[3,19],"start":[3,14]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[3,19],"start":[3,18]}},"type":"Var","value":{"identifier":"a","sourcePos":[3,1]}},"type":"App"},"type":"Abs"},"type":"Abs"},"type":"Abs"},"identifier":"flip"}],"exports":["flip"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[3,19],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Golden","Bug2","Test"],"modulePath":"golden/Golden/Bug2/Test.purs","reExports":{},"sourceSpan":{"end":[3,19],"start":[1,1]}}

test/ps/output/Golden.Bug2.Test/golden.ir

@@ -0,0 +1,21 @@
+UberModule
+  { uberModuleBindings = [], uberModuleForeigns = [], uberModuleExports =
+    [
+      ( Name "flip", Abs Nothing
+        ( ParamNamed Nothing ( Name "f" ) )
+        ( Abs Nothing
+          ( ParamNamed Nothing ( Name "a" ) )
+          ( Abs Nothing
+            ( ParamNamed Nothing ( Name "b" ) )
+            ( App Nothing
+              ( App Nothing
+                ( Ref Nothing ( Local ( Name "f" ) ) 0 )
+                ( Ref Nothing ( Local ( Name "b" ) ) 0 )
+              )
+              ( Ref Nothing ( Local ( Name "a" ) ) 0 )
+            )
+          )
+        )
+      )
+    ]
+  }

test/ps/output/Golden.Bug2.Test/golden.lua

@@ -0,0 +1,5 @@
+return {
+  flip = function(f)
+    return function(a) return function(b) return f(b)(a) end end
+  end
+}

test/ps/output/Golden.NameShadowing.Test/golden.ir

@@ -51,8 +51,20 @@ UberModule
           )
         )
       ),
-      ( Name "c", Ref Nothing
-        ( Imported ( ModuleName "Golden.NameShadowing.Test" ) ( Name "f" ) ) 0
+      ( Name "c", Abs Nothing
+        ( ParamNamed Nothing ( Name "y" ) )
+        ( Abs Nothing
+          ( ParamNamed Nothing ( Name "x1" ) )
+          ( App Nothing
+            ( App Nothing
+              ( Ref Nothing
+                ( Imported ( ModuleName "Golden.NameShadowing.Test" ) ( Name "f" ) ) 0
+              )
+              ( Ref Nothing ( Local ( Name "x1" ) ) 0 )
+            )
+            ( Ref Nothing ( Local ( Name "y" ) ) 0 )
+          )
+        )
       )
     ]
   }

test/ps/output/Golden.NameShadowing.Test/golden.lua

@@ -10,5 +10,7 @@ return {
       return M.Golden_NameShadowing_Test_f(M.Golden_NameShadowing_Test_f(x)(x1))(M.Golden_NameShadowing_Test_f(42)(1))
     end
   end,
-  c = M.Golden_NameShadowing_Test_f
+  c = function(y)
+    return function(x1) return M.Golden_NameShadowing_Test_f(x1)(y) end
+  end
 }

test/ps/output/Golden.RecursiveBindings.Test/golden.ir

@@ -96,8 +96,20 @@ UberModule
           ( Nothing, Name "z", LiteralInt Nothing 1 ) :|
           [ RecursiveGroup
             (
-              ( Nothing, Name "a", Ref Nothing ( Local ( Name "b" ) ) 0 ) :|
-              [ ( Nothing, Name "b", Ref Nothing ( Local ( Name "a" ) ) 0 ) ]
+              ( Nothing, Name "a", Abs Nothing ( ParamUnused Nothing )
+                ( App Nothing
+                  ( Ref Nothing ( Local ( Name "b" ) ) 0 )
+                  ( Ref Nothing ( Local ( Name "z" ) ) 0 )
+                )
+              ) :|
+              [
+                ( Nothing, Name "b", Abs Nothing ( ParamUnused Nothing )
+                  ( App Nothing
+                    ( Ref Nothing ( Local ( Name "a" ) ) 0 )
+                    ( Ref Nothing ( Local ( Name "z" ) ) 0 )
+                  )
+                )
+              ]
             ), Standalone
             ( Nothing, Name "f", Abs Nothing ( ParamUnused Nothing )
               ( Ref Nothing ( Local ( Name "a" ) ) 0 )

test/ps/output/Golden.RecursiveBindings.Test/golden.lua

@@ -57,8 +57,8 @@ return {
     local z = 1
     local a
     local b
-    a = b
-    b = a
+    a = function() return b(z) end
+    b = function() return a(z) end
     local f = function() return a end
     local y = f(z)(z)
     return f(f(y)(y))(f(y)(0))

test/ps/spago.dhall

@@ -1,5 +1,5 @@
 { name = "test-project"
-, dependencies = [ "effect", "prelude" ]
+, dependencies = [ "console", "effect", "prelude" ]
 , packages = ./packages.dhall
 , sources = [ "golden/**/*.purs" ]
 }