I found Simon Peyton Jones' proposal for guarded equations very
interesting and convincing. However, I see situations where yet more
flexibility in guarded expressions would be useful, and I have included
a suggestion for an extension below. I hope the following is
understandable and makes sense, although it is certainly not the product
of as deep considerations as those underlying Simon Peyton Jones'
proposal.

Heribert Schutz.


An Example
----------

Consider a type for arithmetic expressions that consist of constants,
variables, and a binary addition operation:

  data Expr = Val Integer | Var String | Plus Expr Expr

We want to simplify such an expression by removing superfluous zeroes.
This can be implemented in today's Haskell as follows:

  -- version 1
  simplify (Plus e e')  = case s of
                            (Val 0) -> s'
                            _       -> case s' of
                                         (Val 0) -> s
                                         _       -> (Plus s s')
    where
    s  = simplify e
    s' = simplify e'
  simplify e            = e

Many of Simon Peyton Jones' considerations about "clunky" also hold for
"simplify". For example, as in the "clunky" example, we can avoid the
case expressions by introducing a helper function:

  -- version 2
  simplify (Plus e e') = simplify_plus (simplify e) (simplify e')
    where simplify_plus (Val 0) s'       = s'
          simplify_plus s       (Val 0)  = s
          simplify_plus s       s'       = Plus s s'
  simplify e           = e


The Problem
-----------

We can avoid both the case expressions and the helper function by Simon
Peyton Jones' guard syntax

  -- version 3
  simplify (Plus e e') | s  <- simplify e ,
                         s' <- simplify e',
                         (Val 0) <- s       = s'
                       | s  <- simplify e ,
                         s' <- simplify e',
                         (Val 0) <- s'      = s
                       | s  <- simplify e ,
                         s' <- simplify e'  = (Plus s s')
  simplify e                                = e

but perhaps this is not what we want: We might not want to replicate the
expressions "simplify e" and "simplify e'".

The problem lies in the "linearity" of qualifier lists.  If any
qualifier fails, then the *entire* qualifier list fails and the next
guard (or the next equation) is tried.  It is not possible to backtrack
just a part of the list and to try alternatives for those qualifiers
over which we have backtracked.


A Solution
----------

Therefore I would suggest some sort of "nested" qualifiers. I have not
thought much about syntax, but I hope that the following code is
sufficiently intuitive for understanding the idea:

  -- version 4
  simplify (Plus e e') | s  <- simplify e ,
                         s' <- simplify e'  | (Val 0) <- s  = s'
                                            | (Val 0) <- s' = s
                                            | otherwise     = (Plus s s')
  simplify e                                                = e

The second "|" indicates that failure of the qualifier "(Val 0) <- s"
should not lead to backtracking over the entire guard (and continuing
with the last equation), but only to the second "|". Pattern matching
continues with the third "|", which appears on the same nesting level.
(I have tried to hint at this by using the same indentation, but as I
said before, the syntax is not the essential point of the idea.) If the
qualifier "(Val 0) <- s'" fails as well, the "otherwise" case is chosen.

In this example the entire guard (from the first "|" to "otherwise")
cannot fail, because the first two qualifiers have failure-free patterns
on the left hand side and the last qualifier is an "alternative
qualifier" including "otherwise". But if any of the qualifiers were
modified in such a way that they can fail, then it would make sense to
add an alternative to this guard. This alternative would start with a
"|" under the first "|", just before the last equation.


Miscellaneous Remarks
---------------------

- Can we expect a compiler to recognize common prefixes of
  "Peyton-Jones-style" guards? If so, then one might prefer the style of
  coding as given in version 3, according to the consideration that we
  can "write down the cases we want to consider, one at a time,
  independently of each other." (Quoted from Simon Peyton Jones' note.)

  But one might also prefer a style where the common prefixes of the
  qualifier lists are "factored out" as in version 4. This is then
  similar to the possibility to factor out the parameter matching before
  the guards.

- Something like these nested qualifiers might also be interesting for
  monad comprehensions and do expressions (of course only for instances
  of MonadPlus). But there we already have the possibility of nesting
  and using "++" on the right hand side of a "<-" qualifier.

- Nested qualifiers would become superfluous if we modified Simon Peyton
  Jones' proposal a bit: The qualifier list is interpreted as in a Maybe
  comprehension.  The definition of "simplify" would look like:

    -- version 5
    simplify (Plus e e') | s  <- Just (simplify e ),
                           s' <- Just (simplify e'),
                           result <- [s' | (Val 0) <- Just s ]
                                     ++
                                     [s  | (Val 0) <- Just s']
                                     ++
                                     Just (Plus s s')          = result
    simplify e                                                 = e

  Of course it is a bit annoying that we have to write "Just" so
  frequently. (One might also find it awful if the language requires
  Maybe, a data type that could in principle be user-defined. But we
  already have Bool in guards and list qualifiers.)

- I think that version 5 is very much in line with Johannes Waldmann's
  considerations comparing guards with do expressions. While version 5
  employs the Maybe monad, the Peyton-Jones-style guards employ
  something like a "Bool monad". (In the sense that Bool can be
  simulated by "Maybe ()": True, False, &&, and || correspond to Just
  (), Nothing, >>, and ++, respectively.)



Reply via email to