ghc/compiler/hsSyn/HsMatches.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[HsMatches]{Abstract syntax: matches and guarded right-hand-sides}
   5
   6 The @Match@, @GRHSsAndBinds@ and @GRHS@ datatypes.
   7
   8 \begin{code}
   9 module HsMatches where
  10
  11 #include "HsVersions.h"
  12
  13 -- Friends
  14 import HsExpr           ( HsExpr, Stmt(..) )
  15 import HsBinds          ( HsBinds, nullBinds )
  16
  17 -- Others
  18 import Type             ( GenType )
  19 import SrcLoc           ( SrcLoc )
  20 import Outputable
  21 import Name             ( NamedThing )
  22 \end{code}
  23
  24 %************************************************************************
  25 %*                                                                      *
  26 \subsection{@Match@, @GRHSsAndBinds@, and @GRHS@ datatypes}
  27 %*                                                                      *
  28 %************************************************************************
  29
  30 @Match@es are sets of pattern bindings and right hand sides for
  31 functions, patterns or case branches. For example, if a function @g@
  32 is defined as:
  33 \begin{verbatim}
  34 g (x,y) = y
  35 g ((x:ys),y) = y+1,
  36 \end{verbatim}
  37 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
  38
  39 It is always the case that each element of an @[Match]@ list has the
  40 same number of @PatMatch@s inside it.  This corresponds to saying that
  41 a function defined by pattern matching must have the same number of
  42 patterns in each equation.
  43
  44 \begin{code}
  45 data Match flexi id pat
  46   = PatMatch        pat
  47                     (Match flexi id pat)
  48   | GRHSMatch       (GRHSsAndBinds flexi id pat)
  49
  50   | SimpleMatch     (HsExpr flexi id pat)               -- Used in translations
  51 \end{code}
  52
  53 Sets of guarded right hand sides (GRHSs). In:
  54 \begin{verbatim}
  55 f (x,y) | x==True = y
  56         | otherwise = y*2
  57 \end{verbatim}
  58 a guarded right hand side is either
  59 @(x==True = y)@, or @(otherwise = y*2)@.
  60
  61 For each match, there may be several guarded right hand
  62 sides, as the definition of @f@ shows.
  63
  64 \begin{code}
  65 data GRHSsAndBinds flexi id pat
  66   = GRHSsAndBindsIn     [GRHS flexi id pat]         -- at least one GRHS
  67                         (HsBinds flexi id pat)
  68
  69   | GRHSsAndBindsOut    [GRHS flexi id pat]         -- at least one GRHS
  70                         (HsBinds flexi id pat)
  71                         (GenType flexi)
  72
  73 data GRHS flexi id pat
  74   = GRHS            [Stmt flexi id pat]         -- The RHS is the final ExprStmt
  75                                                 -- I considered using a RetunStmt, but
  76                                                 -- it printed 'wrong' in error messages
  77                     SrcLoc
  78
  79 unguardedRHS :: (HsExpr flexi id pat) -> SrcLoc -> [GRHS flexi id pat]
  80 unguardedRHS rhs loc = [GRHS [ExprStmt rhs loc] loc]
  81 \end{code}
  82
  83 @getMatchLoc@ takes a @Match@ and returns the
  84 source-location gotten from the GRHS inside.
  85 THis is something of a nuisance, but no more.
  86
  87 \begin{code}
  88 getMatchLoc :: Match flexi id pat -> SrcLoc
  89 getMatchLoc (PatMatch _ m)                                   = getMatchLoc m
  90 getMatchLoc (GRHSMatch (GRHSsAndBindsIn (GRHS _ loc : _) _)) = loc
  91 \end{code}
  92
  93 %************************************************************************
  94 %*                                                                      *
  95 \subsection{Printing}
  96 %*                                                                      *
  97 %************************************************************************
  98
  99 We know the list must have at least one @Match@ in it.
 100 \begin{code}
 101 pprMatches :: (NamedThing id, Outputable id, Outputable pat)
 102            => (Bool, SDoc) -> [Match flexi id pat] -> SDoc
 103
 104 pprMatches print_info@(is_case, name) [match]
 105   = if is_case then
 106         pprMatch is_case match
 107     else
 108         name <+> (pprMatch is_case match)
 109
 110 pprMatches print_info (match1 : rest)
 111  = ($$) (pprMatches print_info [match1])
 112            (pprMatches print_info rest)
 113
 114 ---------------------------------------------
 115 pprMatch :: (NamedThing id, Outputable id, Outputable pat)
 116          => Bool -> Match flexi id pat -> SDoc
 117
 118 pprMatch is_case first_match
 119  = sep [(sep (map (ppr) row_of_pats)),
 120         grhss_etc_stuff]
 121  where
 122     (row_of_pats, grhss_etc_stuff) = ppr_match is_case first_match
 123
 124     ppr_match is_case (PatMatch pat match)
 125       = (pat:pats, grhss_stuff)
 126       where
 127         (pats, grhss_stuff) = ppr_match is_case match
 128
 129     ppr_match is_case (GRHSMatch grhss_n_binds)
 130       = ([], pprGRHSsAndBinds is_case grhss_n_binds)
 131
 132     ppr_match is_case (SimpleMatch expr)
 133       = ([], text (if is_case then "->" else "=") <+> ppr expr)
 134
 135 ----------------------------------------------------------
 136
 137 pprGRHSsAndBinds :: (NamedThing id, Outputable id, Outputable pat)
 138                  => Bool -> GRHSsAndBinds flexi id pat -> SDoc
 139
 140 pprGRHSsAndBinds is_case (GRHSsAndBindsIn grhss binds)
 141  = ($$) (vcat (map (pprGRHS is_case) grhss))
 142            (if (nullBinds binds)
 143             then empty
 144             else vcat [ text "where", nest 4 (pprDeeper (ppr binds)) ])
 145
 146 pprGRHSsAndBinds is_case (GRHSsAndBindsOut grhss binds ty)
 147  = ($$) (vcat (map (pprGRHS is_case) grhss))
 148            (if (nullBinds binds)
 149             then empty
 150             else vcat [text "where", nest 4 (pprDeeper (ppr binds)) ])
 151
 152 ---------------------------------------------
 153 pprGRHS :: (NamedThing id, Outputable id, Outputable pat)
 154         => Bool -> GRHS flexi id pat -> SDoc
 155
 156 pprGRHS is_case (GRHS [ExprStmt expr _] locn)
 157  =  text (if is_case then "->" else "=") <+> pprDeeper (ppr expr)
 158
 159 pprGRHS is_case (GRHS guarded locn)
 160  = sep [char '|' <+> interpp'SP guards,
 161         text (if is_case then "->" else "=") <+> pprDeeper (ppr expr)
 162    ]
 163  where
 164     ExprStmt expr _ = last guarded      -- Last stmt should be a ExprStmt for guards
 165     guards          = init guarded
 166 \end{code}