409044c · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

Optimize bytes_for_range - replace with direct ptr access when possible

409044ccoreyoconnor17 years ago

src/Data/Terminfo/Eval.hs+9−11

compare with master

unifiedsplit

@@ -12,10 +12,10 @@

12 -}

13module Data.Terminfo.Eval ( cap_expression_required_bytes

14 , serialize_cap_expression

15− , bytes_for_range

16 )

15 )

17 where

16 where

18+import Data.ByteString.Internal ( memcpy )

19import Data.Marshalling

20import Data.Terminfo.Parse

@@ -29,6 +29,8 @@ import Data.Array.Unboxed

29import Data.Bits ( (.|.), (.&.), xor )

30import Data.List

32+import Foreign.Ptr

33+

32import GHC.Prim

34import GHC.Prim

33import GHC.Word

35import GHC.Word

@@ -58,14 +60,9 @@ apply_param_op :: [CapParam] -> ParamOp -> [CapParam]

58apply_param_op params IncFirstTwo = map (+ 1) params

60apply_param_op params IncFirstTwo = map (+ 1) params

60-- | range is 0-based offset into cap_bytes and count

62-- | range is 0-based offset into cap_bytes and count

61−--

63+{-# INLINE ptr_at_offset #-}

62−-- todo: The returned list is not assured to have a length st. length == count

63−bytes_for_range :: CapExpression -> Word8 -> Word8 -> [Word8]

64+ptr_at_offset :: CapExpression -> Word8 -> Ptr Word8

64−bytes_for_range cap !offset !count

65+ptr_at_offset cap !offset = fst ( cap_bytes cap ) `plusPtr` ( fromEnum offset )

65− = take (fromEnum count)

66− $ drop (fromEnum offset)

67− $ elems

68− $ cap_bytes cap

70cap_expression_required_bytes :: CapExpression -> [CapParam] -> Word

67cap_expression_required_bytes :: CapExpression -> [CapParam] -> Word

71cap_expression_required_bytes cap params =

68cap_expression_required_bytes cap params =

@@ -163,8 +160,9 @@ serialize_cap_ops out_ptr ops = foldM serialize_cap_op out_ptr ops

163serialize_cap_op :: MonadIO m => OutputBuffer -> CapOp -> EvalT m OutputBuffer

160serialize_cap_op :: MonadIO m => OutputBuffer -> CapOp -> EvalT m OutputBuffer

164serialize_cap_op out_ptr (Bytes offset c) = do

161serialize_cap_op out_ptr (Bytes offset c) = do

165 (cap, _) <- ask

162 (cap, _) <- ask

166− let out_bytes = bytes_for_range cap offset c

163+ let src_ptr = ptr_at_offset cap offset

167− serialize_bytes out_bytes out_ptr

164+ liftIO $! memcpy out_ptr src_ptr ( toEnum $! fromEnum c )

165+ return $! out_ptr `plusPtr` ( fromEnum c)

168serialize_cap_op out_ptr DecOut = do

166serialize_cap_op out_ptr DecOut = do

169 p <- pop

167 p <- pop

170 let out_str = show p

168 let out_str = show p

src/Data/Terminfo/Parse.hs+24−17

@@ -9,6 +9,7 @@ module Data.Terminfo.Parse ( module Data.Terminfo.Parse

9 )

10 where

12+import Control.Applicative ( Applicative(..), pure, (<*>) )

12import Control.Monad ( liftM )

13import Control.Monad ( liftM )

13import Control.Monad.Trans

14import Control.Monad.Trans

14import Control.Parallel.Strategies

15import Control.Parallel.Strategies

@@ -17,11 +18,14 @@ import Data.Array.Unboxed

17import Data.Monoid

18import Data.Monoid

18import Data.Word

19import Data.Word

21+import Foreign.Marshal.Array

22+import Foreign.Ptr

23+

20import Text.ParserCombinators.Parsec

24import Text.ParserCombinators.Parsec

22type BytesLength = Word8

26type BytesLength = Word8

23type BytesOffset = Word8

27type BytesOffset = Word8

24−type CapBytes = UArray Word8 Word8

28+type CapBytes = ( Ptr Word8, Word )

26data CapExpression = CapExpression

30data CapExpression = CapExpression

27 { cap_ops :: !CapOps

31 { cap_ops :: !CapOps

@@ -67,7 +71,11 @@ data ParamOp =

67 IncFirstTwo

71 IncFirstTwo

68 deriving ( Show )

72 deriving ( Show )

74+parse_cap_expression :: ( Applicative m

75+ , MonadIO m

76+ )

77+ => String

70−parse_cap_expression :: MonadIO m => String -> m ( Either ParseError CapExpression )

78+ -> m ( Either ParseError CapExpression )

71parse_cap_expression cap_string =

79parse_cap_expression cap_string =

72 let v = runParser cap_expression_parser

80 let v = runParser cap_expression_parser

73 initial_build_state

81 initial_build_state

@@ -75,21 +83,20 @@ parse_cap_expression cap_string =

75 cap_string

83 cap_string

76 in case v of

84 in case v of

77 Left e -> return $ Left e

85 Left e -> return $ Left e

78− Right build_results ->

86+ Right build_results -> pure Right <*> construct_cap_expression cap_string build_results

79− return

87+

80− $! Right

88+construct_cap_expression cap_string build_results = do

89+ byte_array <- liftIO $ newArray (map ( toEnum . fromEnum ) cap_string )

81− $! ( CapExpression

90+ let expr = CapExpression

82− { cap_ops = out_cap_ops build_results

91+ { cap_ops = out_cap_ops build_results

83− -- The cap bytes are the lower 8 bits of the input string's characters.

92+ -- The cap bytes are the lower 8 bits of the input string's characters.

84− -- \todo Verify the input string actually contains an 8bit byte per character.

93+ -- \todo Verify the input string actually contains an 8bit byte per character.

85− , cap_bytes = listArray (0, toEnum $ length cap_string - 1)

94+ , cap_bytes = ( byte_array, toEnum $! length cap_string )

86− $ map (toEnum . fromEnum) cap_string

87− , source_string = cap_string

95+ , source_string = cap_string

88− , param_count = out_param_count build_results

96+ , param_count = out_param_count build_results

89− , param_ops = out_param_ops build_results

97+ , param_ops = out_param_ops build_results

90− }

98+ }

91− `using` rdeepseq

99+ return $! expr `using` rdeepseq

92− )

100

94type CapParser a = GenParser Char BuildState a

101type CapParser a = GenParser Char BuildState a

102

test/Verify/Data/Terminfo/Parse.hs+12−5

@@ -16,11 +16,11 @@ import Numeric

16instance Show CapExpression where

17 show c

18 = "CapExpression { " ++ show (cap_ops c) ++ " }"

19− ++ " <- [" ++ hex_dump (cap_bytes c) ++ "]"

19+ ++ " <- [" ++ hex_dump ( map ( toEnum . fromEnum ) $! source_string c ) ++ "]"

20 ++ " <= " ++ show (source_string c)

22−hex_dump :: CapBytes -> String

22+hex_dump :: [Word8] -> String

23−hex_dump bytes = foldr (\b s -> showHex b s) "" $ elems bytes

23+hex_dump bytes = foldr (\b s -> showHex b s) "" bytes

25data NonParamCapString = NonParamCapString String

26 deriving Show

@@ -95,20 +95,27 @@ is_bytes_op :: CapOp -> Bool

95is_bytes_op (Bytes {}) = True

96-- is_bytes_op _ = False

98+bytes_for_range cap offset c

99+ = take (fromEnum c)

100+ $ drop (fromEnum offset)

101+ $ ( map ( toEnum . fromEnum ) $! source_string cap )

102+

98collect_bytes :: CapExpression -> [Word8]

103collect_bytes :: CapExpression -> [Word8]

99collect_bytes e = concat [ bytes

104collect_bytes e = concat [ bytes

100 | Bytes offset c <- cap_ops e

105 | Bytes offset c <- cap_ops e

101 , let bytes = bytes_for_range e offset c

106 , let bytes = bytes_for_range e offset c

102 ]

107 ]

108+

103

109

110+verify_bytes_equal :: [Word8] -> [Word8] -> Result

104verify_bytes_equal out_bytes expected_bytes

111verify_bytes_equal out_bytes expected_bytes

105 = if out_bytes == expected_bytes

112 = if out_bytes == expected_bytes

106 then succeeded

113 then succeeded

107 else failed

114 else failed

108 { reason = "out_bytes ["

115 { reason = "out_bytes ["

109− ++ hex_dump ( listArray (0, toEnum $ length out_bytes - 1) out_bytes )

116+ ++ hex_dump out_bytes

110 ++ "] /= expected_bytes ["

117 ++ "] /= expected_bytes ["

111− ++ hex_dump ( listArray (0, toEnum $ length expected_bytes - 1) expected_bytes )

118+ ++ hex_dump expected_bytes

112 ++ "]"

119 ++ "]"

113 }

120 }

114

121

test/verify_parse_terminfo_caps.hs−2

@@ -4,8 +4,6 @@ module Main where

5import Prelude hiding ( catch )

7−import Data.Terminfo.Eval ( bytes_for_range )

8−

9import qualified System.Console.Terminfo as Terminfo

7import qualified System.Console.Terminfo as Terminfo

11import Verify.Data.Terminfo.Parse

9import Verify.Data.Terminfo.Parse