[make string pattern matching match against packed strings
John Meacham <john@repetae.net>**20061215052704] hunk ./E/FromHs.hs 732
+                (eqUnpackedString,_,_) <- convertValue v_eqUnpackedString
hunk ./E/FromHs.hs 736
-                        return $ ifzh (EAp (EAp (EVar eqString) bv) (toE s)) m els
+                        let (s',packed) = packupString s
+                        if packed
+                            then return $ ifzh (EAp (EAp (EVar eqUnpackedString) s') bv) m els
+                            else return $ ifzh (EAp (EAp (EVar eqString) s') bv) m els
hunk ./E/FromHs.hs 781
-
+packupString :: String -> (E,Bool)
+packupString s | all (\c -> c > '\NUL' && c <= '\xff') s = (EPrim (APrim (PrimString (packString s)) mempty) [] (rawType "HsPtr"),True)
+packupString s = (toE s,False)
hunk ./Name/Names.hs 101
-v_eqUnpacked = toName Val  ("Jhc.String","eqUnpacked")
-v_unpackASCII = toName Val  ("Jhc.String","unpackASCII")
+v_eqUnpackedString = toName Val  ("Jhc.String","eqUnpackedString")
+v_unpackString = toName Val  ("Jhc.String","unpackString")
hunk ./lib/base/Jhc/List.hs 10
+import Jhc.String
+
hunk ./lib/base/Jhc/List.hs 37
+{-# RULES "foldr/unpackString"  forall k z (addr::Addr__) . foldr k z (unpackString addr) = unpackStringFoldr addr k z  #-}
hunk ./lib/base/Jhc/String.hs 5
-    unpackASCII
+    eqUnpackedString,
+    unpackStringFoldr,
+    unpackString
hunk ./lib/base/Jhc/String.hs 13
-{-# VCONSTRUCTOR unpackASCII #-}
-{-# NOINLINE unpackASCII #-}
-unpackASCII :: Addr__ -> [Char]
-unpackASCII addr = f addr where
+-- TODO make it handle full UTF8
+
+{-# VCONSTRUCTOR unpackString #-}
+{-# NOINLINE unpackString #-}
+unpackString :: Addr__ -> [Char]
+unpackString addr = f addr where
hunk ./lib/base/Jhc/String.hs 23
+{-
+unpackFoldrString :: Addr__ -> (Char__ -> b -> b) -> b -> b
+unpackFoldrString addr f e = unpack addr where
+    unpack addr = case constPeekByte addr of
+      '\NUL'# -> e
+      ch  | ch `leChar__` '\x7F'# = ch `f` unpack (increment addr)
+          | ch `leChar__` '\xDF'# = (((ch .&. '\x1f') `shiftL` 6#) .|. (constPeekByte (increment addr) .&. '\x3f')) `f` unpack (increment (increment addr))
+           (chr# (((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharArray# addr (nh +# 1#)) -# 0x80#))) `f`
+          unpack (nh +# 2#)
+      | ch `leChar#` '\xEF'# =
+           (chr# (((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12#) +#
+                    ((ord# (indexCharArray# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharArray# addr (nh +# 2#)) -# 0x80#))) `f`
+          unpack (nh +# 3#)
+      | otherwise            =
+           (chr# (((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18#) +#
+                    ((ord# (indexCharArray# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12#) +#
+                    ((ord# (indexCharArray# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharArray# addr (nh +# 3#)) -# 0x80#))) `f`
+          unpack (nh +# 4#)
+      where
+	ch = indexCharArray# addr nh
+
+-}
+
+unpackStringFoldr :: Addr__ -> (Char -> b -> b) -> b -> b
+unpackStringFoldr addr cons nil = f addr where
+    f addr = case constPeekByte addr of
+        0# -> nil
+        c -> (box c `cons` f (increment addr))
+
+{-# NOINLINE eqUnpackedString #-}
+eqUnpackedString :: Addr__ -> [Char] -> Bool__
+eqUnpackedString addr cs = f addr cs where
+    f :: Addr__ -> [Char] -> Bool__
+    f offset [] = case constPeekByte offset of 0# -> 1#; _ -> 0#
+    f offset (c:cs) = case constPeekByte offset of
+        0# -> 0#
+        uc -> case equalsChar uc (unbox c) of
+            0# -> 0#
+            1# -> f (increment offset) cs
+
+