[commit: ghc] wip/14691: Try using tcLookupId instead of lookupId (f00a371)

git at git.haskell.org git at git.haskell.org
Mon Jan 22 15:54:58 UTC 2018


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/14691
Link       : http://ghc.haskell.org/trac/ghc/changeset/f00a37149ce9f018008bf52da2d7df09f6055d78/ghc

>---------------------------------------------------------------

commit f00a37149ce9f018008bf52da2d7df09f6055d78
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Mon Jan 22 10:54:17 2018 -0500

    Try using tcLookupId instead of lookupId
    
    (the latter goes through tcLookupGlobal)


>---------------------------------------------------------------

f00a37149ce9f018008bf52da2d7df09f6055d78
 compiler/typecheck/TcEvTerm.hs | 21 ++++++++++-----------
 1 file changed, 10 insertions(+), 11 deletions(-)

diff --git a/compiler/typecheck/TcEvTerm.hs b/compiler/typecheck/TcEvTerm.hs
index e9d3db3..114d4e4 100644
--- a/compiler/typecheck/TcEvTerm.hs
+++ b/compiler/typecheck/TcEvTerm.hs
@@ -81,7 +81,7 @@ type TypeRepExpr = CoreExpr
 -- | Returns a @CoreExpr :: TypeRep ty@
 ds_ev_typeable :: Type -> EvTypeable -> TcS CoreExpr
 ds_ev_typeable ty (EvTypeableTyCon tc kind_ev)
-  = do { mkTrCon <- lookupId mkTrConName
+  = do { mkTrCon <- tcLookupId mkTrConName
                     -- mkTrCon :: forall k (a :: k). TyCon -> TypeRep k -> TypeRep a
        ; someTypeRepTyCon <- tcLookupTyCon someTypeRepTyConName
        ; someTypeRepDataCon <- lookupDataCon someTypeRepDataConName
@@ -90,7 +90,7 @@ ds_ev_typeable ty (EvTypeableTyCon tc kind_ev)
        ; tc_rep <- tyConRep tc                      -- :: TyCon
        ; let ks = tyConAppArgs ty
              -- Construct a SomeTypeRep
-             toSomeTypeRep :: MonadThings m => Type -> EvTerm -> m CoreExpr
+             toSomeTypeRep :: Type -> EvTerm -> TcS CoreExpr
              toSomeTypeRep t ev = do
                  rep <- getRep ev t
                  return $ mkCoreConApps someTypeRepDataCon [Type (typeKind t), Type t, rep]
@@ -113,7 +113,7 @@ ds_ev_typeable ty (EvTypeableTyApp ev1 ev2)
   | Just (t1,t2) <- splitAppTy_maybe ty
   = do { e1  <- getRep ev1 t1
        ; e2  <- getRep ev2 t2
-       ; mkTrApp <- lookupId mkTrAppName
+       ; mkTrApp <- tcLookupId mkTrAppName
                     -- mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
                     --            TypeRep a -> TypeRep b -> TypeRep (a b)
        ; let (k1, k2) = splitFunTy (typeKind t1)
@@ -127,7 +127,7 @@ ds_ev_typeable ty (EvTypeableTrFun ev1 ev2)
   | Just (t1,t2) <- splitFunTy_maybe ty
   = do { e1 <- getRep ev1 t1
        ; e2 <- getRep ev2 t2
-       ; mkTrFun <- lookupId mkTrFunName
+       ; mkTrFun <- tcLookupId mkTrFunName
                     -- mkTrFun :: forall r1 r2 (a :: TYPE r1) (b :: TYPE r2).
                     --            TypeRep a -> TypeRep b -> TypeRep (a -> b)
        ; let r1 = getRuntimeRep t1
@@ -137,7 +137,7 @@ ds_ev_typeable ty (EvTypeableTrFun ev1 ev2)
        }
 
 ds_ev_typeable ty (EvTypeableTyLit dict)
-  = do { fun  <- lookupId tr_fun
+  = do { fun  <- tcLookupId tr_fun
        ; let proxy = mkTyApps (Var proxyHashId) [ty_kind, ty]
        ; return (mkApps (mkTyApps (Var fun) [ty]) [ dict, proxy ]) }
   where
@@ -153,23 +153,22 @@ ds_ev_typeable ty (EvTypeableTyLit dict)
 ds_ev_typeable ty ev
   = pprPanic "dsEvTypeable" (ppr ty $$ ppr ev)
 
-getRep :: MonadThings m
-       => EvTerm          -- ^ EvTerm for @Typeable ty@
+getRep :: EvTerm          -- ^ EvTerm for @Typeable ty@
        -> Type            -- ^ The type @ty@
-       -> m TypeRepExpr -- ^ Return @CoreExpr :: TypeRep ty@
+       -> TcS TypeRepExpr -- ^ Return @CoreExpr :: TypeRep ty@
                           -- namely @typeRep# dict@
 -- Remember that
 --   typeRep# :: forall k (a::k). Typeable k a -> TypeRep a
 getRep ev ty
-  = do { typeRepId     <- lookupId typeRepIdName
+  = do { typeRepId     <- tcLookupId typeRepIdName
        ; let ty_args = [typeKind ty, ty]
        ; return (mkApps (mkTyApps (Var typeRepId) ty_args) [ ev ]) }
 
-tyConRep :: MonadThings m => TyCon -> m CoreExpr
+tyConRep :: TyCon -> TcS CoreExpr
 -- Returns CoreExpr :: TyCon
 tyConRep tc
   | Just tc_rep_nm <- tyConRepName_maybe tc
-  = do { tc_rep_id <- lookupId tc_rep_nm
+  = do { tc_rep_id <- tcLookupId tc_rep_nm
        ; return (Var tc_rep_id) }
   | otherwise
   = pprPanic "tyConRep" (ppr tc)



More information about the ghc-commits mailing list