dd4c9ae97d9efef0eab4bb8fe65bd1272f3c7b61
[ghc-hetmet.git] / ghc / compiler / deSugar / Check.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
3 %
4 % Author: Juan J. Quintela    <quintela@krilin.dc.fi.udc.es>
5 \section{Module @Check@ in @deSugar@}
6
7 \begin{code}
8
9
10 module Check ( check , ExhaustivePat ) where
11
12
13 import HsSyn            
14 import TcHsSyn          ( TypecheckedPat )
15 import DsHsSyn          ( outPatType ) 
16 import DsUtils          ( EquationInfo(..), MatchResult(..), EqnSet, 
17                           CanItFail(..),  tidyLitPat, tidyNPat, 
18                         )
19 import Id               ( idType )
20 import DataCon          ( DataCon, dataConTyCon, dataConArgTys,
21                           dataConSourceArity, dataConFieldLabels )
22 import Name             ( Name, mkLocalName, getOccName, isDataSymOcc, getName, mkVarOcc )
23 import Type             ( splitAlgTyConApp, mkTyVarTys, splitTyConApp_maybe )
24 import TysPrim          ( charPrimTy )
25 import TysWiredIn
26 import PrelNames        ( unboundKey )
27 import TyCon            ( tyConDataCons, tupleTyConBoxity, isTupleTyCon )
28 import BasicTypes       ( Boxity(..) )
29 import SrcLoc           ( noSrcLoc )
30 import UniqSet
31 import Outputable
32
33 #include "HsVersions.h"
34 \end{code}
35
36 This module performs checks about if one list of equations are:
37 \begin{itemize}
38 \item Overlapped
39 \item Non exhaustive
40 \end{itemize}
41 To discover that we go through the list of equations in a tree-like fashion.
42
43 If you like theory, a similar algorithm is described in:
44 \begin{quotation}
45         {\em Two Techniques for Compiling Lazy Pattern Matching},
46         Luc Maranguet,
47         INRIA Rocquencourt (RR-2385, 1994)
48 \end{quotation}
49 The algorithm is based on the first technique, but there are some differences:
50 \begin{itemize}
51 \item We don't generate code
52 \item We have constructors and literals (not only literals as in the 
53           article)
54 \item We don't use directions, we must select the columns from 
55           left-to-right
56 \end{itemize}
57 (By the way the second technique is really similar to the one used in 
58  @Match.lhs@ to generate code)
59
60 This function takes the equations of a pattern and returns:
61 \begin{itemize}
62 \item The patterns that are not recognized
63 \item The equations that are not overlapped
64 \end{itemize}
65 It simplify the patterns and then call @check'@ (the same semantics), and it 
66 needs to reconstruct the patterns again ....
67
68 The problem appear with things like:
69 \begin{verbatim}
70   f [x,y]   = ....
71   f (x:xs)  = .....
72 \end{verbatim}
73 We want to put the two patterns with the same syntax, (prefix form) and 
74 then all the constructors are equal:
75 \begin{verbatim}
76   f (: x (: y []))   = ....
77   f (: x xs)         = .....
78 \end{verbatim}
79 (more about that in @simplify_eqns@)
80
81 We would prefer to have a @WarningPat@ of type @String@, but Strings and the 
82 Pretty Printer are not friends.
83
84 We use @InPat@ in @WarningPat@ instead of @OutPat@
85 because we need to print the 
86 warning messages in the same way they are introduced, i.e. if the user 
87 wrote:
88 \begin{verbatim}
89         f [x,y] = ..
90 \end{verbatim}
91 He don't want a warning message written:
92 \begin{verbatim}
93         f (: x (: y [])) ........
94 \end{verbatim}
95 Then we need to use InPats.
96 \begin{quotation}
97      Juan Quintela 5 JUL 1998\\
98           User-friendliness and compiler writers are no friends.
99 \end{quotation}
100 \begin{code}
101
102 type WarningPat = InPat Name
103 type ExhaustivePat = ([WarningPat], [(Name, [HsLit])])
104
105
106 check :: [EquationInfo] -> ([ExhaustivePat],EqnSet)
107 check qs = (untidy_warns, incomplete)
108       where
109         (warns, incomplete) = check' (simplify_eqns qs)
110         untidy_warns = map untidy_exhaustive warns 
111
112 untidy_exhaustive :: ExhaustivePat -> ExhaustivePat
113 untidy_exhaustive ([pat], messages) = 
114                   ([untidy_no_pars pat], map untidy_message messages)
115 untidy_exhaustive (pats, messages) = 
116                   (map untidy_pars pats, map untidy_message messages)
117
118 untidy_message :: (Name, [HsLit]) -> (Name, [HsLit])
119 untidy_message (string, lits) = (string, map untidy_lit lits)
120 \end{code}
121
122 The function @untidy@ does the reverse work of the @simplify_pat@ funcion.
123
124 \begin{code}
125
126 type NeedPars = Bool 
127
128 untidy_no_pars :: WarningPat -> WarningPat
129 untidy_no_pars p = untidy False p
130
131 untidy_pars :: WarningPat -> WarningPat
132 untidy_pars p = untidy True p
133
134 untidy :: NeedPars -> WarningPat -> WarningPat
135 untidy _ p@WildPatIn = p
136 untidy _ p@(VarPatIn name) = p
137 untidy _ (LitPatIn lit) = LitPatIn (untidy_lit lit)
138 untidy _ p@(ConPatIn name []) = p
139 untidy b (ConPatIn name pats)  = 
140        pars b (ConPatIn name (map untidy_pars pats)) 
141 untidy b (ConOpPatIn pat1 name fixity pat2) = 
142        pars b (ConOpPatIn (untidy_pars pat1) name fixity (untidy_pars pat2)) 
143 untidy _ (ListPatIn pats)  = ListPatIn (map untidy_no_pars pats) 
144 untidy _ (TuplePatIn pats boxed) = TuplePatIn (map untidy_no_pars pats) boxed
145
146 untidy _ pat = pprPanic "Check.untidy: SigPatIn" (ppr pat)
147
148 pars :: NeedPars -> WarningPat -> WarningPat
149 pars True p = ParPatIn p
150 pars _    p = p
151
152 untidy_lit :: HsLit -> HsLit
153 untidy_lit (HsCharPrim c) = HsChar c
154 --untidy_lit (HsStringPrim s) = HsString s
155 untidy_lit lit = lit
156 \end{code}
157
158 This equation is the same that check, the only difference is that the
159 boring work is done, that work needs to be done only once, this is
160 the reason top have two functions, check is the external interface,
161 @check'@ is called recursively.
162
163 There are several cases:
164
165 \begin{itemize} 
166 \item There are no equations: Everything is OK. 
167 \item There are only one equation, that can fail, and all the patterns are
168       variables. Then that equation is used and the same equation is 
169       non-exhaustive.
170 \item All the patterns are variables, and the match can fail, there are 
171       more equations then the results is the result of the rest of equations 
172       and this equation is used also.
173
174 \item The general case, if all the patterns are variables (here the match 
175       can't fail) then the result is that this equation is used and this 
176       equation doesn't generate non-exhaustive cases.
177
178 \item In the general case, there can exist literals ,constructors or only 
179       vars in the first column, we actuate in consequence.
180
181 \end{itemize}
182
183
184 \begin{code}
185
186 check' :: [EquationInfo] -> ([ExhaustivePat],EqnSet)  
187 check' []                                              = ([([],[])],emptyUniqSet)
188
189 check' [EqnInfo n ctx ps (MatchResult CanFail _)] 
190    | all_vars ps  = ([(take (length ps) (repeat new_wild_pat),[])],  unitUniqSet n)
191
192 check' qs@((EqnInfo n ctx ps (MatchResult CanFail _)):rs)
193    | all_vars ps  = (pats,  addOneToUniqSet indexs n)
194   where
195     (pats,indexs) = check' rs
196
197 check' qs@((EqnInfo n ctx ps result):_) 
198    | all_vars ps  = ([],  unitUniqSet n)
199 --   | nplusk       = panic "Check.check': Work in progress: nplusk"
200 --   | npat         = panic "Check.check': Work in progress: npat ?????"
201    | literals     = split_by_literals qs
202    | constructors = split_by_constructor qs
203    | only_vars    = first_column_only_vars qs
204    | otherwise    = panic "Check.check': Not implemented :-("
205   where
206      -- Note: RecPats will have been simplified to ConPats
207      --       at this stage.
208     constructors = or (map is_con qs)
209     literals     = or (map is_lit qs)    
210     only_vars    = and (map is_var qs) 
211 --    npat         = or (map is_npat qs)
212 --    nplusk       = or (map is_nplusk qs)
213 \end{code}
214
215 Here begins the code to deal with literals, we need to split the matrix
216 in different matrix beginning by each literal and a last matrix with the 
217 rest of values.
218
219 \begin{code}
220 split_by_literals :: [EquationInfo] -> ([ExhaustivePat],EqnSet)
221 split_by_literals qs = process_literals used_lits qs
222            where
223              used_lits = get_used_lits qs
224 \end{code}
225
226 @process_explicit_literals@ is a function that process each literal that appears 
227 in the column of the matrix. 
228
229 \begin{code}
230 process_explicit_literals :: [HsLit] -> [EquationInfo] -> ([ExhaustivePat],EqnSet)
231 process_explicit_literals lits qs = (concat pats, unionManyUniqSets indexs)
232     where                  
233       pats_indexs   = map (\x -> construct_literal_matrix x qs) lits
234       (pats,indexs) = unzip pats_indexs 
235
236 \end{code}
237
238
239 @process_literals@ calls @process_explicit_literals@ to deal with the literals 
240 that appears in the matrix and deal also with the rest of the cases. It 
241 must be one Variable to be complete.
242
243 \begin{code}
244
245 process_literals :: [HsLit] -> [EquationInfo] -> ([ExhaustivePat],EqnSet)
246 process_literals used_lits qs 
247   | length default_eqns == 0 = ([make_row_vars used_lits (head qs)]++pats,indexs)
248   | otherwise                = (pats_default,indexs_default)
249      where
250        (pats,indexs)   = process_explicit_literals used_lits qs
251        default_eqns    = (map remove_var (filter is_var qs))
252        (pats',indexs') = check' default_eqns 
253        pats_default    = [(new_wild_pat:ps,constraints) | (ps,constraints) <- (pats')] ++ pats 
254        indexs_default  = unionUniqSets indexs' indexs
255 \end{code}
256
257 Here we have selected the literal and we will select all the equations that 
258 begins for that literal and create a new matrix.
259
260 \begin{code}
261 construct_literal_matrix :: HsLit -> [EquationInfo] -> ([ExhaustivePat],EqnSet)
262 construct_literal_matrix lit qs =
263     (map (\ (xs,ys) -> (new_lit:xs,ys)) pats,indexs) 
264   where
265     (pats,indexs) = (check' (remove_first_column_lit lit qs)) 
266     new_lit = LitPatIn lit 
267
268 remove_first_column_lit :: HsLit
269                         -> [EquationInfo] 
270                         -> [EquationInfo]
271 remove_first_column_lit lit qs = 
272     map shift_pat (filter (is_var_lit lit) qs)
273   where
274      shift_pat (EqnInfo n ctx []     result) =  panic "Check.shift_var: no patterns"
275      shift_pat (EqnInfo n ctx (_:ps) result) =  EqnInfo n ctx ps result
276
277 \end{code}
278
279 This function splits the equations @qs@ in groups that deal with the 
280 same constructor.
281
282 \begin{code}
283
284 split_by_constructor :: [EquationInfo] -> ([ExhaustivePat],EqnSet)
285
286 split_by_constructor qs | length unused_cons /= 0 = need_default_case used_cons unused_cons qs 
287                         | otherwise               = no_need_default_case used_cons qs 
288                        where 
289                           used_cons   = get_used_cons qs 
290                           unused_cons = get_unused_cons used_cons 
291
292 \end{code}
293
294 The first column of the patterns matrix only have vars, then there is 
295 nothing to do.
296
297 \begin{code}
298 first_column_only_vars :: [EquationInfo] -> ([ExhaustivePat],EqnSet)
299 first_column_only_vars qs = (map (\ (xs,ys) -> (new_wild_pat:xs,ys)) pats,indexs)
300                           where
301                             (pats,indexs) = check' (map remove_var qs)
302        
303 \end{code}
304
305 This equation takes a matrix of patterns and split the equations by 
306 constructor, using all the constructors that appears in the first column 
307 of the pattern matching.
308
309 We can need a default clause or not ...., it depends if we used all the 
310 constructors or not explicitly. The reasoning is similar to @process_literals@,
311 the difference is that here the default case is not always needed.
312
313 \begin{code}
314 no_need_default_case :: [TypecheckedPat] -> [EquationInfo] -> ([ExhaustivePat],EqnSet)
315 no_need_default_case cons qs = (concat pats, unionManyUniqSets indexs)
316     where                  
317       pats_indexs   = map (\x -> construct_matrix x qs) cons
318       (pats,indexs) = unzip pats_indexs 
319
320 need_default_case :: [TypecheckedPat] -> [DataCon] -> [EquationInfo] -> ([ExhaustivePat],EqnSet)
321 need_default_case used_cons unused_cons qs 
322   | length default_eqns == 0 = (pats_default_no_eqns,indexs)
323   | otherwise                = (pats_default,indexs_default)
324      where
325        (pats,indexs)   = no_need_default_case used_cons qs
326        default_eqns    = (map remove_var (filter is_var qs))
327        (pats',indexs') = check' default_eqns 
328        pats_default    = [(make_whole_con c:ps,constraints) | 
329                           c <- unused_cons, (ps,constraints) <- pats'] ++ pats
330        new_wilds       = make_row_vars_for_constructor (head qs)
331        pats_default_no_eqns =  [(make_whole_con c:new_wilds,[]) | c <- unused_cons] ++ pats
332        indexs_default  = unionUniqSets indexs' indexs
333
334 construct_matrix :: TypecheckedPat -> [EquationInfo] -> ([ExhaustivePat],EqnSet)
335 construct_matrix con qs =
336     (map (make_con con) pats,indexs) 
337   where
338     (pats,indexs) = (check' (remove_first_column con qs)) 
339 \end{code}
340
341 Here remove first column is more difficult that with literals due to the fact 
342 that constructors can have arguments.
343
344 For instance, the matrix
345 \begin{verbatim}
346  (: x xs) y
347  z        y
348 \end{verbatim}
349 is transformed in:
350 \begin{verbatim}
351  x xs y
352  _ _  y
353 \end{verbatim}
354
355 \begin{code}
356 remove_first_column :: TypecheckedPat                -- Constructor 
357                     -> [EquationInfo] 
358                     -> [EquationInfo]
359 remove_first_column (ConPat con _ _ _ con_pats) qs = 
360     map shift_var (filter (is_var_con con) qs)
361   where
362      new_wilds = [WildPat (outPatType arg_pat) | arg_pat <- con_pats]
363      shift_var (EqnInfo n ctx (ConPat _ _ _ _ ps':ps) result) = 
364                 EqnInfo n ctx (ps'++ps)               result 
365      shift_var (EqnInfo n ctx (WildPat _     :ps)     result) = 
366                 EqnInfo n ctx (new_wilds ++   ps)     result
367      shift_var _ = panic "Check.Shift_var:No done"
368
369 make_row_vars :: [HsLit] -> EquationInfo -> ExhaustivePat
370 make_row_vars used_lits (EqnInfo _ _ pats _ ) = 
371    (VarPatIn new_var:take (length (tail pats)) (repeat new_wild_pat),[(new_var,used_lits)])
372   where new_var = hash_x
373
374 hash_x = mkLocalName unboundKey {- doesn't matter much -}
375                      (mkVarOcc SLIT("#x"))
376                      noSrcLoc
377
378 make_row_vars_for_constructor :: EquationInfo -> [WarningPat]
379 make_row_vars_for_constructor (EqnInfo _ _ pats _ ) = take (length (tail pats)) (repeat new_wild_pat)
380
381 compare_cons :: TypecheckedPat -> TypecheckedPat -> Bool
382 compare_cons (ConPat id1 _ _ _ _) (ConPat id2 _ _ _ _) = id1 == id2  
383
384 remove_dups :: [TypecheckedPat] -> [TypecheckedPat]
385 remove_dups []     = []
386 remove_dups (x:xs) | or (map (\y -> compare_cons x y) xs) = remove_dups  xs
387                    | otherwise                            = x : remove_dups xs
388
389 get_used_cons :: [EquationInfo] -> [TypecheckedPat]
390 get_used_cons qs = remove_dups [con | (EqnInfo _ _ (con@(ConPat _ _ _ _ _):_) _) <- qs ]
391
392 remove_dups' :: [HsLit] -> [HsLit] 
393 remove_dups' []                   = []
394 remove_dups' (x:xs) | x `elem` xs = remove_dups' xs
395                     | otherwise   = x : remove_dups' xs 
396
397
398 get_used_lits :: [EquationInfo] -> [HsLit]
399 get_used_lits qs = remove_dups' all_literals
400                  where
401                    all_literals = get_used_lits' qs
402
403 get_used_lits' :: [EquationInfo] -> [HsLit]
404 get_used_lits' [] = []
405 get_used_lits' ((EqnInfo _ _ ((LitPat lit _):_) _):qs) = 
406                lit : get_used_lits qs
407 get_used_lits' ((EqnInfo _ _ ((NPat lit _ _):_) _):qs) = 
408                lit : get_used_lits qs
409 get_used_lits' (q:qs)                                  =       
410                get_used_lits qs
411
412 get_unused_cons :: [TypecheckedPat] -> [DataCon]
413 get_unused_cons used_cons = unused_cons
414      where
415        (ConPat _ ty _ _ _) = head used_cons
416        Just (ty_con,_)     = sTyConApp_maybe used_cons ty
417        all_cons            = tyConDataCons ty_con
418        used_cons_as_id     = map (\ (ConPat d _ _ _ _) -> d) used_cons
419        unused_cons         = uniqSetToList
420                  (mkUniqSet all_cons `minusUniqSet` mkUniqSet used_cons_as_id) 
421
422 sTyConApp_maybe used_cons ty =
423     case splitTyConApp_maybe ty of
424     Just x -> Just x
425     Nothing -> pprTrace "splitTyConApp_maybe" (ppr (used_cons, ty)) $ Nothing
426
427 all_vars :: [TypecheckedPat] -> Bool
428 all_vars []              = True
429 all_vars (WildPat _:ps)  = all_vars ps
430 all_vars _               = False
431
432 remove_var :: EquationInfo -> EquationInfo
433 remove_var (EqnInfo n ctx (WildPat _:ps) result) = EqnInfo n ctx ps result
434 remove_var _                                     =
435          panic "Check.remove_var: equation does not begin with a variable"
436
437 is_con :: EquationInfo -> Bool
438 is_con (EqnInfo _ _ ((ConPat _ _ _ _ _):_) _) = True
439 is_con _                                      = False
440
441 is_lit :: EquationInfo -> Bool
442 is_lit (EqnInfo _ _ ((LitPat _ _):_) _) = True
443 is_lit (EqnInfo _ _ ((NPat _ _ _):_) _) = True
444 is_lit _                                = False
445
446 is_npat :: EquationInfo -> Bool
447 is_npat (EqnInfo _ _ ((NPat _ _ _):_) _) = True
448 is_npat _                                 = False
449
450 is_nplusk :: EquationInfo -> Bool
451 is_nplusk (EqnInfo _ _ ((NPlusKPat _ _ _ _ _):_) _) = True
452 is_nplusk _                                         = False
453
454 is_var :: EquationInfo -> Bool
455 is_var (EqnInfo _ _ ((WildPat _):_) _)  = True
456 is_var _                                = False
457
458 is_var_con :: DataCon -> EquationInfo -> Bool
459 is_var_con con (EqnInfo _ _ ((WildPat _):_)     _)                 = True
460 is_var_con con (EqnInfo _ _ ((ConPat id _ _ _ _):_) _) | id == con = True
461 is_var_con con _                                                   = False
462
463 is_var_lit :: HsLit -> EquationInfo -> Bool
464 is_var_lit lit (EqnInfo _ _ ((WildPat _):_)     _)               = True
465 is_var_lit lit (EqnInfo _ _ ((LitPat lit' _):_) _) | lit == lit' = True
466 is_var_lit lit (EqnInfo _ _ ((NPat lit' _ _):_) _) | lit == lit' = True
467 is_var_lit lit _                                                 = False
468 \end{code}
469
470 The difference beteewn @make_con@ and @make_whole_con@ is that
471 @make_wole_con@ creates a new constructor with all their arguments, and
472 @make_con@ takes a list of argumntes, creates the contructor getting their
473 arguments from the list. See where \fbox{\ ???\ } are used for details.
474
475 We need to reconstruct the patterns (make the constructors infix and
476 similar) at the same time that we create the constructors.
477
478 You can tell tuple constructors using
479 \begin{verbatim}
480         Id.isTupleCon
481 \end{verbatim}
482 You can see if one constructor is infix with this clearer code :-))))))))))
483 \begin{verbatim}
484         Lex.isLexConSym (Name.occNameString (Name.getOccName con))
485 \end{verbatim}
486
487        Rather clumsy but it works. (Simon Peyton Jones)
488
489
490 We don't mind the @nilDataCon@ because it doesn't change the way to
491 print the messsage, we are searching only for things like: @[1,2,3]@,
492 not @x:xs@ ....
493
494 In @reconstruct_pat@ we want to ``undo'' the work
495 that we have done in @simplify_pat@.
496 In particular:
497 \begin{tabular}{lll}
498         @((,) x y)@   & returns to be & @(x, y)@
499 \\      @((:) x xs)@  & returns to be & @(x:xs)@
500 \\      @(x:(...:[])@ & returns to be & @[x,...]@
501 \end{tabular}
502 %
503 The difficult case is the third one becouse we need to follow all the
504 contructors until the @[]@ to know that we need to use the second case,
505 not the second. \fbox{\ ???\ }
506 %
507 \begin{code}
508 isInfixCon con = isDataSymOcc (getOccName con)
509
510 is_nil (ConPatIn con []) = con == getName nilDataCon
511 is_nil _                 = False
512
513 is_list (ListPatIn _) = True
514 is_list _             = False
515
516 return_list id q = id == consDataCon && (is_nil q || is_list q) 
517
518 make_list p q | is_nil q   = ListPatIn [p]
519 make_list p (ListPatIn ps) = ListPatIn (p:ps)  
520 make_list _ _              = panic "Check.make_list: Invalid argument"
521
522 make_con :: TypecheckedPat -> ExhaustivePat -> ExhaustivePat           
523 make_con (ConPat id _ _ _ _) (p:q:ps, constraints) 
524      | return_list id q = (make_list p q : ps, constraints)
525      | isInfixCon id = ((ConOpPatIn p name fixity q) : ps, constraints) 
526     where name   = getName id
527           fixity = panic "Check.make_con: Guessing fixity"
528
529 make_con (ConPat id _ _ _ pats) (ps,constraints) 
530       | isTupleTyCon tc = (TuplePatIn pats_con (tupleTyConBoxity tc) : rest_pats, constraints) 
531       | otherwise       = (ConPatIn name pats_con                    : rest_pats, constraints)
532     where num_args  = length pats
533           name      = getName id
534           pats_con  = take num_args ps
535           rest_pats = drop num_args ps
536           tc        = dataConTyCon id
537           
538
539 make_whole_con :: DataCon -> WarningPat
540 make_whole_con con | isInfixCon con = ConOpPatIn new_wild_pat name fixity new_wild_pat
541                    | otherwise      = ConPatIn name pats
542                 where 
543                   fixity = panic "Check.make_whole_con: Guessing fixity"
544                   name   = getName con
545                   arity  = dataConSourceArity con 
546                   pats   = take arity (repeat new_wild_pat)
547
548
549 new_wild_pat :: WarningPat
550 new_wild_pat = WildPatIn
551 \end{code}
552
553 This equation makes the same thing as @tidy@ in @Match.lhs@, the
554 difference is that here we can do all the tidy in one place and in the
555 @Match@ tidy it must be done one column each time due to bookkeeping 
556 constraints.
557
558 \begin{code}
559
560 simplify_eqns :: [EquationInfo] -> [EquationInfo]
561 simplify_eqns []                               = []
562 simplify_eqns ((EqnInfo n ctx pats result):qs) = 
563  (EqnInfo n ctx pats' result) : simplify_eqns qs
564  where
565   pats' = map simplify_pat pats
566
567 simplify_pat :: TypecheckedPat -> TypecheckedPat  
568
569 simplify_pat pat@(WildPat gt) = pat
570 simplify_pat (VarPat id)      = WildPat (idType id) 
571
572 simplify_pat (LazyPat p)    = simplify_pat p
573 simplify_pat (AsPat id p)   = simplify_pat p
574
575 simplify_pat (ConPat id ty tvs dicts ps) = ConPat id ty tvs dicts (map simplify_pat ps)
576
577 simplify_pat (ListPat ty ps) = foldr (\ x -> \y -> ConPat consDataCon list_ty [] [] [x, y])
578                                      (ConPat nilDataCon list_ty [] [] [])
579                                      (map simplify_pat ps)
580                              where list_ty = mkListTy ty
581
582
583 simplify_pat (TuplePat ps boxity)
584   = ConPat (tupleCon boxity arity)
585            (mkTupleTy boxity arity (map outPatType ps)) [] []
586            (map simplify_pat ps)
587   where
588     arity = length ps
589
590 simplify_pat (RecPat dc ty ex_tvs dicts [])   
591   = ConPat dc ty ex_tvs dicts all_wild_pats
592   where
593     all_wild_pats = map WildPat con_arg_tys
594
595       -- identical to machinations in Match.tidy1:
596     (_, inst_tys, _) = splitAlgTyConApp ty
597     con_arg_tys      = dataConArgTys dc (inst_tys ++ mkTyVarTys ex_tvs)
598
599 simplify_pat (RecPat dc ty ex_tvs dicts idps) 
600   = ConPat dc ty ex_tvs dicts pats
601   where
602     pats = map (simplify_pat.snd) all_pats
603
604      -- pad out all the missing fields with WildPats.
605     field_pats = map (\ f -> (getName f, WildPat (panic "simplify_pat(RecPat-2)")))
606                      (dataConFieldLabels dc)
607     all_pats = 
608       foldr
609        ( \ (id,p,_) acc -> insertNm (getName id) p acc)
610        field_pats
611        idps
612        
613     insertNm nm p [] = [(nm,p)]
614     insertNm nm p (x@(n,_):xs)
615       | nm == n    = (nm,p):xs
616       | otherwise  = x : insertNm nm p xs
617
618 simplify_pat pat@(LitPat lit lit_ty)        = tidyLitPat lit pat
619
620 -- unpack string patterns fully, so we can see when they overlap with
621 -- each other, or even explicit lists of Chars.
622 simplify_pat pat@(NPat (HsString s) _ _) = 
623    foldr (\c pat -> ConPat consDataCon stringTy [] [] [mk_char_lit c,pat])
624         (ConPat nilDataCon stringTy [] [] []) (_UNPK_INT_ s)
625   where
626     mk_char_lit c = ConPat charDataCon charTy [] [] 
627                         [LitPat (HsCharPrim c) charPrimTy]
628
629 simplify_pat pat@(NPat lit lit_ty hsexpr) = tidyNPat lit lit_ty pat
630
631 simplify_pat (NPlusKPat id hslit ty hsexpr1 hsexpr2) = 
632      WildPat ty
633    where ty = panic "Check.simplify_pat: Gessing ty"
634
635 simplify_pat (DictPat dicts methods) = 
636     case num_of_d_and_ms of
637        0 -> simplify_pat (TuplePat [] Boxed) 
638        1 -> simplify_pat (head dict_and_method_pats) 
639        _ -> simplify_pat (TuplePat dict_and_method_pats Boxed)
640     where
641        num_of_d_and_ms   = length dicts + length methods
642        dict_and_method_pats = map VarPat (dicts ++ methods)
643
644 \end{code}