Merge pull request #2615 from unisonweb/fix/float-redundancy

Try to only float a single copy of a definition
unisonweb · Feb 18, 2022 · 9eeb98f · 9eeb98f
2 parents 7e49199 + 381f890
commit 9eeb98f
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 8 deletions.
diff --git a/parser-typechecker/src/Unison/Runtime/ANF.hs b/parser-typechecker/src/Unison/Runtime/ANF.hs
@@ -281,11 +281,16 @@ lamFloater
   :: (Var v, Monoid a)
   => Bool -> Term v a -> Maybe v -> a -> [v] -> Term v a -> FloatM v a v
 lamFloater closed tm mv a vs bd
-  = state $ \(cvs, ctx, dcmp) ->
-      let v = ABT.freshIn cvs $ fromMaybe (typed Var.Float) mv
-       in (v, ( Set.insert v cvs
-              , ctx <> [(v, lam' a vs bd)]
-              , floatDecomp closed v tm dcmp))
+  = state $ \trip@(cvs, ctx, dcmp) -> case find p ctx of
+      Just (v, _) -> (v, trip)
+      Nothing ->
+        let v = ABT.freshIn cvs $ fromMaybe (typed Var.Float) mv
+         in (v, ( Set.insert v cvs
+                , ctx <> [(v, lam' a vs bd)]
+                , floatDecomp closed v tm dcmp))
+  where
+  tgt = unannotate (lam' a vs bd)
+  p (_, flam) = unannotate flam == tgt
 
 floatDecomp
   :: Bool -> v -> Term v a -> [(v, Term v a)] -> [(v, Term v a)]

diff --git a/unison-src/transcripts/bug-strange-closure.output.md b/unison-src/transcripts/bug-strange-closure.output.md
@@ -3469,9 +3469,10 @@ rendered = Pretty.get (docFormatConsole doc.guide)
                                                                     1
                                                                     (Term.Term
                                                                       (Any
-                                                                        '(x ->
-                                                                            sqr
-                                                                              x))))),
+                                                                        (_
+                                                                        x ->
+                                                                          sqr
+                                                                            x))))),
                                                               Lit
                                                                 ()
                                                                 (Right
-Original file line number
+Diff line change
@@ Expand Up / @@ -3469,9 +3469,10 @@ rendered = Pretty.get (docFormatConsole doc.guide) @@
                                                                         (Term.Term
                                                                           (Any
-                                                                            '(x ->
-                                                                                sqr
-                                                                                  x))))),
+                                                                            (_
+                                                                            x ->
+                                                                              sqr
+                                                                                x))))),
                                                                   Lit
                                                                     ()
                                                                     (Right
@@ Expand Down @@