X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsPat.lhs;h=ea59e8827eade9dc485d489011b6ef60e7d93fa7;hb=644c8d8a16f2198cdecf3281dd9419168037b21a;hp=79b906207b54629de873bd8e107bb02318af71d8;hpb=e6d057711f4d6d6ff6342c39fa2b9e44d25447f1;p=ghc-hetmet.git diff --git a/compiler/hsSyn/HsPat.lhs b/compiler/hsSyn/HsPat.lhs index 79b9062..ea59e88 100644 --- a/compiler/hsSyn/HsPat.lhs +++ b/compiler/hsSyn/HsPat.lhs @@ -1,4 +1,5 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[PatSyntax]{Abstract Haskell syntax---patterns} @@ -8,6 +9,7 @@ module HsPat ( Pat(..), InPat, OutPat, LPat, HsConDetails(..), hsConArgs, + HsRecField(..), mkRecField, mkPrefixConPat, mkCharLitPat, mkNilPat, mkCoPat, @@ -22,20 +24,20 @@ module HsPat ( import {-# SOURCE #-} HsExpr ( SyntaxExpr ) -- friends: -import HsBinds ( DictBinds, HsBind(..), HsWrapper, isIdHsWrapper, pprHsWrapper, - emptyLHsBinds, pprLHsBinds ) -import HsLit ( HsLit(HsCharPrim), HsOverLit ) -import HsTypes ( LHsType, PostTcType ) -import BasicTypes ( Boxity, tupleParens ) +import HsBinds +import HsLit +import HsTypes +import HsDoc +import BasicTypes -- others: import PprCore ( {- instance OutputableBndr TyVar -} ) -import TysWiredIn ( nilDataCon, charDataCon, charTy ) -import Var ( TyVar ) -import DataCon ( DataCon, dataConTyCon ) -import TyCon ( isProductTyCon ) +import TysWiredIn +import Var +import DataCon +import TyCon import Outputable -import Type ( Type ) -import SrcLoc ( Located(..), unLoc, noLoc ) +import Type +import SrcLoc \end{code} @@ -138,13 +140,21 @@ HsConDetails is use both for patterns and for data type declarations \begin{code} data HsConDetails id arg - = PrefixCon [arg] -- C p1 p2 p3 - | RecCon [(Located id, arg)] -- C { x = p1, y = p2 } - | InfixCon arg arg -- p1 `C` p2 + = PrefixCon [arg] -- C p1 p2 p3 + | RecCon [HsRecField id arg] -- C { x = p1, y = p2 } + | InfixCon arg arg -- p1 `C` p2 + +data HsRecField id arg = HsRecField { + hsRecFieldId :: Located id, + hsRecFieldArg :: arg, + hsRecFieldDoc :: Maybe (LHsDoc id) +} + +mkRecField id arg = HsRecField id arg Nothing hsConArgs :: HsConDetails id arg -> [arg] hsConArgs (PrefixCon ps) = ps -hsConArgs (RecCon fs) = map snd fs +hsConArgs (RecCon fs) = map hsRecFieldArg fs hsConArgs (InfixCon p1 p2) = [p1,p2] \end{code} @@ -209,13 +219,17 @@ pprConArgs (PrefixCon pats) = interppSP pats pprConArgs (InfixCon p1 p2) = interppSP [p1,p2] pprConArgs (RecCon rpats) = braces (hsep (punctuate comma (map (pp_rpat) rpats))) where - pp_rpat (v, p) = hsep [ppr v, char '=', ppr p] - + pp_rpat (HsRecField v p _d) = + hsep [ppr v, char '=', ppr p] -- add parallel array brackets around a document -- pabrackets :: SDoc -> SDoc pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]") + +instance (OutputableBndr id, Outputable arg) => + Outputable (HsRecField id arg) where + ppr (HsRecField n ty doc) = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc \end{code}