Mercurial > hg > Members > atton > delta_monad
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 |