diff options
author | Richard Eisenberg <rae@richarde.dev> | 2019-11-05 13:11:19 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-02-08 10:16:33 -0500 |
commit | 7755ffc2920facb7ed74efe379ad825feeaf1024 (patch) | |
tree | c2bcece9de4776d99af32265084b78b7735d6654 /compiler/GHC/Rename/Pat.hs | |
parent | 309f8cfdad9cf81f5ee6003821810ea1205ae1d5 (diff) | |
download | haskell-7755ffc2920facb7ed74efe379ad825feeaf1024.tar.gz |
Introduce IsPass; refactor wrappers.
There are two main payloads of this patch:
1. This introduces IsPass, which allows e.g. printing
code to ask what pass it is running in (Renamed vs
Typechecked) and thus print extension fields. See
Note [IsPass] in Hs.Extension
2. This moves the HsWrap constructor into an extension
field, where it rightly belongs. This is done for
HsExpr and HsCmd, but not for HsPat, which is left
as an exercise for the reader.
There is also some refactoring around SyntaxExprs, but this
is really just incidental.
This patch subsumes !1721 (sorry @chreekat).
Along the way, there is a bit of refactoring in GHC.Hs.Extension,
including the removal of NameOrRdrName in favor of NoGhcTc.
This meant that we had no real need for GHC.Hs.PlaceHolder, so
I got rid of it.
Updates haddock submodule.
-------------------------
Metric Decrease:
haddock.compiler
-------------------------
Diffstat (limited to 'compiler/GHC/Rename/Pat.hs')
-rw-r--r-- | compiler/GHC/Rename/Pat.hs | 26 |
1 files changed, 11 insertions, 15 deletions
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs index ae509867b3..0f8041447b 100644 --- a/compiler/GHC/Rename/Pat.hs +++ b/compiler/GHC/Rename/Pat.hs @@ -309,7 +309,7 @@ There are various entry points to renaming patterns, depending on -- * local namemaker -- * unused and duplicate checking -- * no fixities -rnPats :: HsMatchContext Name -- for error messages +rnPats :: HsMatchContext GhcRn -- for error messages -> [LPat GhcPs] -> ([LPat GhcRn] -> RnM (a, FreeVars)) -> RnM (a, FreeVars) @@ -337,7 +337,7 @@ rnPats ctxt pats thing_inside where doc_pat = text "In" <+> pprMatchContext ctxt -rnPat :: HsMatchContext Name -- for error messages +rnPat :: HsMatchContext GhcRn -- for error messages -> LPat GhcPs -> (LPat GhcRn -> RnM (a, FreeVars)) -> RnM (a, FreeVars) -- Variables bound by pattern do not @@ -429,7 +429,7 @@ rnPatAndThen mk (LitPat x lit) rnPatAndThen _ (NPat x (L l lit) mb_neg _eq) = do { (lit', mb_neg') <- liftCpsFV $ rnOverLit lit ; mb_neg' -- See Note [Negative zero] - <- let negative = do { (neg, fvs) <- lookupSyntaxName negateName + <- let negative = do { (neg, fvs) <- lookupSyntax negateName ; return (Just neg, fvs) } positive = return (Nothing, emptyFVs) in liftCpsFV $ case (mb_neg , mb_neg') of @@ -437,7 +437,7 @@ rnPatAndThen _ (NPat x (L l lit) mb_neg _eq) (Just _ , Nothing) -> negative (Nothing, Nothing) -> positive (Just _ , Just _ ) -> positive - ; eq' <- liftCpsFV $ lookupSyntaxName eqName + ; eq' <- liftCpsFV $ lookupSyntax eqName ; return (NPat x (L l lit') mb_neg' eq') } rnPatAndThen mk (NPlusKPat x rdr (L l lit) _ _ _ ) @@ -446,8 +446,8 @@ rnPatAndThen mk (NPlusKPat x rdr (L l lit) _ _ _ ) -- We skip negateName as -- negative zero doesn't make -- sense in n + k patterns - ; minus <- liftCpsFV $ lookupSyntaxName minusName - ; ge <- liftCpsFV $ lookupSyntaxName geName + ; minus <- liftCpsFV $ lookupSyntax minusName + ; ge <- liftCpsFV $ lookupSyntax geName ; return (NPlusKPat x (L (nameSrcSpan new_name) new_name) (L l lit') lit' ge minus) } -- The Report says that n+k patterns must be in Integral @@ -481,7 +481,7 @@ rnPatAndThen mk (ListPat _ pats) = do { opt_OverloadedLists <- liftCps $ xoptM LangExt.OverloadedLists ; pats' <- rnLPatsAndThen mk pats ; case opt_OverloadedLists of - True -> do { (to_list_name,_) <- liftCps $ lookupSyntaxName toListName + True -> do { (to_list_name,_) <- liftCps $ lookupSyntax toListName ; return (ListPat (Just to_list_name) pats')} False -> return (ListPat Nothing pats') } @@ -864,16 +864,12 @@ rnOverLit origLit | otherwise = origLit } ; let std_name = hsOverLitName val - ; (SyntaxExpr { syn_expr = from_thing_name }, fvs1) - <- lookupSyntaxName std_name - ; let rebindable = case from_thing_name of - HsVar _ lv -> (unLoc lv) /= std_name - _ -> panic "rnOverLit" - ; let lit' = lit { ol_witness = from_thing_name + ; (from_thing_name, fvs1) <- lookupSyntaxName std_name + ; let rebindable = from_thing_name /= std_name + lit' = lit { ol_witness = nl_HsVar from_thing_name , ol_ext = rebindable } ; if isNegativeZeroOverLit lit' - then do { (SyntaxExpr { syn_expr = negate_name }, fvs2) - <- lookupSyntaxName negateName + then do { (negate_name, fvs2) <- lookupSyntaxExpr negateName ; return ((lit' { ol_val = negateOverLitVal val }, Just negate_name) , fvs1 `plusFV` fvs2) } else return ((lit', Nothing), fvs1) } |