ghc/compiler/deSugar/Check.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1997
   3 %
   4 % Author: Juan J. Quintela    <quintela@dc.fi.udc.es>
   5
   6 \begin{code}
   7
   8
   9 module Check ( check , ExhaustivePat, WarningPat, BoxedString(..) ) where
  10
  11
  12 import {-# SOURCE #-} DsExpr  ( dsExpr  )
  13 import {-# SOURCE #-} DsBinds ( dsBinds )
  14
  15 import HsSyn
  16 import TcHsSyn          ( TypecheckedPat,
  17                           TypecheckedMatch,
  18                           TypecheckedHsBinds,
  19                           TypecheckedHsExpr
  20                         )
  21 import DsHsSyn          ( outPatType )
  22 import CoreSyn
  23
  24 import DsMonad          ( DsM, DsMatchContext(..),
  25                           DsMatchKind(..)
  26                         )
  27 import DsUtils          ( EquationInfo(..),
  28                           MatchResult(..),
  29                           EqnNo,
  30                           EqnSet,
  31                           CanItFail(..)
  32                         )
  33 import Id               ( idType,
  34                           Id,
  35                           idName,
  36                           isTupleCon,
  37                           getIdArity
  38                         )
  39 import IdInfo           ( ArityInfo(..) )
  40 import Lex              ( isLexConSym )
  41 import Name             ( occNameString,
  42                           Name,
  43                           getName,
  44                           nameUnique,
  45                           getOccName,
  46                           getOccString
  47                         )
  48 import Type             ( Type,
  49                           isUnboxedType,
  50                           splitTyConApp_maybe
  51                         )
  52 import TyVar            ( TyVar )
  53 import TysPrim          ( intPrimTy,
  54                           charPrimTy,
  55                           floatPrimTy,
  56                           doublePrimTy,
  57                           addrPrimTy,
  58                           wordPrimTy
  59                         )
  60 import TysWiredIn       ( nilDataCon, consDataCon,
  61                           mkTupleTy, tupleCon,
  62                           mkListTy,
  63                           charTy, charDataCon,
  64                           intTy, intDataCon,
  65                           floatTy, floatDataCon,
  66                           doubleTy, doubleDataCon,
  67                           addrTy, addrDataCon,
  68                           wordTy, wordDataCon
  69                         )
  70 import TyCon            ( tyConDataCons )
  71 import UniqSet
  72 import Unique           ( Unique )
  73 import Outputable
  74
  75 #include "HsVersions.h"
  76 \end{code}
  77
  78 This module perfoms checks about if one list of equations are:
  79         - Overlapped
  80         - Non exhaustive
  81
  82 To discover that we go through the list of equations in a tree-like fashion.
  83
  84 If you like theory, a similar algoritm is described in:
  85         Two Tecniques for Compiling Lazy Pattern Matching
  86         Luc Maranguet
  87         INRIA Rocquencourt (RR-2385, 1994)
  88
  89 The algorithm is based in the first Technique, but there are somo diferences:
  90         - We don't generate code
  91         - We have constructors and literals (not only literals as in the article)
  92         - We don't use directions, we must select the columns from left-to-right
  93
  94 (By the wat the second technique is really similar to the one used in MAtch.lhs to generate code)
  95
  96
  97 This function takes the equations of a pattern and returns:
  98   - The patterns that are not recognized
  99   - The equations that are not overlapped
 100
 101 It symplify the patterns and then call check' (the same semantics),and it needs to
 102 reconstruct the patterns again ....
 103
 104 The problem appear with things like:
 105   f [x,y]   = ....
 106   f (x:xs)  = .....
 107
 108 We want to put the two patterns with the same syntax, (prefix form) and then all the
 109 constructors are equal:
 110   f (: x (: y []))   = ....
 111   f (: x xs)         = .....
 112
 113 (more about that in symplify_eqns)
 114
 115 We would preffer to have a WarningPat of type String, but Strings and the
 116 Pretty Printer are not friends.
 117
 118 \begin{code}
 119
 120 newtype BoxedString = BS String
 121
 122 type WarningPat = InPat BoxedString --Name --String
 123 type ExhaustivePat = ([WarningPat], [(BoxedString, [HsLit])])
 124
 125
 126 instance Outputable BoxedString where
 127     ppr (BS s) = text s
 128
 129
 130 check :: [EquationInfo] -> ([ExhaustivePat],EqnSet)
 131 check qs = check' (simplify_eqns qs)
 132
 133 \end{code}
 134
 135 This equation is the same that check, the only difference is that the
 136 boring work is done, that woprk needs to be done only once, this is
 137 the reason top have two funtions, check is the external interface,
 138 check' is called recursively.
 139
 140 There are several cases:
 141
 142 \begin{item}
 143 \item There are no equations: Everything is okey.
 144 \item There are only one equation, that can fail, and all the patterns are
 145       variables. Then that equation is used and the same equation is
 146       nonexhaustive.
 147 \item All the patterns are variables, and the match can fail,therr are more equations
 148       then the results is the result of the rest of equations and this equation is used also.
 149
 150 \item The general case, if all the patterns are variables (here the match can't fail)
 151       then the result is that this equation is used and this equation doesn't generate
 152       non-exustive cases.
 153
 154 \item In the general case, there can exist literals ,constructors or only vars in the
 155       first column, we actuate in consecuence.
 156
 157 \end{item}
 158
 159
 160 \begin{code}
 161
 162 check' :: [EquationInfo] -> ([ExhaustivePat],EqnSet)
 163 check' []                                              = ([([],[])],emptyUniqSet)
 164
 165 check' [EqnInfo n ctx ps (MatchResult CanFail _ _)]
 166    | all_vars ps  = ([(take (length ps) (repeat new_wild_pat),[])],  unitUniqSet n)
 167
 168 check' qs@((EqnInfo n ctx ps (MatchResult CanFail _ _)):_)
 169    | all_vars ps  = (pats,  addOneToUniqSet indexs n)
 170   where
 171     (pats,indexs) = check' (tail qs)
 172
 173 check' qs@((EqnInfo n ctx ps result):_)
 174    | all_vars ps  = ([],  unitUniqSet n)
 175 --   | nplusk       = panic "Check.check': Work in progress: nplusk"
 176 --   | npat         = panic "Check.check': Work in progress: npat ?????"
 177    | literals     = split_by_literals qs
 178    | constructors = split_by_constructor qs
 179    | only_vars    = first_column_only_vars qs
 180    | otherwise    = panic "Check.check': Not implemented :-("
 181   where
 182     constructors = or (map is_con qs)
 183     literals     = or (map is_lit qs)
 184 --    npat         = or (map is_npat qs)
 185 --    nplusk       = or (map is_nplusk qs)
 186     only_vars    = and (map is_var qs)
 187 \end{code}
 188
 189 Here begins the code to deal with literals, we need to split the matrix in diferent matrix
 190 begining by each literal and a last matrix with the rest of values.
 191
 192 \begin{code}
 193 split_by_literals :: [EquationInfo] -> ([ExhaustivePat],EqnSet)
 194 split_by_literals qs = process_literals used_lits qs
 195            where
 196              used_lits = get_used_lits qs
 197 \end{code}
 198
 199 process_explicit_literals is a funtion taht process each literal that appears in
 200 the column of the matrix.
 201
 202 \begin{code}
 203 process_explicit_literals :: [HsLit] -> [EquationInfo] -> ([ExhaustivePat],EqnSet)
 204 process_explicit_literals lits qs = (concat pats, unionManyUniqSets indexs)
 205     where
 206       pats_indexs   = map (\x -> construct_literal_matrix x qs) lits
 207       (pats,indexs) = unzip pats_indexs
 208
 209 \end{code}
 210
 211
 212 Process_literals calls process_explicit_literals to deal with the literals taht apears in
 213 the matrix and deal also sith ther rest of the cases. It must be one Variable to be complete.
 214
 215 \begin{code}
 216
 217 process_literals :: [HsLit] -> [EquationInfo] -> ([ExhaustivePat],EqnSet)
 218 process_literals used_lits qs
 219   | length default_eqns == 0 = ([make_row_vars used_lits (head qs)]++pats,indexs)
 220   | otherwise                = (pats_default,indexs_default)
 221      where
 222        (pats,indexs)   = process_explicit_literals used_lits qs
 223        default_eqns    = (map remove_var (filter is_var qs))
 224        (pats',indexs') = check' default_eqns
 225        pats_default    = [(new_wild_pat:ps,constraints) | (ps,constraints) <- (pats')] ++ pats
 226        indexs_default  = unionUniqSets indexs' indexs
 227 \end{code}
 228
 229 Here we have selected the literal and we will select all the equations that begins for that
 230 literal and create a new matrix.
 231
 232 \begin{code}
 233 construct_literal_matrix :: HsLit -> [EquationInfo] -> ([ExhaustivePat],EqnSet)
 234 construct_literal_matrix lit qs =
 235     (map (\ (xs,ys) -> (new_lit:xs,ys)) pats,indexs)
 236   where
 237     (pats,indexs) = (check' (remove_first_column_lit lit qs))
 238     new_lit = LitPatIn lit
 239
 240 remove_first_column_lit :: HsLit
 241                         -> [EquationInfo]
 242                         -> [EquationInfo]
 243 remove_first_column_lit lit qs =
 244     map shift_pat (filter (is_var_lit lit) qs)
 245   where
 246      shift_pat (EqnInfo n ctx []     result) =  panic "Check.shift_var: no patterns"
 247      shift_pat (EqnInfo n ctx (_:ps) result) =  EqnInfo n ctx ps result
 248
 249 \end{code}
 250
 251 This function splits the equations @qs@ in groups that deal with the same constructor
 252
 253 \begin{code}
 254
 255 split_by_constructor :: [EquationInfo] -> ([ExhaustivePat],EqnSet)
 256
 257 split_by_constructor qs | length unused_cons /= 0 = need_default_case used_cons unused_cons qs
 258                         | otherwise               = no_need_default_case used_cons qs
 259                        where
 260                           used_cons   = get_used_cons qs
 261                           unused_cons = get_unused_cons used_cons
 262
 263 \end{code}
 264
 265 The first column of the patterns matrix only have vars, then there is nothing to do.
 266
 267 \begin{code}
 268 first_column_only_vars :: [EquationInfo] -> ([ExhaustivePat],EqnSet)
 269 first_column_only_vars qs = (map (\ (xs,ys) -> (WildPatIn:xs,ys)) pats,indexs)
 270                           where
 271                             (pats,indexs) = check' (map remove_var qs)
 272
 273 \end{code}
 274
 275 This equation takes a matrix of patterns and split the equations by constructor, using all
 276 the constructors that appears in the first column of the pattern matching.
 277
 278 We can need a default clause or not ...., it depends if we used all the constructors or not
 279 explicitily. The reasoning is similar to process_literals, the difference is that here
 280 the default case is not allways needed.
 281
 282 \begin{code}
 283 no_need_default_case :: [TypecheckedPat] -> [EquationInfo] -> ([ExhaustivePat],EqnSet)
 284 no_need_default_case cons qs = (concat pats, unionManyUniqSets indexs)
 285     where
 286       pats_indexs   = map (\x -> construct_matrix x qs) cons
 287       (pats,indexs) = unzip pats_indexs
 288
 289 need_default_case :: [TypecheckedPat] -> [Id] -> [EquationInfo] -> ([ExhaustivePat],EqnSet)
 290 need_default_case used_cons unused_cons qs
 291   | length default_eqns == 0 = (pats_default_no_eqns,indexs)
 292   | otherwise                = (pats_default,indexs_default)
 293      where
 294        (pats,indexs)   = no_need_default_case used_cons qs
 295        default_eqns    = (map remove_var (filter is_var qs))
 296        (pats',indexs') = check' default_eqns
 297        pats_default    = [(make_whole_con c:ps,constraints) |
 298                           c <- unused_cons, (ps,constraints) <- pats'] ++ pats
 299        new_wilds       = make_row_vars_for_constructor (head qs)
 300        pats_default_no_eqns =  [(make_whole_con c:new_wilds,[]) | c <- unused_cons] ++ pats
 301        indexs_default  = unionUniqSets indexs' indexs
 302
 303 construct_matrix :: TypecheckedPat -> [EquationInfo] -> ([ExhaustivePat],EqnSet)
 304 construct_matrix con qs =
 305
 306     (map (make_con con) pats,indexs)
 307   where
 308     (pats,indexs) = (check' (remove_first_column con qs))
 309 \end{code}
 310
 311 Here remove first column is more difficult that with literals due to the fact that
 312 constructors can have arguments.
 313
 314 for instance, the matrix
 315
 316  (: x xs) y
 317  z        y
 318
 319 is transformed in:
 320
 321  x xs y
 322  _ _  y
 323
 324
 325 \begin{code}
 326 remove_first_column :: TypecheckedPat                -- Constructor
 327                     -> [EquationInfo]
 328                     -> [EquationInfo]
 329 remove_first_column (ConPat con _ con_pats) qs =
 330     map shift_var (filter (is_var_con con) qs)
 331   where
 332      new_wilds = [WildPat (outPatType arg_pat) | arg_pat <- con_pats]
 333      shift_var (EqnInfo n ctx (ConPat _ _ ps':ps) result) =
 334                 EqnInfo n ctx (ps'++ps)           result
 335      shift_var (EqnInfo n ctx (WildPat _     :ps) result) =
 336                 EqnInfo n ctx (new_wilds ++   ps) result
 337      shift_var _                                          = panic "Check.Shift_var:No done"
 338
 339 make_row_vars :: [HsLit] -> EquationInfo -> ExhaustivePat
 340 make_row_vars used_lits (EqnInfo _ _ pats _ ) =
 341    (VarPatIn new_var:take (length (tail pats)) (repeat WildPatIn),[(new_var,used_lits)])
 342   where new_var = BS "#x"
 343
 344 make_row_vars_for_constructor :: EquationInfo -> [WarningPat]
 345 make_row_vars_for_constructor (EqnInfo _ _ pats _ ) = take (length (tail pats)) (repeat WildPatIn)
 346
 347 compare_cons :: TypecheckedPat -> TypecheckedPat -> Bool
 348 compare_cons (ConPat id1 _ _) (ConPat id2 _ _) = id1 == id2
 349
 350 remove_dups :: [TypecheckedPat] -> [TypecheckedPat]
 351 remove_dups []     = []
 352 remove_dups (x:xs) | or (map (\y -> compare_cons x y) xs) = remove_dups  xs
 353                    | otherwise                            = x : remove_dups xs
 354
 355 get_used_cons :: [EquationInfo] -> [TypecheckedPat]
 356 get_used_cons qs = remove_dups [con | (EqnInfo _ _ (con@(ConPat _ _ _):_) _) <- qs]
 357
 358 remove_dups' :: [HsLit] -> [HsLit]
 359 remove_dups' []                   = []
 360 remove_dups' (x:xs) | x `elem` xs = remove_dups' xs
 361                     | otherwise   = x : remove_dups' xs
 362
 363
 364 get_used_lits :: [EquationInfo] -> [HsLit]
 365 get_used_lits qs = remove_dups' (get_used_lits' qs)
 366
 367 get_used_lits' :: [EquationInfo] -> [HsLit]
 368 get_used_lits' []                                      = []
 369 get_used_lits' ((EqnInfo _ _ ((LitPat lit _):_) _):qs) = lit : get_used_lits qs
 370 get_used_lits' ((EqnInfo _ _ ((NPat lit _ _):_) _):qs) = lit : get_used_lits qs
 371 get_used_lits' (q:qs)                                  =       get_used_lits qs
 372
 373 get_unused_cons :: [TypecheckedPat] -> [Id]
 374 get_unused_cons used_cons = unused_cons
 375      where
 376        (ConPat _ ty _) = head used_cons
 377        Just (ty_con,_) = splitTyConApp_maybe ty
 378        all_cons        = tyConDataCons ty_con
 379        used_cons_as_id = map (\ (ConPat id _ _) -> id) used_cons
 380        unused_cons     = uniqSetToList (mkUniqSet all_cons `minusUniqSet` mkUniqSet used_cons_as_id)
 381
 382 all_vars :: [TypecheckedPat] -> Bool
 383 all_vars []              = True
 384 all_vars (WildPat _:ps)  = all_vars ps
 385 all_vars _               = False
 386
 387 remove_var :: EquationInfo -> EquationInfo
 388 remove_var (EqnInfo n ctx (WildPat _:ps) result) = EqnInfo n ctx ps result
 389 remove_var _                                     = panic "Check:remove_var: equation not begin with a variable"
 390
 391 is_con :: EquationInfo -> Bool
 392 is_con (EqnInfo _ _ ((ConPat _ _ _):_) _) = True
 393 is_con _                                  = False
 394
 395 is_lit :: EquationInfo -> Bool
 396 is_lit (EqnInfo _ _ ((LitPat _ _):_) _) = True
 397 is_lit (EqnInfo _ _ ((NPat _ _ _):_) _) = True
 398 is_lit _                                = False
 399
 400 is_npat :: EquationInfo -> Bool
 401 is_npat (EqnInfo _ _ ((NPat _ _ _):_) _) = True
 402 is_npat _                                 = False
 403
 404 is_nplusk :: EquationInfo -> Bool
 405 is_nplusk (EqnInfo _ _ ((NPlusKPat _ _ _ _ _):_) _) = True
 406 is_nplusk _                                         = False
 407
 408 is_var :: EquationInfo -> Bool
 409 is_var (EqnInfo _ _ ((WildPat _):_) _)  = True
 410 is_var _                                = False
 411
 412 is_var_con :: Id -> EquationInfo -> Bool
 413 is_var_con con (EqnInfo _ _ ((WildPat _):_)     _)             = True
 414 is_var_con con (EqnInfo _ _ ((ConPat id _ _):_) _) | id == con = True
 415 is_var_con con _                                               = False
 416
 417 is_var_lit :: HsLit -> EquationInfo -> Bool
 418 is_var_lit lit (EqnInfo _ _ ((WildPat _):_)     _)               = True
 419 is_var_lit lit (EqnInfo _ _ ((LitPat lit' _):_) _) | lit == lit' = True
 420 is_var_lit lit (EqnInfo _ _ ((NPat lit' _ _):_) _) | lit == lit' = True
 421 is_var_lit lit _                                                 = False
 422 \end{code}
 423
 424 The difference beteewn make_con and make_whole_con is that make_wole_con creates a new
 425 constructor with all their arguments, and make_Con takes a list of argumntes, creates
 426 the contructor geting thir argumnts from the list. See where are used for details.
 427
 428 We need to reconstruct the patterns (make the constructors infix and similar) at the
 429 same time that we create the constructors.
 430
 431 You can tell tuple constructors using
 432
 433         Id.isTupleCon
 434
 435 You can see if one contructur is infix with this clearer code :-))))))))))
 436
 437         Lex.isLexConSym (Name.occNameString (Name.getOccName con))
 438
 439        Rather clumsy but it works. (Simon Peyton Jones)
 440
 441
 442 We con't mind the nilDataCon because it doesn't change the way to print the messsage,
 443 we are searching only for things like: [1,2,3], not x:xs ....
 444
 445
 446 In recontruct_pat we want to "undo" the work taht we have done in simplify_pat
 447 In particular:
 448         ((,) x y)  returns to be (x, y)
 449         ((:) x xs) returns to be (x:xs)
 450         (x:(...:[]) returns to be [x,...]
 451
 452 The dificult case is the third one becouse we need to follow all the contructors until the []
 453 to know taht we need to use the second case, not the second.
 454
 455 \begin{code}
 456
 457 isInfixCon con = isLexConSym (occNameString (getOccName con))
 458
 459 is_nil (ConPatIn (BS con) []) = con == getOccString nilDataCon
 460 is_nil _                      = False
 461
 462 is_list (ListPatIn _) = True
 463 is_list _             = False
 464
 465 return_list id q = id == consDataCon && (is_nil q || is_list q)
 466
 467 make_list p q | is_nil q   = ListPatIn [p]
 468 make_list p (ListPatIn ps) = ListPatIn (p:ps)
 469 make_list _ _              = panic "Check.make_list: Invalid argument"
 470
 471 make_con :: TypecheckedPat -> ExhaustivePat -> ExhaustivePat
 472 make_con (ConPat id ty pats) (p:q:ps, constraints)
 473      | return_list id q = (make_list p q : ps, constraints)
 474      | isInfixCon id = (ParPatIn (ConOpPatIn p name fixity q) : ps, constraints)
 475     where name   = BS (getOccString id)
 476           fixity = panic "Check.make_con: Guessing fixity"
 477 make_con (ConPat id ty pats) (ps,constraints)
 478       | isTupleCon id = (TuplePatIn pats_con : rest_pats,    constraints)
 479       | otherwise     = (ConPatIn name pats_con : rest_pats, constraints)
 480     where num_args  = length pats
 481           name      = BS (getOccString id)
 482           pats_con  = (take num_args ps)
 483           rest_pats = drop num_args ps
 484
 485 make_whole_con :: Id -> WarningPat
 486 make_whole_con con | isInfixCon con = ParPatIn(ConOpPatIn new_wild_pat name fixity new_wild_pat)
 487                    | otherwise      = ConPatIn name pats
 488                 where
 489                   fixity = panic "Check.make_whole_con: Guessing fixity"
 490                   name   = BS (getOccString con)
 491                   arity  = get_int_arity con
 492                   pats   = take arity (repeat new_wild_pat)
 493
 494
 495 new_wild_pat :: WarningPat
 496 new_wild_pat = WildPatIn
 497
 498 get_int_arity :: Id -> Int
 499 get_int_arity id = arity_to_int (getIdArity id)
 500     where
 501       arity_to_int (ArityExactly n) = n
 502       arity_to_int _                = panic "getIntArity: Unknown arity"
 503
 504 \end{code}
 505
 506 This equation makes the same thing that tidy in Match.lhs, the
 507 diference is that here we can do all the tidy in one place and in the
 508 Match tidy it must be done one column each time due to bookeping
 509 constraints.
 510
 511 \begin{code}
 512
 513 simplify_eqns :: [EquationInfo] -> [EquationInfo]
 514 simplify_eqns []                               = []
 515 simplify_eqns ((EqnInfo n ctx pats result):qs) =
 516     (EqnInfo n ctx(map simplify_pat pats) result) :
 517     simplify_eqns qs
 518
 519 simplify_pat :: TypecheckedPat -> TypecheckedPat
 520 simplify_pat (WildPat gt ) = WildPat gt
 521
 522 simplify_pat (VarPat id)   = WildPat (idType id)
 523
 524 simplify_pat (LazyPat p)   = simplify_pat p
 525
 526 simplify_pat (AsPat id p)  = simplify_pat p
 527
 528 simplify_pat (ConPat id ty ps) = ConPat id ty (map simplify_pat ps)
 529
 530 simplify_pat (ConOpPat p1 id p2 ty) = ConPat id ty (map simplify_pat [p1,p2])
 531
 532 simplify_pat (ListPat ty ps) = foldr (\ x -> \y -> ConPat consDataCon list_ty [x, y])
 533                                                     (ConPat nilDataCon  list_ty [])
 534                                                     (map simplify_pat ps)
 535                              where list_ty = mkListTy ty
 536
 537
 538 simplify_pat (TuplePat ps) = ConPat (tupleCon arity)
 539                                      (mkTupleTy arity (map outPatType ps))
 540                                      (map simplify_pat ps)
 541                            where
 542                               arity = length ps
 543
 544 simplify_pat (RecPat id ty idps) = ConPat id ty pats
 545                                  where
 546                                    pats = map (\ (id,p,_)-> simplify_pat p) idps
 547
 548 simplify_pat pat@(LitPat lit lit_ty)
 549   | isUnboxedType lit_ty = LitPat lit lit_ty
 550
 551   | lit_ty == charTy = ConPat charDataCon charTy [LitPat (mk_char lit) charPrimTy]
 552
 553   | otherwise = pprPanic "tidy1:LitPat:" (ppr pat)
 554   where
 555     mk_char (HsChar c)    = HsCharPrim c
 556
 557 simplify_pat (NPat lit lit_ty hsexpr) = better_pat
 558   where
 559     better_pat
 560       | lit_ty == charTy   = ConPat charDataCon   lit_ty [LitPat (mk_char lit)   charPrimTy]
 561       | lit_ty == intTy    = ConPat intDataCon    lit_ty [LitPat (mk_int lit)    intPrimTy]
 562       | lit_ty == wordTy   = ConPat wordDataCon   lit_ty [LitPat (mk_word lit)   wordPrimTy]
 563       | lit_ty == addrTy   = ConPat addrDataCon   lit_ty [LitPat (mk_addr lit)   addrPrimTy]
 564       | lit_ty == floatTy  = ConPat floatDataCon  lit_ty [LitPat (mk_float lit)  floatPrimTy]
 565       | lit_ty == doubleTy = ConPat doubleDataCon lit_ty [LitPat (mk_double lit) doublePrimTy]
 566
 567                 -- Convert the literal pattern "" to the constructor pattern [].
 568       | null_str_lit lit       = ConPat nilDataCon    lit_ty []
 569
 570       | otherwise              = NPat lit lit_ty hsexpr
 571
 572     mk_int    (HsInt i)      = HsIntPrim i
 573     mk_int    l@(HsLitLit s) = l
 574
 575     mk_char   (HsChar c)     = HsCharPrim c
 576     mk_char   l@(HsLitLit s) = l
 577
 578     mk_word   l@(HsLitLit s) = l
 579
 580     mk_addr   l@(HsLitLit s) = l
 581
 582     mk_float  (HsInt i)      = HsFloatPrim (fromInteger i)
 583     mk_float  (HsFrac f)     = HsFloatPrim f
 584     mk_float  l@(HsLitLit s) = l
 585
 586     mk_double (HsInt i)      = HsDoublePrim (fromInteger i)
 587     mk_double (HsFrac f)     = HsDoublePrim f
 588     mk_double l@(HsLitLit s) = l
 589
 590     null_str_lit (HsString s) = _NULL_ s
 591     null_str_lit other_lit    = False
 592
 593 simplify_pat (NPlusKPat id hslit ty hsexpr1 hsexpr2) = --NPlusKPat id hslit ty hsexpr1 hsexpr2
 594      WildPat ty
 595    where ty = panic "Check.simplify_pat: Never used"
 596
 597 simplify_pat (DictPat dicts methods) =
 598     case num_of_d_and_ms of
 599        0 -> simplify_pat (TuplePat [])
 600        1 -> simplify_pat (head dict_and_method_pats)
 601        _ -> simplify_pat (TuplePat dict_and_method_pats)
 602     where
 603        num_of_d_and_ms   = length dicts + length methods
 604        dict_and_method_pats = map VarPat (dicts ++ methods)
 605
 606 \end{code}