diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2019-03-19 17:47:55 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@well-typed.com> | 2019-07-09 11:52:45 -0400 |
| commit | 6a03d77b9a9915e4b37fe1ea6688c135e7b00654 (patch) | |
| tree | 4154abaa768adbfadc4eb17db620c3ed08b82c5f /compiler/rename/RnPat.hs | |
| parent | 5af815f2e43e9f1b5ca9ec0803f9fccabb49e2fe (diff) | |
| download | haskell-6a03d77b9a9915e4b37fe1ea6688c135e7b00654.tar.gz | |
Use an empty data type in TTG extension constructors (#15247)
To avoid having to `panic` any time a TTG extension constructor is
consumed, this MR introduces an uninhabited 'NoExtCon' type and uses
that in every extension constructor's type family instance where it
is appropriate. This also introduces a 'noExtCon' function which
eliminates a 'NoExtCon', much like 'Data.Void.absurd' eliminates
a 'Void'.
I also renamed the existing `NoExt` type to `NoExtField` to better
distinguish it from `NoExtCon`. Unsurprisingly, there is a lot of
code churn resulting from this.
Bumps the Haddock submodule. Fixes #15247.
Diffstat (limited to 'compiler/rename/RnPat.hs')
| -rw-r--r-- | compiler/rename/RnPat.hs | 14 |
1 files changed, 7 insertions, 7 deletions
diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs index 4a08ab4761..150b1cd23f 100644 --- a/compiler/rename/RnPat.hs +++ b/compiler/rename/RnPat.hs @@ -384,7 +384,7 @@ rnLPatAndThen :: NameMaker -> LPat GhcPs -> CpsRn (LPat GhcRn) rnLPatAndThen nm lpat = wrapSrcSpanCps (rnPatAndThen nm) lpat rnPatAndThen :: NameMaker -> Pat GhcPs -> CpsRn (Pat GhcRn) -rnPatAndThen _ (WildPat _) = return (WildPat noExt) +rnPatAndThen _ (WildPat _) = return (WildPat noExtField) rnPatAndThen mk (ParPat x pat) = do { pat' <- rnLPatAndThen mk pat ; return (ParPat x pat') } rnPatAndThen mk (LazyPat x pat) = do { pat' <- rnLPatAndThen mk pat @@ -471,7 +471,7 @@ rnPatAndThen mk (ConPatIn con stuff) -- The pattern for the empty list needs to be replaced by an empty explicit list pattern when overloaded lists is turned on. = case unLoc con == nameRdrName (dataConName nilDataCon) of True -> do { ol_flag <- liftCps $ xoptM LangExt.OverloadedLists - ; if ol_flag then rnPatAndThen mk (ListPat noExt []) + ; if ol_flag then rnPatAndThen mk (ListPat noExtField []) else rnConPatAndThen mk con stuff} False -> rnConPatAndThen mk con stuff @@ -548,7 +548,7 @@ rnHsRecPatsAndThen mk (dL->L _ con) ; check_unused_wildcard (implicit_binders flds' <$> dd) ; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }) } where - mkVarPat l n = VarPat noExt (cL l n) + mkVarPat l n = VarPat noExtField (cL l n) rn_field (dL->L l fld, n') = do { arg' <- rnLPatAndThen (nested_mk dd mk n') (hsRecFieldArg fld) ; return (cL l (fld { hsRecFieldArg = arg' })) } @@ -747,7 +747,7 @@ rnHsRecUpdFields flds then do { checkErr pun_ok (badPun (cL loc lbl)) -- Discard any module qualifier (#11662) ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl) - ; return (cL loc (HsVar noExt (cL loc arg_rdr))) } + ; return (cL loc (HsVar noExtField (cL loc arg_rdr))) } else return arg ; (arg'', fvs) <- rnLExpr arg' @@ -757,10 +757,10 @@ rnHsRecUpdFields flds Right _ -> fvs lbl' = case sel of Left sel_name -> - cL loc (Unambiguous sel_name (cL loc lbl)) + cL loc (Unambiguous sel_name (cL loc lbl)) Right [sel_name] -> - cL loc (Unambiguous sel_name (cL loc lbl)) - Right _ -> cL loc (Ambiguous noExt (cL loc lbl)) + cL loc (Unambiguous sel_name (cL loc lbl)) + Right _ -> cL loc (Ambiguous noExtField (cL loc lbl)) ; return (cL l (HsRecField { hsRecFieldLbl = lbl' , hsRecFieldArg = arg'' |