blob: 9952ec2c5b1bdf66c4c80c26e595ab08e80e8161 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
{-# LANGUAGE ForeignFunctionInterface #-}
import qualified Data.Attoparsec.Text as Atto
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import Data.List as List
import Data.Either
import Data.ByteString.Unsafe
import Data.Text
import Data.Text.Encoding
import Data.Word
import Foreign.Ptr
import System.IO.Unsafe
import qualified Data.Vector as V
import Control.Monad.State ( State, execState, gets, modify )
import qualified Data.IntMap as IntMap
import Codec.Wavefront.Lexer ( lexer )
import Codec.Wavefront.Object ( WavefrontOBJ, ctxtToWavefrontOBJ, objLocations )
import Codec.Wavefront.Token ( tokenize )
import qualified Graphics.WaveFront.Parse as Parse
import qualified Graphics.WaveFront.Parse.Common as Parse
import Wavefront
import Criterion.Main
import Weigh -- WARNING: weigh is incompatible with profiling. It reports much more allocations with profiling turned on.
foreign import ccall "&cube_obj" cube_ptr :: Ptr Word8
cube_obj_len :: Int
cube_obj_len = 840
cube_obj :: L.ByteString
cube_obj = L.fromChunks . pure . unsafePerformIO $ do
unsafePackCStringFinalizer cube_ptr cube_obj_len (return ())
{-# NOINLINE cube_obj #-}
cube_objT :: Text
cube_objT = decodeASCII $ L.toStrict cube_obj
{-# NOINLINE cube_objT #-}
countVerticesSabadie :: Text -> Int
countVerticesSabadie ts = V.length vs
where
obj = sabadie ts
vs = either (const V.empty) objLocations obj
countVerticesSundqvist :: Text -> Int
countVerticesSundqvist ts = List.length vs
where
obj = sundqvist ts
vs = either (const []) (List.filter isOBJVertex) obj
isOBJVertex (Parse.OBJVertex {}) = True
isOBJVertex _ = False
countVerticesCrayne :: L.ByteString -> Int
countVerticesCrayne bs = execState (parseOBJ builder (ObjConfig IntMap.empty) bs) 0
where
builder = nullBuilder
{ vertex = \_ -> modify succ
}
sabadie :: Text -> Either String WavefrontOBJ
sabadie = fmap (ctxtToWavefrontOBJ . lexer) . tokenize
sundqvist :: Text -> Either String (Parse.OBJ Double Text Integer [])
sundqvist = Atto.parseOnly (Parse.wholeFile Parse.obj)
main :: IO ()
main = do
print $ countVerticesSabadie cube_objT
print $ countVerticesSundqvist cube_objT
print $ countVerticesCrayne cube_obj
putStrLn $ "---- Benchmarking"
defaultMain [
bgroup "count vertices"
[ bench "crayne" $ whnf countVerticesCrayne cube_obj
, bench "sabadie" $ whnf countVerticesSabadie cube_objT
, bench "sundqvist" $ whnf countVerticesSundqvist cube_objT
]
]
return ()
|
