Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/89c0f09ac144a6b0cd20adbf73b196cc99e90a8f >--------------------------------------------------------------- commit 89c0f09ac144a6b0cd20adbf73b196cc99e90a8f Author: Simon Peyton Jones <[email protected]> Date: Fri Dec 23 16:16:56 2011 +0000 Implemnt Trac #5712: show method for infix GADT constructors This is a tiny feature improvement; see the ticket. I have updated the user manual too. >--------------------------------------------------------------- compiler/iface/TcIface.lhs | 2 +- compiler/rename/RnSource.lhs | 50 +++++++++++++++++++++++++----------- docs/users_guide/glasgow_exts.xml | 14 ++++++++++ 3 files changed, 50 insertions(+), 16 deletions(-) diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 8a279ca..a662d6a 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -561,7 +561,7 @@ tcIfaceDataCons tycon_name tycon _ if_cons ; let orig_res_ty = mkFamilyTyConApp tycon (substTyVars (mkTopTvSubst eq_spec) univ_tyvars) - ; buildDataCon name is_infix {- Not infix -} + ; buildDataCon name is_infix stricts lbl_names univ_tyvars ex_tyvars eq_spec theta diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs index 31c7c33..197f2b2 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -1055,9 +1055,9 @@ rnConDecls condecls rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name) rnConDecl decl@(ConDecl { con_name = name, con_qvars = tvs - , con_cxt = cxt, con_details = details - , con_res = res_ty, con_doc = mb_doc - , con_old_rec = old_rec, con_explicit = expl }) + , con_cxt = cxt, con_details = details + , con_res = res_ty, con_doc = mb_doc + , con_old_rec = old_rec, con_explicit = expl }) = do { addLocM checkConName name ; when old_rec (addWarn (deprecRecSyntax decl)) ; new_name <- lookupLocatedTopBndrRn name @@ -1084,35 +1084,43 @@ rnConDecl decl@(ConDecl { con_name = name, con_qvars = tvs ; bindTyVarsRn doc new_tvs $ \new_tyvars -> do { new_context <- rnContext doc cxt ; new_details <- rnConDeclDetails doc details - ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty + ; (new_details', new_res_ty) <- rnConResult doc (unLoc new_name) new_details res_ty ; return (decl { con_name = new_name, con_qvars = new_tyvars, con_cxt = new_context , con_details = new_details', con_res = new_res_ty, con_doc = mb_doc' }) }} where doc = ConDeclCtx name get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy HsBoxedTuple tys)) -rnConResult :: HsDocContext +rnConResult :: HsDocContext -> Name -> HsConDetails (LHsType Name) [ConDeclField Name] -> ResType RdrName -> RnM (HsConDetails (LHsType Name) [ConDeclField Name], ResType Name) -rnConResult _ details ResTyH98 = return (details, ResTyH98) -rnConResult doc details (ResTyGADT ty) +rnConResult _ _ details ResTyH98 = return (details, ResTyH98) +rnConResult doc con details (ResTyGADT ty) = do { ty' <- rnLHsType doc ty ; let (arg_tys, res_ty) = splitHsFunType ty' -- We can finally split it up, -- now the renamer has dealt with fixities -- See Note [Sorting out the result type] in RdrHsSyn - details' = case details of - RecCon {} -> details - PrefixCon {} -> PrefixCon arg_tys - InfixCon {} -> pprPanic "rnConResult" (ppr ty) - -- See Note [Sorting out the result type] in RdrHsSyn + ; case details of + InfixCon {} -> pprPanic "rnConResult" (ppr ty) + -- See Note [Sorting out the result type] in RdrHsSyn - ; when (not (null arg_tys) && case details of { RecCon {} -> True; _ -> False }) - (addErr (badRecResTy (docOfHsDocContext doc))) - ; return (details', ResTyGADT res_ty) } + RecCon {} -> do { unless (null arg_tys) + (addErr (badRecResTy (docOfHsDocContext doc))) + ; return (details, ResTyGADT res_ty) } + + PrefixCon {} | isSymOcc (getOccName con) -- See Note [Infix GADT cons] + , [ty1,ty2] <- arg_tys + -> do { fix_env <- getFixityEnv + ; return (if con `elemNameEnv` fix_env + then InfixCon ty1 ty2 + else PrefixCon arg_tys + , ResTyGADT res_ty) } + | otherwise + -> return (PrefixCon arg_tys, ResTyGADT res_ty) } rnConDeclDetails :: HsDocContext -> HsConDetails (LHsType RdrName) [ConDeclField RdrName] @@ -1161,6 +1169,18 @@ badDataCon name = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)] \end{code} +Note [Infix GADT constructors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We do not currently have syntax to declare an infix constructor in GADT syntax, +but it makes a (small) difference to the Show instance. So as a slightly +ad-hoc solution, we regard a GADT data constructor as infix if + a) it is an operator symbol + b) it has two arguments + c) there is a fixity declaration for it +For example: + infix 6 (:--:) + data T a where + (:--:) :: t1 -> t2 -> T Int %********************************************************* %* * diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 7443abf..e3c0e73 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -2944,6 +2944,20 @@ data Counter a where As before, only one selector function is generated here, that for <literal>tag</literal>. Nevertheless, you can still use all the field names in pattern matching and record construction. </para></listitem> + +<listitem><para> +In a GADT-style data type declaration there is no obvious way to specify that a data constructor +should be infix, which makes a difference if you derive <literal>Show</literal> for the type. +(Data constructors declared infix are displayed infix by the derived <literal>show</literal>.) +So GHC implements the following design: a data constructor declared in a GADT-style data type +declaration is displayed infix by <literal>Show</literal> iff (a) it is an operator symbol, +(b) it has two arguments, (c) it has a programmer-supplied fixity declaration. For example +<programlisting> + infix 6 (:--:) + data T a where + (:--:) :: Int -> Bool -> T Int +</programlisting> +</para></listitem> </itemizedlist></para> </sect2> _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
