From 5a552652286f9a019d37ded2428fb6543b169310 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Thu, 7 Sep 2006 10:27:18 +0000 Subject: [PATCH] Result type signatures are no longer supported (partial) I had failed to remove the bit where result type signatures bind lexical type variables. And now we are planning to remove them entirely. This commit therefore does a partial removal (to avoid destablising 6.6). It also arranges that f :: sig = rhs means a *pattern* binding (not a function binding with no arguments and a result signature), which makes sense. --- compiler/hsSyn/HsBinds.lhs | 11 ++++++----- compiler/parser/RdrHsSyn.lhs | 4 ++++ compiler/typecheck/TcMatches.lhs | 14 +++++++------- 3 files changed, 17 insertions(+), 12 deletions(-) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index 78a2234..31c1cae 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -59,14 +59,15 @@ type LHsBind id = Located (HsBind id) data HsBind id = FunBind { -- FunBind is used for both functions f x = e -- and variables f = \x -> e --- Reason 1: the Match stuff lets us have an optional --- result type sig f :: a->a = ...mentions a... +-- Reason 1: Special case for type inference: see TcBinds.tcMonoBinds -- --- Reason 2: Special case for type inference: see TcBinds.tcMonoBinds --- --- Reason 3: instance decls can only have FunBinds, which is convenient +-- Reason 2: instance decls can only have FunBinds, which is convenient -- If you change this, you'll need tochange e.g. rnMethodBinds +-- But note that the form f :: a->a = ... +-- parses as a pattern binding, just like +-- (f :: a -> a) = ... + fun_id :: Located id, fun_infix :: Bool, -- True => infix declaration diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 2e846a5..ca24070 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -596,6 +596,10 @@ checkValDef :: LHsExpr RdrName -> Located (GRHSs RdrName) -> P (HsBind RdrName) +checkValDef lhs (Just sig) grhss + -- x :: ty = rhs parses as a *pattern* binding + = checkPatBind (L (combineLocs lhs sig) (ExprWithTySig lhs sig)) grhss + checkValDef lhs opt_sig grhss = do { mb_fun <- isFunLhs lhs ; case mb_fun of diff --git a/compiler/typecheck/TcMatches.lhs b/compiler/typecheck/TcMatches.lhs index 07a1094..27d1e9b 100644 --- a/compiler/typecheck/TcMatches.lhs +++ b/compiler/typecheck/TcMatches.lhs @@ -23,10 +23,8 @@ import HsSyn ( HsExpr(..), LHsExpr, MatchGroup(..), ExprCoFn ) import TcRnMonad -import TcHsType ( tcPatSig, UserTypeCtxt(..) ) import Inst ( newMethodFromName ) -import TcEnv ( TcId, tcLookupLocalIds, tcLookupId, tcExtendIdEnv, - tcExtendTyVarEnv2 ) +import TcEnv ( TcId, tcLookupLocalIds, tcLookupId, tcExtendIdEnv ) import TcPat ( PatCtxt(..), tcPats, tcPat ) import TcMType ( newFlexiTyVarTy, newFlexiTyVarTys ) import TcType ( TcType, TcRhoType, @@ -165,15 +163,16 @@ tcMatch ctxt pat_tys rhs_ty match = addErrCtxt (matchCtxt (mc_what ctxt) match) $ do { (pats', grhss') <- tcPats LamPat pats pat_tys rhs_ty $ tc_grhss ctxt maybe_rhs_sig grhss - ; returnM (Match pats' Nothing grhss') } + ; return (Match pats' Nothing grhss') } tc_grhss ctxt Nothing grhss rhs_ty = tcGRHSs ctxt grhss rhs_ty -- No result signature + -- Result type sigs are no longer supported tc_grhss ctxt (Just res_sig) grhss rhs_ty - = do { (inner_ty, sig_tvs) <- tcPatSig ResSigCtxt res_sig rhs_ty - ; tcExtendTyVarEnv2 sig_tvs $ - tcGRHSs ctxt grhss inner_ty } + = do { addErr (ptext SLIT("Ignoring (deprecated) result type signature") + <+> ppr res_sig) + ; tcGRHSs ctxt grhss rhs_ty } ------------- tcGRHSs :: TcMatchCtxt -> GRHSs Name -> BoxyRhoType -> TcM (GRHSs TcId) @@ -500,6 +499,7 @@ checkArgs fun (MatchGroup (match1:matches) _) args_in_match :: LMatch Name -> Int args_in_match (L _ (Match pats _ _)) = length pats +checkArgs fun other = panic "TcPat.checkArgs" -- Matches always non-empty \end{code} \begin{code} -- 1.7.10.4