diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/ghci/ByteCodeGen.hs | 4 | ||||
| -rw-r--r-- | compiler/ghci/ByteCodeTypes.hs | 6 | ||||
| -rw-r--r-- | compiler/main/InteractiveEval.hs | 63 |
3 files changed, 60 insertions, 13 deletions
diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 8b23e08003..12331e2d52 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -432,8 +432,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 b2c644e65c..ee43aaf675 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -521,20 +521,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) @@ -550,11 +547,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 @@ -591,6 +589,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] @@ -632,6 +648,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 |