diff options
author | Roland Senn <rsx@bluewin.ch> | 2020-01-30 17:11:06 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-02-09 02:55:06 -0500 |
commit | 82f9be8c6aafb70f612e72bef517c76437726c78 (patch) | |
tree | cd43800e3c2f3c044a0fbb6a8583a5f881e2aaed | |
parent | 3ae83da13f03d22a4d810b5d9c0f37f818cb6a00 (diff) | |
download | haskell-82f9be8c6aafb70f612e72bef517c76437726c78.tar.gz |
Fix #14628: Panic (No skolem Info) in GHCi
This patch implements the [sugggestion from Simon (PJ)](https://gitlab.haskell.org/ghc/ghc/issues/14628#note_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!
-rw-r--r-- | compiler/typecheck/TcErrors.hs | 24 | ||||
-rw-r--r-- | compiler/typecheck/TcOrigin.hs | 3 | ||||
-rw-r--r-- | testsuite/tests/ghci.debugger/scripts/T14628.hs | 14 | ||||
-rw-r--r-- | testsuite/tests/ghci.debugger/scripts/T14628.script | 4 | ||||
-rw-r--r-- | testsuite/tests/ghci.debugger/scripts/T14628.stderr | 12 | ||||
-rw-r--r-- | testsuite/tests/ghci.debugger/scripts/T14628.stdout | 5 | ||||
-rw-r--r-- | testsuite/tests/ghci.debugger/scripts/all.T | 1 |
7 files changed, 52 insertions, 11 deletions
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index b20fb55e11..9557efa40c 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -1762,8 +1762,7 @@ suggestAddSig ctxt ty1 ty2 inferred_bndrs = nub (get_inf ty1 ++ get_inf ty2) get_inf ty | Just tv <- tcGetTyVar_maybe ty , isSkolemTyVar tv - , (implic, _) : _ <- getSkolemInfo (cec_encl ctxt) [tv] - , InferSkol prs <- ic_info implic + , ((InferSkol prs, _) : _) <- getSkolemInfo (cec_encl ctxt) [tv] = map fst prs | otherwise = [] @@ -2755,11 +2754,13 @@ pprSkols :: ReportErrCtxt -> [TcTyVar] -> SDoc pprSkols ctxt tvs = vcat (map pp_one (getSkolemInfo (cec_encl ctxt) tvs)) where - pp_one (Implic { ic_info = skol_info }, tvs) - | UnkSkol <- skol_info + pp_one (UnkSkol, tvs) = hang (pprQuotedList tvs) 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) 2 (is_or_are tvs "a" "rigid" <+> text "bound by") , nest 2 (pprSkolInfo skol_info) @@ -2779,20 +2780,21 @@ getAmbigTkvs ct dep_tkv_set = tyCoVarsOfTypes (map tyVarKind tkvs) getSkolemInfo :: [Implication] -> [TcTyVar] - -> [(Implication, [TcTyVar])] + -> [(SkolemInfo, [TcTyVar])] -- #14628 -- 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 [] tvs - = pprPanic "No skolem info:" (ppr tvs) + | all isRuntimeUnkSkol tvs = [(RuntimeUnkSkol, tvs)] -- #14628 + | otherwise = pprPanic "No skolem info:" (ppr tvs) getSkolemInfo (implic:implics) tvs - | null tvs_here = getSkolemInfo implics tvs - | otherwise = (implic, tvs_here) : getSkolemInfo implics tvs_other + | null tvs_here = getSkolemInfo implics tvs + | otherwise = (ic_info implic, tvs_here) : getSkolemInfo implics tvs_other where (tvs_here, tvs_other) = partition (`elem` ic_skols implic) tvs diff --git a/compiler/typecheck/TcOrigin.hs b/compiler/typecheck/TcOrigin.hs index fd260f01ac..df7a39f72e 100644 --- a/compiler/typecheck/TcOrigin.hs +++ b/compiler/typecheck/TcOrigin.hs @@ -237,6 +237,8 @@ data SkolemInfo | QuantCtxtSkol -- Quantified context, e.g. -- 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) instance Outputable SkolemInfo where @@ -267,6 +269,7 @@ pprSkolInfo (DataConSkol name)= text "the data constructor" <+> quotes (ppr name pprSkolInfo ReifySkol = text "the type being reified" pprSkolInfo (QuantCtxtSkol {}) = text "a quantified context" +pprSkolInfo RuntimeUnkSkol = text "Unknown type from GHCi runtime" -- UnkSkol -- For type variables the others are dealt with by pprSkolTvBinding. diff --git a/testsuite/tests/ghci.debugger/scripts/T14628.hs b/testsuite/tests/ghci.debugger/scripts/T14628.hs new file mode 100644 index 0000000000..b94d9e736e --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/T14628.hs @@ -0,0 +1,14 @@ +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,") diff --git a/testsuite/tests/ghci.debugger/scripts/T14628.script b/testsuite/tests/ghci.debugger/scripts/T14628.script new file mode 100644 index 0000000000..4675b515de --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/T14628.script @@ -0,0 +1,4 @@ +:l T14628.hs +:br 12 46 +:trace putArrayBytes stdout [['1'..'9'],['2'..'8'],['3'..'7']] +snd $ runStateT _result 0 diff --git a/testsuite/tests/ghci.debugger/scripts/T14628.stderr b/testsuite/tests/ghci.debugger/scripts/T14628.stderr new file mode 100644 index 0000000000..276d63ff38 --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/T14628.stderr @@ -0,0 +1,12 @@ +<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 diff --git a/testsuite/tests/ghci.debugger/scripts/T14628.stdout b/testsuite/tests/ghci.debugger/scripts/T14628.stdout new file mode 100644 index 0000000000..9564271f8f --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/T14628.stdout @@ -0,0 +1,5 @@ +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" diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T index 297b4c2b76..01662361c4 100644 --- a/testsuite/tests/ghci.debugger/scripts/all.T +++ b/testsuite/tests/ghci.debugger/scripts/all.T @@ -113,6 +113,7 @@ test('T13825-debugger', [when(arch('powerpc64'), expect_broken(14455)), when(arch('arm'), fragile_for(17557, ['ghci-ext']))], ghci_script, ['T13825-debugger.script']) +test('T14628', normal, ghci_script, ['T14628.script']) test('T14690', normal, ghci_script, ['T14690.script']) test('T16700', normal, ghci_script, ['T16700.script']) |