Skip to content

Commit

Permalink
updates for compatibility with GHC HEAD
Browse files Browse the repository at this point in the history
  • Loading branch information
shayne-fletcher committed Oct 30, 2024
1 parent 50bb18f commit 8798d9a
Show file tree
Hide file tree
Showing 5 changed files with 27 additions and 20 deletions.
6 changes: 0 additions & 6 deletions src/GHC/Util/Brackets.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,8 +36,6 @@ instance Brackets (LocatedA (HsExpr GhcPs)) where
isAtom (L _ x) = case x of
HsVar{} -> True
HsUnboundVar{} -> True
-- Technically atomic, but lots of people think it shouldn't be
HsRecSel{} -> False
-- Only relevant for OverloadedRecordDot extension
HsGetField{} -> True
HsOverLabel{} -> True
Expand All @@ -61,12 +59,10 @@ instance Brackets (LocatedA (HsExpr GhcPs)) where
_ -> False
where
isNegativeLit (HsInt _ i) = il_neg i
isNegativeLit (HsRat _ f _) = fl_neg f
isNegativeLit (HsFloatPrim _ f) = fl_neg f
isNegativeLit (HsDoublePrim _ f) = fl_neg f
isNegativeLit (HsIntPrim _ x) = x < 0
isNegativeLit (HsInt64Prim _ x) = x < 0
isNegativeLit (HsInteger _ x _) = x < 0
isNegativeLit _ = False
isNegativeOverLit OverLit {ol_val=HsIntegral i} = il_neg i
isNegativeOverLit OverLit {ol_val=HsFractional f} = fl_neg f
Expand Down Expand Up @@ -133,8 +129,6 @@ instance Brackets (LocatedA (Pat GhcPs)) where
isSignedLit HsInt{} = True
isSignedLit HsIntPrim{} = True
isSignedLit HsInt64Prim{} = True
isSignedLit HsInteger{} = True
isSignedLit HsRat{} = True
isSignedLit HsFloatPrim{} = True
isSignedLit HsDoublePrim{} = True
isSignedLit _ = False
Expand Down
5 changes: 0 additions & 5 deletions src/GHC/Util/FreeVars.hs
Original file line number Diff line number Diff line change
Expand Up @@ -128,7 +128,6 @@ instance FreeVars (LocatedA (HsExpr GhcPs)) where
freeVars (L _ (HsUntypedBracket _ (ExpBr _ e))) = freeVars e
freeVars (L _ (HsUntypedBracket _ (VarBr _ _ v))) = Set.fromList [occName (unLoc v)]

freeVars (L _ HsRecSel{}) = mempty -- Variable pointing to a record selector.
freeVars (L _ HsOverLabel{}) = mempty -- Overloaded label. The id of the in-scope fromLabel.
freeVars (L _ HsIPVar{}) = mempty -- Implicit parameter.
freeVars (L _ HsOverLit{}) = mempty -- Overloaded literal.
Expand Down Expand Up @@ -172,10 +171,6 @@ instance FreeVars (LocatedA (HsFieldBind (LocatedA (FieldOcc GhcPs)) (LocatedA (
freeVars o@(L _ (HsFieldBind _ x _ True)) = Set.singleton $ occName $ unLoc $ foLabel $ unLoc x -- a pun
freeVars o@(L _ (HsFieldBind _ _ x _)) = freeVars x

instance FreeVars (LocatedA (HsFieldBind (LocatedA (AmbiguousFieldOcc GhcPs)) (LocatedA (HsExpr GhcPs)))) where
freeVars (L _ (HsFieldBind _ x _ True)) = Set.singleton $ rdrNameOcc $ ambiguousFieldOccRdrName $ unLoc x -- a pun
freeVars (L _ (HsFieldBind _ _ x _)) = freeVars x

instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) (LocatedA (HsExpr GhcPs)))) where
freeVars (L _ (HsFieldBind _ _ x _)) = freeVars x

Expand Down
2 changes: 1 addition & 1 deletion src/GHC/Util/Scope.hs
Original file line number Diff line number Diff line change
Expand Up @@ -119,7 +119,7 @@ possImport (L _ i) (L _ (Unqual x)) =
then maybe PossiblyImported (f . first (== EverythingBut)) (ideclImportList i)
else NotImported
where
f :: (Bool, LocatedL [LIE GhcPs]) -> IsImported
f :: (Bool, LocatedLI [LocatedA (IE GhcPs)]) -> IsImported
f (hide, L _ xs)
| hide = if Just True `elem` ms then NotImported else PossiblyImported
| Just True `elem` ms = Imported
Expand Down
32 changes: 25 additions & 7 deletions src/GHC/Util/Unify.hs
Original file line number Diff line number Diff line change
Expand Up @@ -119,7 +119,10 @@ unify' nm root x y
| Just (x :: EpAnn AnnContext) <- cast x = Just mempty
| Just (x :: EpAnn AnnExplicitSum) <- cast x = Just mempty
| Just (x :: EpAnn AnnFieldLabel) <- cast x = Just mempty
| Just (x :: EpAnn AnnList) <- cast x = Just mempty
| Just (x :: EpAnn (AnnList [EpToken ","])) <- cast x = Just mempty
| Just (x :: EpAnn (AnnList ())) <- cast x = Just mempty
| Just (x :: EpAnn (AnnList (EpToken "where"))) <- cast x = Just mempty
| Just (x :: EpAnn (AnnList (EpToken "hiding", [EpToken ","]))) <- cast x = Just mempty
| Just (x :: EpAnn AnnListItem) <- cast x = Just mempty
| Just (x :: EpAnn AnnParen) <- cast x = Just mempty
| Just (x :: EpAnn AnnPragma) <- cast x = Just mempty
Expand All @@ -135,18 +138,33 @@ unify' nm root x y
| Just (x :: EpAnn HsRuleAnn) <- cast x = Just mempty
| Just (x :: EpAnn NameAnn) <- cast x = Just mempty
| Just (x :: EpAnn NoEpAnns) <- cast x = Just mempty
| Just (x :: EpAnn [AddEpAnn]) <- cast x = Just mempty
| Just (x :: EpAnn (AddEpAnn, AddEpAnn)) <- cast x = Just mempty
| Just (x :: EpToken "let") <- cast x = Just mempty
| Just (x :: EpToken "in") <- cast x = Just mempty
| Just (x :: EpToken "@") <- cast x = Just mempty
| Just (x :: EpToken "|") <- cast x = Just mempty
| Just (x :: EpToken ",") <- cast x = Just mempty
| Just (x :: EpToken ";") <- cast x = Just mempty
| Just (x :: EpToken "`") <- cast x = Just mempty
| Just (x :: EpToken ".") <- cast x = Just mempty
| Just (x :: EpToken "\\") <- cast x = Just mempty
| Just (x :: EpToken "(") <- cast x = Just mempty
| Just (x :: EpToken ")") <- cast x = Just mempty
| Just (x :: EpToken "@") <- cast x = Just mempty
| Just (x :: EpToken "#-}") <- cast x = Just mempty
| Just (x :: EpToken "if") <- cast x = Just mempty
| Just (x :: EpToken "then") <- cast x = Just mempty
| Just (x :: EpToken "else") <- cast x = Just mempty
| Just (x :: EpToken "case") <- cast x = Just mempty
| Just (x :: EpToken "of") <- cast x = Just mempty
| Just (x :: EpToken "in") <- cast x = Just mempty
| Just (x :: EpToken "type") <- cast x = Just mempty
| Just (x :: EpToken "%") <- cast x = Just mempty
| Just (x :: EpToken "%1") <- cast x = Just mempty
| Just (x :: EpToken "") <- cast x = Just mempty
| Just (x :: EpToken "proc") <- cast x = Just mempty
| Just (x :: EpToken "static") <- cast x = Just mempty
| Just (x :: EpToken "qualified") <- cast x = Just mempty
| Just (x :: EpToken "safe") <- cast x = Just mempty
| Just (x :: EpToken "as") <- cast x = Just mempty
| Just (x :: EpToken "import") <- cast x = Just mempty
| Just (x :: EpUniToken "->" "") <- cast x = Just mempty
| Just (x :: EpUniToken "::" "") <- cast x = Just mempty
| Just (x :: TokenLocation) <- cast y = Just mempty
| Just (y :: SrcSpan) <- cast y = Just mempty

Expand Down
2 changes: 1 addition & 1 deletion src/Hint/Pattern.hs
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,7 @@ import Data.Either
import Refact.Types hiding (RType(Pattern, Match), SrcSpan)
import Refact.Types qualified as R (RType(Pattern, Match), SrcSpan)

import GHC.Hs
import GHC.Hs hiding (asPattern)
import GHC.Types.SrcLoc
import GHC.Types.Name.Reader
import GHC.Types.Name.Occurrence
Expand Down

0 comments on commit 8798d9a

Please sign in to comment.