blob: e610e84973148d318218da66f9a3a28904da3085 (
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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
{-# LANGUAGE CPP #-}
{-# 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.Lex
import qualified Data.Wavefront as C
import Wavefront as C
import Criterion.Main
#ifdef WEIGH
import Weigh -- WARNING: weigh is incompatible with profiling. It reports much more allocations with profiling turned on.
#endif
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 = decodeUtf8 $ 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
}
countVerticesCrayneFull :: L.ByteString -> Int
countVerticesCrayneFull ts = V.length vs
where
obj = C.parse ts
vs = C.objLocations obj
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 "crayneFull" $ whnf countVerticesCrayneFull cube_obj
, bench "sabadie" $ whnf countVerticesSabadie cube_objT
, bench "sundqvist" $ whnf countVerticesSundqvist cube_objT
]
]
#ifdef WEIGH
Weigh.mainWith $ do
func "crayne" countVerticesCrayne cube_obj
func "crayneFull" countVerticesCrayneFull cube_obj
func "sabadie" countVerticesSabadie cube_objT
func "sundqvist" countVerticesSundqvist cube_objT
#endif
return ()
|
