ghc/compiler/hsSyn/HsMatches.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   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 Util             ( panic )
  21 import Outputable
  22 import Name             ( NamedThing )
  23 \end{code}
  24
  25 %************************************************************************
  26 %*                                                                      *
  27 \subsection{@Match@, @GRHSsAndBinds@, and @GRHS@ datatypes}
  28 %*                                                                      *
  29 %************************************************************************
  30
  31 @Match@es are sets of pattern bindings and right hand sides for
  32 functions, patterns or case branches. For example, if a function @g@
  33 is defined as:
  34 \begin{verbatim}
  35 g (x,y) = y
  36 g ((x:ys),y) = y+1,
  37 \end{verbatim}
  38 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
  39
  40 It is always the case that each element of an @[Match]@ list has the
  41 same number of @PatMatch@s inside it.  This corresponds to saying that
  42 a function defined by pattern matching must have the same number of
  43 patterns in each equation.
  44
  45 \begin{code}
  46 data Match flexi id pat
  47   = PatMatch        pat
  48                     (Match flexi id pat)
  49   | GRHSMatch       (GRHSsAndBinds flexi id pat)
  50
  51   | SimpleMatch     (HsExpr flexi id pat)               -- Used in translations
  52 \end{code}
  53
  54 Sets of guarded right hand sides (GRHSs). In:
  55 \begin{verbatim}
  56 f (x,y) | x==True = y
  57         | otherwise = y*2
  58 \end{verbatim}
  59 a guarded right hand side is either
  60 @(x==True = y)@, or @(otherwise = y*2)@.
  61
  62 For each match, there may be several guarded right hand
  63 sides, as the definition of @f@ shows.
  64
  65 \begin{code}
  66 data GRHSsAndBinds flexi id pat
  67   = GRHSsAndBindsIn     [GRHS flexi id pat]         -- at least one GRHS
  68                         (HsBinds flexi id pat)
  69
  70   | GRHSsAndBindsOut    [GRHS flexi id pat]         -- at least one GRHS
  71                         (HsBinds flexi id pat)
  72                         (GenType flexi)
  73
  74 data GRHS flexi id pat
  75   = GRHS            [Stmt flexi id pat] -- guard(ed)...
  76                     (HsExpr flexi id pat)       -- ... right-hand side
  77                     SrcLoc
  78
  79 unguardedRHS :: (HsExpr flexi id pat) -> SrcLoc -> [GRHS flexi id pat]
  80 unguardedRHS rhs loc = [GRHS [] rhs 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 (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 (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 [] expr locn)
 157  =  text (if is_case then "->" else "=") <+> ppr expr
 158
 159 pprGRHS is_case (GRHS guard expr locn)
 160  = sep [char '|' <+> interpp'SP guard,
 161         text (if is_case then "->" else "=") <+> ppr expr
 162    ]
 163 \end{code}