Commit 6353ae0f authored by Simon Peyton Jones's avatar Simon Peyton Jones

Allow type signatures in instance decls (Trac #5676)

This new feature-ette, enable with -XInstanceSigs, lets
you give a type signature in an instance declaration:

   instance Eq Int where
     (==) :: Int -> Int -> Bool
     (==) = ...blah...

Scoped type variables work too.
parent 4bc413de
......@@ -402,7 +402,8 @@ data ExtensionFlag
| Opt_RebindableSyntax
| Opt_ConstraintKinds
| Opt_PolyKinds -- Kind polymorphism
| Opt_InstanceSigs
| Opt_StandaloneDeriving
| Opt_DeriveDataTypeable
| Opt_DeriveFunctor
......@@ -1934,6 +1935,7 @@ xFlags = [
( "RebindableSyntax", Opt_RebindableSyntax, nop ),
( "ConstraintKinds", Opt_ConstraintKinds, nop ),
( "PolyKinds", Opt_PolyKinds, nop ),
( "InstanceSigs", Opt_InstanceSigs, nop ),
( "MonoPatBinds", Opt_MonoPatBinds,
\ turn_on -> when turn_on $ deprecate "Experimental feature now removed; has no effect" ),
( "ExplicitForAll", Opt_ExplicitForAll, nop ),
......
......@@ -728,14 +728,14 @@ okHsSig ctxt (L _ sig)
(GenericSig {}, ClsDeclCtxt {}) -> True
(GenericSig {}, _) -> False
(TypeSig {}, InstDeclCtxt {}) -> False
(TypeSig {}, _) -> True
(TypeSig {}, _) -> True
(FixSig {}, InstDeclCtxt {}) -> False
(FixSig {}, _) -> True
(IdSig {}, TopSigCtxt) -> True
(IdSig {}, _) -> False
(IdSig {}, TopSigCtxt) -> True
(IdSig {}, InstDeclCtxt {}) -> True
(IdSig {}, _) -> False
(InlineSig {}, HsBootCtxt) -> False
(InlineSig {}, _) -> True
......
......@@ -52,6 +52,7 @@ import ListSetOps ( findDupsEq )
import Digraph ( SCC, flattenSCC, stronglyConnCompFromEdgedVertices )
import Control.Monad
import Data.List( partition )
import Maybes( orElse )
import Data.Maybe( isNothing )
\end{code}
......@@ -427,6 +428,16 @@ rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
-- Used for both source and interface file decls
= do { inst_ty' <- rnLHsInstType (text "In an instance declaration") inst_ty
; let Just (inst_tyvars, _, L _ cls,_) = splitLHsInstDeclTy_maybe inst_ty'
(spec_inst_prags, other_sigs) = partition isSpecInstLSig uprags
-- Rename the associated types, and type signatures
-- Both need to have the instance type variables in scope
; ((ats', other_sigs'), more_fvs)
<- extendTyVarEnvFVRn (map hsLTyVarName inst_tyvars) $
do { (ats', at_fvs) <- rnATInsts cls ats
; other_sigs' <- renameSigs (InstDeclCtxt cls) other_sigs
; return ( (ats', other_sigs')
, at_fvs `plusFV` hsSigsFVs other_sigs') }
-- Rename the bindings
-- The typechecker (not the renamer) checks that all
......@@ -434,29 +445,24 @@ rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
-- (Slightly strangely) when scoped type variables are on, the
-- forall-d tyvars scope over the method bindings too
; (mbinds', meth_fvs) <- extendTyVarEnvForMethodBinds inst_tyvars $
rnMethodBinds cls (\_ -> []) -- No scoped tyvars
rnMethodBinds cls (mkSigTvFn other_sigs')
mbinds
-- Rename the associated types
-- NB: We allow duplicate associated-type decls;
-- See Note [Associated type instances] in TcInstDcls
; (ats', at_fvs) <- extendTyVarEnvFVRn (map hsLTyVarName inst_tyvars) $
rnATInsts cls ats
-- Rename the prags and signatures.
-- Note that the type variables are not in scope here,
-- Rename the SPECIALISE instance pramas
-- Annoyingly the type variables are not in scope here,
-- so that instance Eq a => Eq (T a) where
-- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
-- works OK.
-- works OK. That's why we did the partition game above
--
-- But the (unqualified) method names are in scope
; let binders = collectHsBindsBinders mbinds'
; uprags' <- bindLocalNames binders $
renameSigs (InstDeclCtxt cls) uprags
-- ; let binders = collectHsBindsBinders mbinds'
; spec_inst_prags' <- -- bindLocalNames binders $
renameSigs (InstDeclCtxt cls) spec_inst_prags
; let uprags' = spec_inst_prags' ++ other_sigs'
; return (InstDecl inst_ty' mbinds' uprags' ats',
meth_fvs `plusFV` at_fvs
`plusFV` hsSigsFVs uprags'
meth_fvs `plusFV` more_fvs
`plusFV` hsSigsFVs spec_inst_prags'
`plusFV` extractHsTyNames inst_ty') }
-- We return the renamed associated data type declarations so
-- that they can be entered into the list of type declarations
......@@ -474,6 +480,8 @@ Renaming of the associated types in instances.
\begin{code}
rnATInsts :: Name -> [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
-- NB: We allow duplicate associated-type decls;
-- See Note [Associated type instances] in TcInstDcls
rnATInsts cls atDecls = rnList rnATInst atDecls
where
rnATInst tydecl@TyData {} = rnTyClDecl (Just cls) tydecl
......
......@@ -1197,11 +1197,10 @@ mkSigFun sigs = lookupNameEnv env
\begin{code}
tcTySig :: LSig Name -> TcM [TcId]
tcTySig (L span (TypeSig names ty))
= setSrcSpan span $ mapM f names
where
f (L _ name) = do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
; return (mkLocalId name sigma_ty) }
tcTySig (L span (TypeSig names@(L _ name1 : _) ty))
= setSrcSpan span $
do { sigma_ty <- tcHsSigType (FunSigCtxt name1) ty
; return [ mkLocalId name sigma_ty | L _ name <- names ] }
tcTySig (L _ (IdSig id))
= return [id]
tcTySig s = pprPanic "tcTySig" (ppr s)
......
......@@ -789,6 +789,38 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
dfun_id = instanceDFunId ispec
loc = getSrcSpan dfun_id
------------------------------
checkInstSig :: Class -> [TcType] -> LSig Name -> TcM ()
-- Check that any type signatures have exactly the right type
checkInstSig clas inst_tys (L loc (TypeSig names@(L _ name1:_) hs_ty))
= setSrcSpan loc $
do { inst_sigs <- xoptM Opt_InstanceSigs
; if inst_sigs then
do { sigma_ty <- tcHsSigType (FunSigCtxt name1) hs_ty
; mapM_ (check sigma_ty) names }
else
addErrTc (misplacedInstSig names hs_ty) }
where
check sigma_ty (L _ n)
= do { sel_id <- tcLookupId n
; let meth_ty = instantiateMethod clas sel_id inst_tys
; checkTc (sigma_ty `eqType` meth_ty)
(badInstSigErr n meth_ty) }
checkInstSig _ _ _ = return ()
badInstSigErr :: Name -> Type -> SDoc
badInstSigErr meth ty
= hang (ptext (sLit "Method signature does not match class; it should be"))
2 (pprPrefixName meth <+> dcolon <+> ppr ty)
misplacedInstSig :: [Located Name] -> LHsType Name -> SDoc
misplacedInstSig names hs_ty
= vcat [ hang (ptext (sLit "Illegal type signature in instance declaration:"))
2 (hang (hsep $ punctuate comma (map (pprPrefixName . unLoc) names))
2 (dcolon <+> ppr hs_ty))
, ptext (sLit "(Use -XInstanceSigs to allow this)") ]
------------------------------
tcSuperClass :: [TcTyVar] -> [EvVar]
-> (Id, PredType)
......@@ -936,8 +968,9 @@ tcInstanceMethods :: DFunId -> Class -> [TcTyVar]
-- forall tvs. theta => ...
tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
(spec_inst_prags, prag_fn)
op_items (VanillaInst binds _ standalone_deriv)
= mapAndUnzipM tc_item op_items
op_items (VanillaInst binds sigs standalone_deriv)
= do { mapM_ (checkInstSig clas inst_tys) sigs
; mapAndUnzipM tc_item op_items }
where
----------------------
tc_item :: (Id, DefMeth) -> TcM (Id, LHsBind Id)
......@@ -953,12 +986,14 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
= add_meth_ctxt sel_id generated_code rn_bind $
do { (meth_id, local_meth_id) <- mkMethIds clas tyvars dfun_ev_vars
inst_tys sel_id
; let prags = prag_fn (idName sel_id)
; let sel_name = idName sel_id
prags = prag_fn (idName sel_id)
; meth_id1 <- addInlinePrags meth_id prags
; spec_prags <- tcSpecPrags meth_id1 prags
; bind <- tcInstanceMethodBody InstSkol
tyvars dfun_ev_vars
meth_id1 local_meth_id meth_sig_fn
meth_id1 local_meth_id
(mk_meth_sig_fn sel_name)
(mk_meth_spec_prags meth_id1 spec_prags)
rn_bind
; return (meth_id1, bind) }
......@@ -1038,8 +1073,13 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
[ L loc (SpecPrag meth_id wrap inl)
| L loc (SpecPrag _ wrap inl) <- spec_inst_prags])
loc = getSrcSpan dfun_id
meth_sig_fn _ = Just ([],loc) -- The 'Just' says "yes, there's a type sig"
loc = getSrcSpan dfun_id
sig_fn = mkSigFun sigs
mk_meth_sig_fn sel_name _meth_name
= case sig_fn sel_name of
Nothing -> Just ([],loc)
Just r -> Just r
-- The orElse 'Just' says "yes, in effect there's always a type sig"
-- But there are no scoped type variables from local_method_id
-- Only the ones from the instance decl itself, which are already
-- in scope. Example:
......
......@@ -160,8 +160,8 @@ unifyKindTcS ty1 ty2 ki1 ki2
= wrapTcS $ TcM.addErrCtxtM ctxt $ do
(_errs, mb_r) <- TcM.tryTc (TcM.unifyKindEq ki1 ki2)
return (maybe False (const True) mb_r)
where ctxt = TcM.mkKindErrorCtxt ty1 ki1 ty2 ki2
where
ctxt = TcM.mkKindErrorCtxt ty1 ki1 ty2 ki2
\end{code}
%************************************************************************
......
......@@ -4347,7 +4347,40 @@ overlapping instances without the library client having to know.
</para>
</sect3>
<sect3 id="instance-sigs">
<title>Type signatures in instance declarations</title>
<para>In Haskell, you can't write a type signature in an instance declaration, but it
is sometimes convenient to do so, and the language extension <option>-XInstanceSigs</option>
allows you to do so. For example:
<programlisting>
data T a = MkT a a
instance Eq a => Eq (T a) where
(==) :: T a -> T a -> Bool -- The signature
(==) (MkT x1 x2) (MkTy y1 y2) = x1==y1 && x2==y2
</programlisting>
The type signature in the instance declaration must be precisely the same as
the one in the class declaration, instantiated with the instance type.
</para>
<para>
One stylistic reason for wanting to write a type signature is simple documentation. Another
is that you may want to bring scoped type variables into scope. For example:
<programlisting>
class C a where
foo :: b -> a -> (a, [b])
instance C a => C (T a) where
foo :: forall b. b -> T a -> (T a, [b])
foo x (T y) = (T y, xs)
where
xs :: [b]
xs = [x,x,x]
</programlisting>
Provided that you also specify <option>-XScopedTypeVariables</option>
(<xref linkend="scoped-type-variables"/>),
the <literal>forall b</forall> scopes over the definition of <literal>foo</literal>,
and in particular over the type signature for <literal>xs</literal>.
</para>
</sect3>
</sect2>
......
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