Reiner Pope

July 19, 2009

Building first-class patterns, continued.

Filed under: pattern-combinators — Reiner Pope @ 1:50 am
Tags:

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 Tuples:

> 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 Tuples; the last is for using Tuples.

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.

About these ads

Leave a Comment »

No comments yet.

RSS feed for comments on this post. TrackBack URI

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

The Rubric Theme. Create a free website or blog at WordPress.com.

Follow

Get every new post delivered to your Inbox.

%d bloggers like this: