[Haskell] Views in Haskell

Pablo Nogueira pirelo at googlemail.com
Mon Jan 29 10:17:55 EST 2007


Hi Simon,

(I'm sending this email to the main Haskell list because the
discussion continues on it, I haven't seen it moved to the cafe)

Below are some comments on the goodness of view patterns in relation
to Palao's active
patterns, and especially to their "@" combinator.

A few people have replied that there's not a lot of "pattern matching" in view
patterns. In (expr -> pat), pattern matching occurs in the observer function
expr and, when it returns a Just w value, w is matched against pat. But in
most cases w is a single value or a tuple of values. In the extension with
JustN (N=1..?), w is often just a list of variables, not much of a pattern.

Of course, this is so because view patterns are syntactic sugar for
observation, that is, optional discrimination (guard) followed by selection of
values that are bound to variables. The "failure" case is hidden and nested
observation can be expressed more neatly. In other words,

  expr -> pat

is

  [discriminate + ] select -> variables

One problem with this is that discrimination may take place multiple times and
selections may be discarded after matching, and both operations could involve
elaborate computations. It may be possible for the compiler to optimise when
the same function appears in the expr cases (your g function in the very first
examples), yet I doubt this can be generalised when the functions are
different.

A concrete example: the length function for FIFO queues.

lengthQ :: Queue q => q a -> Int
lengthQ (isEmpty ->)    = 0
lengthQ (split -> _ q)  = 1 + lengthQ q

Function split has been added to the queue interface:

class Queue q where
  empty     :: q a
  isEmpty  :: q a -> Bool
  snoc       :: a -> q a -> q a
  head       :: q a -> a
  tail          :: q a -> q a
  split        :: q a -> Maybe2 a (q a)

The code for split is given below.

Assume a Physicist's implementation of queues (cf. Okasaki's "Purely
Functional Data Structures", page 187). Function tail invokes a "check"
function that maintains the representation invariant. It makes sense to reuse
head and tail in the implementation of split and avoid duplicating work
(otherwise split's body would repeat tail's). We'd have:

  data PhysicistQueue a = PQ [a] Int [a] Int [a]

  instance Queue PhysicistQueue where
     ...
    isEmpty (PQ w lenf f lenr r) = (lenf == 0)
    ...
    split q |
      isEmpty q   = Nothing2
      otherwise   = Just2 (head q) (tail q)

Typically, selectors (head, tail) are partial, and a combination of selectors
into one, such as split, should be partial. However, to account for
pattern-matching failure we make it total (Nothing2 case).
Discrimination may take place several times in views: for non-empty
queues lengthQ performs an emptiness test twice. There are overlapping
cases, and we give up statically checking this cause to the left of
the arrow there are different functions.

[ASIDE: is it okay that pattern matching failure is represented by so many
types: Bool, Maybe, Maybe1, etc? And that it is reified to a value?].

Another problem is that selected stuff may be discarded: for non-empty queues,
split calculates a head value (computation), but it is discarded by
lengthQ. The compiler cannot help us even if underscores appear to the right
of the arrow because computation takes place before matching. Laziness will be
of help, but some evaluations to WHNF may take place.

In contrast, Palao's "@" combinator is quite handy:

  lengthQ Empty    = 0
  lengthQ (Tail t) = 1 + lengthQ t

  show :: Queue q => q a -> String
  show Empty               = ""
  show ((Head h)@(Tail t)) = show h ++ show t

The Tail active constructor is like invoking tail, and when the head is needed
we compose it with the Head active constructor. Head and Tail are partial, the
assumption is that pattern matching starts at the Empty case, just like it
happens with ordinary pattern matching. The failure is not reified to a
value.


More information about the Haskell mailing list