diff options
author | Joe Crayne <joe@jerkface.net> | 2019-06-12 20:17:54 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-06-12 20:17:54 -0400 |
commit | 500a6ca99eb5b878a4d79706d48f776d2bd2b450 (patch) | |
tree | a7deb1a6979ae26e9e96e4948e9624d277050d6a | |
parent | 6ee08be31b394b54f77c243a3691864e9e229f43 (diff) |
Optmizations, disabled weigh benchmarking.
-rw-r--r-- | src/Wavefront.hs | 11 | ||||
-rw-r--r-- | test/bench.hs | 9 |
2 files changed, 15 insertions, 5 deletions
diff --git a/src/Wavefront.hs b/src/Wavefront.hs index 9e42779..d53c786 100644 --- a/src/Wavefront.hs +++ b/src/Wavefront.hs | |||
@@ -189,15 +189,15 @@ nextToken :: (L.ByteString -> L.ByteString) -> L.ByteString -> L.ByteString | |||
189 | nextToken tok bs = tok $ L.dropWhile (not . isSpace) bs | 189 | nextToken tok bs = tok $ L.dropWhile (not . isSpace) bs |
190 | 190 | ||
191 | parseFloats tok bs cont = case L.splitAt 10 (tok bs) of | 191 | parseFloats tok bs cont = case L.splitAt 10 (tok bs) of |
192 | (ds,bs') -> case F.readSigned F.readExponential (L.toStrict ds) of | 192 | (ds,bs') -> case F.readSigned F.readDecimal (L.toStrict ds) of |
193 | Just (x,b) -> parseFloats tok (reconsChunk b bs') (cont . (x :)) | 193 | Just (x,b) -> parseFloats tok (reconsChunk b bs') (cont . (x :)) |
194 | Nothing -> cont [] (ds <> bs') | 194 | Nothing -> cont [] bs |
195 | 195 | ||
196 | parseFloatsN 0 _ bs cont = cont [] bs | 196 | parseFloatsN 0 _ bs cont = cont [] bs |
197 | parseFloatsN n tok bs cont = case L.splitAt 10 (tok bs) of | 197 | parseFloatsN n tok bs cont = case L.splitAt 10 (tok bs) of |
198 | (ds,bs') -> case F.readSigned F.readExponential (L.toStrict ds) of | 198 | (ds,bs') -> case F.readSigned F.readDecimal (L.toStrict ds) of |
199 | Just (x,b) -> parseFloatsN (n-1) tok (reconsChunk b bs') (cont . (x :)) | 199 | Just (x,b) -> parseFloatsN (n-1) tok (reconsChunk b bs') (cont . (x :)) |
200 | Nothing -> cont [] (ds <> bs') | 200 | Nothing -> cont [] bs |
201 | 201 | ||
202 | parseInts tok bs cont = case L.splitAt 5 (tok bs) of | 202 | parseInts tok bs cont = case L.splitAt 5 (tok bs) of |
203 | (ds,bs') -> case I.readSigned I.readDecimal (L.toStrict ds) of | 203 | (ds,bs') -> case I.readSigned I.readDecimal (L.toStrict ds) of |
@@ -210,6 +210,7 @@ parseIntsN n tok bs cont = case L.splitAt 5 (tok bs) of | |||
210 | Just (x,b) -> parseIntsN (n-1) tok (reconsChunk b bs') (cont . (x :)) | 210 | Just (x,b) -> parseIntsN (n-1) tok (reconsChunk b bs') (cont . (x :)) |
211 | Nothing -> cont [] (ds <> bs') | 211 | Nothing -> cont [] (ds <> bs') |
212 | 212 | ||
213 | -- Optimize me | ||
213 | parseTriples :: (L.ByteString -> L.ByteString) -> L.ByteString -> ([RefTriple] -> L.ByteString -> b) -> b | 214 | parseTriples :: (L.ByteString -> L.ByteString) -> L.ByteString -> ([RefTriple] -> L.ByteString -> b) -> b |
214 | parseTriples tok bs cont = case L.splitAt 17 (tok bs) of | 215 | parseTriples tok bs cont = case L.splitAt 17 (tok bs) of |
215 | (ds,bs') -> case I.readSigned I.readDecimal (L.toStrict ds) of | 216 | (ds,bs') -> case I.readSigned I.readDecimal (L.toStrict ds) of |
@@ -235,7 +236,7 @@ parseTriples tok bs cont = case L.splitAt 17 (tok bs) of | |||
235 | 236 | ||
236 | _ -> parseTriples tok (reconsChunk b bs') $ cont . (RefTriple v Nothing Nothing :) | 237 | _ -> parseTriples tok (reconsChunk b bs') $ cont . (RefTriple v Nothing Nothing :) |
237 | 238 | ||
238 | Nothing -> cont [] (ds <> bs') | 239 | Nothing -> cont [] bs |
239 | 240 | ||
240 | parseCurveSpecs :: (L.ByteString -> L.ByteString) -> L.ByteString -> ([CurveSpec] -> L.ByteString -> b) -> b | 241 | parseCurveSpecs :: (L.ByteString -> L.ByteString) -> L.ByteString -> ([CurveSpec] -> L.ByteString -> b) -> b |
241 | parseCurveSpecs tok bs cont = parseFloatsN 2 tok bs $ \fs bs' -> case fs of | 242 | parseCurveSpecs tok bs cont = parseFloatsN 2 tok bs $ \fs bs' -> case fs of |
diff --git a/test/bench.hs b/test/bench.hs index 9952ec2..3125ed9 100644 --- a/test/bench.hs +++ b/test/bench.hs | |||
@@ -1,3 +1,4 @@ | |||
1 | {-# LANGUAGE CPP #-} | ||
1 | {-# LANGUAGE ForeignFunctionInterface #-} | 2 | {-# LANGUAGE ForeignFunctionInterface #-} |
2 | import qualified Data.Attoparsec.Text as Atto | 3 | import qualified Data.Attoparsec.Text as Atto |
3 | import qualified Data.ByteString.Char8 as S | 4 | import qualified Data.ByteString.Char8 as S |
@@ -24,7 +25,9 @@ import qualified Graphics.WaveFront.Parse.Common as Parse | |||
24 | import Wavefront | 25 | import Wavefront |
25 | 26 | ||
26 | import Criterion.Main | 27 | import Criterion.Main |
28 | #ifdef WEIGH | ||
27 | import Weigh -- WARNING: weigh is incompatible with profiling. It reports much more allocations with profiling turned on. | 29 | import Weigh -- WARNING: weigh is incompatible with profiling. It reports much more allocations with profiling turned on. |
30 | #endif | ||
28 | 31 | ||
29 | foreign import ccall "&cube_obj" cube_ptr :: Ptr Word8 | 32 | foreign import ccall "&cube_obj" cube_ptr :: Ptr Word8 |
30 | cube_obj_len :: Int | 33 | cube_obj_len :: Int |
@@ -79,4 +82,10 @@ main = do | |||
79 | , bench "sundqvist" $ whnf countVerticesSundqvist cube_objT | 82 | , bench "sundqvist" $ whnf countVerticesSundqvist cube_objT |
80 | ] | 83 | ] |
81 | ] | 84 | ] |
85 | #ifdef WEIGH | ||
86 | Weigh.mainWith $ do | ||
87 | func "crayne" countVerticesCrayne cube_obj | ||
88 | func "sabadie" countVerticesSabadie cube_objT | ||
89 | func "sundqvist" countVerticesSundqvist cube_objT | ||
90 | #endif | ||
82 | return () | 91 | return () |