Commit 82f9be8c authored by Roland Senn's avatar Roland Senn Committed by Marge Bot

Fix #14628: Panic (No skolem Info) in GHCi

This patch implements the [sugggestion from Simon (PJ)](#14628 (comment 146559)):
- Make `TcErrors.getSkolemInfo` return a `SkolemInfo` rather than an `Implication`.
- If `getSkolemInfo` gets `RuntimeUnk`s, just return a new data constructor in `SkolemInfo`, called `RuntimeUnkSkol`.
- In `TcErrors.pprSkols` print something sensible for a `RuntimeUnkSkol`.

The `getSkolemInfo` function paniced while formating suggestions to add type annotations (subfunction `suggestAddSig`)
to a *"Couldn't match type ‘x’ with ‘y’"* error message.
The `getSkolemInfo` function didn't find any Implication value and paniced.
With this patch the `getSkolemInfo` function does no longer panic, if it finds `RuntimeUnkSkol`s.

As the panic occured while processing an error message, we don't need to implement any new error message!
parent 3ae83da1
Pipeline #15581 passed with stages
in 434 minutes and 28 seconds
...@@ -1762,8 +1762,7 @@ suggestAddSig ctxt ty1 ty2 ...@@ -1762,8 +1762,7 @@ suggestAddSig ctxt ty1 ty2
inferred_bndrs = nub (get_inf ty1 ++ get_inf ty2) inferred_bndrs = nub (get_inf ty1 ++ get_inf ty2)
get_inf ty | Just tv <- tcGetTyVar_maybe ty get_inf ty | Just tv <- tcGetTyVar_maybe ty
, isSkolemTyVar tv , isSkolemTyVar tv
, (implic, _) : _ <- getSkolemInfo (cec_encl ctxt) [tv] , ((InferSkol prs, _) : _) <- getSkolemInfo (cec_encl ctxt) [tv]
, InferSkol prs <- ic_info implic
= map fst prs = map fst prs
| otherwise | otherwise
= [] = []
...@@ -2755,11 +2754,13 @@ pprSkols :: ReportErrCtxt -> [TcTyVar] -> SDoc ...@@ -2755,11 +2754,13 @@ pprSkols :: ReportErrCtxt -> [TcTyVar] -> SDoc
pprSkols ctxt tvs pprSkols ctxt tvs
= vcat (map pp_one (getSkolemInfo (cec_encl ctxt) tvs)) = vcat (map pp_one (getSkolemInfo (cec_encl ctxt) tvs))
where where
pp_one (Implic { ic_info = skol_info }, tvs) pp_one (UnkSkol, tvs)
| UnkSkol <- skol_info
= hang (pprQuotedList tvs) = hang (pprQuotedList tvs)
2 (is_or_are tvs "an" "unknown") 2 (is_or_are tvs "an" "unknown")
| otherwise pp_one (RuntimeUnkSkol, tvs)
= hang (pprQuotedList tvs)
2 (is_or_are tvs "an" "unknown runtime")
pp_one (skol_info, tvs)
= vcat [ hang (pprQuotedList tvs) = vcat [ hang (pprQuotedList tvs)
2 (is_or_are tvs "a" "rigid" <+> text "bound by") 2 (is_or_are tvs "a" "rigid" <+> text "bound by")
, nest 2 (pprSkolInfo skol_info) , nest 2 (pprSkolInfo skol_info)
...@@ -2779,20 +2780,21 @@ getAmbigTkvs ct ...@@ -2779,20 +2780,21 @@ getAmbigTkvs ct
dep_tkv_set = tyCoVarsOfTypes (map tyVarKind tkvs) dep_tkv_set = tyCoVarsOfTypes (map tyVarKind tkvs)
getSkolemInfo :: [Implication] -> [TcTyVar] getSkolemInfo :: [Implication] -> [TcTyVar]
-> [(Implication, [TcTyVar])] -> [(SkolemInfo, [TcTyVar])] -- #14628
-- Get the skolem info for some type variables -- Get the skolem info for some type variables
-- from the implication constraints that bind them -- from the implication constraints that bind them.
-- --
-- In the returned (implic, tvs) pairs, the 'tvs' part is non-empty -- In the returned (skolem, tvs) pairs, the 'tvs' part is non-empty
getSkolemInfo _ [] getSkolemInfo _ []
= [] = []
getSkolemInfo [] tvs getSkolemInfo [] tvs
= pprPanic "No skolem info:" (ppr tvs) | all isRuntimeUnkSkol tvs = [(RuntimeUnkSkol, tvs)] -- #14628
| otherwise = pprPanic "No skolem info:" (ppr tvs)
getSkolemInfo (implic:implics) tvs getSkolemInfo (implic:implics) tvs
| null tvs_here = getSkolemInfo implics tvs | null tvs_here = getSkolemInfo implics tvs
| otherwise = (implic, tvs_here) : getSkolemInfo implics tvs_other | otherwise = (ic_info implic, tvs_here) : getSkolemInfo implics tvs_other
where where
(tvs_here, tvs_other) = partition (`elem` ic_skols implic) tvs (tvs_here, tvs_other) = partition (`elem` ic_skols implic) tvs
......
...@@ -237,6 +237,8 @@ data SkolemInfo ...@@ -237,6 +237,8 @@ data SkolemInfo
| QuantCtxtSkol -- Quantified context, e.g. | QuantCtxtSkol -- Quantified context, e.g.
-- f :: forall c. (forall a. c a => c [a]) => blah -- f :: forall c. (forall a. c a => c [a]) => blah
| RuntimeUnkSkol -- Runtime skolem from the GHCi debugger #14628
| UnkSkol -- Unhelpful info (until I improve it) | UnkSkol -- Unhelpful info (until I improve it)
instance Outputable SkolemInfo where instance Outputable SkolemInfo where
...@@ -267,6 +269,7 @@ pprSkolInfo (DataConSkol name)= text "the data constructor" <+> quotes (ppr name ...@@ -267,6 +269,7 @@ pprSkolInfo (DataConSkol name)= text "the data constructor" <+> quotes (ppr name
pprSkolInfo ReifySkol = text "the type being reified" pprSkolInfo ReifySkol = text "the type being reified"
pprSkolInfo (QuantCtxtSkol {}) = text "a quantified context" pprSkolInfo (QuantCtxtSkol {}) = text "a quantified context"
pprSkolInfo RuntimeUnkSkol = text "Unknown type from GHCi runtime"
-- UnkSkol -- UnkSkol
-- For type variables the others are dealt with by pprSkolTvBinding. -- For type variables the others are dealt with by pprSkolTvBinding.
......
module T14628 where
import System.IO
import Control.Monad.IO.Class
import Control.Monad.Trans.State
import Text.Printf
putArrayBytes :: Handle -- ^ output file handle
-> [String] -- ^ byte-strings
-> IO Int -- ^ total number of bytes written
putArrayBytes outfile xs = do
let writeCount x = modify' (+ length x) >> liftIO (putLine x) :: MonadIO m => StateT Int m ()
execStateT (mapM_ writeCount xs) 0
where putLine = hPutStrLn outfile . (" "++) . concatMap (printf "0x%02X,")
:l T14628.hs
:br 12 46
:trace putArrayBytes stdout [['1'..'9'],['2'..'8'],['3'..'7']]
snd $ runStateT _result 0
<interactive>:4:7:
Couldn't match type ‘m’ with ‘(,) a0’
‘m’ is untouchable
inside the constraints: ()
bound by the inferred type of it :: ((), Int)
at <interactive>:4:1-25
‘m’ is an interactive-debugger skolem
Expected type: (a0, ((), Int))
Actual type: m ((), Int)
In the second argument of ‘($)’, namely ‘runStateT _result 0’
In the expression: snd $ runStateT _result 0
In an equation for ‘it’: it = snd $ runStateT _result 0
Breakpoint 0 activated at T14628.hs:12:46-63
Stopped in T14628.putArrayBytes.writeCount, T14628.hs:12:46-63
_result :: StateT Int m () = _
putLine :: [Char] -> IO () = _
x :: [Char] = "123456789"
...@@ -113,6 +113,7 @@ test('T13825-debugger', ...@@ -113,6 +113,7 @@ test('T13825-debugger',
[when(arch('powerpc64'), expect_broken(14455)), [when(arch('powerpc64'), expect_broken(14455)),
when(arch('arm'), fragile_for(17557, ['ghci-ext']))], when(arch('arm'), fragile_for(17557, ['ghci-ext']))],
ghci_script, ['T13825-debugger.script']) ghci_script, ['T13825-debugger.script'])
test('T14628', normal, ghci_script, ['T14628.script'])
test('T14690', normal, ghci_script, ['T14690.script']) test('T14690', normal, ghci_script, ['T14690.script'])
test('T16700', normal, ghci_script, ['T16700.script']) test('T16700', normal, ghci_script, ['T16700.script'])
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment