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 #include "HsVersions.h"
  10
  11 module HsMatches where
  12
  13 IMP_Ubiq(){-uitous-}
  14
  15 IMPORT_DELOOPER(HsLoop)         ( HsExpr, nullBinds, HsBinds )
  16 import Outputable       ( ifPprShowAll )
  17 import PprType          ( GenType{-instance Outputable-} )
  18 import Pretty
  19 import SrcLoc           ( SrcLoc{-instances-} )
  20 import Util             ( panic )
  21 \end{code}
  22
  23 %************************************************************************
  24 %*                                                                      *
  25 \subsection{@Match@, @GRHSsAndBinds@, and @GRHS@ datatypes}
  26 %*                                                                      *
  27 %************************************************************************
  28
  29 @Match@es are sets of pattern bindings and right hand sides for
  30 functions, patterns or case branches. For example, if a function @g@
  31 is defined as:
  32 \begin{verbatim}
  33 g (x,y) = y
  34 g ((x:ys),y) = y+1,
  35 \end{verbatim}
  36 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
  37
  38 It is always the case that each element of an @[Match]@ list has the
  39 same number of @PatMatch@s inside it.  This corresponds to saying that
  40 a function defined by pattern matching must have the same number of
  41 patterns in each equation.
  42
  43 \begin{code}
  44 data Match tyvar uvar id pat
  45   = PatMatch        pat
  46                     (Match tyvar uvar id pat)
  47   | GRHSMatch       (GRHSsAndBinds tyvar uvar id pat)
  48
  49   | SimpleMatch     (HsExpr tyvar uvar id pat)          -- Used in translations
  50 \end{code}
  51
  52 Sets of guarded right hand sides (GRHSs). In:
  53 \begin{verbatim}
  54 f (x,y) | x==True = y
  55         | otherwise = y*2
  56 \end{verbatim}
  57 a guarded right hand side is either
  58 @(x==True = y)@, or @(otherwise = y*2)@.
  59
  60 For each match, there may be several guarded right hand
  61 sides, as the definition of @f@ shows.
  62
  63 \begin{code}
  64 data GRHSsAndBinds tyvar uvar id pat
  65   = GRHSsAndBindsIn     [GRHS tyvar uvar id pat]            -- at least one GRHS
  66                         (HsBinds tyvar uvar id pat)
  67
  68   | GRHSsAndBindsOut    [GRHS tyvar uvar id pat]            -- at least one GRHS
  69                         (HsBinds tyvar uvar id pat)
  70                         (GenType tyvar uvar)
  71
  72 data GRHS tyvar uvar id pat
  73   = GRHS            (HsExpr tyvar uvar id pat)  -- guard(ed)...
  74                     (HsExpr tyvar uvar id pat)  -- ... right-hand side
  75                     SrcLoc
  76
  77   | OtherwiseGRHS   (HsExpr tyvar uvar id pat)  -- guard-free
  78                     SrcLoc
  79 \end{code}
  80
  81 %************************************************************************
  82 %*                                                                      *
  83 \subsection{Printing}
  84 %*                                                                      *
  85 %************************************************************************
  86
  87 We know the list must have at least one @Match@ in it.
  88 \begin{code}
  89 pprMatches :: (NamedThing id, Outputable id, Outputable pat,
  90                Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
  91                 PprStyle -> (Bool, Pretty) -> [Match tyvar uvar id pat] -> Pretty
  92
  93 pprMatches sty print_info@(is_case, name) [match]
  94   = if is_case then
  95         pprMatch sty is_case match
  96     else
  97         ppHang name 4 (pprMatch sty is_case match)
  98
  99 pprMatches sty print_info (match1 : rest)
 100  = ppAbove (pprMatches sty print_info [match1])
 101            (pprMatches sty print_info rest)
 102
 103 ---------------------------------------------
 104 pprMatch :: (NamedThing id, Outputable id, Outputable pat,
 105                Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 106         PprStyle -> Bool -> Match tyvar uvar id pat -> Pretty
 107
 108 pprMatch sty is_case first_match
 109  = ppHang (ppSep (map (ppr sty) row_of_pats))
 110         8 grhss_etc_stuff
 111  where
 112     (row_of_pats, grhss_etc_stuff) = ppr_match sty is_case first_match
 113
 114     ppr_match sty is_case (PatMatch pat match)
 115       = (pat:pats, grhss_stuff)
 116       where
 117         (pats, grhss_stuff) = ppr_match sty is_case match
 118
 119     ppr_match sty is_case (GRHSMatch grhss_n_binds)
 120       = ([], pprGRHSsAndBinds sty is_case grhss_n_binds)
 121
 122     ppr_match sty is_case (SimpleMatch expr)
 123       = ([], ppr sty expr)
 124
 125 ----------------------------------------------------------
 126
 127 pprGRHSsAndBinds sty is_case (GRHSsAndBindsIn grhss binds)
 128  = ppAbove (ppAboves (map (pprGRHS sty is_case) grhss))
 129            (if (nullBinds binds)
 130             then ppNil
 131             else ppAboves [ ppStr "where", ppNest 4 (ppr sty binds) ])
 132
 133 pprGRHSsAndBinds sty is_case (GRHSsAndBindsOut grhss binds ty)
 134  = ppAbove (ppAboves (map (pprGRHS sty is_case) grhss))
 135            (if (nullBinds binds)
 136             then ppNil
 137             else ppAboves [ ifPprShowAll sty
 138                                 (ppCat [ppStr "{- ty:", ppr sty ty, ppStr "-}"]),
 139                             ppStr "where", ppNest 4 (ppr sty binds) ])
 140
 141 ---------------------------------------------
 142 pprGRHS :: (NamedThing id, Outputable id, Outputable pat,
 143             Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 144         => PprStyle -> Bool -> GRHS tyvar uvar id pat -> Pretty
 145
 146 pprGRHS sty is_case (GRHS guard expr locn)
 147  = ppHang (ppCat [ppChar '|', ppr sty guard, ppStr (if is_case then "->" else "=")])
 148         4 (ppr sty expr)
 149
 150 pprGRHS sty is_case (OtherwiseGRHS  expr locn)
 151   = ppHang (ppStr (if is_case then "->" else "="))
 152          4 (ppr sty expr)
 153 \end{code}