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/deSugar/Match.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/deSugar/Match.hs')
| -rw-r--r-- | compiler/deSugar/Match.hs | 16 |
1 files changed, 8 insertions, 8 deletions
diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs index c057298420..921b829fb9 100644 --- a/compiler/deSugar/Match.hs +++ b/compiler/deSugar/Match.hs @@ -501,9 +501,9 @@ tidy_bang_pat v o _ (SigPat _ (dL->L l p) _) = tidy_bang_pat v o l p -- Push the bang-pattern inwards, in the hope that -- it may disappear next time tidy_bang_pat v o l (AsPat x v' p) - = tidy1 v o (AsPat x v' (cL l (BangPat noExt p))) + = tidy1 v o (AsPat x v' (cL l (BangPat noExtField p))) tidy_bang_pat v o l (CoPat x w p t) - = tidy1 v o (CoPat x w (BangPat noExt (cL l p)) t) + = tidy1 v o (CoPat x w (BangPat noExtField (cL l p)) t) -- Discard bang around strict pattern tidy_bang_pat v o _ p@(LitPat {}) = tidy1 v o p @@ -538,7 +538,7 @@ tidy_bang_pat v o l p@(ConPatOut { pat_con = (dL->L _ (RealDataCon dc)) -- -- NB: SigPatIn, ConPatIn should not happen -tidy_bang_pat _ _ l p = return (idDsWrapper, BangPat noExt (cL l p)) +tidy_bang_pat _ _ l p = return (idDsWrapper, BangPat noExtField (cL l p)) ------------------- push_bang_into_newtype_arg :: SrcSpan @@ -549,16 +549,16 @@ push_bang_into_newtype_arg :: SrcSpan -- We are transforming !(N p) into (N !p) push_bang_into_newtype_arg l _ty (PrefixCon (arg:args)) = ASSERT( null args) - PrefixCon [cL l (BangPat noExt arg)] + PrefixCon [cL l (BangPat noExtField arg)] push_bang_into_newtype_arg l _ty (RecCon rf) | HsRecFields { rec_flds = (dL->L lf fld) : flds } <- rf , HsRecField { hsRecFieldArg = arg } <- fld = ASSERT( null flds) RecCon (rf { rec_flds = [cL lf (fld { hsRecFieldArg - = cL l (BangPat noExt arg) })] }) + = cL l (BangPat noExtField arg) })] }) push_bang_into_newtype_arg l ty (RecCon rf) -- If a user writes !(T {}) | HsRecFields { rec_flds = [] } <- rf - = PrefixCon [cL l (BangPat noExt (noLoc (WildPat ty)))] + = PrefixCon [cL l (BangPat noExtField (noLoc (WildPat ty)))] push_bang_into_newtype_arg _ _ cd = pprPanic "push_bang_into_newtype_arg" (pprConArgs cd) @@ -752,13 +752,13 @@ matchWrapper ctxt mb_scr (MG { mg_alts = (dL->L _ matches) ; return (EqnInfo { eqn_pats = upats , eqn_orig = FromSource , eqn_rhs = match_result }) } - mk_eqn_info _ (dL->L _ (XMatch _)) = panic "matchWrapper" + mk_eqn_info _ (dL->L _ (XMatch nec)) = noExtCon nec mk_eqn_info _ _ = panic "mk_eqn_info: Impossible Match" -- due to #15884 handleWarnings = if isGenerated origin then discardWarningsDs else id -matchWrapper _ _ (XMatchGroup _) = panic "matchWrapper" +matchWrapper _ _ (XMatchGroup nec) = noExtCon nec matchEquations :: HsMatchContext Name -> [MatchId] -> [EquationInfo] -> Type |