Remove SkolemiseMode -- always go deep.
authorRichard Eisenberg <eir@cis.upenn.edu>
Thu, 9 Jul 2015 18:39:16 +0000 (14:39 -0400)
committerRichard Eisenberg <eir@cis.upenn.edu>
Thu, 9 Jul 2015 18:39:16 +0000 (14:39 -0400)
compiler/typecheck/Inst.hs
compiler/typecheck/TcBinds.hs
compiler/typecheck/TcExpr.hs
compiler/typecheck/TcMatches.hs
compiler/typecheck/TcUnify.hs

index 2eac549..338bd0d 100644 (file)
@@ -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@.
-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)
index 1b2f72f..3c081e3 100644 (file)
@@ -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
index dd65965..11889e7 100644 (file)
@@ -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) }
 
index a5410a9..58b68a8 100644 (file)
@@ -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 ->
index d863338..021139f 100644 (file)
@@ -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@.
--- The 'SkolemiseMode' parameter tells 'tcSkolemise' which quantifiers
--- to skolemise. The returned 'HsWrapper' has type
--- @specific_ty -> expected_ty@.
-tcSkolemise :: SkolemiseMode
-            -> UserTypeCtxt -> TcSigmaType
+-- The returned 'HsWrapper' has type @specific_ty -> expected_ty@.
+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 [