200 likes | 364 Views
Stateful Aspects. Monitoring and Lazy Semantics. Base program. fact :: Int -> Int -> Int fact n acc = if n == 0 then acc else fact (n - 1 ) (acc * n) Purely functional Don ’ t know the existence of imperative monitor. Aspects and Syntactic Sugar.
E N D
Stateful Aspects Monitoring and Lazy Semantics
Base program • fact :: Int -> Int -> Int • fact n acc =if n == 0 then accelse fact (n -1) (acc * n) • Purely functional • Don’t know the existence of imperative monitor
Aspects and Syntactic Sugar • var indent :: String ="" • monitor@aspect around{fact} (arg) = \acc ->let ind = getIndent setIndent ("| "++ ind); putMsg $ ind ++"fact is call with "++ show arg;let result = proceed arg acc in setIndent ind; putMsg $ ind ++"`returns "++ show result; result
Aspects and Syntactic Sugar (cont.) • times_monitor@aspect around{(*)} (lhs)=\rhs ->let ind = getIndent setIndent ("| "++ ind); putMsg $ ind ++ show lhs ++" times "++ show rhs ++" is called";let result = proceed lhs rhs in setIndent ind; putMsg $ ind ++"`returns "++ show result; result
Desugared UserState • data UserState = U{ indent :: String }deriving Show • emptyUserState = U{ indent = "" } • getIndent :: S String • getIndent = getUserState >>=\u -> return $ indent u • setIndent :: String -> S () • setIndent ind = modifyUserState $\u -> u{ indent = ind }
API for Accessing Internal State • type S a = State (UserState, InternalState) a • type M a = S a • runM = runState • emptyM = (emptyUserState, emptyInternalState) • type InternalState = [String] • emptyInternalState = [] • putMsg :: String -> M () • putMsg str = modify $\(u, s) -> (u, str:s) • putMsgs :: [String] -> M () • putMsgs strs = modify $\(u, s) -> (u, strs ++ s) • getUserState :: M UserState • getUserState = gets fst • modifyUserState :: (UserState -> UserState) -> M () • modifyUserState trans = modify $\(u, s) -> (trans u, s)
Translated Advice (orig.) • times_monitor :: M (M Int -> M (M Int -> M Int))->M (M Int -> M (M Int -> M Int)) • times_monitor proceed = return $\lhs -> return $\rhs ->do ind <- getIndentsetIndent ("| "++ ind) lhs' <- lhs; rhs' <- rhs putMsg $ ind ++ show lhs' ++" times "++ show rhs' ++" is called"p <- proceed; p' <- p lhs; result <- p' rhs setIndent ind putMsg $ ind ++"`returns "++ show result return result Bind out for every applica-tion
Translated Base Program • fact_chain :: M (M Int -> M (M Int -> M Int)) • fact_chain = monitor fact_body -- <fact_body, {monitor}> • fact_body :: M (M Int -> M (M Int -> M Int)) • fact_body = return $\n -> return $\acc ->let eq a b = a >>=\a' -> b >>=\b' -> return (a' == b') sub a b = a >>=\a' -> b >>=\b' -> return (a' - b') zero = return 0 one = return 1indo eq_n_zero <- eq n zeroif eq_n_zero then accelsedo t <- times_chain t' <- t n f <- fact_chain f' <- f (sub n one) f' (t' acc) Monadic all built-in functions and constants
Test Bed • runFact :: Int -> (Int, (UserState, [String])) • runFact n = runM (do f <- fact_chain f' <- f (return n) f' (return 1) ) emptyM
Result from the lhs' <- lhs; rhs' <- rhsputMsg $ ind ++ show lhs' ++" times "++show rhs'++" is called" Montor Result (orig.) *Main> mapM_ putStrLn $ reverse $ snd $ snd $ runFact 3 fact is call with 3 | fact is call with 2 | | fact is call with 1 | | | fact is call with 0 | | | | | | 3 times 1 is called | | | | | | `returns 3 | | | | | 2 times 3 is called | | | | | | 3 times 1 is called | | | | | | `returns 3 | | | | | `returns 6 | | | | 1 times 6 is called | | | | | | 3 times 1 is called | | | | | | `returns 3 | | | | | 2 times 3 is called | | | | | | 3 times 1 is called | | | | | | `returns 3 | | | | | `returns 6 | | | | `returns 6 | | | `returns 6 | | `returns 6 | `returns 6 `returns 6
Solution • Viewing "M a" as a "thunk" holding a value typed "a", the solution is to build updatable thunks. • Well known way to do so: • Environment mapping variables (names) to locations • Store is updatable. • (M a) holds an integer • A store passed inside monad
CState: Cached State Monad • import qualified Data.Map as M • newtype CState s a = CState{ realrunCState :: (s, CacheSet) -> (Either a Int, (s, CacheSet))} • data Cell = forall s a. Cell Bool (CState s a)-- Cell Ever_used Thunk • type CacheSet = M.Map Int (Maybe Cell) • If (cs :: CState s a) (st, ca) = Right i • then (lookup i ca) has the form Just (Just (Cell b (ca :: (CState s a)))) • It exists, and the value in it has the same type.
CState (cont.) • instance Monad (CState s) • instance MonadState s (CState s) • getNewCache :: CState Int • mkCache :: Int -> CState s a -> CState s a • fromCell :: Cell -> (s, CacheSet) -> (Either a Int, (s, CacheSet)) • Used GHC.Prim.unsafeCoarce# • fromCacheEither :: Either a Int -> (s, CacheSet) -> (a, (s, CacheSet))
Allocate cache location before consuming the last argument Put the monad into the location Location allocated Thunk made, location filled Translated Advice (with CState) • times_monitor proceed = return $\lhs -> getNewCache >>=\cacheN -> return $\rhs -> mkCache cacheN $do ind <- getIndent …… • t <- times_chaint' <- t nf' (t' acc)
Result from the lhs' <- lhs; rhs' <- rhsputMsg $ ind ++ show lhs' ++" times "++show rhs'++" is called" Multiplication result cached, thus not do the “times” body twice. Monitor Result (with CState) *Main> mapM_ putStrLn $ reverse $ snd $ snd $ runFact 3 fact is call with 3 | fact is call with 2 | | fact is call with 1 | | | fact is call with 0 | | | | | | 3 times 1 is called | | | | | | `returns 3 | | | | | 2 times 3 is called | | | | | | 3 times 1 is called | | | | | | `returns 3 | | | | | `returns 6 | | | | 1 times 6 is called | | | | | | 3 times 1 is called | | | | | | `returns 3 | | | | | 2 times 3 is called | | | | | | 3 times 1 is called | | | | | | `returns 3 | | | | | `returns 6 | | | | `returns 6 | | | `returns 6 | | `returns 6 | `returns 6 `returns 6
Resolving the advice interference • showM :: M Int -> String • showM :: (M Int -> M String) is more natural but complicated to use • unserialize :: CacheSet -> String -> String • Find the substrings encoded by showM and decode by the CacheSet
Translated Advice (final) • times_monitorM :: M (M Int -> M (M Int -> M Int))-> M (M Int -> M (M Int -> M Int)) • times_monitorM proceed = return $\lhs -> getNewCache >>=\cacheN -> return $\rhs -> mkCache cacheN $do ind <- getIndent setIndent ("| "++ ind) putMsg $ ind ++ showM lhs ++" times "++ showM rhs ++" is called" p <- proceed; p' <- p lhs; result <- p' rhs setIndent ind putMsg $ ind ++"`returns "++ show result return result
Monitor Result (final) *Main> mapM_ putStrLn $ reverse $ snd $ snd $ runFactM 3 fact is call with 3 | fact is call with 2 | | fact is call with 1 | | | fact is call with 0 | | | | 1 times 6 is called | | | | | 2 times 3 is called | | | | | | 3 times 1 is called | | | | | | `returns 3 | | | | | `returns 6 | | | | `returns 6 | | | `returns 6 | | `returns 6 | `returns 6 `returns 6 *Main> mapM_ putStrLn $ reverse $ snd $ snd $ runFactM' 3 fact is call with 3 | fact is call with 2 | | fact is call with 1 | | | fact is call with 0 | | | | 1 times <M'M:5| is called | | | | | 2 times <M'M:2| is called | | | | | | 3 times 1 is called | | | | | | `returns 3 | | | | | `returns 6 | | | | `returns 6 | | | `returns 6 | | `returns 6 | `returns 6 `returns 6
TODOs • Cooperating with Cflow’s reader monad • Use ReaderT • Formalize translation rules • Type translation is now like: • T(a -> b) = M (T(a) -> T(b)) • T(t) = M t • Expression translation • let => bind • Function app. => bind out function first • Lifting built-in functions and constants