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