1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
|
-----------------------------------------------------------------------------
-- |
-- Module : Harp.Match
-- Copyright : (c) Niklas Broberg 2004,
-- License : BSD-style (see the file LICENSE.txt)
--
-- Maintainer : Niklas Broberg, d00nibro@dtek.chalmers.se
-- Stability : experimental
-- Portability : portable
--
-- Functions that simulate the behavior of regular patterns
-- using a Match monad for parsing lists.
-----------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
module Harp.Match (
Match -- Match e a
, runMatch -- Match e a -> [e] -> Maybe a
, baseMatch -- (a -> Maybe b) -> Match a (a, b)
, manyMatch -- Match e a -> Match e [a]
, gManyMatch -- Match e a -> Match e [a]
, foldComp -- [[a] -> [a]] -> ([a] -> [a])
, unzip0, unzip1, unzip2, unzip3, unzip4, unzip5, unzip6, unzip7
, (+++)
) where
#if MIN_VERSION_base(4,8,0)
import Control.Monad (ap, liftM)
#endif
import Data.List (unzip3, unzip4, unzip5, unzip6, unzip7)
--------------------------------------------------------------
-- | The Match monad
newtype Match e a = Match ([e] -> [(a, [e])])
(+++) :: Match e a -> Match e a -> Match e a
(Match f) +++ (Match g) = Match (\es -> let aes1 = f es
aes2 = g es
in aes1 ++ aes2)
#if MIN_VERSION_base(4,8,0)
instance Applicative (Match e) where
(<*>) = ap
pure = return
instance Functor (Match e) where
fmap = liftM
#endif
instance Monad (Match e) where
return x = Match (\es -> [(x, es)])
(Match f) >>= k = Match (\es -> let aes = f es
in concatMap help aes)
where help (a, es) = let Match g = k a
in g es
mfail :: Match e a
mfail = Match $ \_ -> []
runM :: Match e a -> [e] -> [a]
runM (Match f) es = let aes = f es
in map fst $ filter (null . snd) aes
getElement :: Match e e
getElement = Match $ \es -> case es of
[] -> []
(x:xs) -> [(x,x:xs)]
discard :: Match e ()
discard = Match $ \es -> case es of
[] -> []
(_:xs) -> [((), xs)]
runMatch :: Match e a -> [e] -> Maybe a
runMatch m es = case runM m es of
[] -> Nothing
(a:_) -> Just a
baseMatch :: (a -> Maybe b) -> Match a (a, b)
baseMatch f = do e <- getElement
case f e of
Nothing -> mfail
Just b -> do discard
return (e, b)
gManyMatch :: Match e a -> Match e [a]
gManyMatch m = (do a <- m
as <- gManyMatch m
return (a:as))
+++ (return [])
manyMatch :: Match e a -> Match e [a]
manyMatch m = (return []) +++
(do a <- m
as <- manyMatch m
return (a:as))
foldComp :: [[a] -> [a]] -> ([a] -> [a])
foldComp = foldl (.) id
unzip0 :: [()] -> ()
unzip0 = const ()
unzip1 :: [a] -> [a]
unzip1 = id
unzip2 :: [(a,b)] -> ([a],[b])
unzip2 = unzip
{-
data M e a = Element (e -> M e a)
| Fail
| Return a (M e a)
instance Monad (M e) where
return x = Return x Fail
(Element f) >>= k = Element (\e -> f e >>= k)
Fail >>= k = Fail
(Return x m) >>= k = k x ++++ (m >>= k)
infix 5 ++++
(++++) :: M e a -> M e a -> M e a
Fail ++++ n = n
m ++++ Fail = m
Return x m ++++ n = Return x (m ++++ n)
m ++++ Return x n = Return x (m ++++ n)
Element f ++++ Element g = Element (\e -> f e ++++ g e)
runM :: M e a -> [e] -> [a]
runM (Element f) (e:es) = runM (f e) es
runM (Element _) [] = []
runM Fail _ = []
runM (Return x m) [] = x : runM m []
runM (Return _ m) es = runM m es
-- the continuation trick
newtype Match e a = Match ()
instance Monad (Match e) where
return x = Match (\k -> k x)
(Match f) >>= k = Match (\h -> f (\a -> let Match g = k a
in g h))
runMatch :: Match e a -> [e] -> [a]
runMatch (Match f) = runM (f return)
mfail :: Match e a
mfail = Match $ \_ -> Fail
-}
|