Merge Haddock comment support from ghc.haddock -- big patch

[ghc-hetmet.git] / compiler / hsSyn / HsPat.lhs

diff --git a/compiler/hsSyn/HsPat.lhs b/compiler/hsSyn/HsPat.lhs
index 5bb443b..f2ba6b3 100644 (file)
--- a/compiler/hsSyn/HsPat.lhs
+++ b/compiler/hsSyn/HsPat.lhs
@@ -8,6 +8,7 @@ module HsPat (
        Pat(..), InPat, OutPat, LPat, 
        
        HsConDetails(..), hsConArgs,
+       HsRecField(..), mkRecField,
 
        mkPrefixConPat, mkCharLitPat, mkNilPat, mkCoPat,
 
@@ -22,9 +23,11 @@ module HsPat (
 import {-# SOURCE #-} HsExpr           ( SyntaxExpr )
 
 -- friends:
-import HsBinds         ( DictBinds, HsBind(..), ExprCoFn, isIdCoercion, emptyLHsBinds, pprLHsBinds )
+import HsBinds         ( DictBinds, HsBind(..), HsWrapper, isIdHsWrapper, pprHsWrapper,
+                         emptyLHsBinds, pprLHsBinds )
 import HsLit           ( HsLit(HsCharPrim), HsOverLit )
 import HsTypes         ( LHsType, PostTcType )
+import HsDoc            ( LHsDoc, ppr_mbDoc )
 import BasicTypes      ( Boxity, tupleParens )
 -- others:
 import PprCore         ( {- instance OutputableBndr TyVar -} )
@@ -121,27 +124,37 @@ data Pat id
 
        ------------ Dictionary patterns (translation only) ---------------
   | DictPat        -- Used when destructing Dictionaries with an explicit case
-                   [id]                        -- superclass dicts
-                   [id]                        -- methods
+                   [id]                -- Superclass dicts
+                   [id]                -- Methods
 
        ------------ Pattern coercions (translation only) ---------------
-  | CoPat      ExprCoFn                -- If co::t1 -> t2, p::t2, 
+  | CoPat      HsWrapper               -- If co::t1 -> t2, p::t2, 
                                        -- then (CoPat co p) :: t1
-               (Pat id)                -- No nested location reqd
-               Type    
+               (Pat id)                -- Why not LPat?  Ans: existing locn will do
+               Type
+       -- During desugaring a (CoPat co pat) turns into a cast with 'co' on 
+       -- the scrutinee, followed by a match on 'pat'
 \end{code}
 
 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}
 
@@ -192,7 +205,7 @@ pprPat (NPat l Nothing  _ _)  = ppr l
 pprPat (NPat l (Just _) _ _)  = char '-' <> ppr l
 pprPat (NPlusKPat n k _ _)    = hcat [ppr n, char '+', ppr k]
 pprPat (TypePat ty)          = ptext SLIT("{|") <> ppr ty <> ptext SLIT("|}")
-pprPat (CoPat co pat _)              = parens (ppr co) <+> ptext SLIT("`cast`") <+> ppr pat
+pprPat (CoPat co pat _)              = parens (pprHsWrapper (ppr pat) co)
 pprPat (SigPatIn pat ty)      = ppr pat <+> dcolon <+> ppr ty
 pprPat (SigPatOut pat ty)     = ppr pat <+> dcolon <+> ppr ty
 pprPat (DictPat ds ms)       = parens (sep [ptext SLIT("{-dict-}"),
@@ -206,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 d, 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}
 
 
@@ -236,9 +253,9 @@ mkNilPat ty = mkPrefixConPat nilDataCon [] ty
 mkCharLitPat :: Char -> OutPat id
 mkCharLitPat c = mkPrefixConPat charDataCon [noLoc $ LitPat (HsCharPrim c)] charTy
 
-mkCoPat :: ExprCoFn -> OutPat id -> Type -> OutPat id
+mkCoPat :: HsWrapper -> OutPat id -> Type -> OutPat id
 mkCoPat co lpat@(L loc pat) ty
-  | isIdCoercion co = lpat
+  | isIdHsWrapper co = lpat
   | otherwise = L loc (CoPat co pat ty)
 \end{code}