From 0d61ee90a6c181b18345174f20bd6506456db442 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Wed, 31 May 2000 15:44:29 +0000
Subject: [PATCH] [project @ 2000-05-31 15:44:29 by simonmar] Incorporate
Josef's patch to fix the bogus warning about overlapping string patterns.
Thanks Josef!
---
ghc/compiler/deSugar/DsUtils.lhs | 18 ++++++++++--------
1 file changed, 10 insertions(+), 8 deletions(-)
diff --git a/ghc/compiler/deSugar/DsUtils.lhs b/ghc/compiler/deSugar/DsUtils.lhs
index cdd1fd3b3ab4..c96665f7f79b 100644
--- a/ghc/compiler/deSugar/DsUtils.lhs
+++ b/ghc/compiler/deSugar/DsUtils.lhs
@@ -91,11 +91,8 @@ tidyLitPat lit lit_ty default_pat
| lit_ty == floatTy = ConPat floatDataCon lit_ty [] [] [LitPat (mk_float lit) floatPrimTy]
| lit_ty == doubleTy = ConPat doubleDataCon lit_ty [] [] [LitPat (mk_double lit) doublePrimTy]
- -- Convert the literal pattern "" to the constructor pattern [].
- | null_str_lit lit = ConPat nilDataCon lit_ty [] [] []
- -- Similar special case for "x"
- | one_str_lit lit = ConPat consDataCon lit_ty [] []
- [mk_first_char_lit lit, ConPat nilDataCon lit_ty [] [] []]
+ -- Convert literal patterns like "foo" to 'f':'o':'o':[]
+ | str_lit lit = mk_list lit
| otherwise = default_pat
@@ -121,9 +118,14 @@ tidyLitPat lit lit_ty default_pat
null_str_lit (HsString s) = _NULL_ s
null_str_lit other_lit = False
- one_str_lit (HsString s) = _LENGTH_ s == (1::Int)
- one_str_lit other_lit = False
- mk_first_char_lit (HsString s) = ConPat charDataCon charTy [] [] [LitPat (HsCharPrim (_HEAD_ s)) charPrimTy]
+ str_lit (HsString s) = True
+ str_lit _ = False
+
+ mk_list (HsString s) = foldr
+ (\c pat -> ConPat consDataCon lit_ty [] [] [mk_char_lit c,pat])
+ (ConPat nilDataCon lit_ty [] [] []) (_UNPK_ s)
+
+ mk_char_lit c = ConPat charDataCon charTy [] [] [LitPat (HsCharPrim c) charPrimTy]
\end{code}
--
GitLab