[add various primitives to support unpackASCII and eqPacked in Jhc.String
John Meacham <john@repetae.net>**20061215043212] hunk ./E/ToHs.hs 225
+                  | otherwise -> mparen $ return $ text "int2Addr#" <+> text (show num) <> text "#"
hunk ./E/ToHs.hs 311
+transE (EPrim (APrim Peek { primArgType = at } _) [x] (ELit LitCons { litName = n })) = mparen $ ans where
+    ans = do x <- ans'; castVal at (show n) x
+    ans' = mparen $ do
+        x <- transE x
+        return (text func <+> x <+> text "0#")
+    (tt,_,_) = cTypeInfo at
+    Just pi = primitiveInfo at
+    size = primTypeSizeOf pi * 8
+    sign = primTypeIsSigned pi
+    func = case tt of
+        "Char#" -> "indexWideCharOffAddr#"
+        "Addr#" -> "indexAddrOffAddr#"
+        "Int#" -> "indexInt" ++ show size ++ "OffAddr#"
+        "Word#" -> "indexWord" ++ show size ++ "OffAddr#"
hunk ./E/ToHs.hs 348
-transE (EPrim (APrim cast@CCast { primArgType = at, primRetType = rt } _) [x] _) = mparen $ transE x >>= \x ->  case (showCType at,showCType rt) of
-    (a,b) | a == b -> return x
-    ("Int#","Char#") -> return (text "chr#" <+> x)
-    ("Char#","Int#") -> return (text "ord#" <+> x)
-    ("Addr#","Int#") -> return (text "addr2Int#" <+> x)
-    ("Int#","Addr#") -> return (text "int2Addr#" <+> x)
-    ("Word#","Int#") -> return (text "word2Int#" <+> x)
-    ("Int#","Word#") -> return (text "int2Word#" <+> x)
-    ("Char#","Word#") -> return (text "char2Word__" <+> x)
-    ("Word#","Char#") -> return (text "word2Char__" <+> x)
-    ("Addr#","Word#") -> return (text "int2Word#" <+> parens (text "addr2Int#" <+> x))
-    ("Word#","Addr#") -> return (text "int2Addr#" <+> parens (text "word2Int#" <+> x))
-    xs -> fail $ "unknown coercion: " ++ show xs
+transE (EPrim (APrim cast@CCast { primArgType = at, primRetType = rt } _) [x] _) = mparen $ transE x >>= \x ->  castVal at rt x
hunk ./E/ToHs.hs 367
+castVal :: ExtType -> ExtType -> Doc -> TM Doc
+castVal at rt x = case (showCType at,showCType rt) of
+        (a,b) | a == b -> return x
+        z | Just co <- lookup z coercions -> mparen $ return (text co <+> x)
+        xs -> fail $ "unknown coercion: " ++ show xs
+    where
+    coercions = [
+        (("Int#","Char#"),"chr#"),
+        (("Char#","Int#"),"ord#"),
+        (("Addr#","Int#"),"addr2Int#"),
+        (("Int#","Addr#"),"int2Addr#"),
+        (("Word#","Int#"),"word2Int#"),
+        (("Int#","Word#"),"int2Word#"),
+        (("Char#","Word#"),"char2Word__"),
+        (("Word#","Char#"),"word2Char__"),
+        (("Addr#","Word#"),"int2Word#"),
+        (("Word#","Addr#"),"int2Addr#")
+        ]
hunk ./E/ToHs.hs 393
-    table = [ ("Int#",intTable),("Word#",wordTable)]
+    table = [ ("Int#",intTable),("Word#",wordTable),("Addr#",addrTable)]
hunk ./E/ToHs.hs 408
+    addrTable = [ ("+","plusAddr__") ]
hunk ./Grin/FromE.hs 429
-                ptv = Var v2 pt
hunk ./Grin/FromE.hs 434
+        Peek pt' | [addr] <- xs -> do
+            let p = prim { primType = ([Ty $ toAtom (show rt_HsPtr)],pt) }
+                pt = toType (Ty $ toAtom pt') ty
+            return $ Prim p (args [addr])
hunk ./Grin/FromE.hs 441
-                ptv = Var v2 pt
hunk ./Name/Names.hs 78
+tc_Word8__ = toName TypeConstructor  ("Jhc.Prim","Word8__")
hunk ./Name/Names.hs 101
+v_eqUnpacked = toName Val  ("Jhc.String","eqUnpacked")
+v_unpackASCII = toName Val  ("Jhc.String","unpackASCII")
hunk ./Name/Names.hs 145
-    func_runNoWrapper = toName Val ("Jhc.IO","runNoWrapper")
+    func_runNoWrapper = toName Val ("Jhc.Prim","runNoWrapper")
hunk ./data/ViaGhc.hs 42
+plusAddr__ :: Addr# -> Addr# -> Addr#
+plusAddr__ a1 a2 = plusAddr# a1 (addr2Int# a2)
hunk ./lib/base/Jhc/IO.hs 137
--- | when no exception wrapper is wanted
-runNoWrapper :: IO a -> World__ -> World__
-runNoWrapper (IO run) w = case run w of (# w, _ #) -> w
hunk ./lib/base/Jhc/Prim.hs 22
+data Word8__ :: #
hunk ./lib/base/Jhc/Prim.hs 27
+-- | when no exception wrapper is wanted
+runNoWrapper :: IO a -> World__ -> World__
+runNoWrapper (IO run) w = case run w of (# w, _ #) -> w
+
hunk ./lib/base/Jhc/String.hs 3
-module Jhc.String where
+module Jhc.String(
+    eqString,
+    unpackASCII
+    )where
hunk ./lib/base/Jhc/String.hs 11
+{-# VCONSTRUCTOR unpackASCII #-}
+{-# NOINLINE unpackASCII #-}
+unpackASCII :: Addr__ -> [Char]
+unpackASCII addr = f addr where
+    f addr = case constPeekByte addr of
+        0# -> []
+        c -> (box c:f (increment addr))
+
+{-# NOINLINE eqUnpacked #-}
+eqUnpacked :: Addr__ -> [Char] -> Bool__
+eqUnpacked 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
+
+-- returns it in an Char__ even though it is just a byte
+foreign import primitive constPeekByte :: Addr__ -> Char__
hunk ./lib/base/Jhc/String.hs 42
+foreign import primitive increment :: Addr__ -> Addr__
+foreign import primitive box :: Char__ -> Char