X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FCheck.lhs;h=32b47b6b04983c1da1594d18a00b48fa3379a462;hb=8a2809c29de9f23eba7ca682b48390033a9d40f6;hp=9f3bad0b0d92f44fd18410fe28e25f116e9f6079;hpb=940524aec90652b5ef81789c9a453c57c0e42cc9;p=ghc-hetmet.git

diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs
index 9f3bad0..32b47b6 100644
--- a/compiler/deSugar/Check.lhs
+++ b/compiler/deSugar/Check.lhs
@@ -145,7 +145,9 @@ untidy b (L loc p) = L loc (untidy' b p)
 
 untidy_con (PrefixCon pats) = PrefixCon (map untidy_pars pats) 
 untidy_con (InfixCon p1 p2) = InfixCon  (untidy_pars p1) (untidy_pars p2)
-untidy_con (RecCon bs)      = RecCon    [ HsRecField f (untidy_pars p) d | HsRecField f p d <- bs ]
+untidy_con (RecCon (HsRecFields flds dd)) 
+  = RecCon (HsRecFields [ fld { hsRecFieldArg = untidy_pars (hsRecFieldArg fld) }
+			| fld <- flds ] dd)
 
 pars :: NeedPars -> WarningPat -> Pat Name
 pars True p = ParPat p
@@ -607,8 +609,8 @@ has_nplusk_pat (TuplePat ps _ _)   	     = any has_nplusk_lpat ps
 has_nplusk_pat (PArrPat ps _)  	   	     = any has_nplusk_lpat ps
 has_nplusk_pat (LazyPat p)     	   	     = False	-- Why?
 has_nplusk_pat (BangPat p)     	   	     = has_nplusk_lpat p	-- I think
-has_nplusk_pat (ConPatOut { pat_args = ps }) = any has_nplusk_lpat (hsConArgs ps)
-has_nplusk_pat p = False 	-- VarPat, VarPatOut, WildPat, LitPat, NPat, TypePat, DictPat
+has_nplusk_pat (ConPatOut { pat_args = ps }) = any has_nplusk_lpat (hsConPatArgs ps)
+has_nplusk_pat p = False 	-- VarPat, VarPatOut, WildPat, LitPat, NPat, TypePat
 
 simplify_lpat :: LPat Id -> LPat Id  
 simplify_lpat p = fmap simplify_pat p
@@ -661,21 +663,12 @@ simplify_pat (NPat lit mb_neg eq lit_ty) = tidyNPat lit mb_neg eq lit_ty
 simplify_pat (NPlusKPat id hslit hsexpr1 hsexpr2)
    = WildPat (idType (unLoc id))
 
-simplify_pat (DictPat dicts methods)
-  = case num_of_d_and_ms of
-       0 -> simplify_pat (TuplePat [] Boxed unitTy) 
-       1 -> simplify_pat (head dict_and_method_pats) 
-       _ -> simplify_pat (mkVanillaTuplePat (map noLoc dict_and_method_pats) Boxed)
-    where
-       num_of_d_and_ms	 = length dicts + length methods
-       dict_and_method_pats = map VarPat (dicts ++ methods)
-
 simplify_pat (CoPat co pat ty) = simplify_pat pat 
 
 -----------------
 simplify_con con (PrefixCon ps)   = PrefixCon (map simplify_lpat ps)
 simplify_con con (InfixCon p1 p2) = PrefixCon [simplify_lpat p1, simplify_lpat p2]
-simplify_con con (RecCon fs)      
+simplify_con con (RecCon (HsRecFields fs _))      
   | null fs   = PrefixCon [nlWildPat | t <- dataConOrigArgTys con]
 		-- Special case for null patterns; maybe not a record at all
   | otherwise = PrefixCon (map (simplify_lpat.snd) all_pats)