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