Example of a runner for instrumenting user code with a simple cost model

examples/without_signals/CostTests.hs

@@ -0,0 +1,93 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MonoLocalBinds #-}
+
+{-|
+Module      : IntStateTests
+Description : Example use cases of the runner for cost model instrumentation from `Control.Runner.Cost`
+Copyright   : (c) Danel Ahman, 2019
+License     : MIT
+Maintainer  : danel.ahman@eesti.ee
+Stability   : experimental
+
+This module provides example use cases of the runner for 
+cost model instrumentation from `Control.Runner.Cost`.
+-}
+module CostTests where
+
+import Control.Runner
+import Control.Runner.Cost
+
+import Control.Runner.MLState
+
+import Control.Runner.FileIO
+import System.IO hiding (withFile)
+
+
+-- Instrumenting ML-style state with a simple cost model
+
+test1 :: Int -> Int -> User '[MLState] (Int,Int)
+test1 x y =
+  do r <- alloc x;
+     r' <- alloc y;
+     x' <- (!) r;
+     y' <- (!) r';
+     return (x',y')
+
+test2 =
+  mlTopLevel (costInstrumentation (test1 4 2)) -- expected result ((4,2),4)                            
+
+test3 :: Int -> User '[MLState] Int
+test3 x =
+  do r <- alloc x;
+     r =:=  (x + 2);
+     y <- (!) r;
+     return y
+
+test4 = mlTopLevel (costInstrumentation (test3 4)) -- expected result (6,3)
+
+test5 :: String -> (String -> Int) -> User '[MLState] Int
+test5 s f =
+  do r <- alloc f;  -- storing a higher-order (pure) function argument in the state
+     x <- test3 42;
+     g <- (!) r;
+     return (g s + x) -- length s + 44
+
+test6 = mlTopLevel (costInstrumentation (test5 "foobar" length)) -- expected result (50,5)
+                                                                 -- 2 operation calls from test5,
+                                                                 -- and 3 operation calls from test3
+
+
+-- Instrumenting file IO state with a simple cost model
+
+writeLines :: Member File sig => [String] -> User sig ()
+writeLines [] = return ()
+writeLines (l:ls) = do fWrite l;
+                       fWrite "\n";
+                       writeLines ls
+
+exampleLines = ["Lorem ipsum dolor sit amet, consectetur adipiscing elit.",
+                "Cras sit amet felis arcu.",
+                "Maecenas ac mollis mauris, vel fermentum nibh."]
+
+test7 :: User '[IO] ()
+test7 =                                   -- in IO signature, using IO container
+  run
+    fioRunner
+    ioFioInitialiser
+    (                                     -- in FileIO signature, using FIO runner
+      run
+        fhRunner
+        (fioFhInitialiser "./out.txt")
+        (                                 -- in File signature, using FH runner
+          writeLines exampleLines
+        )
+        fioFhFinaliser
+    )
+    ioFioFinaliser
+
+test8 = ioTopLevel (costInstrumentation test7) -- expected result ((),11)
+                                               -- 6 operation calls from writeLines
+                                               -- 4 operation calls from fioFhInitialiser
+                                               -- 1 operation call from fioFhFinaliser
+                                               -- 0 operation calls from ioFioInitialiser and ioFioFinaliser

haskell-coop.cabal

@@ -24,6 +24,7 @@ library
     Control.Runner,
     Control.SignalRunner,
     Control.Runner.Ambients,
+    Control.Runner.Cost,
     Control.Runner.FileIO,
     Control.Runner.FileIOAndMLState,
     Control.Runner.FPState,
@@ -44,6 +45,7 @@ library
     GADTs,
     GeneralizedNewtypeDeriving,
     KindSignatures,
+    MonoLocalBinds,
     PolyKinds,
     RankNTypes,
     ScopedTypeVariables,

src/Control/Runner/Cost.hs

@@ -0,0 +1,73 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-|
+Module      : Control.Runner.Cost
+Description : Runner for instrumenting a user computation with a simple cost model
+Copyright   : (c) Danel Ahman, 2019
+License     : MIT
+Maintainer  : danel.ahman@eesti.ee
+Stability   : experimental
+
+This module implements a runner that provides a means
+to instrument user code with a very simple cost model 
+that simply counts the total number of operation calls 
+that the user code makes, with the corresponding 
+finaliser `costFinaliser` then reporting the final cost.
+
+For simplicity, the finaliser `costFinaliser`
+simply returns a pair of the user code's return value 
+and the final cost of the computation. One can of course
+envisage both more elaborate cost models, but also 
+finalisers that act on the final cost with other effects, 
+e.g., by writing the final cost of the computation to IO.
+-}
+module Control.Runner.Cost (
+  costRunner, costInitialiser, costFinaliser, costInstrumentation
+  ) where
+
+import Control.Runner
+
+-- | The co-operations of the runner `costRunner`.
+costCoOps :: Member eff sig => eff a -> Kernel sig Int a
+costCoOps e =
+  do c <- getEnv;
+     setEnv (c + 1);
+     performK e
+
+-- | Runner that instruments a user computation with a simple
+-- cost model that simply counts the number of operation calls
+-- the user code makes (storing the count in its runtime state).
+costRunner :: Member eff sig => Runner '[eff] sig Int
+costRunner = mkRunner costCoOps
+
+-- | Initialiser for the runner `costRunner`.
+--
+-- It sets the number of operation calls to zero.
+costInitialiser :: User sig Int
+costInitialiser = return 0
+
+-- | Finaliser for the runner `costRunner`.
+--
+-- It returns the pair of the return value and the
+-- final cost of the user computation that was run.
+costFinaliser :: a -> Int -> User sig (a,Int)
+costFinaliser x c = return (x,c)
+
+-- | Sugar for inserting the runner `costRunner` inbetween
+-- the user code @m@ and some enveloping runner.
+--
+-- As it stands, `costInstrumentation` is defined for a single
+-- effect @eff@. For instrumenting code that uses more than one
+-- effect, one can union the runner `costRunner` with itself
+-- using `unionRunners` suitably many times.
+costInstrumentation :: Member eff sig => User '[eff] a -> User sig (a,Int)
+costInstrumentation m =
+  run
+    costRunner
+    costInitialiser
+    m
+    costFinaliser