Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

GHC 9.8 backwards compatibility (WIP) #2380

Merged
merged 3 commits into from
Oct 17, 2024
Merged

GHC 9.8 backwards compatibility (WIP) #2380

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
dc25324
GHC-9.8 compatibility: `Unique`s contain `Int`s instead of `Word64`s.
gergoerdi Oct 11, 2024
2825dc1
GHC-9.8 compatibility: Different module names for `Foldable` and `Real`
gergoerdi Oct 16, 2024
c4b8d24
Add a description to the header of Liquid.GHC.API.Compat
facundominguez Oct 17, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions liquidhaskell-boot/liquidhaskell-boot.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -60,6 +60,7 @@ library
Language.Haskell.Liquid.Constraint.Types
Language.Haskell.Liquid.Constraint.Relational
Liquid.GHC.API
Liquid.GHC.API.Compat
Liquid.GHC.API.Extra
Liquid.GHC.API.StableModule
Language.Haskell.Liquid.GHC.CoreToLogic
Expand Down
3 changes: 1 addition & 2 deletions liquidhaskell-boot/src-ghc/Liquid/GHC/API.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ module Liquid.GHC.API (
) where

import Liquid.GHC.API.Extra as Ghc
import Liquid.GHC.API.Compat as Ghc

import GHC as Ghc
( Class
Expand Down Expand Up @@ -167,14 +168,12 @@ import GHC.Builtin.Names as Ghc
, Unique
, and_RDR
, bindMName
, gHC_INTERNAL_DATA_FOLDABLE
, eqClassKey
, eqClassName
, ge_RDR
, gt_RDR
, fractionalClassKey
, fractionalClassKeys
, gHC_INTERNAL_REAL
, getUnique
, hasKey
, isStringClassName
Expand Down
32 changes: 32 additions & 0 deletions liquidhaskell-boot/src-ghc/Liquid/GHC/API/Compat.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,32 @@
-- | This module contains definitions that change between different versions
-- of the GHC API. It helps encapsulating differences between branches of LH
-- that could support different versions of GHC.
module Liquid.GHC.API.Compat (
facundominguez marked this conversation as resolved.
Show resolved Hide resolved
UniqueId
, toUniqueId

, foldableModule
, realModule
) where

import Data.Word (Word64)
import qualified GHC.Builtin.Names as Ghc
import GHC (Module)

----------------------
-- Uniques
----------------------

type UniqueId = Word64

toUniqueId :: Word64 -> UniqueId
toUniqueId = id

----------------------
-- Built-in modules
----------------------

foldableModule, realModule :: Module

foldableModule = Ghc.gHC_INTERNAL_DATA_FOLDABLE
realModule = Ghc.gHC_INTERNAL_REAL
2 changes: 1 addition & 1 deletion liquidhaskell-boot/src/Language/Haskell/Liquid/Bare/Elaborate.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -604,7 +604,7 @@ fixExprToHsExpr env (F.PAnd (e : es)) = L.foldr f (fixExprToHsExpr env e) es
-- (nlHsVar (varQual_RDR dATA_FOLDABLE (fsLit "and")))
-- (nlList $ fixExprToHsExpr env <$> es)
fixExprToHsExpr env (F.POr es) = mkHsApp
(nlHsVar (varQual_RDR gHC_INTERNAL_DATA_FOLDABLE (fsLit "or")))
(nlHsVar (varQual_RDR foldableModule (fsLit "or")))
(nlList $ fixExprToHsExpr env <$> es)
fixExprToHsExpr env (F.PIff e0 e1) = mkHsApp
(mkHsApp (nlHsVar (mkVarUnqual (mkFastString "<=>"))) (fixExprToHsExpr env e0)
Expand Down
12 changes: 6 additions & 6 deletions liquidhaskell-boot/src/Language/Haskell/Liquid/GHC/Misc.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -105,11 +105,11 @@ maybeAuxVar s
name = mkInternalName (mkUnique 'x' uid) occ noSrcSpan
occ = mkVarOcc (T.unpack (symbolText sym))

stringTyCon :: Char -> Word64 -> String -> TyCon
stringTyCon :: Char -> UniqueId -> String -> TyCon
stringTyCon = stringTyConWithKind anyTy

-- FIXME: reusing uniques like this is really dangerous
stringTyConWithKind :: Kind -> Char -> Word64 -> String -> TyCon
stringTyConWithKind :: Kind -> Char -> UniqueId -> String -> TyCon
stringTyConWithKind k c n s = Ghc.mkPrimTyCon name [] k []
where
name = mkInternalName (mkUnique c n) occ noSrcSpan
Expand Down Expand Up @@ -508,8 +508,8 @@ takeModuleUnique = mungeNames tailName sepUnique "takeModuleUnique: "
where
tailName msg = symbol . safeLast msg

splitModuleUnique :: Symbol -> (Symbol, Word64)
splitModuleUnique x = (dropModuleNamesAndUnique x, base62ToW (takeModuleUnique x))
splitModuleUnique :: Symbol -> (Symbol, UniqueId)
splitModuleUnique x = (dropModuleNamesAndUnique x, toUniqueId $ base62ToW (takeModuleUnique x))

base62ToW :: Symbol -> Word64
base62ToW s = fromMaybe (errorstar "base62ToW Out Of Range") $ go (F.symbolText s)
Expand Down Expand Up @@ -993,7 +993,7 @@ withWiredIn m = discardConstraints $ do
return $ TcWiredIn n Nothing ty

prependGHCRealQual :: FastString -> RdrName
prependGHCRealQual = varQual_RDR gHC_INTERNAL_REAL
prependGHCRealQual = varQual_RDR realModule

isFromGHCReal :: NamedThing a => a -> Bool
isFromGHCReal x = Ghc.nameModule (Ghc.getName x) == gHC_INTERNAL_REAL
isFromGHCReal x = Ghc.nameModule (Ghc.getName x) == realModule
3 changes: 1 addition & 2 deletions liquidhaskell-boot/src/Language/Haskell/Liquid/Transforms/ANF.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,6 @@

module Language.Haskell.Liquid.Transforms.ANF (anormalize) where

import Data.Word (Word64)
import Debug.Trace (trace)
import Prelude hiding (error)
import Language.Haskell.Liquid.GHC.TypeRep
Expand Down Expand Up @@ -355,7 +354,7 @@ freshNormalVar γ t = do
let sp = Sp.srcSpan (aeSrcSpan γ)
return (mkUserLocalOrCoVar (anfOcc i) u Ghc.ManyTy t sp)

anfOcc :: Word64 -> OccName
anfOcc :: UniqueId -> OccName
anfOcc = mkVarOccFS . GM.symbolFastString . F.intSymbol F.anfPrefix

data AnfEnv = AnfEnv
Expand Down
Loading