From 9b999f2896e61273cbd4d835e02450656d62950a Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Wed, 4 Aug 2021 10:31:54 -0400
Subject: [PATCH] Avoid another variable-renaming let case

---
 parser-typechecker/src/Unison/Runtime/ANF.hs  | 14 ++++++----
 .../src/Unison/Runtime/MCode.hs               |  2 +-
 unison-src/transcripts/fix2187.md             | 19 ++++++++++++++
 unison-src/transcripts/fix2187.output.md      | 26 +++++++++++++++++++
 4 files changed, 55 insertions(+), 6 deletions(-)
 create mode 100644 unison-src/transcripts/fix2187.md
 create mode 100644 unison-src/transcripts/fix2187.output.md

diff --git a/parser-typechecker/src/Unison/Runtime/ANF.hs b/parser-typechecker/src/Unison/Runtime/ANF.hs
index 0b9a58e7d..6e5761a6d 100644
--- a/parser-typechecker/src/Unison/Runtime/ANF.hs
+++ b/parser-typechecker/src/Unison/Runtime/ANF.hs
@@ -1030,11 +1030,15 @@ anfBlock (Match' scrut cas) = do
             mdf
     AccumEmpty -> pure (sctx <> cx, pure $ TMatch v MatchEmpty)
 anfBlock (Let1Named' v b e)
-  = anfBlock b >>= \(bctx, (d0, cb)) -> bindLocal [v] $ do
-      (ectx, ce) <- anfBlock e
-      d <- bindDirection d0
-      let octx = bctx <> directed [ST1 d v BX cb] <> ectx
-      pure (octx, ce)
+  = anfBlock b >>= \case
+      (bctx, (Direct, TVar u)) -> do
+        (ectx, ce) <- anfBlock e
+        pure (bctx <> ectx, ABTN.rename v u <$> ce)
+      (bctx, (d0, cb)) -> bindLocal [v] $ do
+        (ectx, ce) <- anfBlock e
+        d <- bindDirection d0
+        let octx = bctx <> directed [ST1 d v BX cb] <> ectx
+        pure (octx, ce)
 anfBlock (Apps' f args) = do
   (fctx, (d, cf)) <- anfFunc f
   (actx, cas) <- anfArgs args
diff --git a/parser-typechecker/src/Unison/Runtime/MCode.hs b/parser-typechecker/src/Unison/Runtime/MCode.hs
index b791045a3..27152f4c0 100644
--- a/parser-typechecker/src/Unison/Runtime/MCode.hs
+++ b/parser-typechecker/src/Unison/Runtime/MCode.hs
@@ -916,7 +916,7 @@ emitLet _   grp _   _ _   ctx (TApp (FPrim p) args)
   = fmap (Ins . either emitPOp emitFOp p $ emitArgs grp ctx args)
 emitLet rns grp rec d vcs ctx bnd
   | Direct <- d
-  = internalBug $ "unsupported compound direct let" ++ show bnd
+  = internalBug $ "unsupported compound direct let: " ++ show bnd
   | Indirect w <- d
   = \esect ->
       f <$> emitSection rns grp rec (Block ctx) bnd
diff --git a/unison-src/transcripts/fix2187.md b/unison-src/transcripts/fix2187.md
new file mode 100644
index 000000000..5468b2a24
--- /dev/null
+++ b/unison-src/transcripts/fix2187.md
@@ -0,0 +1,19 @@
+```ucm:hide
+.> builtins.mergeio
+```
+
+```unison 
+
+lexicalScopeEx: [Text]
+lexicalScopeEx = 
+  parent = "outer"
+  inner1 = let 
+    child1 = "child1"
+    inner2 : [Text]
+    inner2 = let 
+      child2 = "child2"
+      [parent, child1, child2]
+    inner2
+  inner1
+
+```
\ No newline at end of file
diff --git a/unison-src/transcripts/fix2187.output.md b/unison-src/transcripts/fix2187.output.md
new file mode 100644
index 000000000..e314ac66e
--- /dev/null
+++ b/unison-src/transcripts/fix2187.output.md
@@ -0,0 +1,26 @@
+```unison
+lexicalScopeEx: [Text]
+lexicalScopeEx = 
+  parent = "outer"
+  inner1 = let 
+    child1 = "child1"
+    inner2 : [Text]
+    inner2 = let 
+      child2 = "child2"
+      [parent, child1, child2]
+    inner2
+  inner1
+
+```
+
+```ucm
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      lexicalScopeEx : [Text]
+
+```