Skip to content

Commit

Permalink
Remove unneeded TyThing lookup method
Browse files Browse the repository at this point in the history
  • Loading branch information
facundominguez committed Oct 30, 2024
1 parent 837af37 commit 1ad605d
Show file tree
Hide file tree
Showing 2 changed files with 0 additions and 27 deletions.
24 changes: 0 additions & 24 deletions liquidhaskell-boot/src-ghc/Liquid/GHC/API/Extra.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,8 +14,6 @@ module Liquid.GHC.API.Extra (
, fsToUnitId
, isPatErrorAlt
, minus_RDR
, modInfoLookupName
, moduleInfoTc
, qualifiedNameFS
, renderWithStyle
, showPprQualified
Expand All @@ -28,7 +26,6 @@ module Liquid.GHC.API.Extra (
, untick
) where

import Control.Monad.IO.Class
import Liquid.GHC.API.StableModule as StableModule
import GHC hiding (modInfoLookupName)
import Data.Data (Data, gmapQr, gmapT)
Expand All @@ -45,19 +42,15 @@ import GHC.Core.Type as Ghc hiding (typeKind , isPredTy, extend
import GHC.Data.FastString as Ghc
import GHC.Data.Maybe
import qualified GHC.Data.Strict
import GHC.Driver.Env
import GHC.Driver.Main
import GHC.Driver.Session as Ghc
import GHC.Tc.Types
import GHC.Types.Id
import GHC.Types.Basic
import GHC.Types.Name (isSystemName, nameModule_maybe, occNameFS)
import GHC.Types.Name.Reader (nameRdrName)
import GHC.Types.SrcLoc as Ghc
import GHC.Types.TypeEnv
import GHC.Types.Unique (getUnique, hasKey)

import GHC.Unit.Module.ModDetails (md_types)
import GHC.Utils.Outputable as Ghc hiding ((<>))

import GHC.Unit.Module
Expand Down Expand Up @@ -176,23 +169,6 @@ addNoInlinePragmasToBinds tcg = tcg{ tcg_binds = go (tcg_binds tcg) }
{ abe_poly = markId poly
, abe_mono = markId mono }


-- | Our own simplified version of 'ModuleInfo' to overcome the fact we cannot construct the \"original\"
-- one as the constructor is not exported, and 'getHomeModuleInfo' and 'getPackageModuleInfo' are not
-- exported either, so we had to backport them as well.
newtype ModuleInfoLH = ModuleInfoLH { minflh_type_env :: TypeEnv }

modInfoLookupName :: (GhcMonad m) => ModuleInfoLH -> Name -> m (Maybe TyThing)
modInfoLookupName minf name = do
case lookupTypeEnv (minflh_type_env minf) name of
Just tyThing -> return (Just tyThing)
Nothing -> lookupGlobalName name

moduleInfoTc :: HscEnv -> TcGblEnv -> IO ModuleInfoLH
moduleInfoTc hscEnv tcGblEnv = do
details <- md_types <$> liftIO (makeSimpleDetails (hsc_logger hscEnv) tcGblEnv)
pure ModuleInfoLH { minflh_type_env = details }

-- | Tells if a case alternative calls to patError
isPatErrorAlt :: CoreAlt -> Bool
isPatErrorAlt (Alt _ _ exprCoreBndr) = hasPatErrorCall exprCoreBndr
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -179,12 +179,9 @@ lookupTyThings tcGblEnv = mapM (lookupTyThing tcGblEnv) names

lookupTyThing :: (GhcMonad m) => TcGblEnv -> Name -> m (Name, Maybe TyThing)
lookupTyThing tcGblEnv name = do
hscEnv <- getSession
mbTy <- runMaybeT . msum . map MaybeT $
[ pure (lookupNameEnv (tcg_type_env tcGblEnv) name)
, lookupName name
, do minf <- liftIO $ moduleInfoTc hscEnv tcGblEnv
modInfoLookupName minf name
]
return (name, mbTy)

Expand Down

0 comments on commit 1ad605d

Please sign in to comment.