benchmarks

4 files changed, 175 insertions, 0 deletions

diff --git a/src/Wavefront.hs b/src/Wavefront.hs
index 66d6cdb..9e42779 100644
--- a/src/Wavefront.hs
+++ b/src/Wavefront.hs
@@ -42,6 +42,39 @@ data ObjBuilder m = ObjBuilder
     , badToken         :: L.ByteString -> m ()
     }
 
+nullBuilder :: Applicative m => ObjBuilder m
+nullBuilder = ObjBuilder
+    { vertex           = \vs -> pure ()
+    , vertexT          = \vs -> pure ()
+    , vertexN          = \vs -> pure ()
+    , vertexP          = \vs -> pure ()
+    , face             = \is -> pure ()
+    , cstype           = \isRat typ -> pure ()
+    , curv2            = \is -> pure ()
+    , curv             = \u0 v0 is -> pure ()
+    , parm             = \isU is -> pure ()
+    , specialPoints    = \is -> pure ()
+    , endFreeForm      = pure ()
+    , ctech            = \approx -> pure ()
+    , stech            = \approx -> pure ()
+    , deg              = \is -> pure ()
+    , surf             = \u0 u1 v0 v1 ts -> pure ()
+    , trim             = \ss -> pure ()
+    , hole             = \ss -> pure ()
+    , specialCurves    = \ss -> pure ()
+    , equivalentCurves = \ccs -> pure ()
+    , groups           = \gs -> pure ()
+    , smoothingGroup   = \sg -> pure ()
+    , mergingGroup     = \mg δ -> pure ()
+    , usemtl           = \mtl -> pure ()
+    , deprecated_cdc   = \is -> pure ()
+    , deprecated_bzp   = \is -> pure ()
+    , mtllib           = \fns -> pure ()
+    , objectName       = \obn -> pure ()
+    , badToken         = \bs -> pure ()
+    }
+
+
 data CurveSamplingSpec
     -- ctech cparm
     = UniformSubdivision
diff --git a/test/bench.hs b/test/bench.hs
new file mode 100644
index 0000000..9952ec2
--- /dev/null
+++ b/test/bench.hs
@@ -0,0 +1,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 ()
diff --git a/test/cube.c b/test/cube.c
new file mode 100644
index 0000000..952f32e
--- /dev/null
+++ b/test/cube.c
@@ -0,0 +1,54 @@
+
+unsigned char cube_obj[] =
+    "          \n"
+    " \n"
+    // For now, sabadie parser has bug and cannot handle leading comments.
+    // "# cube.obj\n"
+    // "#\n"
+    "\n"
+    "o cube\n"
+    "mtllib cube.mtl\n"
+    "\n"
+    "v -0.500000 -0.500000 0.500000\n"
+    "v 0.500000 -0.500000 0.500000\n"
+    "v -0.500000 0.500000 0.500000\n"
+    "v 0.500000 0.500000 0.500000\n"
+    "v -0.500000 0.500000 -0.500000\n"
+    "v 0.500000 0.500000 -0.500000\n"
+    "v -0.500000 -0.500000 -0.500000\n"
+    "v 0.500000 -0.500000 -0.500000\n"
+    "\n"
+    "vt 0.000000 0.000000\n"
+    "vt 1.000000 0.000000\n"
+    "vt 0.000000 1.000000\n"
+    "vt 1.000000 1.000000\n"
+    "\n"
+    "vn 0.000000 0.000000 1.000000\n"
+    "vn 0.000000 1.000000 0.000000\n"
+    "vn 0.000000 0.000000 -1.000000\n"
+    "vn 0.000000 -1.000000 0.000000\n"
+    "vn 1.000000 0.000000 0.000000\n"
+    "vn -1.000000 0.000000 0.000000\n"
+    "\n"
+    "g cube\n"
+    "usemtl material0\n"
+    "s 1\n"
+    "f 1/1/1 2/2/1 3/3/1\n"
+    "f 3/3/1 2/2/1 4/4/1\n"
+    "s 2\n"
+    "f 3/1/2 4/2/2 5/3/2\n"
+    "f 5/3/2 4/2/2 6/4/2\n"
+    "s 3\n"
+    "f 5/4/3 6/3/3 7/2/3\n"
+    "f 7/2/3 6/3/3 8/1/3\n"
+    "s 4\n"
+    "f 7/1/4 8/2/4 1/3/4\n"
+    "f 1/3/4 8/2/4 2/4/4\n"
+    "s 5\n"
+    "f 2/1/5 8/2/5 4/3/5\n"
+    "f 4/3/5 8/2/5 6/4/5\n"
+    "s 6\n"
+    "f 7/1/6 1/2/6 5/3/6\n"
+    "f 5/3/6 1/2/6 3/4/6\n";
+
+unsigned int cube_obj_len = 840;
diff --git a/wavefront-obj.cabal b/wavefront-obj.cabal
index 612d6f5..a1087df 100644
--- a/wavefront-obj.cabal
+++ b/wavefront-obj.cabal
@@ -92,3 +92,9 @@ library
 
   hs-source-dirs:      src
   default-language:    Haskell2010
+
+executable bench
+  main-is: test/bench.hs
+  C-sources: test/cube.c
+  ghc-options: -Wall -rtsopts
+  build-depends: base, bytestring, attoparsec, text, vector, transformers, mtl, containers, wavefront-obj, criterion, weigh