[Haskell-cafe] Re: Pattern combinators
Massimiliano Gubinelli
m.gubinelli at gmail.com
Sat Jan 3 16:06:26 EST 2009
David Menendez <dave <at> zednenem.com> writes:
>
> On Sun, Dec 21, 2008 at 10:14 PM, Andrew Wagner
> <wagner.andrew <at> gmail.com> wrote:
> > I'd love to see a copy of this go up on hackage for experimentation.
>> Would
> > you care to upload your code, or send it to me so I can upload it?
>
> I've uploaded my latest version to <http://hpaste.org/13263>. It
> explicitly makes patterns polymorphic over the answer type of the case
> statement by making Pattern a newtype and universally quantifying the
> (un)currying and matching functions.
>
> For example,
>
> (->>) :: Pattern a () vec -> Curry vec ans -> Case a ans
>
> I'm not sure it makes sense to create a package just yet. At the very
> least, you should ask Morten Rhiger first. The type signatures are
> mine, but the code is mostly straight transcriptions from his paper.
>
Hi,
I've tried to undestand the paper, in particular the relation between
the combinators written in cps style and combinators written using a
Maybe type (i.e pattern matching functions returning Maybe to signal
success or failure). The code below gives an implementation of the
basic pattern matching functions on top of two possible implementation
of an abstract interface for building and using bindings. In particular
using type families it seems to be possible to automatically construct a
function inj to convert between a function in the form a->b->c->d to a
function in the form (a,(b,c,())) -> d, thereby removing the need of
building such coverter via the pattern matching functions like suggested
in the paper.
Since I'm an Haskell begineer I would appreciate very much comments or
suggestions for improvements.
Best,
Massimiliano Gubinelli
Here the code:
-----------------------------------
{-# LANGUAGE TypeFamilies, MultiParamTypeClasses,
FlexibleInstances, RankNTypes #-}
module PM where
-- inj converts a function of the form a -> b -> c -> d to the
-- uniform representation (a,(b,(c,()))) -> d
class Fn a c where
type Fnq a c
inj :: Fnq a c -> a -> c
instance Fn () c where
type Fnq () c = c
inj f () = f
instance Fn b c => Fn (a,b) c where
type Fnq (a,b) c = a -> Fnq b c
inj f (a,b) = inj (f a) b
-- pattern matching, cps style
-- a binding function has three inputs: ks kf v. v is a list of
-- current bindings.
newtype PatA a b = PatA {
unPatA :: forall ans. (b -> ans) -> ans -> a -> ans
}
applyA :: PatA a b -> (b -> c) -> c -> a -> c
applyA (PatA p) ks kf v = p ks kf v
meetA :: PatA a b -> PatA b c -> PatA a c
meetA (PatA a) (PatA b) = PatA $ \ ks kf -> a (b ks kf) kf
joinA :: PatA a b -> PatA a b -> PatA a b
joinA (PatA a) (PatA b) = PatA $ \ ks kf v -> a ks (b ks kf v) v
anyA :: PatA a a
anyA = PatA $ \ ks kf -> ks
noneA :: PatA a a
noneA = PatA $ \ ks kf v -> kf
varA :: x -> PatA a (x,a)
varA x = PatA $ \ ks kf v -> ks (x,v)
pairA a b (x,y) = meetA (a x) (b y)
conA a x = if a == x then anyA else noneA
andA a b x = meetA (a x) (b x)
orA p n x = joinA (p x) (n x)
matchA val pat = pat val ()
caseA a fa fb x v = applyA (a x) (inj fa) (fb x v) v
otherwiseA kf = \x v -> kf
isA p x = matchA x $ caseA p (\_ -> True) $ otherwiseA False
testA1 z = matchA z $ caseA (conA (1,2)) ("first match") $
caseA (pairA (conA 1) varA)
(\x -> "second match " ++ show x) $
caseA (pairA varA varA)
(\x y -> "third match " ++ show x) $
otherwiseA "mismatch"
-- pattern matching, Maybe style
-- a binding function receives a list of current bindings and returns
-- a Maybe type containing the list of updated bindings in case of
-- success
newtype PatB a b = PatB { unPatB :: a -> Maybe b }
applyB :: PatB a b -> (b -> c) -> c -> a -> c
applyB (PatB p) ks kf v = maybe kf ks (p v)
meetB :: PatB a b -> PatB c a -> PatB c b
meetB (PatB a) (PatB b) = PatB $ \v -> (b v) >>= a
joinB :: PatB a b -> PatB a b -> PatB a b
joinB (PatB a) (PatB b) = PatB $ \v -> maybe (b v) Just (a v)
anyB :: PatB a a
anyB = PatB $ \v -> Just v
noneB :: PatB a a
noneB = PatB $ \v -> Nothing
varB :: x -> PatB a (x,a)
varB x = PatB $ \v -> Just (x,v)
pairB a b (x,y) = meetB (a x) (b y)
conB a x = if a == x then anyB else noneB
orB a b x = joinB (a x) (b x)
andB a b x = meetB (a x) (b x)
matchB val pat = pat val ()
--caseB a fa fb x v = maybe (fb x v) (inj fa) ((unPatB $ a x) v)
caseB a fa fb x v = applyB (a x) (inj fa) (fb x v) v
otherwiseB f = \x v -> f
isB p x = matchB x $ caseB p (\_ -> True) $ otherwiseB False
testB1 z = matchB z $ caseB (pairB (conB 1) (conB 2)) ("first match") $
caseB (pairB (conB 1) varB) (\x -> "second match " ++ show x) $
caseB (pairB varB varB) (\x y -> "third match " ++ show x) $
otherwiseB "mismatch"
More information about the Haskell-Cafe
mailing list