[commit: ghc] wip/type-app: Use ExprSigOrigin where appropriate (9536809)

git at git.haskell.org git at git.haskell.org
Fri Aug 7 12:07:49 UTC 2015


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

On branch  : wip/type-app
Link       : http://ghc.haskell.org/trac/ghc/changeset/95368091a1c293e9023c90eadce59366a924d024/ghc

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

commit 95368091a1c293e9023c90eadce59366a924d024
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Thu Aug 6 10:40:02 2015 -0400

    Use ExprSigOrigin where appropriate


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

95368091a1c293e9023c90eadce59366a924d024
 compiler/typecheck/TcExpr.hs | 22 ++++++----------------
 1 file changed, 6 insertions(+), 16 deletions(-)

diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 298639d..9f342f6 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -84,25 +84,15 @@ tcPolyExpr expr res_ty
   = addExprErrCtxt expr $
     do { traceTc "tcPolyExpr" (ppr res_ty); tcPolyExprNC expr res_ty }
 
-tcPolyExprNC expr res_ty
-  = fst <$> tcPolyExprNC_O expr res_ty
-
--- variant of tcPolyExpr that returns the origin
-tcPolyExprNC_O
-         :: LHsExpr Name        -- Expression to type check
-         -> TcSigmaType         -- Expected type (could be a polytype)
-         -> TcM (LHsExpr TcId, CtOrigin) -- Generalised expr with expected type
-              -- The origin is useful if you ever need to instantiate the type
-
-tcPolyExprNC_O (L loc expr) res_ty
+tcPolyExprNC (L loc expr) res_ty
   = do { traceTc "tcPolyExprNC_O" (ppr res_ty)
-       ; (wrap, (expr', orig))
+       ; (wrap, (expr', _))
            <- tcSkolemise GenSigCtxt res_ty $ \ _ res_ty ->
               setSrcSpan loc $
                 -- NB: setSrcSpan *after* skolemising, so we get better
                 -- skolem locations
               tcExpr expr res_ty
-       ; return (L loc (mkHsWrap wrap expr'), orig) }
+       ; return $ L loc (mkHsWrap wrap expr') }
 
 ---------------
 tcMonoExpr, tcMonoExprNC
@@ -239,7 +229,7 @@ tcExpr (ExprWithTySig expr sig_ty wcs) res_ty
  = do { nwc_tvs <- mapM newWildcardVarMetaKind wcs
       ; tcExtendTyVarEnv nwc_tvs $ do {
         sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty
-      ; (gen_fn, (expr', orig))
+      ; (gen_fn, expr')
             <- tcSkolemise ExprSigCtxt sig_tc_ty $
                \ skol_tvs res_ty ->
 
@@ -248,13 +238,13 @@ tcExpr (ExprWithTySig expr sig_ty wcs) res_ty
                tcExtendTyVarEnv2
                   [(n,tv) | (Just n, tv) <- findScopedTyVars sig_ty sig_tc_ty skol_tvs] $
 
-               tcPolyExprNC_O expr res_ty
+               tcPolyExprNC expr res_ty
 
       ; let inner_expr = ExprWithTySigOut (mkLHsWrap gen_fn expr') sig_ty
 
       ; addErrCtxt (pprSigCtxt ExprSigCtxt empty (ppr sig_ty)) $
         emitWildcardHoleConstraints (zip wcs nwc_tvs)
-      ; tcWrapResult inner_expr sig_tc_ty res_ty orig } }
+      ; tcWrapResult inner_expr sig_tc_ty res_ty ExprSigOrigin } }
 
 tcExpr (HsType ty _) _
   = failWithTc (sep [ text "Type argument used outside of a function argument:"



More information about the ghc-commits mailing list