X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FMatch.lhs;h=de45c66dbca65015d40a59f9217fab4ddac21ea3;hb=fe131871441f3a0b0f5ed7e8978cb89f05be97c7;hp=529432021254f5fd8e221ddcd1c0e2344fb00c5e;hpb=b1ab4b8a607addc4d097588db5761313c996a41f;p=ghc-hetmet.git diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs index 5294320..de45c66 100644 --- a/compiler/deSugar/Match.lhs +++ b/compiler/deSugar/Match.lhs @@ -6,6 +6,13 @@ The @match@ function \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module Match ( match, matchEquations, matchWrapper, matchSimply, matchSinglePat ) where #include "HsVersions.h" @@ -123,8 +130,8 @@ pp_context (DsMatchContext kind _loc) msg rest_of_msg_fun where (ppr_match, pref) = case kind of - FunRhs fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) - other -> (pprMatchContext kind, \ pp -> pp) + FunRhs fun _ -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) + other -> (pprMatchContext kind, \ pp -> pp) ppr_pats pats = sep (map ppr pats) @@ -447,15 +454,6 @@ tidy1 v (TuplePat pats boxity ty) arity = length pats tuple_ConPat = mkPrefixConPat (tupleCon boxity arity) pats ty -tidy1 v (DictPat dicts methods) - = case num_of_d_and_ms of - 0 -> tidy1 v (TuplePat [] Boxed unitTy) - 1 -> tidy1 v (unLoc (head dict_and_method_pats)) - _ -> tidy1 v (mkVanillaTuplePat dict_and_method_pats Boxed) - where - num_of_d_and_ms = length dicts + length methods - dict_and_method_pats = map nlVarPat (dicts ++ methods) - -- LitPats: we *might* be able to replace these w/ a simpler form tidy1 v (LitPat lit) = returnDs (idDsWrapper, tidyLitPat lit)