Fix #8487: Debugger confuses variables

To display the free variables for a single breakpoint, GHCi pulls out the
information from the fields `modBreaks_breakInfo` and `modBreaks_vars`
of the `ModBreaks` data structure. For a specific breakpoint this gives 2
lists of types 'Id` (`Var`) and `OccName`. They are used to create the Id's
for the free variables and must be kept in sync:
If we remove an element from the Names list, then we also must remove the
corresponding element from the OccNames list.

(cherry picked from commit 32be44613fed3fa7bff7190381acbdaa8ea15cfc)

7 files changed, 79 insertions, 13 deletions

diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs
index 0f5d6496dc..346add07e7 100644
--- a/compiler/ghci/ByteCodeGen.hs
+++ b/compiler/ghci/ByteCodeGen.hs
@@ -419,8 +419,8 @@ schemeER_wrk d p rhs
         return $ breakInstr `consOL` code
    | otherwise = schemeE d 0 p rhs
 
-getVarOffSets :: DynFlags -> StackDepth -> BCEnv -> [Id] -> [(Id, Word16)]
-getVarOffSets dflags depth env = catMaybes . map getOffSet
+getVarOffSets :: DynFlags -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, Word16)]
+getVarOffSets dflags depth env = map getOffSet
   where
     getOffSet id = case lookupBCEnv_maybe id env of
         Nothing     -> Nothing
diff --git a/compiler/ghci/ByteCodeTypes.hs b/compiler/ghci/ByteCodeTypes.hs
index 628b576ca0..0c0c34ad64 100644
--- a/compiler/ghci/ByteCodeTypes.hs
+++ b/compiler/ghci/ByteCodeTypes.hs
@@ -35,6 +35,7 @@ import Data.Array.Base  ( UArray(..) )
 import Data.ByteString (ByteString)
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
+import Data.Maybe (catMaybes)
 import GHC.Exts.Heap
 import GHC.Stack.CCS
 
@@ -110,14 +111,15 @@ instance NFData BCONPtr where
 -- | Information about a breakpoint that we know at code-generation time
 data CgBreakInfo
    = CgBreakInfo
-   { cgb_vars   :: [(Id,Word16)]
+   { cgb_vars   :: [Maybe (Id,Word16)]
    , cgb_resty  :: Type
    }
+-- See Note [Syncing breakpoint info] in compiler/main/InteractiveEval.hs
 
 -- Not a real NFData instance because we can't rnf Id or Type
 seqCgBreakInfo :: CgBreakInfo -> ()
 seqCgBreakInfo CgBreakInfo{..} =
-  rnf (map snd cgb_vars) `seq`
+  rnf (map snd (catMaybes (cgb_vars))) `seq`
   seqType cgb_resty
 
 instance Outputable UnlinkedBCO where
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 325a06c49b..ffde5b9631 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -503,20 +503,17 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
        breaks    = getModBreaks hmi
        info      = expectJust "bindLocalsAtBreakpoint2" $
                      IntMap.lookup breakInfo_number (modBreaks_breakInfo breaks)
-       vars      = cgb_vars info
+       mbVars    = cgb_vars info
        result_ty = cgb_resty info
        occs      = modBreaks_vars breaks ! breakInfo_number
        span      = modBreaks_locs breaks ! breakInfo_number
        decl      = intercalate "." $ modBreaks_decls breaks ! breakInfo_number
 
-           -- Filter out any unboxed ids;
+           -- Filter out any unboxed ids by changing them to Nothings;
            -- we can't bind these at the prompt
-       pointers = filter (\(id,_) -> isPointer id) vars
-       isPointer id | [rep] <- typePrimRep (idType id)
-                    , isGcPtrRep rep                   = True
-                    | otherwise                        = False
+       mbPointers = nullUnboxed <$> mbVars
 
-       (ids, offsets) = unzip pointers
+       (ids, offsets, occs') = syncOccs mbPointers occs
 
        free_tvs = tyCoVarsOfTypesList (result_ty:map idType ids)
 
@@ -532,11 +529,12 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
 
    us <- mkSplitUniqSupply 'I'   -- Dodgy; will give the same uniques every time
    let tv_subst     = newTyVars us free_tvs
-       filtered_ids = [ id | (id, Just _hv) <- zip ids mb_hValues ]
+       (filtered_ids, occs'') = unzip         -- again, sync the occ-names
+          [ (id, occ) | (id, Just _hv, occ) <- zip3 ids mb_hValues occs' ]
        (_,tidy_tys) = tidyOpenTypes emptyTidyEnv $
                       map (substTy tv_subst . idType) filtered_ids
 
-   new_ids     <- zipWith3M mkNewId occs tidy_tys filtered_ids
+   new_ids     <- zipWith3M mkNewId occs'' tidy_tys filtered_ids
    result_name <- newInteractiveBinder hsc_env (mkVarOccFS result_fs) span
 
    let result_id = Id.mkVanillaGlobal result_name
@@ -572,6 +570,24 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
                     | (tv, uniq) <- tvs `zip` uniqsFromSupply us
                     , let name = setNameUnique (tyVarName tv) uniq ]
 
+   isPointer id | [rep] <- typePrimRep (idType id)
+                , isGcPtrRep rep                   = True
+                | otherwise                        = False
+
+   -- Convert unboxed Id's to Nothings
+   nullUnboxed (Just (fv@(id, _)))
+     | isPointer id          = Just fv
+     | otherwise             = Nothing
+   nullUnboxed Nothing       = Nothing
+
+   -- See Note [Syncing breakpoint info]
+   syncOccs :: [Maybe (a,b)] -> [c] -> ([a], [b], [c])
+   syncOccs mbVs ocs = unzip3 $ catMaybes $ joinOccs mbVs ocs
+     where
+       joinOccs :: [Maybe (a,b)] -> [c] -> [Maybe (a,b,c)]
+       joinOccs = zipWith joinOcc
+       joinOcc mbV oc = (\(a,b) c -> (a,b,c)) <$> mbV <*> pure oc
+
 rttiEnvironment :: HscEnv -> IO HscEnv
 rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
    let tmp_ids = [id | AnId id <- ic_tythings ic]
@@ -613,6 +629,35 @@ pushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 }
         ictxt0 = hsc_IC hsc_env
         ictxt1 = ictxt0 { ic_resume = resume : ic_resume ictxt0 }
 
+
+  {-
+  Note [Syncing breakpoint info]
+
+  To display the values of the free variables for a single breakpoint, the
+  function `compiler/main/InteractiveEval.hs:bindLocalsAtBreakpoint` pulls
+  out the information from the fields `modBreaks_breakInfo` and
+  `modBreaks_vars` of the `ModBreaks` data structure.
+  For a specific breakpoint this gives 2 lists of type `Id` (or `Var`)
+  and `OccName`.
+  They are used to create the Id's for the free variables and must be kept
+  in sync!
+
+  There are 3 situations where items are removed from the Id list
+  (or replaced with `Nothing`):
+  1.) If function `compiler/ghci/ByteCodeGen.hs:schemeER_wrk` (which creates
+      the Id list) doesn't find an Id in the ByteCode environement.
+  2.) If function `compiler/main/InteractiveEval.hs:bindLocalsAtBreakpoint`
+      filters out unboxed elements from the Id list, because GHCi cannot
+      yet handle them.
+  3.) If the GHCi interpreter doesn't find the reference to a free variable
+      of our breakpoint. This also happens in the function
+      bindLocalsAtBreakpoint.
+
+  If an element is removed from the Id list, then the corresponding element
+  must also be removed from the Occ list. Otherwise GHCi will confuse
+  variable names as in #8487.
+  -}
+
 -- -----------------------------------------------------------------------------
 -- Abandoning a resume context
 
diff --git a/testsuite/tests/ghci.debugger/scripts/T8487.hs b/testsuite/tests/ghci.debugger/scripts/T8487.hs
new file mode 100644
index 0000000000..d77738e3c9
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T8487.hs
@@ -0,0 +1,11 @@
+import Control.Exception
+
+f = do
+  ma <- try $ evaluate a
+  x <- case ma of
+    Right str -> return a
+    Left  err -> return $ show (err :: SomeException)
+  putStrLn x
+  where
+    a :: String
+    a = error "hi"
diff --git a/testsuite/tests/ghci.debugger/scripts/T8487.script b/testsuite/tests/ghci.debugger/scripts/T8487.script
new file mode 100644
index 0000000000..628088e954
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T8487.script
@@ -0,0 +1,3 @@
+:l T8487.hs
+:b 5
+f
diff --git a/testsuite/tests/ghci.debugger/scripts/T8487.stdout b/testsuite/tests/ghci.debugger/scripts/T8487.stdout
new file mode 100644
index 0000000000..ab7151a563
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T8487.stdout
@@ -0,0 +1,4 @@
+Breakpoint 0 activated at T8487.hs:(5,8)-(7,53)
+Stopped in Main.f, T8487.hs:(5,8)-(7,53)
+_result :: IO String = _
+ma :: Either SomeException String = Left _
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index 4095cf2c0b..5899e5c82a 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -101,6 +101,7 @@ test('T2740', normal, ghci_script, ['T2740.script'])
 
 test('getargs', extra_files(['../getargs.hs']), ghci_script, ['getargs.script'])
 test('T7386', normal, ghci_script, ['T7386.script'])
+test('T8487', normal, ghci_script, ['T8487.script'])
 test('T8557', normal, ghci_script, ['T8557.script'])
 test('T12458', normal, ghci_script, ['T12458.script'])
 test('T13825-debugger', when(arch('powerpc64'), expect_broken(14455)),