Optimize bytes_for_range - replace with direct ptr access when possible

Ignore-this: c082249814e88500de8243138bcb2fd

darcs-hash:20100114022236-f0a0d-d7f114a7c6356f4865ae84ace55d5e377b769e8b.gz

src/Data/Terminfo/Eval.hs

@@ -12,10 +12,10 @@
  -}
 module Data.Terminfo.Eval ( cap_expression_required_bytes
                           , serialize_cap_expression
-                          , bytes_for_range
                           )
     where
 
+import Data.ByteString.Internal ( memcpy ) 
 import Data.Marshalling
 import Data.Terminfo.Parse
 
@@ -29,6 +29,8 @@ import Data.Array.Unboxed
 import Data.Bits ( (.|.), (.&.), xor )
 import Data.List 
 
+import Foreign.Ptr
+
 import GHC.Prim
 import GHC.Word
 
@@ -58,14 +60,9 @@ apply_param_op :: [CapParam] -> ParamOp -> [CapParam]
 apply_param_op params IncFirstTwo = map (+ 1) params
 
 -- | range is 0-based offset into cap_bytes and count
--- 
--- todo: The returned list is not assured to have a length st. length == count
-bytes_for_range :: CapExpression -> Word8 -> Word8 -> [Word8]
-bytes_for_range cap !offset !count 
-    = take (fromEnum count) 
-    $ drop (fromEnum offset) 
-    $ elems 
-    $ cap_bytes cap
+{-# INLINE ptr_at_offset #-}
+ptr_at_offset :: CapExpression -> Word8 -> Ptr Word8
+ptr_at_offset cap !offset = fst ( cap_bytes cap ) `plusPtr` ( fromEnum offset )
 
 cap_expression_required_bytes :: CapExpression -> [CapParam] -> Word
 cap_expression_required_bytes cap params = 
@@ -163,8 +160,9 @@ serialize_cap_ops out_ptr ops = foldM serialize_cap_op out_ptr ops
 serialize_cap_op :: MonadIO m => OutputBuffer -> CapOp -> EvalT m OutputBuffer
 serialize_cap_op out_ptr (Bytes offset c) = do
     (cap, _) <- ask
-    let out_bytes = bytes_for_range cap offset c
-    serialize_bytes out_bytes out_ptr
+    let src_ptr = ptr_at_offset cap offset
+    liftIO $! memcpy out_ptr src_ptr ( toEnum $! fromEnum c )
+    return $! out_ptr `plusPtr` ( fromEnum c) 
 serialize_cap_op out_ptr DecOut = do
     p <- pop
     let out_str = show p

src/Data/Terminfo/Parse.hs

@@ -9,6 +9,7 @@ module Data.Terminfo.Parse ( module Data.Terminfo.Parse
                            )
     where
 
+import Control.Applicative ( Applicative(..), pure, (<*>) )  
 import Control.Monad ( liftM )
 import Control.Monad.Trans
 import Control.Parallel.Strategies
@@ -17,11 +18,14 @@ import Data.Array.Unboxed
 import Data.Monoid
 import Data.Word
 
+import Foreign.Marshal.Array
+import Foreign.Ptr
+
 import Text.ParserCombinators.Parsec
 
 type BytesLength = Word8
 type BytesOffset = Word8
-type CapBytes = UArray Word8 Word8
+type CapBytes = ( Ptr Word8, Word )
 
 data CapExpression = CapExpression
     { cap_ops :: !CapOps
@@ -67,7 +71,11 @@ data ParamOp =
       IncFirstTwo
     deriving ( Show )
 
-parse_cap_expression :: MonadIO m => String -> m ( Either ParseError CapExpression )
+parse_cap_expression :: ( Applicative m
+                        , MonadIO m
+                        )
+                     => String 
+                     -> m ( Either ParseError CapExpression )
 parse_cap_expression cap_string = 
     let v = runParser cap_expression_parser
                            initial_build_state
@@ -75,21 +83,20 @@ parse_cap_expression cap_string =
                            cap_string 
     in case v of
         Left e -> return $ Left e
-        Right build_results -> 
-            return 
-                $! Right 
-                $! ( CapExpression
-                        { cap_ops = out_cap_ops build_results
-                        -- The cap bytes are the lower 8 bits of the input string's characters.
-                        -- \todo Verify the input string actually contains an 8bit byte per character.
-                        , cap_bytes = listArray (0, toEnum $ length cap_string - 1) 
-                                                $ map (toEnum . fromEnum) cap_string
-                        , source_string = cap_string
-                        , param_count = out_param_count build_results
-                        , param_ops = out_param_ops build_results
-                        } 
-                        `using` rdeepseq
-                   )
+        Right build_results -> pure Right <*> construct_cap_expression cap_string build_results
+
+construct_cap_expression cap_string build_results = do
+    byte_array <- liftIO $ newArray (map ( toEnum . fromEnum ) cap_string )
+    let expr = CapExpression
+                { cap_ops = out_cap_ops build_results
+                -- The cap bytes are the lower 8 bits of the input string's characters.
+                -- \todo Verify the input string actually contains an 8bit byte per character.
+                , cap_bytes = ( byte_array, toEnum $! length cap_string )
+                , source_string = cap_string
+                , param_count = out_param_count build_results
+                , param_ops = out_param_ops build_results
+                } 
+    return $! expr `using` rdeepseq
 
 type CapParser a = GenParser Char BuildState a 
 

test/Verify/Data/Terminfo/Parse.hs

@@ -16,11 +16,11 @@ import Numeric
 instance Show CapExpression where
     show c 
         = "CapExpression { " ++ show (cap_ops c) ++ " }"
-        ++ " <- [" ++ hex_dump (cap_bytes c) ++ "]"
+        ++ " <- [" ++ hex_dump ( map ( toEnum . fromEnum ) $! source_string c ) ++ "]"
         ++ " <= " ++ show (source_string c) 
 
-hex_dump :: CapBytes -> String
-hex_dump bytes = foldr (\b s -> showHex b s) "" $ elems bytes
+hex_dump :: [Word8] -> String
+hex_dump bytes = foldr (\b s -> showHex b s) "" bytes
 
 data NonParamCapString = NonParamCapString String
     deriving Show
@@ -95,20 +95,27 @@ is_bytes_op :: CapOp -> Bool
 is_bytes_op (Bytes {}) = True
 -- is_bytes_op _ = False
 
+bytes_for_range cap offset c
+    = take (fromEnum c)
+    $ drop (fromEnum offset)
+    $ ( map ( toEnum . fromEnum ) $! source_string cap )
+
 collect_bytes :: CapExpression -> [Word8]
 collect_bytes e = concat [ bytes 
                          | Bytes offset c <- cap_ops e
                          , let bytes = bytes_for_range e offset c
                          ]
+    
 
+verify_bytes_equal :: [Word8] -> [Word8] -> Result
 verify_bytes_equal out_bytes expected_bytes 
     = if out_bytes == expected_bytes
         then succeeded
         else failed 
              { reason = "out_bytes [" 
-                       ++ hex_dump ( listArray (0, toEnum $ length out_bytes - 1) out_bytes )
+                       ++ hex_dump out_bytes
                        ++ "] /= expected_bytes ["
-                       ++ hex_dump ( listArray (0, toEnum $ length expected_bytes - 1) expected_bytes )
+                       ++ hex_dump expected_bytes
                        ++ "]"
              }
 

test/verify_parse_terminfo_caps.hs

@@ -4,8 +4,6 @@ module Main where
 
 import Prelude hiding ( catch )
 
-import Data.Terminfo.Eval ( bytes_for_range )
-
 import qualified System.Console.Terminfo as Terminfo
 
 import Verify.Data.Terminfo.Parse