@@ -3,21 +3,28 @@
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
5module Strands.Log
5module Strands.Log
6− ( Log(..)
9+ , Log (..)
7− , LogElem(..)
10+ , IDynamic (..)
11−import Control.Exception (SomeException, catch)
16+import Unsafe.Coerce (unsafeCoerce)
12−import Data.Dynamic (Typeable, typeOf)
13−import System.IO.Unsafe (unsafePerformIO)
15------------------------------------------------------------------------------
18------------------------------------------------------------------------------
16-- Log types
19-- Log types
17------------------------------------------------------------------------------
20------------------------------------------------------------------------------
19-- | Constraint type synonym for a value that can be logged.
22-- | Constraint type synonym for a value that can be logged.
20−type Loggable a = (Show a, Read a, Typeable a)
23+type Loggable a = (Show a, Read a)
25+------------------------------------------------------------------------------
27+------------------------------------------------------------------------------
22-- | Dynamic serializable data for logging.
29-- | Dynamic serializable data for logging.
23data IDynamic =
30data IDynamic =
@@ -28,27 +35,29 @@ instance Show IDynamic where
28 show (IDynamic x) = show (show x)
35 show (IDynamic x) = show (show x)
29 show (IDyns s) = show s
36 show (IDyns s) = show s
31−readWithErr :: (Typeable a, Read a) => String -> IO [(a, String)]
38+instance Read IDynamic where
32−readWithErr line =
39+ readsPrec _ str = map (\(x,s) -> (IDyns x,s)) $ readsPrec 0 str
33− (v `seq` return [(v, left)])
34− `catch` (\(_ :: SomeException) ->
35− error $ "read error trying to read type: \"" ++ show (typeOf v)
36− ++ "\" in: " ++ " <" ++ show line ++ "> ")
37− where [(v, left)] = readsPrec 0 line
39−readsPrec' :: (Typeable a, Read a) => t -> String -> [(a, String)]
41+fromIDyn :: Loggable a => IDynamic -> a
40−readsPrec' _ = unsafePerformIO . readWithErr
42+fromIDyn (IDynamic x) = r
43+ where r = unsafeCoerce x
42−instance Read IDynamic where
45+fromIDyn (IDyns s) = r `seq` r
43− readsPrec n str = map (\(x,s) -> (IDyns x,s)) $ readsPrec' n str
46+ where r = read s
45−data LogElem = Wait | Exec | Var IDynamic
48+toIDyn :: Loggable a => a -> IDynamic
46− deriving (Read, Show)
49+toIDyn x = IDynamic x
48−type Recover = Bool
51+------------------------------------------------------------------------------
49−type CurrentPointer = [LogElem]
52+-- Log
50−type LogEntries = [LogElem]
53+------------------------------------------------------------------------------
56+ Executing -- we are inside this computation, not yet done
57+ | Waiting -- the computation is done and it returned mzero
58+ | Result IDynamic -- computation is done and we have the result to replay
59+ deriving (Read, Show)
52−data Log = Log Recover CurrentPointer LogEntries
61+type Replaying = Bool
53− deriving (Typeable, Show)
63+data Log = Log Replaying [LogEntry] deriving (Show)