| ... |
... |
@@ -85,11 +85,13 @@ import GHC.Data.FastString |
|
85
|
85
|
|
|
86
|
86
|
import GHC.Types.SrcLoc
|
|
87
|
87
|
import GHC.Types.Basic
|
|
|
88
|
+import GHC.Types.Error
|
|
88
|
89
|
|
|
89
|
90
|
import GHC.Utils.Panic
|
|
90
|
91
|
import GHC.Utils.Exception as Ex
|
|
91
|
|
-import GHC.Utils.Outputable(brackets, ppr, showSDocUnsafe)
|
|
|
92
|
+import GHC.Utils.Outputable
|
|
92
|
93
|
import GHC.Utils.Fingerprint
|
|
|
94
|
+import GHC.Utils.Logger (Logger, logMsg)
|
|
93
|
95
|
|
|
94
|
96
|
import GHC.Unit.Module
|
|
95
|
97
|
import GHC.Unit.Home.ModInfo
|
| ... |
... |
@@ -401,11 +403,11 @@ whereFrom interp ref = |
|
401
|
403
|
interpCmd interp (WhereFrom hval)
|
|
402
|
404
|
|
|
403
|
405
|
-- | Send a Seq message to the iserv process to force a value #2950
|
|
404
|
|
-seqHValue :: Interp -> UnitEnv -> ForeignHValue -> IO (EvalResult ())
|
|
405
|
|
-seqHValue interp unit_env ref =
|
|
|
406
|
+seqHValue :: Interp -> UnitEnv -> Logger -> ForeignHValue -> IO (EvalResult ())
|
|
|
407
|
+seqHValue interp unit_env logger ref =
|
|
406
|
408
|
withForeignRef ref $ \hval -> do
|
|
407
|
409
|
status <- interpCmd interp (Seq hval)
|
|
408
|
|
- handleSeqHValueStatus interp unit_env status
|
|
|
410
|
+ handleSeqHValueStatus interp unit_env logger status
|
|
409
|
411
|
|
|
410
|
412
|
evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId
|
|
411
|
413
|
evalBreakpointToId eval_break =
|
| ... |
... |
@@ -419,16 +421,15 @@ evalBreakpointToId eval_break = |
|
419
|
421
|
}
|
|
420
|
422
|
|
|
421
|
423
|
-- | Process the result of a Seq or ResumeSeq message. #2950
|
|
422
|
|
-handleSeqHValueStatus :: Interp -> UnitEnv -> EvalStatus () -> IO (EvalResult ())
|
|
423
|
|
-handleSeqHValueStatus interp unit_env eval_status =
|
|
|
424
|
+handleSeqHValueStatus :: Interp -> UnitEnv -> Logger -> EvalStatus () -> IO (EvalResult ())
|
|
|
425
|
+handleSeqHValueStatus interp unit_env logger eval_status =
|
|
424
|
426
|
case eval_status of
|
|
425
|
427
|
(EvalBreak _ maybe_break resume_ctxt _) -> do
|
|
426
|
428
|
-- A breakpoint was hit; inform the user and tell them
|
|
427
|
429
|
-- which breakpoint was hit.
|
|
428
|
430
|
resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
|
|
429
|
|
-
|
|
430
|
|
- let put x = putStrLn ("*** Ignoring breakpoint " ++ (showSDocUnsafe x))
|
|
431
|
|
- let nothing_case = put $ brackets . ppr $ mkGeneralSrcSpan (fsLit "<unknown>")
|
|
|
431
|
+ let put loc = logMsg logger MCOutput loc ("*** Ignoring breakpoint" <+> brackets (ppr loc))
|
|
|
432
|
+ let nothing_case = put noSrcSpan
|
|
432
|
433
|
case maybe_break of
|
|
433
|
434
|
Nothing -> nothing_case
|
|
434
|
435
|
-- Nothing case - should not occur!
|
| ... |
... |
@@ -445,13 +446,12 @@ handleSeqHValueStatus interp unit_env eval_status = |
|
445
|
446
|
-- Nothing case - should not occur! We should have the appropriate
|
|
446
|
447
|
-- breakpoint information
|
|
447
|
448
|
Nothing -> nothing_case
|
|
448
|
|
- Just modbreaks -> put . brackets . ppr =<<
|
|
449
|
|
- getBreakLoc (readIModModBreaks hug) ibi modbreaks
|
|
|
449
|
+ Just modbreaks -> put =<< getBreakLoc (readIModModBreaks hug) ibi modbreaks
|
|
450
|
450
|
|
|
451
|
451
|
-- resume the seq (:force) processing in the iserv process
|
|
452
|
452
|
withForeignRef resume_ctxt_fhv $ \hval -> do
|
|
453
|
453
|
status <- interpCmd interp (ResumeSeq hval)
|
|
454
|
|
- handleSeqHValueStatus interp unit_env status
|
|
|
454
|
+ handleSeqHValueStatus interp unit_env logger status
|
|
455
|
455
|
(EvalComplete _ r) -> return r
|
|
456
|
456
|
|
|
457
|
457
|
|