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@, @GRHSs@ 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 import HsTypes          ( HsTyVarBndr, HsType )
  17
  18 -- Others
  19 import Type             ( Type )
  20 import SrcLoc           ( SrcLoc )
  21 import Outputable
  22 \end{code}
  23
  24 %************************************************************************
  25 %*                                                                      *
  26 \subsection{@Match@, @GRHSs@, 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 @pats@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 id pat
  46   = Match
  47         [HsTyVarBndr id]                -- Tyvars wrt which this match is universally quantified
  48                                         --      empty after typechecking
  49         [pat]                           -- The patterns
  50         (Maybe (HsType id))             -- A type signature for the result of the match
  51                                         --      Nothing after typechecking
  52
  53         (GRHSs id pat)
  54
  55 -- GRHSs are used both for pattern bindings and for Matches
  56 data GRHSs id pat
  57   = GRHSs [GRHS id pat]         -- Guarded RHSs
  58           (HsBinds id pat)      -- The where clause
  59           (Maybe Type)          -- Just rhs_ty after type checking
  60
  61 data GRHS id pat
  62   = GRHS  [Stmt id pat]         -- The RHS is the final ExprStmt
  63                                 -- I considered using a RetunStmt, but
  64                                 -- it printed 'wrong' in error messages
  65           SrcLoc
  66
  67 mkSimpleMatch :: [pat] -> HsExpr id pat -> Maybe Type -> SrcLoc -> Match id pat
  68 mkSimpleMatch pats rhs maybe_rhs_ty locn
  69   = Match [] pats Nothing (GRHSs (unguardedRHS rhs locn) EmptyBinds maybe_rhs_ty)
  70
  71 unguardedRHS :: HsExpr id pat -> SrcLoc -> [GRHS id pat]
  72 unguardedRHS rhs loc = [GRHS [ExprStmt rhs loc] loc]
  73 \end{code}
  74
  75 @getMatchLoc@ takes a @Match@ and returns the
  76 source-location gotten from the GRHS inside.
  77 THis is something of a nuisance, but no more.
  78
  79 \begin{code}
  80 getMatchLoc :: Match id pat -> SrcLoc
  81 getMatchLoc (Match _ _ _ (GRHSs (GRHS _ loc : _) _ _)) = loc
  82 \end{code}
  83
  84 %************************************************************************
  85 %*                                                                      *
  86 \subsection{Printing}
  87 %*                                                                      *
  88 %************************************************************************
  89
  90 We know the list must have at least one @Match@ in it.
  91 \begin{code}
  92 pprMatches :: (Outputable id, Outputable pat)
  93            => (Bool, SDoc) -> [Match id pat] -> SDoc
  94 pprMatches print_info matches = vcat (map (pprMatch print_info) matches)
  95
  96
  97 pprMatch :: (Outputable id, Outputable pat)
  98            => (Bool, SDoc) -> Match id pat -> SDoc
  99 pprMatch print_info@(is_case, name) (Match _ pats maybe_ty grhss)
 100   = maybe_name <+> sep [sep (map ppr pats),
 101                         ppr_maybe_ty,
 102                         nest 2 (pprGRHSs is_case grhss)]
 103   where
 104     maybe_name | is_case   = empty
 105                | otherwise = name
 106     ppr_maybe_ty = case maybe_ty of
 107                         Just ty -> dcolon <+> ppr ty
 108                         Nothing -> empty
 109
 110
 111 pprGRHSs :: (Outputable id, Outputable pat)
 112          => Bool -> GRHSs id pat -> SDoc
 113 pprGRHSs is_case (GRHSs grhss binds maybe_ty)
 114   = vcat (map (pprGRHS is_case) grhss)
 115     $$
 116     (if nullBinds binds then empty
 117      else text "where" $$ nest 4 (pprDeeper (ppr binds)))
 118
 119
 120 pprGRHS :: (Outputable id, Outputable pat)
 121         => Bool -> GRHS id pat -> SDoc
 122
 123 pprGRHS is_case (GRHS [ExprStmt expr _] locn)
 124  =  text (if is_case then "->" else "=") <+> pprDeeper (ppr expr)
 125
 126 pprGRHS is_case (GRHS guarded locn)
 127  = sep [char '|' <+> interpp'SP guards,
 128         text (if is_case then "->" else "=") <+> pprDeeper (ppr expr)
 129    ]
 130  where
 131     ExprStmt expr _ = last guarded      -- Last stmt should be a ExprStmt for guards
 132     guards          = init guarded
 133 \end{code}