Mercurial > hg > Members > atton > delta_monad

comparison delta.hs @ 83:6635a513f81a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add example for DeltaM
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Sun, 04 Jan 2015 17:20:33 +0900
parents 1339772b2e36
children 8c7bd8bf8092
comparison
equal deleted inserted replaced
82:1339772b2e36 83:6635a513f81a
1 import Control.Applicative 1 import Control.Applicative
2 import Control.Monad.Writer
2 import Data.Numbers.Primes -- $ cabal install primes 3 import Data.Numbers.Primes -- $ cabal install primes
3 4
4 -- delta definition 5 -- delta definition
5 6
6 data Delta a = Mono a | Delta a (Delta a) deriving Show 7 data Delta a = Mono a | Delta a (Delta a) deriving Show
104 tailDeltaM (DeltaM (Delta _ d)) = DeltaM d 105 tailDeltaM (DeltaM (Delta _ d)) = DeltaM d
105 106
106 appendDeltaM :: DeltaM m a -> DeltaM m a -> DeltaM m a 107 appendDeltaM :: DeltaM m a -> DeltaM m a -> DeltaM m a
107 appendDeltaM (DeltaM d) (DeltaM dd) = DeltaM (deltaAppend d dd) 108 appendDeltaM (DeltaM d) (DeltaM dd) = DeltaM (deltaAppend d dd)
108 109
110 checkOut :: Int -> DeltaM m a -> m a
111 checkOut 0 (DeltaM (Mono x)) = x
112 checkOut 0 (DeltaM (Delta x _)) = x
113 checkOut n (DeltaM (Mono x)) = x
114 checkOut n (DeltaM (Delta _ d)) = checkOut (n-1) (DeltaM d)
115
109 116
110 -- DeltaM instance definitions 117 -- DeltaM instance definitions
111 118
112 instance (Functor m) => Functor (DeltaM m) where 119 instance (Functor m) => Functor (DeltaM m) where
113 fmap f (DeltaM d) = DeltaM $ fmap (fmap f) d 120 fmap f (DeltaM d) = DeltaM $ fmap (fmap f) d
126 ((DeltaM d) >>= tailDeltaM . f) 133 ((DeltaM d) >>= tailDeltaM . f)
127 134
128 135
129 -- DeltaM examples 136 -- DeltaM examples
130 137
131 val :: DeltaM [] Int 138 -- DeltaM example utils
132 val = DeltaM $ deltaFromList [[10, 20], [1, 2, 3], [100,200,300], [0]] 139 type DeltaLog = Writer [String]
133 140
134 func :: Int -> DeltaM [] Int 141 returnW :: (Show a) => a -> DeltaLog a
135 func x = DeltaM $ deltaFromList [[x+1, x+2, x+3], 142 returnW x = do tell $ [show x]
136 [x*x], 143 return x
137 [x, x, x, x]] 144
145 dmap :: (m a -> b) -> DeltaM m a -> Delta b
146 dmap f (DeltaM (Mono mx)) = (Mono $ f mx)
147 dmap f (DeltaM (Delta x d)) = Delta (f x) (dmap f (DeltaM d))
148
149
150 -- example : prime filter
151 -- usage : runWriter $ checkOut 0 $ primeCountM 30 -- run specific version
152 -- : dmap runWriter $ primeCountM 30 -- run all version
153
154 generatorM :: Int -> DeltaM DeltaLog [Int]
155 generatorM x = let intList = returnW [1..x] in
156 DeltaM $ deltaFromList $ [intList, intList]
157
158 primeFilterM :: [Int] -> DeltaM DeltaLog [Int]
159 primeFilterM xs = let primeList = filter isPrime xs
160 refactorList = filter even xs in
161 DeltaM $ deltaFromList $ fmap returnW [primeList, refactorList]
162
163
164 countM :: [Int] -> DeltaM DeltaLog Int
165 countM xs = let primeCount = length xs in
166 DeltaM $ deltaFromList $ fmap returnW [primeCount, primeCount]
167
168 primeCountM :: Int -> DeltaM DeltaLog Int
169 primeCountM x = generatorM x >>= primeFilterM >>= countM