comparison haskell/DeltaM.hs @ 134:3f48bd08865f

Rename and split with module for haskell codes
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Fri, 06 Feb 2015 16:28:54 +0900
parents
children
comparison
equal deleted inserted replaced
133:7984c9f4b5eb 134:3f48bd08865f
1 module DeltaM (DeltaM(..), unDeltaM, appendDeltaM, tailDeltaM, headDeltaM, checkOut) where
2
3 import Control.Applicative
4 import Delta
5
6
7 -- DeltaM definition (Delta with Monad)
8
9 data DeltaM m a = DeltaM (Delta (m a)) deriving (Show)
10
11
12 -- DeltaM utils
13
14 unDeltaM :: DeltaM m a -> Delta (m a)
15 unDeltaM (DeltaM d) = d
16
17 headDeltaM :: DeltaM m a -> m a
18 headDeltaM (DeltaM d) = headDelta d
19
20 tailDeltaM :: DeltaM m a -> DeltaM m a
21 tailDeltaM (DeltaM d) = DeltaM $ tailDelta d
22
23 appendDeltaM :: DeltaM m a -> DeltaM m a -> DeltaM m a
24 appendDeltaM (DeltaM d) (DeltaM dd) = DeltaM (deltaAppend d dd)
25
26 checkOut :: Int -> DeltaM m a -> m a
27 checkOut 0 (DeltaM (Mono x)) = x
28 checkOut 0 (DeltaM (Delta x _)) = x
29 checkOut n (DeltaM (Mono x)) = x
30 checkOut n (DeltaM (Delta _ d)) = checkOut (n-1) (DeltaM d)
31
32
33 -- DeltaM instance definitions
34
35 instance (Functor m) => Functor (DeltaM m) where
36 fmap f (DeltaM d) = DeltaM $ fmap (fmap f) d
37
38 instance (Applicative m) => Applicative (DeltaM m) where
39 pure f = DeltaM $ Mono $ pure f
40 (DeltaM (Mono f)) <*> (DeltaM (Mono x)) = DeltaM $ Mono $ f <*> x
41 df@(DeltaM (Mono f)) <*> (DeltaM (Delta x d)) = appendDeltaM (DeltaM $ Mono $ f <*> x) (df <*> (DeltaM d))
42 (DeltaM (Delta f df)) <*> dx@(DeltaM (Mono x)) = appendDeltaM (DeltaM $ Mono $ f <*> x) ((DeltaM df) <*> dx)
43 (DeltaM (Delta f df)) <*> (DeltaM (Delta x dx)) = appendDeltaM (DeltaM $ Mono $ f <*> x) ((DeltaM df) <*> (DeltaM dx))
44
45
46 mu' :: (Functor m, Monad m) => DeltaM m (DeltaM m a) -> DeltaM m a
47 mu' d@(DeltaM (Mono _)) = DeltaM $ Mono $ (>>= id) $ fmap headDeltaM $ headDeltaM d
48 mu' d@(DeltaM (Delta _ _)) = DeltaM $ Delta ((>>= id) $ fmap headDeltaM $ headDeltaM d)
49 (unDeltaM (mu' (fmap tailDeltaM (tailDeltaM d))))
50
51 instance (Functor m, Monad m) => Monad (DeltaM m) where
52 return x = DeltaM $ Mono $ return x
53 d >>= f = mu' $ fmap f d
54
55
56