From: sof <unknown>
Date: Thu, 14 Jan 1999 16:55:16 +0000 (+0000)
Subject: [project @ 1999-01-14 16:55:16 by sof]
X-Git-Tag: Approx_2487_patches~116
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=55e0bdb459e07909bdc09045f6d06568464549b9;p=ghc-hetmet.git

[project @ 1999-01-14 16:55:16 by sof]
Added indexFS,

   indexFS :: FastString -> Int -> Char
---

diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs
index c0bc781..b0a12b1 100644
--- a/ghc/compiler/utils/FastString.lhs
+++ b/ghc/compiler/utils/FastString.lhs
@@ -39,6 +39,7 @@ module FastString
         tailFS,		    -- :: FastString -> FastString
 	concatFS,	    -- :: [FastString] -> FastString
         consFS,             -- :: Char -> FastString -> FastString
+	indexFS,	    -- :: FastString -> Int -> Char
 
         hPutFS		    -- :: Handle -> FastString -> IO ()
        ) where
@@ -176,6 +177,18 @@ headFS f@(FastString _ l# ba#) =
 headFS f@(CharStr a# l#) = 
  if l# ># 0# then C# (indexCharOffAddr# a# 0#) else error ("headFS: empty FS: " ++ unpackFS f)
 
+indexFS :: FastString -> Int -> Char
+indexFS f i@(I# i#) =
+ case f of
+   FastString _ l# ba#
+     | l# ># 0# && l# ># i#  -> C# (indexCharArray# ba# i#)
+     | otherwise	     -> error (msg (I# l#))
+   CharStr a# l#
+     | l# ># 0# && l# ># i#  -> C# (indexCharOffAddr# a# i#)
+     | otherwise	     -> error (msg (I# l#))
+ where
+  msg l =  "indexFS: out of range: " ++ show (l,i)
+
 tailFS :: FastString -> FastString
 tailFS (FastString _ l# ba#) = mkFastSubStringBA# ba# 1# (l# -# 1#)