diff --git a/liquidhaskell-boot/src/Language/Haskell/Liquid/Bare/Resolve.hs b/liquidhaskell-boot/src/Language/Haskell/Liquid/Bare/Resolve.hs index 1b48a50b7c..3e1791c8f1 100644 --- a/liquidhaskell-boot/src/Language/Haskell/Liquid/Bare/Resolve.hs +++ b/liquidhaskell-boot/src/Language/Haskell/Liquid/Bare/Resolve.hs @@ -952,7 +952,7 @@ lookupTyThing env lc@(Loc _ _ c0) = unsafePerformIO $ do LHRIndex i -> panic (Just $ GM.fSrcSpan lc) $ "cannot resolve a LHRIndex " ++ show i LHRLogic (LogicName s _) -> panic (Just $ GM.fSrcSpan lc) $ "lookupTyThing: cannot resolve a LHRLogic name " ++ show s LHRGHC n -> do - (_, m) <- Ghc.reflectGhc (Interface.lookupTyThing (reTcGblEnv env) n) (reSession env) + m <- Ghc.reflectGhc (Interface.lookupTyThing (reTcGblEnv env) n) (reSession env) case m of Just tt -> return tt Nothing -> panic (Just $ GM.fSrcSpan lc) $ "not found: " ++ show c0 diff --git a/liquidhaskell-boot/src/Language/Haskell/Liquid/GHC/Interface.hs b/liquidhaskell-boot/src/Language/Haskell/Liquid/GHC/Interface.hs index 46bf67f976..7717c90b2e 100644 --- a/liquidhaskell-boot/src/Language/Haskell/Liquid/GHC/Interface.hs +++ b/liquidhaskell-boot/src/Language/Haskell/Liquid/GHC/Interface.hs @@ -170,25 +170,24 @@ qImports qns = QImports -- (see `Bare.Resolve`) --------------------------------------------------------------------------------------- lookupTyThings :: (GhcMonad m) => TcGblEnv -> m [(Name, Maybe TyThing)] -lookupTyThings tcGblEnv = mapM (lookupTyThing tcGblEnv) names +lookupTyThings tcGblEnv = zip names <$> mapM (lookupTyThing tcGblEnv) names where names = liftA2 (++) (fmap Ghc.greName . Ghc.globalRdrEnvElts . tcg_rdr_env) (fmap is_dfun_name . tcg_insts) tcGblEnv -lookupTyThing :: (GhcMonad m) => TcGblEnv -> Name -> m (Name, Maybe TyThing) +lookupTyThing :: (GhcMonad m) => TcGblEnv -> Name -> m (Maybe TyThing) lookupTyThing tcGblEnv name = do - mbTy <- runMaybeT . msum . map MaybeT $ + runMaybeT . msum . map MaybeT $ [ pure (lookupNameEnv (tcg_type_env tcGblEnv) name) , lookupName name ] - return (name, mbTy) availableTyThings :: (GhcMonad m) => TcGblEnv -> [AvailInfo] -> m [TyThing] availableTyThings tcGblEnv avails = fmap catMaybes $ - mapM (fmap snd . lookupTyThing tcGblEnv) $ + mapM (lookupTyThing tcGblEnv) $ concatMap availNames avails _dumpTypeEnv :: TypecheckedModule -> IO ()