mirror of
https://github.com/danelahman/haskell-coop.git
synced 2024-10-26 11:08:20 +03:00
Example of a runner for instrumenting user code with a simple cost model
This commit is contained in:
parent
32f8029245
commit
182b5e1d4e
93
examples/without_signals/CostTests.hs
Normal file
93
examples/without_signals/CostTests.hs
Normal file
@ -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
|
@ -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,
|
||||
|
73
src/Control/Runner/Cost.hs
Normal file
73
src/Control/Runner/Cost.hs
Normal file
@ -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
|
Loading…
Reference in New Issue
Block a user