summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoe Crayne <joe@jerkface.net>2019-06-12 20:17:54 -0400
committerJoe Crayne <joe@jerkface.net>2019-06-12 20:17:54 -0400
commit500a6ca99eb5b878a4d79706d48f776d2bd2b450 (patch)
treea7deb1a6979ae26e9e96e4948e9624d277050d6a
parent6ee08be31b394b54f77c243a3691864e9e229f43 (diff)
Optmizations, disabled weigh benchmarking.
-rw-r--r--src/Wavefront.hs11
-rw-r--r--test/bench.hs9
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
189nextToken tok bs = tok $ L.dropWhile (not . isSpace) bs 189nextToken tok bs = tok $ L.dropWhile (not . isSpace) bs
190 190
191parseFloats tok bs cont = case L.splitAt 10 (tok bs) of 191parseFloats 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
196parseFloatsN 0 _ bs cont = cont [] bs 196parseFloatsN 0 _ bs cont = cont [] bs
197parseFloatsN n tok bs cont = case L.splitAt 10 (tok bs) of 197parseFloatsN 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
202parseInts tok bs cont = case L.splitAt 5 (tok bs) of 202parseInts 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
213parseTriples :: (L.ByteString -> L.ByteString) -> L.ByteString -> ([RefTriple] -> L.ByteString -> b) -> b 214parseTriples :: (L.ByteString -> L.ByteString) -> L.ByteString -> ([RefTriple] -> L.ByteString -> b) -> b
214parseTriples tok bs cont = case L.splitAt 17 (tok bs) of 215parseTriples 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
240parseCurveSpecs :: (L.ByteString -> L.ByteString) -> L.ByteString -> ([CurveSpec] -> L.ByteString -> b) -> b 241parseCurveSpecs :: (L.ByteString -> L.ByteString) -> L.ByteString -> ([CurveSpec] -> L.ByteString -> b) -> b
241parseCurveSpecs tok bs cont = parseFloatsN 2 tok bs $ \fs bs' -> case fs of 242parseCurveSpecs 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 #-}
2import qualified Data.Attoparsec.Text as Atto 3import qualified Data.Attoparsec.Text as Atto
3import qualified Data.ByteString.Char8 as S 4import qualified Data.ByteString.Char8 as S
@@ -24,7 +25,9 @@ import qualified Graphics.WaveFront.Parse.Common as Parse
24import Wavefront 25import Wavefront
25 26
26import Criterion.Main 27import Criterion.Main
28#ifdef WEIGH
27import Weigh -- WARNING: weigh is incompatible with profiling. It reports much more allocations with profiling turned on. 29import Weigh -- WARNING: weigh is incompatible with profiling. It reports much more allocations with profiling turned on.
30#endif
28 31
29foreign import ccall "&cube_obj" cube_ptr :: Ptr Word8 32foreign import ccall "&cube_obj" cube_ptr :: Ptr Word8
30cube_obj_len :: Int 33cube_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 ()