Mercurial > hg > Papers > 2015 > atton-thesis

annotate src/orig/Delta.hs @ 53:ca389989b660

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add original sources
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Sun, 15 Feb 2015 22:38:43 +0900
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
53
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
1 module Delta ( Delta(..) , deltaAppend , headDelta , tailDelta , deltaFromList) where
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
2
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
3 import Control.Applicative
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
4
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
5
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
6 -- Delta definition
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
7
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
8 data Delta a = Mono a | Delta a (Delta a) deriving Show
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
9
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
10 instance (Eq a) => Eq (Delta a) where
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
11 (Mono x) == (Mono y) = x == y
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
12 (Mono _) == (Delta _ _) = False
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
13 (Delta x xs) == (Delta y ys) = (x == y) && (xs == ys)
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
14
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
15 -- basic functions
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
16
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
17 deltaAppend :: Delta a -> Delta a -> Delta a
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
18 deltaAppend (Mono x) d = Delta x d
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
19 deltaAppend (Delta x d) ds = Delta x (deltaAppend d ds)
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
20
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
21 headDelta :: Delta a -> a
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
22 headDelta (Mono x) = x
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
23 headDelta (Delta x _) = x
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
24
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
25 tailDelta :: Delta a -> Delta a
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
26 tailDelta d@(Mono _) = d
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
27 tailDelta (Delta _ ds) = ds
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
28
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
29 -- instance definitions
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
30
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
31 instance Functor Delta where
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
32 fmap f (Mono x) = Mono (f x)
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
33 fmap f (Delta x d) = Delta (f x) (fmap f d)
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
34
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
35 instance Applicative Delta where
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
36 pure f = Mono f
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
37 (Mono f) <*> (Mono x) = Mono (f x)
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
38 df@(Mono f) <*> (Delta x d) = Delta (f x) (df <*> d)
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
39 (Delta f df) <*> d@(Mono x) = Delta (f x) (df <*> d)
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
40 (Delta f df) <*> (Delta x d) = Delta (f x) (df <*> d)
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
41
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
42 bind :: (Delta a) -> (a -> Delta b) -> (Delta b)
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
43 bind (Mono x) f = f x
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
44 bind (Delta x d) f = Delta (headDelta (f x)) (bind d (tailDelta . f))
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
45
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
46 mu :: (Delta (Delta a)) -> (Delta a)
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
47 mu d = bind d id
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
48
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
49 instance Monad Delta where
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
50 return x = Mono x
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
51 d >>= f = mu $ fmap f d
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
52
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
53 -- utils
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
54
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
55 deltaFromList :: [a] -> Delta a
ca389989b660 Add original sources
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
56 deltaFromList = (foldl1 deltaAppend) . (fmap return)