[commit: ghc] wip/type-app: Remove SkolemiseMode -- always go deep. (b4194ab)
git at git.haskell.org
git at git.haskell.org
Fri Aug 7 12:05:13 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/type-app
Link : http://ghc.haskell.org/trac/ghc/changeset/b4194abe0e2bc24a3ff63f491e266bb048b526a9/ghc
>---------------------------------------------------------------
commit b4194abe0e2bc24a3ff63f491e266bb048b526a9
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date: Thu Jul 9 14:39:16 2015 -0400
Remove SkolemiseMode -- always go deep.
>---------------------------------------------------------------
b4194abe0e2bc24a3ff63f491e266bb048b526a9
compiler/typecheck/Inst.hs | 44 +----------------------------------------
compiler/typecheck/TcBinds.hs | 2 +-
compiler/typecheck/TcExpr.hs | 11 +++++------
compiler/typecheck/TcMatches.hs | 2 +-
compiler/typecheck/TcUnify.hs | 17 +++++++---------
5 files changed, 15 insertions(+), 61 deletions(-)
diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs
index 2eac549..338bd0d 100644
--- a/compiler/typecheck/Inst.hs
+++ b/compiler/typecheck/Inst.hs
@@ -9,7 +9,7 @@ The @Inst@ type: dictionaries or method instances
{-# LANGUAGE CPP #-}
module Inst (
- skolemise, SkolemiseMode(..),
+ deeplySkolemise,
topInstantiate, topInstantiateInferred, deeplyInstantiate,
instCall, instDFunType, instStupidTheta,
newWanted, newWanteds,
@@ -146,48 +146,6 @@ ToDo: this eta-abstraction plays fast and loose with termination,
fix this
-}
--- | How should we skolemise a type?
-data SkolemiseMode
- = SkolemiseDeeply
- -- ^ Skolemise all inferred and specified variables, and all
- -- constraints, from the top type and to the right of arrows.
- -- See also 'deeplySkolemise'
-
- | SkolemiseTop
- -- ^ Skolemise all variables and all constraints, at the top level only.
- -- Does not look past non-constraint arrows.
-
--- | Skolemise a type according to the provided 'SkolemiseMode'.
--- The caller will likely want to bind the returns variables and
--- givens. The 'HsWrapper' returned has type @skol_ty -> sigma at .
-skolemise :: SkolemiseMode -> TcSigmaType
- -> TcM (HsWrapper, [TyVar], [EvVar], TcType)
-skolemise SkolemiseDeeply = deeplySkolemise
-skolemise SkolemiseTop = topSkolemise
-
--- | Skolemise top-level quantified variables and constraints.
-topSkolemise :: TcSigmaType
- -> TcM (HsWrapper, [TyVar], [EvVar], TcRhoType)
-topSkolemise sigma
- | null tvs && null theta
- = return (idHsWrapper, [], [], rho)
-
- | otherwise
- = do { (subst, tvs') <- tcInstSkolTyVars tvs
- ; let theta' = substTheta subst theta
- rho' = substTy subst rho
- ; ev_vars <- newEvVars theta'
- ; (wrap, inner_tvs', inner_ev_vars, inner_rho) <- topSkolemise rho'
- -- This handles types like
- -- forall a. Num a => forall b. Ord b => ...
-
- ; return ( mkWpTyLams tvs' <.> mkWpLams ev_vars <.> wrap
- , tvs' ++ inner_tvs'
- , ev_vars ++ inner_ev_vars
- , inner_rho ) }
- where
- (tvs, theta, rho) = tcSplitSigmaTy sigma
-
deeplySkolemise
:: TcSigmaType
-> TcM (HsWrapper, [TyVar], [EvVar], TcRhoType)
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index 1b2f72f..3c081e3 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -1048,7 +1048,7 @@ tcSpecWrapper :: UserTypeCtxt -> TcType -> TcType -> TcM HsWrapper
-- See Note [Handling SPECIALISE pragmas], wrinkle 1
tcSpecWrapper ctxt poly_ty spec_ty
= do { (sk_wrap, inst_wrap)
- <- tcSkolemise SkolemiseDeeply ctxt spec_ty $ \ _ spec_tau ->
+ <- tcSkolemise ctxt spec_ty $ \ _ spec_tau ->
do { (inst_wrap, tau) <- topInstantiate orig poly_ty
; _ <- unifyType spec_tau tau
-- Deliberately ignore the evidence
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index dd65965..11889e7 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -88,7 +88,7 @@ tcPolyExpr expr res_ty
tcPolyExprNC (L loc expr) res_ty
= setSrcSpan loc $
do { traceTc "tcPolyExprNC" (ppr res_ty)
- ; expr' <- tcSkolemiseExpr SkolemiseDeeply res_ty $ \ res_ty ->
+ ; expr' <- tcSkolemiseExpr res_ty $ \ res_ty ->
tcExpr expr res_ty
; return (L loc expr') }
@@ -210,7 +210,7 @@ tcExpr (ExprWithTySig expr sig_ty wcs) res_ty
; tcExtendTyVarEnv nwc_tvs $ do {
sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty
; (gen_fn, expr')
- <- tcSkolemise SkolemiseTop ExprSigCtxt sig_tc_ty $
+ <- tcSkolemise ExprSigCtxt sig_tc_ty $
\ skol_tvs res_ty ->
-- Remember to extend the lexical type-variable environment;
@@ -1571,12 +1571,11 @@ checkMissingFields data_con rbinds
-- | Convenient wrapper for skolemising a type during typechecking an expression.
-- Always does uses a 'GenSigCtxt'.
-tcSkolemiseExpr :: SkolemiseMode
- -> TcSigmaType
+tcSkolemiseExpr :: TcSigmaType
-> (TcRhoType -> TcM (HsExpr TcId))
-> (TcM (HsExpr TcId))
-tcSkolemiseExpr mode res_ty thing_inside
- = do { (wrap, expr) <- tcSkolemise mode GenSigCtxt res_ty $
+tcSkolemiseExpr res_ty thing_inside
+ = do { (wrap, expr) <- tcSkolemise GenSigCtxt res_ty $
\_ rho -> thing_inside rho
; return (mkHsWrap wrap expr) }
diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs
index a5410a9..58b68a8 100644
--- a/compiler/typecheck/TcMatches.hs
+++ b/compiler/typecheck/TcMatches.hs
@@ -79,7 +79,7 @@ tcMatchesFun fun_name inf matches exp_ty
; checkArgs fun_name matches
; (wrap_gen, (wrap_fun, group))
- <- tcSkolemise SkolemiseDeeply (FunSigCtxt fun_name True) exp_ty $
+ <- tcSkolemise (FunSigCtxt fun_name True) exp_ty $
\ _ exp_rho ->
-- Note [Polymorphic expected type for tcMatchesFun]
matchFunTys herald arity exp_rho $ \ pat_tys rhs_ty ->
diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs
index d863338..021139f 100644
--- a/compiler/typecheck/TcUnify.hs
+++ b/compiler/typecheck/TcUnify.hs
@@ -10,7 +10,7 @@ Type subsumption and unification
module TcUnify (
-- Full-blown subsumption
- tcWrapResult, tcSkolemise, SkolemiseMode(..),
+ tcWrapResult, tcSkolemise,
tcSubTypeHR, tcSubType, tcSubType_NC, tcSubTypeDS, tcSubTypeDS_NC,
checkConstraints,
@@ -87,7 +87,7 @@ exposeRhoType :: ExpOrAct -> TcSigmaType
-> TcM (HsWrapper, a)
exposeRhoType Expected ty thing_inside
= do { (wrap1, (wrap2, result)) <-
- tcSkolemise SkolemiseTop GenSigCtxt ty $ \_ -> thing_inside
+ tcSkolemise GenSigCtxt ty $ \_ -> thing_inside
; return (wrap1 <.> wrap2, result) }
exposeRhoType (Actual orig) ty thing_inside
= do { (wrap1, rho) <- topInstantiate orig ty
@@ -645,7 +645,7 @@ tc_sub_type origin ctxt ty_actual ty_expected
uType origin ty_actual ty_expected }
| otherwise -- See Note [Deep skolemisation]
- = do { (sk_wrap, inner_wrap) <- tcSkolemise SkolemiseDeeply ctxt ty_expected $
+ = do { (sk_wrap, inner_wrap) <- tcSkolemise ctxt ty_expected $
\ _ sk_rho ->
tc_sub_type_ds origin ctxt ty_actual sk_rho
; return (sk_wrap <.> inner_wrap) }
@@ -759,20 +759,17 @@ tcInfer tc_check
-- | Take an "expected type" and strip off quantifiers to expose the
-- type underneath, binding the new skolems for the @thing_inside at .
--- The 'SkolemiseMode' parameter tells 'tcSkolemise' which quantifiers
--- to skolemise. The returned 'HsWrapper' has type
--- @specific_ty -> expected_ty at .
-tcSkolemise :: SkolemiseMode
- -> UserTypeCtxt -> TcSigmaType
+-- The returned 'HsWrapper' has type @specific_ty -> expected_ty at .
+tcSkolemise :: UserTypeCtxt -> TcSigmaType
-> ([TcTyVar] -> TcType -> TcM result)
-> TcM (HsWrapper, result)
-- The expression has type: spec_ty -> expected_ty
-tcSkolemise mode ctxt expected_ty thing_inside
+tcSkolemise ctxt expected_ty thing_inside
-- We expect expected_ty to be a forall-type
-- If not, the call is a no-op
= do { traceTc "tcSkolemise" Outputable.empty
- ; (wrap, tvs', given, rho') <- skolemise mode expected_ty
+ ; (wrap, tvs', given, rho') <- deeplySkolemise expected_ty
; when debugIsOn $
traceTc "tcSkolemise" $ vcat [
More information about the ghc-commits
mailing list