> instance (Applicative f, Num a) => Num (f a) where
>     (+) = liftA2 (+)
>     (*) = liftA2 (*)
>     ...

However, we never actually want to declare such a general instance as the one above, because it rules out instances which aren’t implemented via Applicative. Instead, a better approach is for some library to define

> applicativePlus  = liftA2 (+)
> applicativeTimes = liftA2 (*)
> ...

and then have everyone who wants the Applicative instance for their particular type (say, Foo) write

> instance Num (Foo a) where
>     (+) = applicativePlus
>     (*) = applicativeTimes
>     ...

Unfortunately, each instance we declare still needs to mention all 6 functions in the Num class. What I would like to do is to say to Haskell, “use the Applicative instance for Num”, and say it just once.¹

Here is a language extension that could allow you to do that. For want of a better name, I will refer to it as “Instance Datatypes” (ID).

> class cxt => C a1 ... an where
>    v1 :: ty1
>    ...
>    vn :: tyn

> data @C a1 ... an =
>    @C {
>       @v1 :: ty1,
>       ...
>       @vn :: tyn
>     }

> instance cxt => C ty1 ... tyn = expr

> d :: cxt => @C ty1 ... tyn
> d = expr
> instance cxt => C ty1 ... tyn where
>    v1 = @v1 d
>    ...
>    vn = @vn d

> buildEq :: (a -> a -> Bool) -> @Eq a
> buildEq eq = @Eq {
>                    (@==) = eq,
>                    (@/=) = \a b -> not (a `eq` b)
>                  }

> -- in some library:
> applicativeNum :: (Applicative f, Num a) => @Num (f a)
> applicativeNum = @Num {
>                     (@+) = liftA2 (+),
>                     (@*) = liftA2 (*),
>                     ...
>                   }
>
> -- when you actually want to declare an instance
> instance Num (MyApplicative Double) = applicativeNum

> -- in some library:
> type Converter a b = (a -> b, b -> a)
>
> -- in the class designer's library:
> class C a where ...
> liftC :: C a => Converter a b -> @C b
> liftC = ...
>
> -- in the class instantiator's library:
> newtype MyType = Wrap { unwrap :: SomeOtherType }
> instance C MyType = liftC (Wrap,unwrap)

> class Eq a where ...
> fromEquality :: (a -> a -> Bool) -> @Eq a
> fromEquality (==) = ...

> {-# LANGUAGE UndecidableInstances #-}
> class C a where
>     f :: a
>     g :: a

> h :: Num a => a
> h = 5^100 -- an "expensive" computatio

> instance Num a => C a where
>     f = ... h ...
>     g = ... h ...

> mkC :: Num a => @C a
> mkC = let h = 5^100 in @C { @f = ... h ... , @g = ... h ... }
> instance Num a => C a = mkC

> instance cxt => C ty1 ... tyn = expr where
>     type TyFam1 ty1 ... tyn = tty1
>     ...
>     type TyFamk ty1 ... tyn = ttyk

Suppose I have an algorithm which imperatively builds two result arrays, and once I have built the result arrays, they will remain constant while I continue to read from them. I need to use a monad for the imperative part, but once I have finished that part, I will want to use the arrays as pure (immutable) arrays so that I don’t need to carry the monad around. I want my code to be efficient, so I won’t tolerate copying the data of the arrays: a mutable array and its corresponding immutable array must refer to the same data.

I don’t know how to do this with current array/ST libraries without using an “unsafe” function like unsafeFreeze. The difficulty comes from needing more than one result arrays: if we only needed one, we could use runSTArray, which has the following type signature¹:

runSTArray :: (forall s. ST s (STArray s a)) -> Array a

We can see the problem in this type signature: each time we run the ST monad, we can only produce one array. I have found one way to address this problem. The main idea is to split the ST monad into two distinct stages: the “normal” stage, which is followed by the “freezing” stage. Reading and writing are permitted in the normal stage, and reading and freezing are permitted in the the freezing stage. This policy ensures that, once we have access to the immutable array, no further writing is permitted. Note that constructing a new array is safe in either stage, but rather pointless in the freezing stage as the array cannot be written to. I rewrite ST as an indexed monad (from category-extras) to enforce the sequencing of the freezing stage after the normal stage:

> {-# LANGUAGE EmptyDataDecls, Rank2Types #-}
> import Control.Monad.Indexed
>
> data ST s t a -- = ...      -- exported abstract
> instance IxFunctor ST
> instance IxPointed ST
> instance IxApplicative ST
> instance IxMonad ST

> data STArray s a -- = ...
> data Array a -- = ...

I make two empty types to label the stages with:

> data Normal s
> data Freezing s

We have construction, read, write, and freeze operations, each of which encode which stages they may be performed in:

> newArray :: Int -> a -> ST (Normal s) (Normal s) (STArray s a)
> readArray :: STArray s a -> Int -> ST (stg s) (stg s) a
> writeArray :: STArray s a -> Int -> a -> ST (Normal s) (Normal s) ()
> freezeArray :: STArray s a -> ST (Freezing s) (Freezing s) (Array a)

The readArray is polymorphic in the stage, as it can be performed in either stage.

The following operation transitions from the first to the second phase:

> beginFreezeStage :: ST (Normal s) (Freezing s) ()

Operationally, this is a no-op.

Finally, we have the new runST, which accepts ST operations starting and ending in either stage:

> runST :: (forall s. ST (stg1 s) (stg2 s) a) -> a

Using this interface, we can freeze both arrays safely in our initial problem, although this library would internally use unsafeFreezeArray:

> runAlgorithm :: ST (Normal s) (Freezing s) (Array Double, Array Double)
> runAlgorithm =
>     newArray 10 (0 :: Double) >>>= \a ->
>     newArray 20 (0 :: Double) >>>= \b ->
>     writeArray a 5 3 >>>= \_ ->
>     readArray b 4 >>>= \_val ->
>     -- and do some more stuff with the array
>     beginFreezeStage >>>= \_ ->
>     freezeArray a >>>= \fa ->
>     freezeArray b >>>= \fb ->
>     ireturn (fa,fb)

Edit: I realise now that the beginFreezeStage operator isn’t necessary; by a small modification of the types, we can make the freeze stage start when some form of freeze is first called. This change is implemented in the Hackage package.

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.

In my previous post I used type families to simplify the types in Morten Rhiger’s “Type safe pattern combinators”. Unfortunately, in order to convince GHC that various types were in fact equal (such as (a :++: b) :++: c and a :++: (b :++: c)) we needed to (recursively) build type equality witnesses. In doing this, we prevented GHC optimising away all the overhead, since GHC will never inline a recursive function.

In this post I start to solve the efficiency problem by using unsafeCoerce. By carefully choosing the exports from the module, we can ensure that the API presented is never-the-less safe.

Type lists, again

These are the same as defined in the previous post, so I give no explanation of them.

> {-# LANGUAGE TypeFamilies, EmptyDataDecls, TypeOperators, ScopedTypeVariables, Rank2Types, GADTs, GeneralizedNewtypeDeriving #-}
> module Difference(
>     Nil,
>     (:*:),
>     (:++:),
>     Difference(..),
>     D,
>  ) where
>
> import Unsafe.Coerce
>
> data Nil
> data h :*: t
> infixr :*:
> type family (:++:) a b
> type instance Nil     :++: xs = xs
> type instance (h:*:t) :++: xs = h :*: (t :++: xs)
> data Proxy a
> proxy :: Proxy a
> proxy = undefined

Difference type-lists

It will be (also, has been) a common theme in building the pattern combinators to define a type inductively for lists. For instance, in the previous post, we defined Tuple xs and CurryFunc xs as types on lists, essentially as folds on the list structure: e.g. with Tuple, replace every (:*:) with a (,), and every Nil with a ().

We can efficiently (read: non-recursively) build objects of these types when we only build the types using Nil and (:*:); however, we have more difficulties when we want to efficiently construct such types using (:++:). For instance, suppose we wanted to construct a function

f :: Tuple xs -> Tuple ys -> Tuple (xs :++: ys)

With the definition of Tuple used in the previous post, we would find it difficult (impossible?) to define such a function non-recursively.

In the previous post, this problem was solved by the “difference list” technique, which we used for the DConv type. It will be convenient to use difference list technique again. Here we package the technique in a single convenient type, D, which adds efficient (non-recursive) concatenation to datatypes defined on type-lists.

We put the operations we will need in a type-class, Difference, which is defined below. The idea is that, if d is an instance of Difference, and t is some datatype defined inductively on lists, then d t is the “difference list converted” version of this type — that is, it contains the same data, but with an efficient append.

> class Difference d where
>     -- | constructs the empty `d t`.
>     zeroD :: d t Nil
>     -- | appends two `d t`s.
>     plusD :: d t xs -> d t ys -> d t (xs :++: ys)
>     -- | given a "cons" operation, constructs the singleton `d t`.
>     mkOneD :: (forall ys. t ys -> t (a :*: ys)) -> d t (a :*: Nil)
>     -- | given a "nil" value, "runs" the `d t`.
>     evalD :: t Nil -> d t xs -> t xs

It is interesting that zeroD and plusD can be defined without any knowledge of the underlying type: internally, they will be implemented just as id and (.). All the knowledge is contained within mkOneD and evalD.

As a demonstration of its use, we can define difference tuples. Note that the t mentioned in the typeclass above must have kind (* -> *). This means that t cannot be a type family. However, it can be a data family, so this is how we define tuples. First, we define tuples inductively:

> data family Tuple' xs
> data instance Tuple' Nil = TupleEmpty
> data instance Tuple' (h:*:t) = TupleCons h !(Tuple' t)

The zeroD and plusD functions need no work. However, we need a little work for the singleton and evaluation functions, mkOneD and evalD:

> singletonTuple :: Difference d => a -> d Tuple' (a :*: Nil)
> singletonTuple a = mkOneD (\t -> TupleCons a t)
> evalTuple :: Difference d => d Tuple' xs -> Tuple' xs
> evalTuple = evalD TupleEmpty

There we have it: tuples with efficient append.

Now we actually need to define an instance of Difference.

Instances

The basic idea of the implementation is just

type D t xs = forall ys. t ys -> t (xs :++: ys)

However, to implement plusD, we will need to convince GHC of the equality of the types (a :++: b) :++ c and a :++: (b :++: c). I give two instances of Difference, which differ in how they prove this equality: one uses GADTs and a List type-class (as in the previous post); the other uses unsafeCoerce. As opposed to the unsafeCoerce approach, the GADT approach is guaranteed to be safe, but is recursive. The unsafeCoerce is non-recursive but circumvents the type system; however, the existence of the GADT implementation should convince us that the use of unsafeCoerce here is actually a safe one.

The GADT instance

This is very similar to the previous post, so I don’t give much explanation.

> data GadtD t xs = List xs => GadtD (forall ys. t ys -> t (xs :++: ys))
>
> instance Difference GadtD where
>     zeroD = GadtD id
>     plusD (GadtD fx :: GadtD t xs) (GadtD fy :: GadtD t ys) =
>         case closure (proxy :: Proxy xs) (proxy :: Proxy ys) of
>           ListD -> GadtD (\(zs :: t zs) ->
>             case assoc (proxy :: Proxy xs) (proxy :: Proxy ys) (proxy :: Proxy zs) of
>               Equal -> fx (fy zs))
>     mkOneD f = GadtD f
>     evalD nil (GadtD f :: GadtD t xs) =
>         case rightIdent (proxy :: Proxy xs) of
>           Equal -> f nil
>
> class List a where
>     closure :: forall b. List b =>
>        Proxy a -> Proxy b ->
>         ListD (a :++: b)
>     assoc :: forall b c.
>        Proxy a -> Proxy b -> Proxy c ->
>         ((a :++: (b :++: c)) :==: ((a :++: b) :++: c))
>     rightIdent :: Proxy a ->
>         (a :++: Nil) :==: a
>
> instance List Nil where
>     closure _ _  = ListD
>     assoc _ _ _  = Equal
>     rightIdent _ = Equal
>
> instance List t => List (h :*: t) where
>     closure _ b  = case closure (proxy :: Proxy t) b of
>                      ListD -> ListD
>     assoc _ b c  = case assoc (proxy :: Proxy t) b c of
>                      Equal -> Equal
>     rightIdent _ = case rightIdent (proxy :: Proxy t) of
>                      Equal -> Equal
>
> data a :==: b where
>     Equal :: a :==: a
> data ListD a where
>     ListD :: List a => ListD a

The unsafeCoerce instance

This instance is a lightweight one. It is the same as the GADT one except that, whenever we needed an equality proof before, we use unsafeCoerce.

> newtype CoerceD t xs = CoerceD (forall ys. t ys -> t (xs :++: ys))
>
> instance Difference CoerceD where
>     zeroD = CoerceD id
>     plusD (CoerceD fx :: CoerceD t xs) (CoerceD fy :: CoerceD t ys) =
>         CoerceD (\(zs :: t zs) ->
>             case assoc2 (proxy :: Proxy xs) (proxy :: Proxy ys) (proxy :: Proxy zs) of
>               Equal -> fx (fy zs))
>     mkOneD f = CoerceD f
>     evalD nil (CoerceD f :: CoerceD t xs) =
>         case rightIdent2 (proxy :: Proxy xs) of
>           Equal -> f nil
>
> assoc2 :: Proxy a -> Proxy b -> Proxy c -> (a :++: (b :++: c)) :==: ((a :++: b) :++: c)
> assoc2 _ _ _ = unsafeCoerce Equal
>
> rightIdent2 :: Proxy a -> (a :++: Nil) :==: a
> rightIdent2 _ = unsafeCoerce Equal

The only equalities we prove with unsafeCoerce are a :++: (b :++: c) ~ (a :++: b) :++: c and a :++: Nil ~ a. These equalities are certainly true for all instances of the List class given in the GADT implementation. The GADT implementation also shows that, for any value of type d t xs constructible using the API of the Difference class, xs will be an instance of List. So the equalities used are true (safe) for any CoerceDs constructed using only the Difference interface. So our use of unsafeCoerce is safe if we export only the Difference class, and the name of the type CoerceD. If you look at the imports, this is what I have done.

Wrapping up

Finally, I also export the type D, which is just a newtype of CoerceD, with a derived instance of Difference:

> newtype D t xs = D (CoerceD t xs) deriving(Difference)

This exposes an instance of Difference to the outside world, but hides which one it is. This gives us a single place to change the implementation from CoerceD to GadtD if we so desire.

It turns out that this module encapsulates all the uses of GADTs that we will need.

I’ll stop here for now, but we will see in later posts how this type is used, and we will see the efficiency it allows.

I recently read Morten Rhiger’s Functional Pearl, Type-safe pattern combinators. He develops a library of combinators for pattern matching, allowing user code such as

match (5, (3, 4)) $
    pair (cst 5) (pair var var) ->> \ x y → x + y

where the equivalent code using Haskell’s own pattern matching is

case (5, (3, 4)) of
    (5, (x, y)) -> x + y

The pattern combinator library has various features we want from a pattern matching library: type-checking of patterns, and a lightweight/efficient implementation. The system is also clearly flexible enough to support all of Haskell’s built-in pattern-matching capabilities, and then some.

However, I found the library confusing to work with, because the type signatures give me no clue about what is going on. For instance, consider the type of var, the “variable pattern” combinator, given by GHCi:

ghci> :type var
var ::
  ((t -> t1 -> t2) -> (t3 -> t) -> (t3, t1) -> t2,
   t4 -> ((t4, t5) -> t6) -> t7 -> t5 -> t6)

There are tuples and functions everywhere, and it is hard to see what is going on — never mind that GHCi helpfully names all the type variables t.

In this post, I attempt to tame the types of the pattern combinators, while leaving the internal code as much the same as possible. In the final result, var has type

var :: Pattern (a :*: Nil) a

The first type parameter lists the types of the variables bound by the pattern, and the second gives the type of the overall pattern to be matched.

Preliminaries

Lists of types

We keep track of the variables bound by a pattern by listing their types. To do that, we use the following type-level list:

> {-# LANGUAGE EmptyDataDecls, TypeFamilies,
>   TypeOperators, RankNTypes, GADTs,
>   ScopedTypeVariables, NoMonomorphismRestriction #-}
> module Pattern where
>
> import Prelude hiding(succ,fail,any, (||))
>
> data Nil
> data h :*: t
> infixr :*

The main operation we do on this is concatenating two lists, (:++:):

> type family (:++:) a b
> type instance Nil     :++: xs = xs
> type instance (h:*:t) :++: xs = h :*: (t :++: xs)

We have two different ways of expressing functions of multiple arguments: curried and uncurried. We can express both with type functions:

> type family Tuple xs
> type instance Tuple Nil = ()
> type instance Tuple (h:*:t) = (h, Tuple t)
>
> type UncurryFunc xs r = Tuple xs -> r
>
> type family   CurryFunc xs r
> type instance CurryFunc Nil r = r
> type instance CurryFunc (h:*:t) r = h -> CurryFunc t r

Both representations of multi-argument functions are used by Morten’s code: internally, uncurried functions are used, but the curried form is presented to the user as it is more idiomatic. Some of the code is hence devoted to conversions between these forms. We define the type of converters from curried to uncurried form:

> type Conv vs r = CurryFunc vs r -> UncurryFunc vs r

It might seem at first that it would just be simpler to use the curried form internally and avoid the fuss of conversion; however, this is unfortunately not possible: it turns out that the uncurried form is necessary in order to support proper handling of pattern-match failure.

Resolving the ambiguity

Since we are using type families, which are not guaranteed to be injective, a number of type signatures will be ambiguous. We will resolve these by adding a proxy parameter which fixes the ambiguity. For this, we use the (empty) Proxy type:

> data Proxy a
> proxy :: Proxy a
> proxy = undefined

Values of type Proxy contain no data, and should not be used by any functions; their only purpose is to fix the types.

As an example of how the disambiguation works, consider the type Conv vars r. The variable vars is only ever mentioned inside type functions, so it would be possible to have two types vars1 and vars2 such that Conv vars1 r ~ Conv vars2 r but not vars1 ~ vars2. Hence, if we fix the type of Conv vars r, then we don’t know what vars is, i.e. vars is ambiguous in Conv vars r. To fix this ambiguity, we add a parameter which fixes vs, to get the new type

Proxy vars -> Conv vars r

Since Proxy is injective, we can find vars unambiguously by looking at the first parameter.

The List class

It will turn out that Morten’s code implicitly uses various properties of list concatenation: in fact, precisely the property that lists form a monoid under ((:++:),Nil). In his code, there is no need to prove that this is true, since his types don’t mention lists explicitly. However, we are using type families, so GHC will need to know these properties in order to type-check our code. Since type families are open, these properties cannot be guaranteed to be true of all instances of (:++:): there is nothing to stop someone else defining instances for which the monoid laws fail. Ideally, we would solve this by using Type Invariants for Haskell, but this has not been implemented in GHC. Instead, we encode these axioms as GADTs in a type-class:

> class List a where
>     closure :: forall b. List b =>
>        Proxy a -> Proxy b ->
>         ListD (a :++: b)
>     assoc :: forall b c.
>        Proxy a -> Proxy b -> Proxy c ->
>         ((a :++: (b :++: c)) :==: ((a :++: b) :++: c))
>     rightIdent :: Proxy a ->
>         (a :++: Nil) :==: a

(In comparison to the monoid laws, this is missing the leftIdent law. This is because GHC can derive that itself from the type family instance Nil :++: xs.) This class relies on the types (:==:) and ListD, which we have not yet defined, with the following intended meanings: an value of type a :==: b means that a and b are equal types; an value of type ListD a means that a is an instance of List. Both of these types can straightforwardly be defined using GADTs:

> data a :==: b where
>     Equal :: a :==: a
>
> data ListD a where
>     ListD :: List a => ListD a

We can also define instances for the lists we are interested in (i.e. the ones constructed with Nil and :*:). We need to tell GHC where to use induction, but it can prove the rest.

> instance List Nil where
>     closure _ _  = ListD
>     assoc _ _ _  = Equal
>     rightIdent _ = Equal
>
> instance List t => List (h :*: t) where
>     closure _ b  = case closure (proxy :: Proxy t) b of
>                      ListD -> ListD
>     assoc _ b c  = case assoc (proxy :: Proxy t) b c of
>                      Equal -> Equal
>     rightIdent _ = case rightIdent (proxy :: Proxy t) of
>                      Equal -> Equal

Types for Morten’s primitives

If we look at Morten’s code, we see that the pattern combinators are all 2-tuples. When larger pattern combinators are built from smaller ones, the first components are always built using only the first components of the smaller combinators, and similarly for the second. In other words, the first and second components of the pattern combinators can be constructed independently. So, instead of jumping straight to a type for patterns, we first give types to the first and second components and their combinators.

The first component: curried-to-uncurried-converter-builders

Morten manipulates the first components with the function

> succ n f    = \(x,xs) -> n (f x) xs

and the Prelude functions id and (.). The type of succ inferred by GHCi is:

ghci> :type succ
succ :: (t2 -> t1 -> t3) -> (t -> t2) -> (t, t1) -> t3

which is not very helpful. Although the types of id and (.) are simpler, they also don’t give much information about the use in building pattern combinators. Our first aim will be to give meaningful types to these combinators.

Using a rough understanding of Morten’s code and a bit of guesswork, we can define the following type synonym

> type DConv1 vars = forall vars' r.
>     Conv vars' r -> Conv (vars :++: vars') r

as the type of the first components of Morten’s pattern combinators. Then, we can give succ and id the following types:

> id1 :: DConv1 Nil
> id1 = id
> succ1 :: DConv1 (a :*: Nil)
> succ1 = succ

The type for (.) is a bit harder, so I will pause now to discuss the interpretation of the DConv1 type. The type Conv vars r is the type of converters from curried to uncurried form with arguments vars and result r. The type DConv1 builds larger converters from smaller converters, so it is a curried-to-uncurried-converter-builder. It is closely analogous to Difference Lists¹: a DConv1 accepts a tail (vars') as a parameter, and sticks its own list of variables onto the front. (This gives us a non-recursive implementation of append, which is what allows the pattern combinators to be completely optimised away by GHC.) So DConv1 is best thought of as the type of curried-to-uncurried converters but with an efficient append.

Under this intepretation, id1 is converter for no parameters, and succ1 is the converter for a single parameter.

Back to (.). This functions as the append operation (just like it does for DLists), so it should have type

(.) :: DConv1 as -> DConv1 bs -> DConv1 (as :++: bs)

However, GHC won’t accept that type, for two reasons: DConv1 vars is ambiguous with respect to vars and vars'; and we need to use the associativity of (:++:), but we don’t yet have a list constraint.

We fix the ambiguity of DConv1 by making it a newtype (which fixes vars) and adding a proxy parameter (which fixes vars'):

> newtype DConv vars = DConv { runDConv :: forall vars' r.
>     Proxy vars' -> Conv vars' r -> Conv (vars :++: vars') r }

Then the combinators can be typed as

> idC :: DConv Nil
> idC = DConv (\_ -> id)
> succC :: DConv (a :*: Nil)
> succC = DConv (\_ -> succ)
> appendC :: forall as bs. List as => DConv as -> DConv bs -> DConv (as :++: bs)
> appendC (DConv fa) (DConv fb) =
>   DConv (\(_ :: Proxy vars') ->
>     case assoc (proxy :: Proxy as) (proxy :: Proxy bs) (proxy :: Proxy vars') of
>       Equal -> fa (proxy :: Proxy (bs :++: vars')) . fb (proxy :: Proxy vars'))

Now, appendC is considerably longer than the other two functions, but most of the length is just in the proxy types and GADT matches, to satisfy the typechecker. The actual data manipulation is still done by (.), which is hidden on the last line of its definition.

These are the only functions Morten uses to manipulate the first components, so we are done with the first component.

The second component: the actual matcher

The process here is similar to the process for the first component, only more complicated. First we find a type which the simple combinators unify with, then we fix the ambiguity problems, and then we discuss the interpretation of the type.

Other than ambiguity and type family problems, the second component of the patterns unifies with this type

> type Component2 vars pat =
>    forall vars' r.
>      pat                               -- pattern to match
>   -> (UncurryFunc (vars :++: vars') r) -- success continuation
>   -> (() -> r)                         -- failure continuation
>   -> Tuple vars'                       -- already-pushed bindings
>   -> r                                 -- continuation result

We can cleanly separate the parts of the type mentioning pat from the parts mentioning vars to get

> type Component2' vars pat = pat -> Push1 vars
> type Push1 vars =
>    forall vars' r.
>      (UncurryFunc (vars :++: vars') r) -- success continuation
>   -> (() -> r)                         -- failure continuation
>   -> Tuple vars'                       -- already-pushed bindings
>   -> r                                 -- continuation result

The failure continuation has an odd-looking type, () -> r. This is similar to the simpler type r, and one might wonder why the failure continuation isn’t just defined like that. It turns out that the reason is the same as the reason that the success continuation must be uncurried internally: there are times when the success and failure continuations are swapped, so they must have unifiable types, so they must both be a type with a single function arrow. However, they still won’t unify, since that would require unifying () with Tuple (vars :++: vars'), and those types might not be equal. Hence we change the failure continuation’s type to (forall s. s -> r). This makes Push1 a rank–3 type.

Making this change, and fixing the ambiguity of vars and vars' like we did before, we get the type

> newtype Push vars = Push { runPush ::
>    forall vars' r.
>       Proxy vars'
>    -> (UncurryFunc (vars :++: vars') r)
>    -> (forall s. s -> r)
>    -> Tuple vars'
>    -> r
>   }

A value of type Push vars is something which does the appropriate plumbing: it either pushes the variables in vars onto the success continuation, or it calls the failure continuation. Below are the 5 functions Morten uses to manipulate (the equivalent of) Push values. I give their equivalents in the Push type (these are the functions with the P suffix). All of them other than catchP are defined using Morten’s function; in catchP I needed to modify the failure continuation so that it accepts any parameter rather than just (), as discussed above.

> -- | succeeds without pushing any variables
> nil         = \ks kf ac -> ks ac
> nilP :: Push Nil
> nilP = Push (\_ -> nil)

> -- | succeeds and pushes one variable
> one v       = \ks kf ac -> ks (v,ac)
> oneP :: a -> Push (a :*: Nil)
> oneP v = Push (\_ -> one v)

> -- | Pushes the variables of the first, then the variables of the second (assuming the first succeeds).
> m # n       = \ks kf ac -> n (m ks kf) kf ac
> appendP :: forall as bs. List as => Push as -> Push bs -> Push (as :++: bs)
> appendP (Push m) (Push n) =
>    Push (\(_ :: Proxy vars') ->
>       case assoc (proxy :: Proxy as) (proxy :: Proxy bs) (proxy :: Proxy vars') of
>          Equal -> m (proxy :: Proxy (bs :++: vars')) # n (proxy :: Proxy vars'))

> -- | Calls the failure continuation immediately
> fail        = \ks kf ac -> kf ()
> failP :: Push as
> failP = Push (\_ -> \ks kf -> fail ks kf)

> -- | Recovers from @m@'s failure by running @n@.

> m `catch` n = \ks kf ac -> m ks (\() -> n ks kf ac) ac
> catchP :: Push as -> Push as -> Push as
> catchP (Push m) (Push n) = Push (\p ks kf ac -> (m p) ks (\_ -> (n p) ks kf ac) ac)

I have omitted the types of Morten’s functions, as they are rather messy and not particularly informative. In contrast, the types of the Push versions are quite informative: they give a list of variables pushed. In the case of failP, it can claim that any number of variables can be pushed: like _|_, it doesn’t have to justify that claim, as it simply fails when run.

Types for patterns

Now we can (finally) give types to patterns. A pattern has a first component and a second component, and it also requires that vars is a list (and it contains the evidence of that).

> data Pattern vars pat = List vars =>
>     Pattern (DConv vars) (pat -> Push vars)

We can define all of Morten’s patterns almost as he defined them, since we have typed all of Morten’s primitive manipulation functions. I give the first few of them here:

> var :: Pattern (a :*: Nil) a
> var = Pattern succC oneP

> cst :: (Eq pat) => pat -> Pattern Nil pat
> cst v' = Pattern idC (\v -> if v == v' then nilP else failP)

> pair :: forall as a bs b. Pattern as a -> Pattern bs b -> Pattern (as :++: bs) (a,b)
> pair (Pattern pC pP) (Pattern qC qP) =
>     case closure (proxy :: Proxy as) (proxy :: Proxy bs) of
>       ListD -> Pattern (appendC pC qC) (\(a,b) -> pP a `appendP` qP b)

> none :: Pattern Nil pat
> none = Pattern idC (\v -> failP)

> (\/) :: Pattern t pat -> Pattern t pat -> Pattern t pat
> (Pattern pC pP) \/ (Pattern qC qP) =
>     Pattern pC (\v -> pP v `catchP` qP v)

> any :: Pattern Nil pat
> any = Pattern idC (\v -> nilP)

> (/\) :: forall as bs a. Pattern as a -> Pattern bs a -> Pattern (as :++: bs) a

> (Pattern pC pP) /\ (Pattern qC qP) =
>     case closure (proxy :: Proxy as) (proxy :: Proxy bs) of
>       ListD -> Pattern (appendC pC qC) (\v -> pP v `appendP` qP v)

In pair and (/\) we unfortunately still need to use GADTs to prove the closure rule, but we can define all the other combinators without any cleverness. All the functions have informative types.

Types for clauses

We now have a nicely-typed way to construct patterns, but we still have no way to run them. There are three more primitive functions we need to define: match, (->>) and (||). Their use is best demonstrated by an example:

match ((3,4),5) $
    pair (pair var var) cst 4        ->> \x y -> x + y
 || pair (pair (cst 3) (cst 4)) var  ->> \x -> x

We first give the types that these functions should have. The (->>) function should accept a pattern and an RHS and yield something which match can be called on (call it a “clause”). The (||) function should take two clauses and give a clause which tries the first clause, and then the second if the first failed. The match function should accept a value to match, and a clause which matches values of that type, and it should yield the value yielded by the clause. A clause’s type should say two things: what values it can match, and what the result value is.

So, the types are:

> (->>) :: forall vars a r.
>    Pattern vars a -> CurryFunc vars r -> Clause a r
> (||) :: Clause a r -> Clause a r -> Clause a r

> match :: a -> Clause a r -> r

An implementation satisfying these types and semantics is below:

> newtype Clause pat res = Clause {
>   runClause :: pat -> (forall s. s -> res) -> res
>  }

> (Pattern c p) ->> k = Clause
>     (case rightIdent (proxy :: Proxy vars) of
>         Equal -> \v kf -> runPush (p v) (proxy :: Proxy Nil) (runDConv c (proxy :: Proxy Nil) zero k) kf ()) where
>             zero   f = \() -> f

> p1 || p2 = Clause (\pat kf -> runClause p1 pat (\_ -> runClause p2 pat kf))

> match a p = runClause p a (\_ -> error "match failed")

The precedences of the operators are

> infix 2 ->>
> infixr 1 ||

This is all the code we need to use our patterns in a nicely-typed way. As an example, we can write

> foo =
>     pair (cst 2 \/ cst 3) any ->> "The tuple has either 2 or 3 as the first component"
>  || pair any var              ->> (\v -> "The second component has value " ++ show v)
>  || var                       ->> (\v -> "The tuple is " ++ show v)

GHC will infer the type of this (under NoMonomorphismRestriction) as

> foo :: (Num t, Show b) => Clause (t, b) [Char]

Wrapping up

Giving better types to the pattern combinators has benefits. These new types are “more static” than the original ones, which gives us the advantages of stronger typing.

The first advantage is that the code is more modular: we can define a pattern combinator independently of the others; if it has the desired type, we have quite good assurance that we have written it correctly. This was not the case for the original types, because it was hard to tell what the desired type actually was.

We can also provide an easier API for the user; the types of the pattern combinators actually give a lot of information about what they do. We are able to export the Pattern type abstract, which we couldn’t do for Morten’s code, because there was no datatype.

One disadvantage is that we have lost Haskell98 compatibility: Type Families play a key role in assigning nicer types to the combinators. For my purposes, trading Haskell98 compatibility for nicer types is a good compromise.

One feature of Morten’s code is that all his functions are implemented non-recursively, so GHC is able to inline all the pattern combinators, and completely optimise away all the overhead. Unfortunately, the closure function in the (h:*:t) instance of List is recursive; this recursion prevents GHC from inlining everything. So, we have lost some of the efficiency of Morten’s code. This is particularly unfortunate, because the actual working code is identical: the recursive code exists only to convince GHC that the types are correct. I have been working on an alternative implementation which uses unsafeCoerce in appropriate places; I will post about this sometime in the future.