This post is in Literate Haskell. The entire contents can be copied into a file called `PatternMaybe.lhs`

and will be compilable by GHC.

The code from this post is available on Hackage, in the first-class-patterns library.

In my previous post I developed difference type-lists with non-recursive append. Using that framework, we can solve the efficiency problem of my first attempt at nicer types for pattern combinators. At the same time, I find the implementation here easier to understand than the original one.

# Preliminaries

>{-# LANGUAGE TypeFamilies, TypeOperators, Rank2Types #-}> module PatternMaybe ( > Tuple, zero, one, (<>), > Fun, > Pattern(..), > Clause, (|||), match, (->>), > var, pair, mk1, left, right, cst, > test1, > ) where

We need the `D`

type and the `Difference`

class from the previous post

> import Difference > import Control.Monad(mplus) > import Data.Maybe(maybe) > import Control.Applicative

## (Curried) Functions

We define a type family of curried functions from `xs`

to `r`

, where `xs`

is a type list. This is the same family as `CurryFunc`

from my first post, but by a different name.

>-- | Curried functions.> type family Fun xs r > type instance Fun Nil r = r > type instance Fun (h:*:t) r = h -> Fun t r

## (CPSed) Tuples

We need tuples to store the variables bound by a pattern. If we CPS-encode the standard tuple type you get the following type, `Tuple'`

, for tuples. We then use the `Difference`

machinery (under the `D`

type) we developed in the previous to give `Tuple'`

an efficient append, which is the `Tuple`

type.

> newtype Tuple' xs = Tuple' { runTuple' :: forall r. Fun xs r -> r } > newtype Tuple xs = Tuple (D Tuple' xs)

The following functions manipulate `Tuple`

s:

> zero :: Tuple Nil > zero = Tuple zeroD

> one :: a -> Tuple (a:*:Nil) > one a = Tuple (mkOneD (\(Tuple' t) -> Tuple' (\k -> t (k a))))

> (<>) :: Tuple xs -> Tuple ys -> Tuple (xs:++:ys) > (Tuple xs) <> (Tuple ys) = Tuple (xs `plusD` ys)

> runTuple :: Tuple xs -> Fun xs r -> r > runTuple (Tuple t) = runTuple' (evalD (Tuple' id) t)

The first three are for building `Tuple`

s; the last is for using `Tuple`

s.

This representation of tuples as “differences” of CPS-encoded tuples is essentially the same as Morten Rhiger used in Section 3.2 of Type-safe pattern combinators.

# The `Pattern`

type

We can now define the `Pattern`

type and `Clause`

types. Unlike in Morten’s code (which I used in my first post), we handle failure using the `Maybe`

monad.

> newtype Pattern vars a = Pattern { runPattern :: a -> Maybe (Tuple vars) } > newtype Clause a r = Clause { runClause :: a -> Maybe r }

In the export list, the `Pattern`

type exposes its implementation. This is safe: the `Difference`

module defined in the previous post contains the trusted kernel and the only unsafe code.

The `Clause`

type is exported abstract. The following three combinators are sufficient for all uses of `Clause`

I am currently aware of; if new needs arise, a user can always define their own `Clause`

type, because the underlying `Pattern`

type is fully exposed.

> infix 2 ->> > infixr 1 ||| > (->>) :: Pattern vars a -> Fun vars r -> Clause a r > (Pattern p) ->> k = Clause (\a -> fmap (\f -> runTuple f k) (p a)) > (|||) :: Clause a r -> Clause a r -> Clause a r > l ||| r = Clause (\a -> runClause l a `mplus` runClause r a) > match :: a -> Clause a r -> r > match a c = maybe (error "match") id $ runClause c a

## Examples

I’ll define just a few combinators, to give an example of `Pattern`

’s use.

> var :: Pattern (a:*:Nil) a > var = Pattern (Just . one)

> pair :: Pattern as a -> Pattern bs b -> Pattern (as:++:bs) (a,b) > pair (Pattern m) (Pattern n) = Pattern (\(a,b) -> (<>) <$> (m a) <*> (n b))

>-- | Useful for building one-argument pattern combinators> mk1 :: (a -> Maybe b) -> (Pattern vars b -> Pattern vars a) > mk1 g (Pattern p) = Pattern (\a -> g a >>= p)

> left :: Pattern vars a -> Pattern vars (Either a b) > left = mk1 (either Just (const Nothing))

> right :: Pattern vars b -> Pattern vars (Either a b) > right = mk1 (either (const Nothing) Just)

> cst :: (Eq a) => a -> Pattern Nil a > cst x = Pattern (\a -> if a==x then Just zero else Nothing)

Now, we can put all of this together in a test example.

> test1 :: Either Int (Int, Int) -> Int > test1 a = match a $ > left (cst 4) ->> 0 > ||| left var ->> id > ||| right (pair var var) ->> (+)

> ex2 :: Num a => Either a (a,a) -> a > ex2 a = case a of > Left 4 -> 0 > Left x -> x > Right (x,y) -> x+y

If we compile this module with `-O2`

and look at the GHC Core output, we see that `test1`

is compiled to the following Core code:

PatternMaybe.$wtest1 :: Data.Either.Either Int (Int, Int) -> Int#PatternMaybe.$wtest1 = \ (a :: Data.Either.Either Int (Int, Int)) -> case a of a' { Data.Either.Left x -> case x of x' { I#x1 -> case x1 of x1' {__DEFAULT-> x1'; 4 -> 0 } }; Data.Either.Right y -> case y of y' { (a3, b) -> case a3 of a3' { I#x -> case b of b' { I#y -> +# x y } } } }

So, `test1`

has been compiled to a standard Haskell pattern match. So the overhead has been completely optimised away, as we wanted.

The first-class-patterns library on Hackage is based on this implementation, and has more combinators. Have a look there for more.