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