Commit 1d874e7c authored by simonpj's avatar simonpj
Browse files

[project @ 2001-11-30 09:32:27 by simonpj]

Wibbles to rank-N
parent b560e2a5
......@@ -814,5 +814,7 @@ genCtxt binder_names
= ptext SLIT("When generalising the type(s) for") <+> pprBinders binder_names
-- Used in error messages
pprBinders bndrs = pprWithCommas ppr bndrs
-- Use quotes for a single one; they look a bit "busy" for several
pprBinders [bndr] = quotes (ppr bndr)
pprBinders bndrs = pprWithCommas ppr bndrs
\end{code}
......@@ -593,16 +593,18 @@ tcApp fun args res_ty
split_fun_ty fun_ty (length args)
) `thenTc` \ (expected_arg_tys, actual_result_ty) ->
-- Unify with expected result before type-checking the args
-- so that the info from res_ty percolates to expected_arg_tys
-- This is when we might detect a too-few args situation
tcAddErrCtxtM (checkArgsCtxt fun args res_ty actual_result_ty)
(tcSub res_ty actual_result_ty) `thenTc` \ (co_fn, lie_res) ->
-- Now typecheck the args
mapAndUnzipTc (tcArg fun)
(zip3 args expected_arg_tys [1..]) `thenTc` \ (args', lie_args_s) ->
-- Unify with expected result after type-checking the args
-- so that the info from args percolates to actual_result_ty.
-- This is when we might detect a too-few args situation.
-- (One can think of cases when the opposite order would give
-- a better error message.)
tcAddErrCtxtM (checkArgsCtxt fun args res_ty actual_result_ty)
(tcSub res_ty actual_result_ty) `thenTc` \ (co_fn, lie_res) ->
returnTc (co_fn <$> foldl HsApp fun' args',
lie_res `plusLIE` lie_fun `plusLIE` plusLIEs lie_args_s)
......@@ -674,7 +676,7 @@ Typecheck expression which in most cases will be an Id.
tcExpr_id :: RenamedHsExpr -> TcM (TcExpr, LIE, TcType)
tcExpr_id (HsVar name) = tcId name
tcExpr_id expr = newTyVarTy openTypeKind `thenNF_Tc` \ id_ty ->
tcMonoExpr expr id_ty `thenTc` \ (expr', lie_id) ->
tcMonoExpr expr id_ty `thenTc` \ (expr', lie_id) ->
returnTc (expr', lie_id, id_ty)
\end{code}
......
......@@ -179,8 +179,13 @@ tc_sub _ (FunTy exp_arg exp_res) _ (FunTy act_arg act_res)
-----------------------------------
-- Type variable meets function: imitate
-- MARK: can we short-cut to an error case?
--
-- NB 1: we can't just unify the type variable with the type
-- because the type might not be a tau-type, and we aren't
-- allowed to instantiate an ordinary type variable with
-- a sigma-type
--
-- NB 2: can we short-cut to an error case?
-- when the arg/res is not a tau-type?
-- NO! e.g. f :: ((forall a. a->a) -> Int) -> Int
-- then x = (f,f)
......@@ -190,14 +195,14 @@ tc_sub exp_sty exp_ty@(FunTy exp_arg exp_res) _ (TyVarTy tv)
= getTcTyVar tv `thenNF_Tc` \ maybe_ty ->
case maybe_ty of
Just ty -> tc_sub exp_sty exp_ty ty ty
Nothing -> imitateFun tv `thenNF_Tc` \ (act_arg, act_res) ->
Nothing -> imitateFun tv exp_sty `thenNF_Tc` \ (act_arg, act_res) ->
tcSub_fun exp_arg exp_res act_arg act_res
tc_sub _ (TyVarTy tv) act_sty act_ty@(FunTy act_arg act_res)
= getTcTyVar tv `thenNF_Tc` \ maybe_ty ->
case maybe_ty of
Just ty -> tc_sub ty ty act_sty act_ty
Nothing -> imitateFun tv `thenNF_Tc` \ (exp_arg, exp_res) ->
Nothing -> imitateFun tv act_sty `thenNF_Tc` \ (exp_arg, exp_res) ->
tcSub_fun exp_arg exp_res act_arg act_res
-----------------------------------
......@@ -238,12 +243,19 @@ tcSub_fun exp_arg exp_res act_arg act_res
in
returnTc (coercion, lie1 `plusLIE` lie2)
imitateFun :: TcTyVar -> NF_TcM (TcType, TcType)
imitateFun tv
imitateFun :: TcTyVar -> TcType -> NF_TcM (TcType, TcType)
imitateFun tv ty
= ASSERT( not (isHoleTyVar tv) )
-- NB: tv is an *ordinary* tyvar and so are the new ones
-- Check that tv isn't a type-signature type variable
-- (This would be found later in checkSigTyVars, but
-- we get a better error message if we do it here.)
checkTcM (not (isSkolemTyVar tv))
(failWithTcM (unifyWithSigErr tv ty)) `thenTc_`
newTyVarTy openTypeKind `thenNF_Tc` \ arg ->
newTyVarTy openTypeKind `thenNF_Tc` \ res ->
-- NB: tv is an *ordinary* tyvar and so are the new ones
putTcTyVar tv (mkFunTy arg res) `thenNF_Tc_`
returnNF_Tc (arg,res)
\end{code}
......
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