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