ghc/compiler/deSugar/MatchCon.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[MatchCon]{Pattern-matching constructors}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module MatchCon (
  10     matchConFamily
  11 ) where
  12
  13 import AbsSyn           -- the stuff being desugared
  14 import PlainCore        -- the output of desugaring;
  15                         -- importing this module also gets all the
  16                         -- CoreSyn utility functions
  17 import DsMonad          -- the monadery used in the desugarer
  18
  19 import AbsUniType       ( mkTyVarTy, splitType, TyVar, TyVarTemplate,
  20                           getTyConDataCons,
  21                           instantiateTauTy, TyCon, Class, UniType,
  22                           TauType(..), InstTyEnv(..)
  23                           IF_ATTACK_PRAGMAS(COMMA instantiateTy)
  24                         )
  25 import DsUtils
  26 import Id               ( eqId, getInstantiatedDataConSig,
  27                           getIdUniType, isDataCon, DataCon(..)
  28                         )
  29 import Maybes           ( Maybe(..) )
  30 import Match            ( match )
  31 import Util
  32 \end{code}
  33
  34 \subsection[matchConFamily]{Making alternatives for a constructor family}
  35
  36 We are confronted with the first column of patterns in a set of
  37 equations, all beginning with constructors from one ``family'' (e.g.,
  38 @[]@ and @:@ make up the @List@ ``family'').  We want to generate the
  39 alternatives for a @CoCase@ expression.  There are several choices:
  40 \begin{enumerate}
  41 \item
  42 Generate an alternative for every constructor in the family, whether
  43 they are used in this set of equations or not; this is what the Wadler
  44 chapter does.
  45 \begin{description}
  46 \item[Advantages:]
  47 (a)~Simple.  (b)~It may also be that large sparsely-used constructor families are mainly
  48 handled by the code for literals.
  49 \item[Disadvantages:]
  50 (a)~Not practical for large sparsely-used constructor families, e.g., the
  51 ASCII character set.  (b)~Have to look up (in the TDE environment) a
  52 list of what constructors make up the whole family.  So far, this is
  53 the only part of desugaring that needs information from the environments.
  54 \end{description}
  55
  56 \item
  57 Generate an alternative for each constructor used, then add a default
  58 alternative in case some constructors in the family weren't used.
  59 \begin{description}
  60 \item[Advantages:]
  61 (a)~Alternatives aren't generated for unused constructors.  (b)~The
  62 STG is quite happy with defaults.  (c)~No lookup in an environment needed.
  63 \item[Disadvantages:]
  64 (a)~A spurious default alternative may be generated.
  65 \end{description}
  66
  67 \item
  68 ``Do it right:'' generate an alternative for each constructor used,
  69 and add a default alternative if all constructors in the family
  70 weren't used.
  71 \begin{description}
  72 \item[Advantages:]
  73 (a)~You will get cases with only one alternative (and no default),
  74 which should be amenable to optimisation.  Tuples are a common example.
  75 \item[Disadvantages:]
  76 (b)~Have to look up constructor families in TDE (as above).
  77 \end{description}
  78 \end{enumerate}
  79
  80 We are implementing the ``do-it-right'' option for now.
  81 The arguments to @matchConFamily@ are the same as to @match@; the extra
  82 @Int@ returned is the number of constructors in the family.
  83
  84 The function @matchConFamily@ is concerned with this
  85 have-we-used-all-the-constructors question; the local function
  86 @match_cons_used@ does all the real work.
  87 \begin{code}
  88 matchConFamily :: [Id]
  89                -> [EquationInfo]
  90                -> [EquationInfo]        -- Shadows
  91                -> DsM MatchResult
  92
  93 matchConFamily (var:vars) eqns_info shadows
  94   = match_cons_used vars eqns_info shadows `thenDs` \ alts ->
  95     mkCoAlgCaseMatchResult var alts
  96 \end{code}
  97
  98 And here is the local function that does all the work.  It is more-or-less the
  99 @matchCon@/@matchClause@ functions on page~94 in Wadler's chapter in SLPJ.
 100 \begin{code}
 101 match_cons_used _ [{- no more eqns -}] _ = returnDs []
 102
 103 match_cons_used vars eqns_info@(EqnInfo (ConPat data_con _ arg_pats : ps1) _ : eqns) shadows
 104   = ASSERT(isDataCon data_con)
 105     let
 106         (eqns_for_this_con, eqns_not_for_this_con)       = splitByCon eqns_info
 107         (shadows_for_this_con, shadows_not_for_this_con) = splitByCon shadows
 108     in
 109     -- Go ahead and do the recursive call to make the alts
 110     -- for the other ConPats in this con family...
 111     match_cons_used vars eqns_not_for_this_con shadows_not_for_this_con `thenDs` \ rest_of_alts ->
 112
 113     -- Make new vars for the con arguments; avoid new locals where possible
 114     selectMatchVars arg_pats                                            `thenDs` \ new_vars ->
 115
 116     -- Now do the business to make the alt for _this_ ConPat ...
 117     match (new_vars++vars)
 118           (map shift_con_pat eqns_for_this_con)
 119           (map shift_con_pat shadows_for_this_con)                      `thenDs` \ match_result ->
 120
 121     returnDs (
 122         (data_con, new_vars, match_result)
 123         : rest_of_alts
 124     )
 125   where
 126     splitByCon :: [EquationInfo] -> ([EquationInfo], [EquationInfo])
 127     splitByCon [] = ([],[])
 128     splitByCon (info@(EqnInfo (pat : _) _) : rest)
 129         = case pat of
 130                 ConPat n _ _ | n `eqId` data_con -> (info:rest_yes, rest_no)
 131                 WildPat _                        -> (info:rest_yes, info:rest_no)
 132                         -- WildPats will be in the shadows only,
 133                         -- and they go into both groups
 134                 other_pat                        -> (rest_yes,      info:rest_no)
 135         where
 136           (rest_yes, rest_no) = splitByCon rest
 137
 138     shift_con_pat :: EquationInfo -> EquationInfo
 139     shift_con_pat (EqnInfo (ConPat _ _ pats': pats) match_result)
 140       = EqnInfo (pats' ++ pats) match_result
 141     shift_con_pat (EqnInfo (WildPat _: pats) match_result)      -- Will only happen in shadow
 142       = EqnInfo ([WildPat (typeOfPat arg_pat) | arg_pat <- arg_pats] ++ pats) match_result
 143     shift_con_pat other = panic "matchConFamily:match_cons_used:shift_con_pat"
 144 \end{code}
 145
 146 Note on @shift_con_pats@ just above: does what the list comprehension in
 147 @matchClause@ (SLPJ, p.~94) does, except things are trickier in real
 148 life.  Works for @ConPats@, and we want it to fail catastrophically
 149 for anything else (which a list comprehension wouldn't).
 150 Cf.~@shift_lit_pats@ in @MatchLits@.