- mk_word l@(HsLitLit s) = l
-
- mk_addr l@(HsLitLit s) = l
-
- mk_float (HsInt i) = HsFloatPrim (fromInteger i)
- mk_float (HsFrac f) = HsFloatPrim f
- mk_float l@(HsLitLit s) = l
-
- mk_double (HsInt i) = HsDoublePrim (fromInteger i)
- mk_double (HsFrac f) = HsDoublePrim f
- mk_double l@(HsLitLit s) = l
+simplify_pat (RecPat dc ty ex_tvs dicts idps)
+ = ConPat dc ty ex_tvs dicts pats
+ where
+ pats = map (simplify_pat.snd) all_pats
+
+ -- pad out all the missing fields with WildPats.
+ field_pats = map (\ f -> (getName f, WildPat (panic "simplify_pat(RecPat-2)")))
+ (dataConFieldLabels dc)
+ all_pats =
+ foldr
+ ( \ (id,p,_) acc -> insertNm (getName id) p acc)
+ field_pats
+ idps
+
+ insertNm nm p [] = [(nm,p)]
+ insertNm nm p (x@(n,_):xs)
+ | nm == n = (nm,p):xs
+ | otherwise = x : insertNm nm p xs
+
+simplify_pat pat@(LitPat lit lit_ty) = tidyLitPat lit pat
+
+-- unpack string patterns fully, so we can see when they overlap with
+-- each other, or even explicit lists of Chars.
+simplify_pat pat@(NPat (HsString s) _ _) =
+ foldr (\c pat -> ConPat consDataCon stringTy [] [] [mk_char_lit c,pat])
+ (ConPat nilDataCon stringTy [] [] []) (_UNPK_INT_ s)
+ where
+ mk_char_lit c = ConPat charDataCon charTy [] []
+ [LitPat (HsCharPrim c) charPrimTy]