Add option to benchmark lvish plus cancel

simonmar · Nov 16, 2013 · afafbab · afafbab
1 parent def8384
commit afafbab
Show file tree

Hide file tree

Showing 3 changed files with 40 additions and 6 deletions.
diff --git a/examples/generate_cabal.sh b/examples/generate_cabal.sh
@@ -18,23 +18,23 @@ executable $PREFIX-$NAME
   if !(flag(trace)  || flag(direct)   || flag(contfree)\
      || flag(trace-st) \
      || flag(sparks) || flag(meta-smp) || flag(meta-numa)\
-     || flag(lvish) || flag(lvish-state) || flag(lvish-rng)  )
+     || flag(lvish) || flag(lvish-state) || flag(lvish-rng) || flag(lvish-cancel)  )
     buildable:       False
 
   build-depends:     $COMMON_DEPS
 
   -- Select whether to use the newer or older (deprecated) generic interfaces:
   if (flag(newgeneric) \
      || flag(trace-st) \
-     || flag(lvish) || flag(lvish-state) || flag(lvish-rng)  )
+     || flag(lvish) || flag(lvish-state) || flag(lvish-rng) || flag(lvish-cancel)  )
   {
     build-depends:     par-classes, par-collections, par-transformers
     cpp-options:      -DNEW_GENERIC
   } else {
     build-depends:     abstract-par, monad-par-extras
   }
 
-  if ( flag(lvish) || flag(lvish-state) || flag(lvish-rng) \
+  if ( flag(lvish) || flag(lvish-state) || flag(lvish-rng) || flag(lvish-cancel) \
      || flag(trace-st) \
      )
   {
@@ -98,6 +98,11 @@ flag lvish-state
 flag lvish-rng
   default:           False
   description:   Use LVish and stack on an RNG transformer.
+
+flag lvish-cancel
+  default:           False
+  description:   Use LVish and stack on an CancelT transformer.
+
 EOF
 executable_header
 }
@@ -146,11 +151,15 @@ cat >> $CABALFILE <<EOF
      build-depends:   lvish >= 1.1
      cpp-options:     -DPARSCHED=LVishPlusRNG
 
+  if flag(lvish-cancel)
+     build-depends:   lvish >= 1.1
+     cpp-options:     -DPARSCHED=LVishPlusCancel
+
   -- ELSE would be better here:
   if  !(flag(trace)  || flag(direct)   || flag(contfree)\
        || flag(trace-st)  \
        || flag(sparks) || flag(meta-smp) || flag(meta-numa)\
-       || flag(lvish) || flag(lvish-state) || flag(lvish-rng)   )
+       || flag(lvish) || flag(lvish-state) || flag(lvish-rng) || flag(lvish-cancel)   )
      build-depends:   monad-par
      -- uses Control.Monad.Par by default
 

diff --git a/examples/run_benchmark.hs b/examples/run_benchmark.hs
@@ -51,7 +51,8 @@ options =
 
      , Option [] ["lvish"]   (NoArg (SetSched LVish))  "add this scheduler "
      , Option [] ["lvish-state"] (NoArg (SetSched LVishState)) "scheduler with one transformer"
-     , Option [] ["lvish-rng"] (NoArg (SetSched LVishRNG)) "scheduler with one transformer" 
+     , Option [] ["lvish-rng"] (NoArg (SetSched LVishRNG)) "scheduler with one transformer"
+     , Option [] ["lvish-cancel"] (NoArg (SetSched LVishCancel)) "scheduler with one transformer"        
      ]
 
 isSetSched (SetSched _) = True
@@ -281,7 +282,9 @@ data Sched
    | Direct | Sparks   -- Basic monad-par
    | SMP | NUMA                -- Meta-par
    | LVish
-   | LVishRNG | LVishState -- Add transformers...
+   | LVishRNG
+   | LVishState -- Add transformers...
+   | LVishCancel  
    | None
    -- | ContFree   -- Obsolete strawman.
  deriving (Eq, Show, Read, Ord, Enum, Bounded)
@@ -309,6 +312,7 @@ schedToCabalFlag s =
     NUMA   -> "-fmeta-numa"
     LVish  -> "-flvish"
     LVishRNG   -> "-flvish-rng"
+    LVishCancel   -> "-flvish-cancel" 
     LVishState -> "-flvish-state"
     None   -> ""
 

diff --git a/examples/src/schedulers/LVishPlusCancelT.hs b/examples/src/schedulers/LVishPlusCancelT.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE DataKinds, Rank2Types #-}
+
+-- | Test how much a (useless) StateT transformer screws up optimizations and adds
+-- overheads, if at all.
+
+module LVishPlusStateT
+       (
+         runPar, Par,
+         module Control.Par.Class 
+       ) where
+
+import qualified Control.LVish as L 
+import Control.Par.Class
+import Control.LVish.CancelT
+
+type Par d s a = CancelT (L.Par d s) a
+
+runPar :: (forall s . Par L.Det s a) -> a
+runPar m =
+  L.runPar $ 
+  runCancelT m