[make string pattern matching use eqString predicate, rather than expanding into large nested case statements.
John Meacham <john@repetae.net>**20061130102525] addfile ./lib/base/Jhc/String.hs
hunk ./E/FromHs.hs 76
+ifzh e a b = eCase e [Alt (LitInt 1 tIntzh) a, Alt (LitInt 0 tIntzh) b] Unknown
hunk ./E/FromHs.hs 127
-simplifyHsPat (HsPLit (HsString s)) = simplifyHsPat (HsPList (map f s)) where
-    f c = HsPLit (HsChar c)
+--simplifyHsPat (HsPLit (HsString s)) | True || length s <= 3 = simplifyHsPat (HsPList (map f s)) where
+--    f c = HsPLit (HsChar c)
hunk ./E/FromHs.hs 650
+            | all isHsPString patternHeads = do
+                let tb = getType b
+                [bv] <- newVars [tb]
+                (eqString,_,_) <- convertValue v_eqString
+                let gps = [ (p,[ (ps,e) |  (_:ps,e) <- xs ]) | (p,xs) <- sortGroupUnderF ((\ (x:_) -> x) . fst) ps]
+                    eq = EAp (func_equals funcs) tb
+                    f els (HsPLit (HsString s),ps) = do
+                        m <- match bs ps err
+                        return $ ifzh (EAp (EAp (EVar eqString) (EVar bv)) (toE s)) m els
+                e <- foldlM f err gps
+                return $ eLetRec [(bv,b)] e
hunk ./E/FromHs.hs 671
-            | all isHsPApp patternHeads = do
+            | all (\c -> isHsPApp c || isHsPString c) patternHeads = do
hunk ./E/FromHs.hs 673
-                let gps =  sortGroupUnderF (hsPatName . (\ (x:_) -> x) . fst) ps
+                let gps =  sortGroupUnderF (hsPPatName . (\ (x:_) -> x) . fst) (map ff ps)
+                    ff ((HsPLit (HsString ""):ps),b) = ((HsPApp (nameName $ dc_EmptyList) []):ps,b)
+                    ff ((HsPLit (HsString (c:cs)):ps),b) = ((HsPApp (nameName $ dc_Cons) [HsPLit (HsChar c),HsPLit (HsString cs)]):ps,b)
+                    ff x = x
hunk ./E/FromHs.hs 714
+hsPPatName p@HsPApp {} = hsPatName p
+hsPPatName (HsPLit (HsString "")) = nameName dc_EmptyList
+hsPPatName (HsPLit (HsString {})) = nameName dc_Cons
+
+isHsPString (HsPLit HsString {}) = True
+isHsPString _ = False
hunk ./E/PrimOpt.hs 156
+    primopt (PrimPrim "equalsChar") [a,b] t = return (EPrim (APrim (Operator "==" ["HsChar","HsChar"] "int") mempty) [a,b] t)
hunk ./Name/Names.hs 99
+v_eqString = toName Val  ("Jhc.String","eqString")
hunk ./lib/base/Jhc/Prim.hs 5
+
+import Jhc.String
hunk ./lib/base/Jhc/String.hs 1
+-- module for things dealing with string constants needed by the compiler internally
+{-# OPTIONS_JHC -N -fffi -funboxed-values #-}
+module Jhc.String where
+
+
+import Jhc.Prim
+
+
+
+eqString :: [Char] -> [Char] -> Bool__
+eqString [] [] = 1#
+eqString (x:xs) (y:ys) = case equalsChar (unbox x) (unbox y) of
+    0# -> 0#
+    1# -> eqString xs ys
+eqString _ _ = 0#
+
+foreign import primitive unbox :: Char -> Char__
+foreign import primitive equalsChar :: Char__ -> Char__ -> Bool__
+
+
+
+
+