Simplify the return type of lookupTyThing

ucsd-progsys · Oct 30, 2024 · 168a914 · 168a914
1 parent 1ad605d
commit 168a914
Show file tree

Hide file tree

Showing 2 changed files with 5 additions and 6 deletions.
diff --git 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
@@ -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 ()