Mercurial > hg > Members > atton > delta_monad

comparison delta.hs @ 58:1229ee398567

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Mini fixes
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Sat, 22 Nov 2014 12:34:06 +0900
parents dfcd72dc697e
children 46b15f368905
comparison
equal deleted inserted replaced
57:dfcd72dc697e 58:1229ee398567
1 import Control.Applicative 1 import Control.Applicative
2 import Data.Numbers.Primes -- $ cabal install primes 2 import Data.Numbers.Primes -- $ cabal install primes
3 3
4 -- delta definition
5
4 data Delta a = Mono a | Delta a (Delta a) deriving Show 6 data Delta a = Mono a | Delta a (Delta a) deriving Show
7
8 -- basic functions
5 9
6 deltaAppend :: Delta a -> Delta a -> Delta a 10 deltaAppend :: Delta a -> Delta a -> Delta a
7 deltaAppend (Mono x) d = Delta x d 11 deltaAppend (Mono x) d = Delta x d
8 deltaAppend (Delta x d) ds = Delta x (deltaAppend d ds) 12 deltaAppend (Delta x d) ds = Delta x (deltaAppend d ds)
9 13
10 headDelta :: Delta a -> Delta a 14 headDelta :: Delta a -> Delta a
11 headDelta d@(Mono _) = d 15 headDelta d@(Mono _) = d
12 headDelta (Delta x _) = Mono x 16 headDelta (Delta x _) = Mono x
13 17
14 tailDelta :: Delta a -> Delta a 18 tailDelta :: Delta a -> Delta a
15 tailDelta d@(Mono _) = d 19 tailDelta d@(Mono _) = d
16 tailDelta (Delta _ ds) = ds 20 tailDelta (Delta _ ds) = ds
21
22 -- instance definitions
17 23
18 instance Functor Delta where 24 instance Functor Delta where
19 fmap f (Mono x) = Mono (f x) 25 fmap f (Mono x) = Mono (f x)
20 fmap f (Delta x d) = Delta (f x) (fmap f d) 26 fmap f (Delta x d) = Delta (f x) (fmap f d)
21 27
24 (Mono f) <*> (Mono x) = Mono (f x) 30 (Mono f) <*> (Mono x) = Mono (f x)
25 df@(Mono f) <*> (Delta x d) = Delta (f x) (df <*> d) 31 df@(Mono f) <*> (Delta x d) = Delta (f x) (df <*> d)
26 (Delta f df) <*> d@(Mono x) = Delta (f x) (df <*> d) 32 (Delta f df) <*> d@(Mono x) = Delta (f x) (df <*> d)
27 (Delta f df) <*> (Delta x d) = Delta (f x) (df <*> d) 33 (Delta f df) <*> (Delta x d) = Delta (f x) (df <*> d)
28 34
29
30 instance Monad Delta where 35 instance Monad Delta where
31 return x = Mono x 36 return x = Mono x
32 (Mono x) >>= f = f x 37 (Mono x) >>= f = f x
33 (Delta x d) >>= f = (headDelta (f x)) `deltaAppend` (d >>= (tailDelta . f)) 38 (Delta x d) >>= f = (headDelta (f x)) `deltaAppend` (d >>= (tailDelta . f))
39
40
41 -- utils
34 42
35 returnS :: (Show s) => s -> Delta s 43 returnS :: (Show s) => s -> Delta s
36 returnS x = Mono x 44 returnS x = Mono x
37 45
38 returnSS :: (Show s) => s -> s -> Delta s 46 returnSS :: (Show s) => s -> s -> Delta s
39 returnSS x y = (returnS x) `deltaAppend` (returnS y) 47 returnSS x y = (returnS x) `deltaAppend` (returnS y)
48
49 deltaFromList :: [a] -> Delta a
50 deltaFromList = (foldl1 deltaAppend) . (fmap return)
40 51
41 52
42 -- samples 53 -- samples
43 54
44 generator :: Int -> Delta [Int] 55 generator :: Int -> Delta [Int]