Commit 0ad2021b authored by Simon Peyton Jones's avatar Simon Peyton Jones

Make SigSkol take TcType not ExpType

For some reason a SigSkol had an ExpType in it, and there were
lots of places where we needed it to have a TcType.  And was indeed
always a Check.  All a lot of fuss about nothing.

Delete code, fewer failure points, types are more precise.
All good.
parent 174d3a53
......@@ -585,7 +585,7 @@ tcPolyCheck rec_tc prag_fn
, sig_loc = loc })
bind
= do { ev_vars <- newEvVars theta
; let skol_info = SigSkol ctxt (mkCheckExpType $ mkPhiTy theta tau)
; let skol_info = SigSkol ctxt (mkPhiTy theta tau)
prag_sigs = lookupPragEnv prag_fn name
skol_tvs = map snd skol_prs
-- Find the location of the original source type sig, if
......@@ -764,7 +764,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs Nothing
; return (binders, my_theta) }
chooseInferredQuantifiers inferred_theta tau_tvs qtvs
(Just (TISI { sig_bndr = bndr_info
(Just (TISI { sig_bndr = bndr_info -- Always PartialSig
, sig_ctxt = ctxt
, sig_theta = annotated_theta
, sig_skols = annotated_tvs }))
......
......@@ -1480,7 +1480,7 @@ tcExprSig expr sig@(TISI { sig_bndr = s_bndr
| otherwise = panic "tcExprSig" -- Can't happen
where
skol_info = SigSkol ExprSigCtxt (mkCheckExpType $ mkPhiTy theta tau)
skol_info = SigSkol ExprSigCtxt (mkPhiTy theta tau)
skol_tvs = map snd skol_prs
{- *********************************************************************
......
......@@ -1270,9 +1270,8 @@ zonkCtEvidence ctev@(CtDerived { ctev_pred = pred })
; return (ctev { ctev_pred = pred' }) }
zonkSkolemInfo :: SkolemInfo -> TcM SkolemInfo
zonkSkolemInfo (SigSkol cx ty) = do { ty <- readExpType ty
; ty' <- zonkTcType ty
; return (SigSkol cx (mkCheckExpType ty')) }
zonkSkolemInfo (SigSkol cx ty) = do { ty' <- zonkTcType ty
; return (SigSkol cx ty') }
zonkSkolemInfo (InferSkol ntys) = do { ntys' <- mapM do_one ntys
; return (InferSkol ntys') }
where
......@@ -1458,9 +1457,7 @@ tidyEvVar env var = setVarType var (tidyType env (varType var))
----------------
tidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo
tidySkolemInfo env (DerivSkol ty) = DerivSkol (tidyType env ty)
tidySkolemInfo env (SigSkol cx ty) = SigSkol cx (mkCheckExpType $
tidyType env $
checkingExpType "tidySkolemInfo" ty)
tidySkolemInfo env (SigSkol cx ty) = SigSkol cx (tidyType env ty)
tidySkolemInfo env (InferSkol ids) = InferSkol (mapSnd (tidyType env) ids)
tidySkolemInfo env (UnifyForAllSkol ty) = UnifyForAllSkol (tidyType env ty)
tidySkolemInfo _ info = info
......@@ -398,8 +398,7 @@ tc_pat penv (ViewPat expr pat _) overall_pat_ty thing_inside
-- expr_wrap1 :: expr'_inferred "->" (inf_arg_ty -> inf_res_ty)
-- check that overall pattern is more polymorphic than arg type
; let pat_origin = GivenOrigin (SigSkol GenSigCtxt overall_pat_ty)
; expr_wrap2 <- tcSubTypeET pat_origin overall_pat_ty inf_arg_ty
; expr_wrap2 <- tcSubTypeET (pe_orig penv) overall_pat_ty inf_arg_ty
-- expr_wrap2 :: overall_pat_ty "->" inf_arg_ty
-- pattern must have inf_res_ty
......
......@@ -2574,7 +2574,7 @@ pushErrCtxtSameOrigin err loc@(CtLoc { ctl_env = lcl })
-- b) an implication constraint is generated
data SkolemInfo
= SigSkol UserTypeCtxt -- A skolem that is created by instantiating
ExpType -- a programmer-supplied type signature
TcType -- a programmer-supplied type signature
-- Location of the binding site is on the TyVar
| PatSynSigSkol Name -- Bound by a programmer-supplied type signature of a pattern
......@@ -2653,7 +2653,7 @@ pprSkolInfo (PatSynSigSkol name) = text "the type signature of pattern synonym"
-- For Insts, these cases should not happen
pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) text "UnkSkol"
pprSigSkolInfo :: UserTypeCtxt -> ExpType -> SDoc
pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc
pprSigSkolInfo ctxt ty
= case ctxt of
FunSigCtxt f _ -> pp_sig f
......
......@@ -746,8 +746,7 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected
do { res_wrap <- tc_sub_type_ds eq_orig inst_orig ctxt act_res exp_res
; arg_wrap
<- tc_sub_tc_type eq_orig (GivenOrigin
(SigSkol GenSigCtxt
(mkCheckExpType exp_arg)))
(SigSkol GenSigCtxt exp_arg))
ctxt exp_arg act_arg
; return (mkWpFun arg_wrap res_wrap exp_arg exp_res) }
-- arg_wrap :: exp_arg ~ act_arg
......@@ -883,8 +882,7 @@ tcSkolemise ctxt expected_ty thing_inside
-- Use the *instantiated* type in the SkolemInfo
-- so that the names of displayed type variables line up
; let skol_info = SigSkol ctxt (mkCheckExpType $
mkFunTys (map varType given) rho')
; let skol_info = SigSkol ctxt (mkFunTys (map varType given) rho')
; (ev_binds, result) <- checkConstraints skol_info tvs' given $
thing_inside tvs' rho'
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment