DOKK Library

Application Patterns in Functional Languages

Authors Nikolaas N. Oosterhof

License CC-BY-SA-2.0

Plaintext
 Application Patterns
in Functional Languages

Nikolaas N. Oosterhof




          2005
      Application Patterns
   in Functional Languages
                   by

    Nikolaas N. Oosterhof


                 a Thesis
     written under the supervision of

            dr. ir. Jan Kuper

dr. Maarten M. Fokkinga     drs. Joeri van Ruth

            submitted to the
     department of Computer Science
         in partial fulfilment of
   the requirements for the degree of
                Ingenieur
     equivalent to a Master’s degree
                    in
            Computer Science




          University of Twente
       Enschede, The Netherlands
                  2005
iv

Copyright c 2005 Nikolaas N. Oosterhof.

This document is free; you can copy, distribute, display, perform and/or modify
it under the terms of the Creative Commons Attribution-ShareAlike License
Version 2.0. A copy of the license is included in Appendix B.1.




Supervisor committee:
    dr. ir. Jan Kuper              Primary supervisor
    dr. Maarten M. Fokkinga        Secundary supervisor
    drs. Joeri van Ruth            Secundary supervisor

This thesis can be cited as:
    Oosterhof, Nikolaas N. (2005). Application Patterns in Functional Lan-
    guages. Master’s thesis, University of Twente, The Netherlands.

The author may be contacted at n.n.oosterhof@student.uva.nl

This thesis is set in Computer Modern Roman by the author using LATEX.
                                                                            v

                  Human-readible summary of the
        Creative Commons Attribution-ShareAlike 2.0 License

You are free:
   • to copy, distribute, display, and perform the work

   • to make derivative works
   • to make commercial use of the work


Under the following conditions:


                   Attribution. You must give the original author credit.




                   Share Alike. If you alter, transform, or build upon this
                   work, you may distribute the resulting work only under a
                   license identical to this one.

   • For any reuse or distribution, you must make clear to others the license
     terms of this work.
   • Any of these conditions can be waived if you get permission from the
     copyright holder.

Your fair use and other rights are in no way affected by the above.


A copy of the Legal Code (the full license) is included in Appendix B.1.
vi
To my parents




      vii
viii
Abstract

Most contemporary pure functional languages provide support for patterns in
function definitions. Examples of common patterns are the identifier, constant,
tuple, list algebraic, n+k and as-pattern.
     This thesis introduces a new kind of patterns, called application patterns.
Such patterns consist of a function applied to arguments: they are of the form
(f x1 ... xn ). When such a pattern is matched against an actual argument,
inverse functions are used to find the binding of variables to values. A theoretical
framework is provided that accomodates for defining multiple generalized inverse
functions (for returning different sets of arguments) for one function. These
inverse functions can be available in the system, derived by the system or defined
by the programmer. A notation is introduced so that in a definition’s left hand
side identifiers can be used that are bound in the context. It is established that
application patterns are universal in the sense that they include constant, tuple,
list, algebraic, n+k and as-patterns.
     This thesis describes an algoritm that translates functional program code
with application patterns to program code without application patterns that
can be run on an interpreter. It also provides a proof-of-concept implementation
of this algoritm in a functional language.

Keywords:     Functional programming, pattern matching, inverse function,
              application pattern




                                         ix
x   ABSTRACT
Contents

Abstract                                                                                                     ix

Acknowledgements                                                                                             xv

1 Introducing patterns                                                                                        1
  1.1 Functions . . . . . . . . . . . . . . . . .    .   .   .   .   .   .   .   .   .   .   .   .   .   .    1
       1.1.1 Mathematical functions . . . . .        .   .   .   .   .   .   .   .   .   .   .   .   .   .    1
       1.1.2 Functions in functional languages       .   .   .   .   .   .   .   .   .   .   .   .   .   .    2
  1.2 Pattern matching . . . . . . . . . . . . .     .   .   .   .   .   .   .   .   .   .   .   .   .   .    3
       1.2.1 Identifier pattern . . . . . . . . .    .   .   .   .   .   .   .   .   .   .   .   .   .   .    3
       1.2.2 Constant pattern . . . . . . . . .      .   .   .   .   .   .   .   .   .   .   .   .   .   .    4
       1.2.3 List pattern . . . . . . . . . . . .    .   .   .   .   .   .   .   .   .   .   .   .   .   .    5
       1.2.4 Tuple pattern . . . . . . . . . . .     .   .   .   .   .   .   .   .   .   .   .   .   .   .    6
       1.2.5 Algebraic pattern . . . . . . . . .     .   .   .   .   .   .   .   .   .   .   .   .   .   .    7
       1.2.6 n+k pattern . . . . . . . . . . . .     .   .   .   .   .   .   .   .   .   .   .   .   .   .    8
       1.2.7 As pattern . . . . . . . . . . . .      .   .   .   .   .   .   .   .   .   .   .   .   .   .    9
       1.2.8 Equivalence pattern . . . . . . .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   10
  1.3 Conclusion . . . . . . . . . . . . . . . .     .   .   .   .   .   .   .   .   .   .   .   .   .   .   10

2 Application patterns                                                                                       11
  2.1 Introduction . . . . . . . . . . . . . . . .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   11
  2.2 Application patterns . . . . . . . . . . .     .   .   .   .   .   .   .   .   .   .   .   .   .   .   11
      2.2.1 Basic application pattern . . . .        .   .   .   .   .   .   .   .   .   .   .   .   .   .   11
      2.2.2 Refutable application patterns .         .   .   .   .   .   .   .   .   .   .   .   .   .   .   13
  2.3 Currying application patterns . . . . . .      .   .   .   .   .   .   .   .   .   .   .   .   .   .   14
      2.3.1 Currying . . . . . . . . . . . . .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   14
      2.3.2 Cousins of functions . . . . . . .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   16
      2.3.3 Generalized inverse . . . . . . . .      .   .   .   .   .   .   .   .   .   .   .   .   .   .   17
  2.4 Some refinements . . . . . . . . . . . . .     .   .   .   .   .   .   .   .   .   .   .   .   .   .   20
      2.4.1 Pattern expressions . . . . . . . .      .   .   .   .   .   .   .   .   .   .   .   .   .   .   20
      2.4.2 Caret notation . . . . . . . . . .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   21
      2.4.3 Extraction functions . . . . . . .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   24
      2.4.4 Programmer’s responsibilities . .        .   .   .   .   .   .   .   .   .   .   .   .   .   .   25
  2.5 Application patterns as a generalization       .   .   .   .   .   .   .   .   .   .   .   .   .   .   26
      2.5.1 List pattern, revisited . . . . . .      .   .   .   .   .   .   .   .   .   .   .   .   .   .   26
      2.5.2 Algebraic pattern, revisited . . .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   26
      2.5.3 Tuple pattern, revisited . . . . .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   27
      2.5.4 n+k pattern, revisited . . . . . .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   27

                                       xi
xii                                                                                              CONTENTS

            2.5.5 Constant pattern, revisited .      .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   28
            2.5.6 As pattern, revisited . . . . .    .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   29
            2.5.7 Equivalence pattern, revisited     .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   29
      2.6   Standard inverse functions . . . . . .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   29
            2.6.1 Arithmetic operators . . . . .     .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   30
            2.6.2 Goniometric functions . . . .      .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   31
            2.6.3 Numerical functions . . . . .      .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   32
            2.6.4 List manipulation . . . . . .      .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   33
            2.6.5 Conversion functions . . . . .     .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   35
      2.7   The use of application patterns . . .    .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   36
            2.7.1 More readible definitions . . .    .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   36
            2.7.2 Simple string parsing . . . . .    .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   37
      2.8   Conclusion . . . . . . . . . . . . . .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   38

3 The Application Pattern Compiler                                                                                   39
  3.1 Introduction . . . . . . . . . . . . . . . . .             .   .   .   .   .   .   .   .   .   .   .   .   .   39
  3.2 Intuitively rewriting application patterns .               .   .   .   .   .   .   .   .   .   .   .   .   .   39
      3.2.1 Basic pattern . . . . . . . . . . . .                .   .   .   .   .   .   .   .   .   .   .   .   .   39
      3.2.2 Adding refutability . . . . . . . . .                .   .   .   .   .   .   .   .   .   .   .   .   .   40
      3.2.3 Adding refutability . . . . . . . . .                .   .   .   .   .   .   .   .   .   .   .   .   .   41
  3.3 A rewriting algoritm . . . . . . . . . . . .               .   .   .   .   .   .   .   .   .   .   .   .   .   43
      3.3.1 Overview . . . . . . . . . . . . . .                 .   .   .   .   .   .   .   .   .   .   .   .   .   43
      3.3.2 Rewriting patterns . . . . . . . . .                 .   .   .   .   .   .   .   .   .   .   .   .   .   44
      3.3.3 Special cases in rewriting . . . . .                 .   .   .   .   .   .   .   .   .   .   .   .   .   46
      3.3.4 Rewriting definitions . . . . . . . .                .   .   .   .   .   .   .   .   .   .   .   .   .   48
      3.3.5 Conclusion . . . . . . . . . . . . .                 .   .   .   .   .   .   .   .   .   .   .   .   .   49
  3.4 The application pattern compiler . . . . .                 .   .   .   .   .   .   .   .   .   .   .   .   .   50
      3.4.1 Requirements . . . . . . . . . . . .                 .   .   .   .   .   .   .   .   .   .   .   .   .   50
      3.4.2 Design . . . . . . . . . . . . . . . .               .   .   .   .   .   .   .   .   .   .   .   .   .   51
      3.4.3 Implementation language . . . . .                    .   .   .   .   .   .   .   .   .   .   .   .   .   51
      3.4.4 Implemenation . . . . . . . . . . .                  .   .   .   .   .   .   .   .   .   .   .   .   .   52
      3.4.5 Results . . . . . . . . . . . . . . .                .   .   .   .   .   .   .   .   .   .   .   .   .   53
      3.4.6 Extensions . . . . . . . . . . . . .                 .   .   .   .   .   .   .   .   .   .   .   .   .   53
      3.4.7 List comprehensions . . . . . . . .                  .   .   .   .   .   .   .   .   .   .   .   .   .   53
      3.4.8 Choose carets . . . . . . . . . . . .                .   .   .   .   .   .   .   .   .   .   .   .   .   54
      3.4.9 Integration . . . . . . . . . . . . .                .   .   .   .   .   .   .   .   .   .   .   .   .   55
  3.5 Conclusion . . . . . . . . . . . . . . . . .               .   .   .   .   .   .   .   .   .   .   .   .   .   55

4 The       future for application patterns                                                                          57
  4.1       Introduction . . . . . . . . . . . . . . . . .       .   .   .   .   .   .   .   .   .   .   .   .   .   57
  4.2       Related work . . . . . . . . . . . . . . . .         .   .   .   .   .   .   .   .   .   .   .   .   .   57
  4.3       Further research . . . . . . . . . . . . . .         .   .   .   .   .   .   .   .   .   .   .   .   .   60
            4.3.1 Lazyness and evaluation order . .              .   .   .   .   .   .   .   .   .   .   .   .   .   60
            4.3.2 Higher order functions . . . . . . .           .   .   .   .   .   .   .   .   .   .   .   .   .   60
            4.3.3 More sophisticated pattern failures            .   .   .   .   .   .   .   .   .   .   .   .   .   61
      4.4   Conclusion . . . . . . . . . . . . . . . . .         .   .   .   .   .   .   .   .   .   .   .   .   .   62

A Implementation of the Application Pattern Compiler                                                                 63
CONTENTS                                                                    xiii

B Example input and output                                                    65
      B.0.1 Example input . . . . . . . . . . . . . . . . . . . . . . . . 65
      B.0.2 Example output . . . . . . . . . . . . . . . . . . . . . . . 67
  B.1 Copyright license . . . . . . . . . . . . . . . . . . . . . . . . . . . 74

Bibliography                                                                 79
xiv   CONTENTS
Acknowledgements

I would like to thank my supervisors Jan Kuper, Maarten Fokkinga and Joeri
van Ruth for their continuous support and valuable remarks, suggestions and
feedback.
    The important roles of both Jan Kuper and Philip Hölzenspies can hardly
by underestimated. I think the three of us contributed evenly important idea’s
for the development of the idea of application patterns. We had many long
meetings with great discussions about syntax, semantics, esthetics, pragmatics
and many other aspects of the concept. Jan and Philip, it has been a privilege
working with you.
    Jan and Philip should also be credited for initiating the Tina development
group. It was this group, with great contributions by Jillis te Hove, Emond
Papegaaij, Arjan Boeijink, Ruben Smelik and Berteun Damman that revived
my enthousiasm for functional programming. This group was very enthusiastic
and open-minded so that the idea for application patterns (in its most basic
form, at that time) could develop. Thank you guys for the nice meetings and
the great atmosphere.

Finally I would like to thank my parents Dick and Janet, my brother Chris and
my sisters Jantine and Dianne for the important role they fulfill in my Life, the
Universe, and Everything. I would like to dedicate my work to all five, but as
there is also another thesis in Philosophy of Science, Technology and Society,
Thinking Machines That Feel: the Role of Emotions in Artificial Intelligence
Research, I considered an even split of dedication for the two generations most
appropriate. Therefore, this thesis is dedicated to my parents.




                                       xv
xvi   ACKNOWLEDGEMENTS
Chapter 1

Introducing patterns

This chapter provides the necessary background for the remainder of this thesis.
It provides a short introduction in the world of functions, function definitions in
functional programming and pattern matching. The structure is as follows: in
Section 1.1 the concept of a function is described, both from a mathematical and
a functional programming perspective. In functional programming, patterns are
important in function definitions. Therefore, Section 1.2 provides an overview
is given of typical patterns in functional programming.


1.1      Functions
In this section a brief overview of functions is given. First mathematical func-
tions are described, followed by functions and their definitions in functional
languages.


1.1.1     Mathematical functions
In mathematics, functions are objects that map elements in one set to sets to
elements in another set. If A and B are sets, then the relation f ⊂ A × B is
called a partial function if, for every x ∈ A, there is at most one y ∈ B so that
(x, y) ∈ f . Instead of (x, y) ∈ f , we write f (x) = y or f x = y, and say that
y ∈ B is the image or result of f applied to x ∈ A. Furthermore, A and B are
called the domain and codomain, and we write f : A → B.
    A partial function f : A → B is a total function if, for every x ∈ A, there is
one y ∈ B so that f (x) = y. Except when stated otherwise, function indicates
a partial function.
    A total function f : A → B is the total inverse of the total function g : B →
A if, for every x and y, (x, y) ∈ f if, and only if, (y, x) ∈ g. We then write
g −1 = f . If f is the total inverse of g, then g is also the total inverse of f , and
we say that f and g are inverse functions.
    Sometimes two functions are not inverse, although they would be if their
domain and codomain are restricted. A function f : A → B is the partial inverse
of the function g : C → D if, for every x, x̂ ∈ B ∩C and every y ∈ A∩D, it holds
that if (x, y) ∈ g and (y, x̂) ∈ f then x = x̂. That is, a function and its partial
inverse may not be defined for the same (co)domain, but for their ‘collective’

                                          1
2                                   CHAPTER 1. INTRODUCING PATTERNS

(co)domain they must agree on the values they map. When no ambiguities can
arise, we say losely that f is the inverse of g and write g −1 = f .

Example. Consider the functions in Table 1.1, whose domain and codomain
are indicated. The functions f , g, h and sin are total functions. For g a total
inverse function exists, whereas for f , h, tan and sin only an partial inverse
exists.

                    Table 1.1: Some functions and their inverses
    function              (co)domain restricted               inverse function
                                       (co)domain
    f : m 7→ m + 1        N→N          N → N∗                 n 7→ n − 1
    g : x 7→ 3x + 5       Q→Q                                 y 7→ y−5
                                                                     3 √
              2
    h : x 7→ x − 2x − 3 R → R          [1, ∞i → [1, ∞i        y 7→ 1 + 4 + y
    tan                   R→R          h− π2 , π2 i → R       arctan
    sin                   R→R          [− π2 , π2 ] → [−1, 1] arcsin

   The concept of functions can is important in functional languages. In such
languages functions can be defined, applied to arguments and the result evalu-
ated by a computer program.

1.1.2       Functions in functional languages
Functional progamming is an area of computer science where pure functional
(computer) programs consists largely of, function definitions. Examples of such
functional languages are Haskell, Clean, Gofer and Miranda. Although in math-
ematics it may be sufficient that a function exists with certain properties, in
functional programming functions are defined in an algoritmic fashion. That is,
given a function f and a value x, the image of x under f (if it exists) can be
calculated in finite time using only a limited number of well-defined rules.
    This thesis will not describe all features of pure functional programming in
detail. For a good introduction the reader is refered to the books by Thompson
(1995) and Plasmijer and Eekelen (1993).
    A Miranda-like syntax is used throughout this thesis. The definition of a
function g with k arguments takes the form


g pat 1 pat 2 . . . pat k
 = value 1 , if guard 1
 = value 2 , if guard 2
 .
 .
 .
    where
      where-clauses

g pat 01 pat 02 . . . pat 0k
 = ...
 .
 .
 .
1.2. PATTERN MATCHING                                                               3

g pat 001 pat 002 . . . pat 00k
  = ...
  .
  .
  .
.
.
.

When g is applied to actual arguments (i.e., values) a1 , . . . , ak , the result is
evaluated as follows. First the left hand side is considered, that is the part up
to and including the last pattern patk . The actual arguments are checked for
having the right form, by matching them against the patterns pat1 , . . . , patk
(more on pattern matching is said in the next section). If the patterns match,
identifiers may be bound by these patterns and evaluation proceeds in the right
hand side. The guards guard1 , guard2 , . . . are evaluated, and the first guardi
that evaluates to True the corresponding valuei is returned as the result of the
evaluation. If there is only one guard, the if, guard1 may be omitted. The
last guard may also be otherwise, which is equivalent to if True
    Both the value∗ ’s and guard∗ ’s may contain identifiers that are bound by
patterns or function definitions in the where-clauses. Contrary to patterns
in the left hand side of a definition, patterns in a where-clause may lead to a
runtime exception if they do not match their right hand side.
    It is possible, though, that the patterns pat1 , . . . , patk do not match, i.e.
a pattern is refused. However, g’s definition can consist of multiple equations,
each with different patterns: pat∗ ’s, pat0∗ ’s, pat00∗ ’s, and so on. For evaluation,
the first equation whose patterns match is used. That means that if one of the
pat∗ patterns does not match, the pat0∗ ’s are tried, then the pat00∗ ’s, and so on,
until an equation is found in which all patterns match the actual arguments. If
no patterns match, evaluation is halted and a runtime exception is thrown.
    The next section shows examples of common patterns in functional lan-
guages.


1.2      Pattern matching
In this section an overview of different types of patterns are given as they are
used in languages such as Haskell (Peyton Jones, 2003) , Clean (Plasmeijer
& Eekelen, 2001) and Miranda (Thompson, 1995). The syntax between these
languages may differ slightly, but Miranda and in one case Amanda are taken
as a starting point.

1.2.1     Identifier pattern
The identifier pattern is the most simple type of pattern. An actual arguments
always matches and is bound to the identifier.

Example. Consider the function max2, that returns the greatest of two num-
bers. Note the first line, the type definition, that states that max2 takes two
numbers as arguments and returns a number as well.


max2 :: num → num → num
4                                         CHAPTER 1. INTRODUCING PATTERNS

max2 x y = x , if x > y
         = y , otherwise

Using this definition, the maximum of the numbers 3 and 5 is computed easily.


max2 3 5
    { patterns match : x := 3 , y := 5 }
 ⇒ 3 , if 3 > 5
    { 3 > 5 ⇒ False , first guard fails }
 ⇒ 5 , if True
 ⇒ 5

Comments are shown between { curly braces }. Here the binding of x to 3
is denoted by x := 3. Binding x to 3 means 1 that each occurence of x can
be replaced by 3 (except when x bound again to some other value in a where
clause).


1.2.2         Constant pattern
Another pattern is the constant pattern that checks whether an actual argument
equals a constant. This pattern refuses the actual argument if it is not equal to
the constant.


Example. The function isSemiVowel takes a character as its arguments and
returns whether this character is a semi-vowel.


isSemiVowel             :: char → bool
isSemiVowel             ’w ’ = True
isSemiVowel             ’y ’ = True
isSemiVowel             _    = False

This definition consists of three equations. The last equation contains the _
pattern, which is an identifier pattern and may replaced by any ‘fresh’ identifier
that is not bound elsewhere.
   With this definition, it is easily determined that the ’y’ character is a semi-
vowel.


isSemiVowel ’y ’
    { ’y ’ does not equal ’w ’; refuse first equation }
    { ’y equals ’y ’ , second pattern matches }
 ⇒ True



    1 As   is the case in any referential transparant language such as Miranda, Clean and Haskell
1.2. PATTERN MATCHING                                                           5

1.2.3    List pattern
Lists are sequences of elements of the same type. Elements in a list are separated
by comma’s and enclosed by brackets. Some examples of lists are


[]
[5 , 12 , 13]
[[ True , False ] , [ False ] , []]
[ ’t ’ , ’i ’ , ’n ’ , ’a ’]

List of characters allow for a special notation using double quotes, so that the
last list can also be written "tina".
    Any list can be considered as either the empty list, denoted Nil or [], or
as some head element x followed by a tail list xs. In the latter case we write
x:xs using the cons operator ‘:’. Thus, we can write the list [5, 12, 13] as
5:(12:(13:Nil)). The parenthesis are optional, so that 5:12:13:Nil is also
valid. In the list x:xs it is required that the elements in xs have the same type
as x.
    A list patterns is of the form h:t, where h and t are patterns that match
the head and tail, respectively. Note that patterns may be nested : a pattern
may contain another pattern. A list pattern is refused if the actual argument is
the empty list, or if the head or tail pattern does not match.

Example. The join2 function, also written infix ‘++’, joins two lists. It is
defined recursively by


join2 :: [*] → [*] → [*]
join2 []         ys = ys
join2 ( x : xs ) ys = x : ( join2 xs ys )

The lists [1, 2] and [3, 4, 5] are joined as follows.


join2    [1 , 2] [3 , 4 , 5]
    {    [1 , 2] does not equal []; refuse first pattern }
    {    second pattern matches ; x := 1 , xs := 2 }
 ⇒ 1     : ( join2 [2] [3 , 4 , 5]
          { [2] does not equal []; refuse first pattern }
          { second pattern matches ; x := 2 , xs := [] }
 ⇒    1 : 2 : ( join2 [] [3 , 4 , 5])
          { [] equals [] , first pattern matches }
 ⇒    1 : 2 : [3 , 4 , 5]
 ⇒    [1 , 2 , 3 , 4 , 5]

List patterns allow for powerful computations, as the following example shows.

Example. Consider the prime function that generates the list of primes. Its
definition contains a list pattern (as well as a list comprehension, but that is
not discussed here).
6                                  CHAPTER 1. INTRODUCING PATTERNS



primes = sieve [2..]
sieve ( p : x ) = p : sieve [ n | n <- x ; n mod p > 0]

The list of primes is infinite and thus can never be evaluated completely. How-
ever, this definition does allow for the evaluation of an initial sublist of the list
of primes. For example,


take 5 primes
 ⇒∗ [2 , 3 , 5 , 8 , 13]




1.2.4     Tuple pattern
A tuple consists of a finite number of elements, possibly of different types.
Elements are seperated by comma’s en enclosed by brackets, and a tuple with
n elements is called an n-tuple. Some examples are


(1 , 2)
( ’t ’ , 1 , ’n ’ , ’a ’)
((1 , ’a ’) , ( ’z ’ , 2) )

A tuple matches a tuple pattern if they have the same number of elements and
each element matches the respective pattern in the tuple.


Example. A complex number a + bi (a, b ∈ R) can be represented by a 2-
tuple (pair ) of numbers (a, b). The definition for multiplication of two complex
numbers is straightforward.


complex == ( num , num )

multComplex :: complex → complex → complex
multComplex ( a0 , b0 ) ( a1 , b1 )
 = ( a0 * a1 - b0 * b1 , a0 * b1 + a1 * b0 )

The complex product of (3 + 4i) · (−1 + 2i) is computed by


multComplex (3 ,4) ( -1 , 2)
    { a0 := 3 , b0 := 4 , a1 := -1 , b1 := 2 }
 ⇒ (3 * -1 - 4 * 2 , 3 * 2 + -1 * 4 }
 ⇒ ( -11 , 2)

resulting in −11 + 2i.
1.2. PATTERN MATCHING                                                         7

1.2.5      Algebraic pattern
Algebraic types allow for labelling values of different types with a constructor
and then joining them in a type. A constructor is written with an uppercase
identifier and is defined to be accompanied by a finite number of values called
arguments. Examples of definitions with algebraic types and values are


bool            ::= True | False
f u n c t i o n a l P r o g r a m m i n g I s O b s o l e t e :: bool
f u n c t i o n a l P r o g r a m m i n g I s O b s o l e t e = False

binTree ::= Leaf num | Node binTree binTree
myTree = Node ( Leaf 3) ( Node ( Leaf 4) ( Leaf 8) )

maybe * ::= Just * | Nothing

In these definitions True, False, Leaf, Node, Just and Nothing are the con-
structors, and they have zero, zero, one, two, one and zero arguments, respec-
tively.
    The binTree is a binary tree that contains numbers. With the maybe type
one can specify that a result is not defined (Nothing), or that the result is
defined and has value v (Just v). In the maybe definition the asterisk ‘*’ is a
type variable, used for polymorphism, so that both Just 3 (of type maybe num)
and Just "ab" (of type maybe [char]) are valid expressions. One example of
its use is given in Chapter 3.
    An algebraic pattern matches an algebraic value if it has the same construc-
tor and each argument matches. Note that constants, lists and tuples can be
expressed using algebraic types.

Example.       Consider finding the sum of all numbers in a binary tree.


sumBinTree ( Leaf n )   = n
sumBinTree ( Node x y ) = sumBinTree x + sumBinTree y

Now summing up values in myTree proceeds as follows:


sumBinTree myTree
 ⇒ sumBinTree ( Node ( Leaf 3) ( Node ( Leaf 4) ( Leaf 8) ) )
   { Node ( Leaf 3) ( Node ( Leaf 4) ( Leaf 8) )
       does not match Leaf x ; refuse first equation }
   { Node ( Leaf 3) ( Node ( Leaf 4) ( Leaf 8) )
       matches Node x y ; x := Leaf 3 ,
                           y := Node ( Leaf 4) ( Leaf 8) }
 ⇒ sumBinTree ( Leaf 3)
      + sumBinTree ( Node ( Leaf 4) ( Leaf 8) )
   { Leaf 3 matches Leaf n ; n := 3 }
 ⇒ 3 + sumBinTree ( Node ( Leaf 4) ( Leaf 8) )
 ⇒∗ 3 + (4 + 8)
8                                 CHAPTER 1. INTRODUCING PATTERNS

    ⇒∗ 15




1.2.6       n+k pattern
The n+k pattern is a pattern that is only applicable to numbers. In its most
common form (e.g., Miranda and Gofer), it only matches nonnegative integers.
In an n+k pattern, the k is a constant number and n is een identifier. When ap-
plied to an actual argument a, n is bound to a-k. Intuitively we can understand
this as ‘solving’ the equation n+k=a for n, which leads to n=a-k.

Example. The power function for natural numbers can be defined by the use
of an n+k pattern. In this example k=1.


power _ 0       = 1
power b ( n +1) = b * power b n

Evaluation of 32 proceeds as follows


power       3 2
    {       0 does not equal 2; refuse first equation }
    {       patterns match : b := 3 , n := (2 -1) }
 ⇒ 3        * power 3 1
    {       0 does not equal 1; refuse first equation }
    {       patterns match : b := 3 , n := (1 -1) }
 ⇒ 3        * 3 * power 3 0
    {       0 equals 0; use first equation }
 ⇒ 3        * 3 * 1
 ⇒ 9

 An extension to this pattern is available in the Gofer language, as a result of a
discussion on the Haskell mailinglist initiated by Tony Davie (as cited by Jones,
1991). Gofer allows for c * p and p + k patterns, where c > 1 and k > 0 are
constants. It extends the syntax using a grammer so that these patterns can be
nested.
               pattern → . . . | pattern + integer | integer ∗ pattern
The semantics of a nested pattern of this form is comparable to that of the
standard n+k pattern.

Example. Tony Davie (as cited by Jones, 1991) gives the following more
efficient definition of the power function


power ’ x 0         = 1
power ’ x (2* n )   = xn * xn
                    where xn = power ’ x n
power ’ x (2* n +1) = x * power ’ x (2* n )
1.2. PATTERN MATCHING                                                          9

The second and third clause use a c*p and a c*p+k pattern (with c=2 and k=1),
respectively. Evalution of 22 using this definition goes as follows:


power ’ 2 2
 ⇒ power ’ 2 2
    { 0 does not equal 2 , first equation fails }
    { 2 equals 2* n for n := 1
 ⇒ xn * xn
    where
       xn
        = power ’ 2 1
       { 1 does not equal 0 , first equation fails }
       { 1 does not equal 2* n for any n , second
          equation fails }
       { 1 equals 2* n +1 for n := 0 }
           ⇒ 2 * power ’ 2 0
           ⇒ 2
 ⇒ 2 * 2
 ⇒ 4

Note that this pattern matches only if the to-be-bound identifier can be given
a non-negative integer value.


1.2.7    As pattern
The as pattern allows for binding identifiers multiple times to (parts of) the
actual argument. That is, if pat is a pattern, (x=pat) is a binding pattern
that binds x to pat if pat matches the actual argument (in Haskell the x@pat
notation is used). It is assumed that x is a free identifier.


Example. The function headListTail gets a non-empty list as argument. It
returns the head of the list, followed by the complete list, followed by the tail
of the list.


headListTail ( list =( x : xs ) ) = x : list ++ tail

Evaluation of this function applied to the list abcde leads to


headListTail " abcde "
   { list pattern matches : x := ’a ’ , xs := " bcde " }
   { binding pattern matches : list := " abcde "
 ⇒ ’a ’ : " abcde " ++ " bcde "
 ⇒ " aabcdebcde "
10                               CHAPTER 1. INTRODUCING PATTERNS

1.2.8    Equivalence pattern
The equivalence pattern allows for multiple occurences of an identifier in one
equation. Not every language supports this: Haskell and Miranda allows for such
patterns but not Amanda. An equivalence pattern matches if every occurence
of an identifier agrees on a value for that identifier.

Example. Consider the function that determines the greatest common devisor
of two numbers.


gcd x x = x
gcd x y = gcd (x - y ) y , if x > y
        = gcd x (y - x ) , otherwise

The first line shows an example of an equivalence pattern, stating that the
greatest common divisors of two equal numbers is that number itself. Using
this definition, the greatest common divisor of 18 and 9 is calculated as


gcd 18 9
     { x := 18 , x := 9 , conflict in first equation , no
         match }
     { x := 18 , y := 9 , second equation matches }
     { 18 > 9 ⇒ True }
 ⇒ gcd (18 -9) 9
 ⇒ gcd 9 9
     { x := 9 , x := 9 -- no conflict , matches }
 ⇒ 9


   Except when stated otherwise, in the remainder of this thesis it is assumed
that any function definition does not contain an equivalence pattern. However,
as we will see in Section 2.4.2, using a caret notation equivalence patterns can
be mimicked while still each identifier is bound only once.

   Several researchers have suggested new forms of pattern matching that are
beyond standard pattern matching described so far. In the next chapter yet an-
other form of pattern matching is introduced. The relation with other proposed
pattern matching extensions is discussed in Section 4.2.


1.3     Conclusion
This chapter gave an overview of function definitions and standard pattern
matching. Function definitions may contain patterns, guards, expressions and
where clauses. Examples of existing patterns are the identifier, constant, list,
algebraic, tuple, n+k, as and equivalence pattern.
   In the next chapter a new type of patterns is introduced: application pat-
terns.
Chapter 2

Application patterns

2.1     Introduction
In the previous section the necessary background about functions and pattern
matching was discussed. In this chapter application patterns are described. The
structure of this chapter is as follows: Section 2.2 introduces the concept of ap-
plication patterns, initially in a basic form that is extended with refutability.
Section 2.3 adds application patterns with an arbitrary number of arguments.
In Section 2.4 some refinements are discussed. Section 2.5 describes how ap-
plication patterns can be considered as a general form of most other patterns.
Section 2.6 lists the definition of inverse functions for many standard functions.
Finally the use of application patterns is discussed in Section 2.7.


2.2     Application patterns
Application patterns as presented here were introduced by Oosterhof, Hölzen-
spies, and Kuper (2005). This section describes such patterns, starting with a
basic from to which refutability is added.


2.2.1    Basic application pattern
In its most simple form, an application pattern is a pattern of the form f x.
As any other pattern, application patterns can be used in both the left hand
side of function definitions and in where clauses. The use of an application
pattern requires that an inverse function f−1 is defined. Such an inverse may
be available as a standard function of the programming language (see 2.6), it
can be derived by the systems (a discussion of this subject is beyond the scope
of this thesis) or it must be defined by the programmer. For now it must be
assured that for an actual argument a, f (f−1 a)= a for every value for which
f and f−1 are defined.
    When an actual argument b is matched against a pattern f x, x is bound
to the value of the inverse function f−1 applied to b. The intuition behind this
procedure is that

                         f x=b       ⇐⇒     x = f−1 b

                                       11
12                               CHAPTER 2. APPLICATION PATTERNS

Note that matching against the pattern f x does not involve checking its syn-
tactic structure. Contrary, an application pattern matches against the semantic
value of the actual argument. Application patterns can be nested and used
together with any other kind of pattern.

Example. The succ function computes the successor of any non-negative in-
teger and has an inverse function succ−1 . Their definitions are trivial.

succ n       = n + 1 , if n ≥ 0

succ −1 n = n - 1 , if n ≥ 1

Now consider yet another definition of the power function, one that uses an
application pattern.

power ’ ’ _ 0          = 1
power ’ ’ b ( succ n ) = b * power ’ ’ b n

In the second equation, the second argument succ n is an application pattern
that consists of the function succ applied to an argument n. Note that this
pattern resembles an n+k pattern. Evaluation of power’’ 2 5 now proceeds as
follows.

power ’ ’  2 5
    { 5    does not equal 0 , refuse first equation }
    { b    := 2
        {  ’ solve ’
               succ n = 5
                     n = succ −1 5
                          ⇒ 4      }
         n := 4                          }
 ⇒    2 * power ’ ’ 2 4
 ⇒∗   32



Example. The zip function zips a pair of lists into a list of pairs and has an
inverse zip−1 .

zip :: ([*] , [**]) → [(* , **) ]
zip (( x : xs ) , ( y : ys ) ) = (x , y ) : zip ( xs , ys )
zip _                          = []

zip −1 :: [(* , **) ] → ([*] , [**])
zip −1 (( x , y ) : xys ) = ( x : xs , y : ys )
                           where
                              ( xs , ys ) = zip −1 xys
    −1
zip    []                 = ([] , [])
2.2. APPLICATION PATTERNS                                                         13

Note that zip−1 always returns lists of equal length, whereas zip is also defined
for pairs of lists with unequal length. This means that zip−1 is a partial inverse
of the function zip.
    Suppose a list of (x, y) coordinates is given. The function upperLeft returns
the coordinates of the upperleft corner of the smallest rectangle (with sides
parallel to the x and y axis) that contains all points of the list. It can be
defined with an application pattern.


upperLeft :: [( num , num ) ] → ( num , num )
upperLeft ( zip ( xs , ys ) ) = ( min xs , max ys )

Here the zip (xs, ys) is an application pattern that consists of the function
zip applied to the pair (xs, ys). For an intuitive understanding of this defini-
tion, suppose upperLeft is applied to an actual argument coords. The meaning
of the application pattern zip (xs, ys) is that, for some lists of x-coordinates
xs and y-coordinates ys, coords is the result of zipping these two lists. The
rectangles’ upperleft corner is calculated by taking the minimum and maximum
from the lists of x-coordinates xs and y-coordinates ys, respectively.
    The upperleft point for the list of coordinates [(1,4), (-2,3), (5,2)] is
evaluated as follows.


upperLeft [(1 ,4) , ( -2 ,3) , (5 ,2) ]
    { { ’ solve ’
             zip ( xs , ys ) = [(1 ,4) , ( -2 ,3) , (5 ,2) ]
                  ( xs , ys ) = zip −1 [(1 ,4) , ( -2 ,3) , (5 ,2) ]
                                 ⇒∗ ([1 , -2 ,5] , [4 ,3 ,2])    }
      xs := [1 , -2 ,5] , ys := [4 ,3 ,2]                          }
 ⇒ ( min [1 , -2 ,5] , max [4 ,3 ,2])
 ⇒ ( -2 , 4)




2.2.2     Refutable application patterns
Just like some other patterns, application patterns can be refutable. Suppose
that the pattern f x is matched against an actual argument a. If for all possible
values of x, a cannot be the result of f x, the pattern is refused. This is indicated
by a partial definition of f−1 . In Chapter 3 it is shown how this approach allows
for rewriting code that supports refutable application patterns.

Example. Consider the builtin sine function sin. Since the range of this
function is [−1, 1], its inverse sin−1 is only defined for values in this range.


sin −1 x = arcsin x , if -1 ≤ x ∧ x ≤ 1

Now consider the definition of h that contains an application pattern with the
sine function.
14                                CHAPTER 2. APPLICATION PATTERNS



h ( sin a ) = a * a
h x         = x - 2

When applied to an actual argument b, it depends on the value of this√
                                                                     argument
which of the two equations is used. When h is applied to 0.866 ≈ 3/2, the
first equation is used which results in 1.0965 ≈ π 2 /9.


h 0.866
    { { ’ solve ’
            sin a = 0.866
                  a = sin −1 0.866
                        { -1 ≤ 0.866 ∧ 0.866 ≤ 1 ⇒                      True ,
                             guard succeeds }
                       ⇒ 1.0471                                               }
      a := 1.0471                                                             }
 ⇒ 1.0471 * 1.0471
 ⇒ 1.0965

However, when applied to a value with a greater absolute value than one, the
second equation is used and its value is decreased by two.


h 100
    { { ’ solve ’
            sin a = 100
                  a = sin −1 100
                        { -1 ≤ 100 ∧ 100 ≤ 1 ⇒                    False ,
                            guard fails }
          solving fails                                                      }}
    { second pattern matches : x := 100 }
 ⇒ 100 - 2
 ⇒ 98

Note that despite the fact that the application pattern sin a does not match
100, no runtime exception is thrown but the next equation is tried. In the
examples shown so far only function applications with one argument were used.
In the next section this is extended to an arbitrary number of arguments.


2.3     Currying application patterns
In this section curried application patterns are discussed. The notions of a
cousin and generalized inverse of a function are introduced, as well as a backtic
notations that allows for defining generalized inverses.

2.3.1    Currying
Many functions take multiple arguments; we have already seen this in the max2
and power functions. However, a function that takes n arguments can be seen
2.3. CURRYING APPLICATION PATTERNS                                              15

as a higher order function that takes one argument and returns a function that
takes n−1 arguments. This new function can again be applied to one argument,
yielding another function that takes n − 2 arguments, and so on. After n − 1
steps all arguments are handled. Considering functions with multiple functions
as sequences of a number of higher order functions that all take one argument
is called currying.

Example. The power function takes two arguments, a base b and an an ex-
ponent x, and returns a number bx . It can be considered as a curried function,
with type


power :: num → ( num → num )

If power is applied to an actual base argument (say 2), the result is a function


power 2 :: ( num → num )

that takes one argument and returns two-to-the-power-of-that-argument. When
power 2 is applied to another actual argument (say 5) the result is the value
32.


power 2 5 :: num
power 2 5 ⇒ 32


    However, applying the idea of application patterns directly to curried func-
tions would yield a typing problem. A function f : A → B takes one argument,
and its inverse is of type f −1 : B → A. But what is the type of, say, the inverse
of the power function? Using the rule for functions with one argument would
yield


!!!   power −1 :: ( num → num ) → num

but this would mean that the inverse of the power function would take a higher
function as its argument. This approach has two problems, the first being that
equality of higher order functions is undecidable (this is discussed in more detail
in Section 4.3.2). The second problem is that is unclear what the meaning of
such an inverse would be. However, for the power function meaningful inverse-
like functions can be defined, because if the result bx and one of the arguments
(b or x) is known, the other argument can be found back:

                            bx = s    ⇐⇒     b = s1/x
                                                  ln s
                                      ⇐⇒     x=
                                                  ln b
Thus, we need a generalized form of inverse functions. For this we need the
concept of cousins of a function.
16                                         CHAPTER 2. APPLICATION PATTERNS

2.3.2     Cousins of functions
Suppose f is a function that takes n arguments

                               f : A0 → · · · → An−1 → B

with
                                    f x0 · · · xn−1 = expr
For now it is assumed that the A∗ ’s and B types do not contain an ‘→’—but
for a discussion of the possibilities for such functions, see Section 4.3.2.
      Note that we can partition the list of indices 0, . . . , n − 1 into two sublists
i1 , . . . , ik and j1 , . . . , jm that both keep their indices in order. We write

                      [i1 , . . . , ik ] ∪ [j1 , . . . , jm ] = [0, . . . , n − 1]

where the ∪ operator merges two ordered lists into a new ordered list.

The function

                fic1 ,...,ik : Aj1 → · · · → Ajm → (Ai1 , . . . , Aik ) → B

so that
                fic1 ,...,ik xj1 · · · xjm (xi1 , . . . , xik ) = f x0 · · · xn−1
is called a cousin of f with respect to i1 , . . . , ik . Thus a cousin of f more or less
calculates the same as f itself, it only takes its argument in a different order.
    The trivial cousin of f is the cousin of f with respect no none of its arguments
and equals f itself: f = f∅c (so that k = 0, m = n and jp = p − 1).

Example. The repeat function takes a number n and an element c as its
arguments and returns a list with n times the element c.


rep :: num → * → [*]
rep 0       c = []
rep ( n +1) c = c : rep n c

The cousin of rep with respect to the first and second argument is


rep c1,2 :: ( num , *) → [*]
rep c1,2 (0 , c ) = []
rep c1,2 ( n +1 , c ) = c : rep c1,2 (n , c )




Example.       The join3 function takes three lists and joins them.


join3 :: [*] → [*] → [*] → [*]
join3 x y z = x ++ y ++ z

It has multiple cousins, two of them being
2.3. CURRYING APPLICATION PATTERNS                                                                      17



join3 c2 x z y        = x ++ y ++ z
join3 c1,3 y (x , z ) = x ++ y ++ z




2.3.3       Generalized inverse
The concept of cousins, as described in the previous section, allows for defining
inverse functions for curried functions.
   Consider the function

                                   f : A0 → · · · → An−1 → B

that has a cousin

                    fic1 ,...,ik : Aj1 → · · · → Ajm → (Ai1 , . . . , Aik ) → B

with respect to i1 , . . . , ik (hence [i1 , . . . , ik ] ∪ [j1 , . . . , jm ] = [0, . . . , n − 1]).

The generalized inverse of f with respect to i1 , . . . , ik is a function

                    fi−1
                      1 ,...,ik
                                : Aj1 → · · · → Ajm → B → (Ai1 , . . . , Aik )

such that
                             fi−1       x · · · xjm y = (xi1 . . . , xik )
                               1 ,...,ik j1

if and only if
                             fic1 ,...,ik xj1 · · · xjm (xi1 . . . , xik ) = y
that is, if and only if
                                         f x0 · · · xn−1 = y
We call such a function an inverse (function) on its i1 − 1st, . . . , and ik − 1th
argument.

Note that both fic1 ,...,ik and fi−1
                                  1 ,...,ik
                                            can be parametrized by m parameters. In
a parametrized form, these two functions are inverse functions, i.e.

                       fi−1       x · · · xjm = (fic1 ,...,ik xj1 · · · xjm )−1
                         1 ,...,ik j1


The trivial inverse of f is the inverse of f on none of its arguments. It has the
type
                       f∅−1 : A0 → · · · → An−1 → B → ()
and is informally specified by

                    f∅−1 x0 . . . xn−1 expr = (), iff x0 . . . xn−1 = expr

Note that his inverse is not defined for values in which the guard is false.

For ease of notation, we write the generalized inverse function

                                                 fi−1
                                                   1 ,...,ik


in Ascii using a backtic notation as
18                                CHAPTER 2. APPLICATION PATTERNS



f ‘[ i1 , ... , ik ]

Note that the backtic ‘ is not an operator: f‘[ i1 , ..., ik ] must be consid-
ered as a (systematically named) identifier. With this notation (generalized)
inverse functions can be defined that are used in matching application patterns.


Example. Since a function can have many cousins, it can have many inverses
too. For the power function two meaningul inverse functions can be defined,
namely an inverse on its first argument


power ‘[0] :: num → num → num
power ‘[0] x s = s ^ (1 // x )

and an inverse on its second argument


power ‘[1] :: num → num → num
power ‘[1] b s = ( ln s ) // ( ln b )

Both can be definied simultaniously.
                          √
    The sqroot function · takes the square root from a non-negative number.
Its definition contains an application pattern with the power function.


sqroot ( power x 2) = x

                     √
For the evaluation of 81, it must be decided which inverse of the power function
must be used. Since in the application pattern power x 2 the first argument is
a variable whereas the second is known (a constant), we choose for the inverse
on the first argument power‘[0]


sqroot 81
 { { ’ solve ’
        power x 2 = 81
        { choose power ‘[0] }
               x  = power ‘[0] 2 81
                     ⇒ 9            }
   x := 9                                              }
 ⇒ 9

Thus, when multiple inverses are defined the choice which inverse is choosen
depends on which arguments are known. If multiple inverses are possible, it is
the programmer’s responsability to ensure that it does not matter which inverse
function is choosen.
2.3. CURRYING APPLICATION PATTERNS                                             19

Example. The repeat function has an inverse on its first and second argument.
Given a list, rep‘[0,1] returns a pair with the length of the list and the first
element—but only if all elements in the list are equal. Otherwise the rep‘[0,1]
is not defined. The rep‘[0,1] function is not defined for an empty list, since the
typing system requires that the type of the repeated element is known. Thus,
strictly speaking, rep‘[0,1] is only a partial inverse of rep.

rep ‘[0 ,1] :: [*] → ( num , *)
rep ‘[0 ,1] [ x ] = (1 , x )
rep ‘[0 ,1] ( x : rep n y ) = ( n +1 , x ) , if x = y

Note that the second equation contains a (nested) application pattern with the
repeat function itself. Thus, this definition of rep is recursive.
   Consider the function f that is defined with an application pattern with rep.

f ( rep n x )        = x : rep n ’. ’

The evaluation of f applied to a list of two ’a’’s uses the inverse function
rep‘[0,1]

f " aaa "
     { ’ solve ’
          rep n x = " aa "
            (n , x ) = rep ‘[0 ,1] " aa "
                        { " aa " does not match [ x ] }
                        { " aa " might match x : rep n ’ y
                           x ’ := ’a ’ , rep n ’ y := " a "
                           { ’ solve ’
                                rep n ’ y = " a "
                                   (n ’ , y ) = rep ‘[0 ,1] " a "
                                                ⇒ (1 , ’a ’) }
                           n ’ := 1 , y := ’a ’
                           { x ’= y ⇒ True }                    }
                        ⇒ (n ’+1 , x ’)
                        ⇒ (2 , ’a ’)
            n := 2 , x := ’a ’                                    }
 ⇒ ’a ’ : rep 2 ’. ’
 ⇒ " a .."

From this definition, two other inverse rep functions can be derived. The first
is used when the repeated element is known but the length of the list must be
computed,

rep ‘[0] :: * → [*] → num
rep ‘[0] y ( rep n x ) = n , if x = y

whereas the other is used if the length of the list is known and the repeated
element must be computed.
20                                 CHAPTER 2. APPLICATION PATTERNS



rep ‘[1] :: num → [*] → *
rep ‘[1] n ( rep m x ) = x , if m = n

Both definitions, when applied to actual arguments, would make implicit use of
rep‘[0,1]. Note that the definition for rep‘[0] is not defined for an empty list,
although in this case such a definition would make sense. A separate definition
of rep‘[0] would fix this issue.

   In this section the basic application pattern was introduced. Refutability
and the concept of generalized inverses that allow for multiple inverses were
added. The next section discusses some refinements to these ideas.


2.4     Some refinements
This section describes how application patterns could be used in where clauses,
lambda abstractions and list comprehensions. Also the caret notation is intro-
duced. This notation allows for more flexible use of bound identifiers in patterns.
Finally extraction functions are discussed.

2.4.1       Pattern expressions
So far we have only dealt with application patterns in the left hand side of func-
tion definitions. Since ordinary patterns can also be used in lambda abstrac-
tions, where clauses and list comprehensions, it is proposed that application
patterns can be used in these expressions. Some examples are:
where clauses such as an application pattern that binds n in


      ...
        where
          2^ n = 8

      (Note that the above might be read as a definition for the power function
      using a constant pattern 2. This issue is addressed in the next section.);
lambda abstractions such as the function that maps every number 2n to the
    number n2


      (2^ n → n ^2) 256

      and
list comprehensions such as the list of numbers


      [ n ^2 | 2^ n <- [1..8]]
2.4. SOME REFINEMENTS                                                             21

With application patterns in function definitions the semantics of application
patterns in lambda abstractions and list comprehensions are easily defined. Here
it is left as an exercise for the reader. The implementation of this functionality
is discussed in Section 3.4.6
     Some ambiguities may arise in application patterns. To address this issue a
caret notation is introduced in the next section.

2.4.2     Caret notation
Application patterns allow for more flexible syntax in function definitions. How-
ever, their use may lead to ambiguities. A caret notation is introduced for iden-
tifiers that indicates that an identifier (or its inverse function, in the case of an
application pattern) must be retrieved from the context.

Example. Consider Haskell (Peyton Jones, 2003), where an expression of the
form n+k can be used in the left hand side of a where clause, as in


...
  where
    n + 1 = expr

Now this reads as a (re)definition of the addition function in a where clause.
But with this syntax, how could an n+k pattern be used in a where clause? The
solution that has been chosen in Haskell is to surround the expression n + 1 by
parenthesis, as in


...
  where
    ( n + 1) = expr

 A similar problem would arise for the use of an application pattern in a where
clause. Rather than surrounding the pattern by parenthesis (which adds even
more semantics to these tokens), an alternative solution is proposed: the caret
^ identifier-prefix notation. To indicate that a function application should be
used to bind arguments (instead of defining the function itself) the function
name must be prefixed by a caret ^. Obviously the prefixed function identifier
must have an inverse defined in the context.

Example.      With the caret notation the definition of sqroot’ could be written


sqroot ’ x
 = y
 where
   ^power y 2 = x

where the caret indicates that the inverse of the power function is retrieved from
the context. Note that such ambiguities cannot only arise in where clauses,
22                                 CHAPTER 2. APPLICATION PATTERNS

not in the left hand side of function definitions, in lambda abstractions or in list
comprehensions. In these cases the caret is optional at the function identifier.
   Use of the caret for operators would make expressions less readible. Since
operators will rarely be redefined in a where clause, it is proposed here that the
caret is left out for operators too.

Example. Use of an application function with the addition function + in a
where clause, as in


| f y = x + y
|  where
|   x ^+ 2 = y

results in a less readible ^+ operator. Note that the same problem applies to
other operators, which would be written as, for instance, ^++, ^:, ^! and even
^^. As the caret is left out for operators, the definition of f can be written


| f y = x + y
|  where
|   x + 2 = y




Sometimes it may be desired to use identifiers from the context in an application
pattern. To allow for this the caret notation is extended to any identifier, not
just a function name in a function application. The semantics of an identifier
^i is a constant with the value of i derived from the context (assumed that
that ^i not the function identifier in an application ^iargs .

Example.     The definition of the factorial function can also be written


fac ^ zero = 1
fac n      = n * fac (n -1)

zero = 0




Example.     Yet another definition of square root is


| sqroot ’ ’ ( power x ^ two ) = x

| two = 2

 The caret notation must be used with care, as it allows for different semantics
of almost identifical expressions, especially in where clauses.
2.4. SOME REFINEMENTS                                                                  23

Example.      Suppose the function f takes two arguments in the context


x = 2

f ‘[1]    x s = ...
f ‘[0 ,1]   s = ...

where the inverse functions f‘[0] and f‘[0,1] are both non-refutable.
    Table 2.1 shows variants of its use (with and without carets) in a where
clause, and for each variant an equivalent where clause without application
patterns. This is an example of what is presented in Section 3.3 more generally,
namely an approach to rewrite code with function definitions and where clauses
into equivelant code without application patterns.


          Table 2.1: Some where clauses and equivalent clauses
 Example where clause                 Equivalent where clause without ap-
                                      plication patterns and carets


 ...                                            ...
   where                                          where
     f ^ x y = expr                                 f 2 y = expr




 ...                                            ...
   where                                          where
     ^ f x y = expr                                 (x , y ) = f ‘[0 ,1] expr




 ...                                            ...
   where                                          where
     ^ f ^ x y = expr                               y = f ‘[1] 2 expr



   As mentioned before, in a nested application pattern like g (f x y) the
caret may be left out in front of f, since no ambiguity can arise. Thus, such a
pattern is equivalent to g (^f x y).

   The caret notation can be extended marginally by assuming that in a left
hand side of a function definition, the context of an identifier also includes other
patterns. Equivalence patterns are not supported by all languages1 . The caret
notation allows for mimicking such a pattern.
   1 Amanda is a clear example. Without extra compiler support, Haskell also requires that

in the left hand side ‘The set of patterns must be linear—no variable may appear more than
once in the set.’ (Peyton Jones, 2003)
24                                 CHAPTER 2. APPLICATION PATTERNS

Example. Consider the following definition of the function that computes the
greatest common divisor for two positive integers.

gcd x           ^x          = x
gcd ( x + ^ y ) y           = gcd x y
gcd x           ( x + ^ y ) = gcd x y

The first equation contains an identifier pattern and a constant pattern that
together mimick an equivalence pattern. In the first pattern x is bound the
actual argument, in the second pattern the actual argument is compared to the
value that is bound in the first pattern, i.e. it is compared to the first actual
argument. The second equation contains an n+k pattern. In this pattern the
value of y is used from the context to compute x. This means that y is bound
in the second pattern before the first pattern is evaluated.
    In general, since application patterns may be refutable, the caret notation as
proposed here may yield a different order of pattern matching during evaluation.
Consider the definition of f in

f ( power ^ x y ) ( sin x ) = x * y
f _          _              = 0

that contains two application patterns. During evaluation, the first pattern
requires that the value for x is known. This value must be retrieved from the
context, in this case from the second pattern h x. Thus, first the second pattern
must be matched against the second argument, and only then the first pattern
can be matched. If the second pattern in the first equation does not match the
second equation is used.
   In brief, with the caret notation it is denoted explicitly which identifiers
are bound and where. It allows for mimicking equivalence patterns and adds a
limited amount of power to existing pattern matching.

2.4.3    Extraction functions
So far we have assumed that defined inverse functions are really the inverse
of some function, and that such inverse functions can be defined more or less
uniquely. However, for application patterns both assumptions are not really
required. In fact, the programmer may go as far as he wants, as far as he
assures that the defined inverse functions are used properly.

Example.     The upperLeft function

upperLeft :: [( num , num ) ] → ( num , num )
upperLeft ( zip ( xs , ys ) ) = ( min xs , max ys )

contains an application pattern with the zip function. For its use the definition
of zip‘[0] is required. However, the definition of the zip function is not
really required for this definition of upperLeft to work.        If an application
patterns contains a function that is not a partial inverse, this function is called
an extraction function.
2.4. SOME REFINEMENTS                                                              25

2.4.4     Programmer’s responsibilities
Another issue is the use of an application pattern for which different inverse
functions can be defined for the same set of arguments.

Example.      The function join2 joins two strings

join2 x y = x ++ y

for which clearly two inverses can be defined, one for each argument.

join2 ‘[0] y s = x , if y = z
               where
                 (x , z ) = split ((# s ) - (# y ) ) s

join2 ‘[1] x s = y , if x = z
               where
                 (y , z ) = split (# x ) s

However, an inverse on both inverses is possible too, but for this multiple defin-
itions are possible. That is, if the list s is the result of x ++ y, the list s can be
split at, e.g., the beginning, middle or end to yield original values for the lists x
and y. These variants can be defined by

join2 ‘[0 ,1]         s = ([] , s )

join2 ‘[0 ,1] ’       s = split ( (# s ) / 2) s

join2 ‘[0 ,1] ’ ’ s = (s , [])

All three are partial inverse   functions of join2, since for any lists x and y it
holds that
           join2‘[0,1]      s   ⇒∗ (x, y)       =⇒      join2 x y ⇒∗ s
           join2‘[0,1]’ s       ⇒∗ (x, y)       =⇒      join2 x y ⇒∗ s
           join2‘[0,1]’’ s      ⇒∗ (x, y)       =⇒      join2 x y ⇒∗ s
However, application patterns that rely on such definitions must be used with
great care. Consider the following definition of mergeSort that sorts a list.

merge :: [*] → [*] → [*]
merge ( x : xs ) ( y : ys ) = x : merge xs ( y : ys ) , if x < y
                            = y : merge ( x : xs ) ys , otherwise
merge xs           ys       = xs ++ ys

mergeSort      :: [*] → [*]
mergeSort      []              = []
mergeSort      [x]             = [x]
mergeSort      ( join2 ’ x y ) = merge ( mergeSort x )
                                       ( mergeSort y )
26                                    CHAPTER 2. APPLICATION PATTERNS

The last equation of the definition of mergeSort contains an application pattern
of the join2’ function. This means that when mergeSort is applied to an actual
list argument with length two or more, the inverse function join2‘[0,1]’ is
used to split the argument in two lists of (almost) equal length. However, the
reader may verify that if the application pattern would contain either the join2
or the join2’’ function, use of the mergeSort function would lead to an infinite
loop for any list with length greater than one. In this case, renaming join2’
to, e.g., join2halves would avoid confusion and ease debugging.
    These examples show that the programmer has a great responsibility in
the definitions of inverse functions and in the use (and misuse) of application
patterns.
    In this section applications patterns in expressions was discussed, as well as
the caret notation and programmer’s responsabilities. With these considerations
in mind, in the next section it is shown how application patterns relate to other
patterns.


2.5      Application patterns as a generalization
In this section it is shown how application patterns can be seen as a general
form of most of the other patterns discussed in Section 1.2. I consider this as
mostly of theoretical importance: is is not my intention to really rewrite all
patterns by application patterns, not in least because performance may suffer
from such a procedure.

2.5.1     List pattern, revisited
A list pattern x:xs matches any non-empty list, binding x to the head and xs
to the tail of that list. To avoid confusion, I define the cons operator : as a
function with a full name:


cons :: * → [*] → [*]
cons x xs = x : xs

This functions has an inverse on both its arguments that accepts all lists except
the empty list.


cons ‘[0 ,1] xs = ( hd xs , tl xs ) , if xs 6= []

Thus, the list pattern x:xs can also be expressed by the application pattern
cons x xs2 .

2.5.2     Algebraic pattern, revisited
In any algebraic pattern, the constructor can be regarded as an injective function
on all of its arguments.
   2 A list pattern can also be expressed by an algebraic pattern. Since it is shown that

algebraic patterns are a special kind of application patterns, this provides another way to
show that list patterns can be expressed by an application pattern.
2.5. APPLICATION PATTERNS AS A GENERALIZATION                                 27

Example. Miranda and Amanda do not support this, but Haskell provides
direct support for such a construction. In this approach, the division tree type


divTree ::= Lit num | Div divTree divTree

defines two functions that have the types


Lit :: num → divTree

Div :: divTree → divTree → divTree

These functions are injective on all of their arguments, hence the inverses


Lit ‘[0] :: divTree → num

Div ‘[0 ,1] :: divTree → ( divTree , divTree )

exist and their definitions follow directly from the type definition of divTree.
This approach can be used for any algebraic pattern; hence the algebraic pattern
can be seen as a special kind of application pattern. Note that the list pattern
is also a special case.

2.5.3    Tuple pattern, revisited
A tuple pattern can be expressed by an algebraic pattern, as a tuple type can
be expressed by an algebraic type.

Example. The most general 3-tuple type (*, **, ***) is expressed by the
algebraic type


threeTuple * ** *** ::= ThreeTuple * ** ***

With this algebraic type, the tuple pattern (2, x, True) where x is a free
identifier is expressed by


ThreeTuple 2 x True

and it can be matched as any other algebraic pattern.

2.5.4    n+k pattern, revisited
With application patterns, an n+k pattern can be considered as just an appli-
cation with the addition function


plus x y = x + y
28                                CHAPTER 2. APPLICATION PATTERNS

For the plus function an inverse function on its first argument can be defined.


plus ‘[0] k n = n - k , if k ≥ 0 ∧ n ≥ k

Note that a variant of this pattern that matches any value (positive or negative)
and allows for any value of k (positive or negative) can be obtained by removing
the guard in this definition.
    Likewise, an c*p pattern can be seen as an application with the multiplica-
tion function


times x y = x * y

for which the inverse on its second argument is defined by


times ‘[1] c p = p / c , if c > 0 ∧ divRem p c = 0

The variant that matches any value (6= 0) can be obtained by replacing the
guard by the condition c 6= 0.


2.5.5    Constant pattern, revisited
The constant pattern only checks an actual argument for having a certain con-
stant value. Since a constant can be considered as a constructor without argu-
ments this translates directly to inverse functions. For example, the constants


3 :: num
False :: bool
’w ’ :: char

have inverses that informally may be written


42 ‘[] x         = () , if x = 42

False ‘[] x = () , if ~ x

’w ’ ‘[] x      = () , if x = ’w ’

Note that these inverses, if they match, only returns the empty tuple (), which
means that a match will not bind any identifiers.


The previous patterns could be expressed directly by application patterns. The
as pattern can be expressed indirectly by use of an helper function.
2.6. STANDARD INVERSE FUNCTIONS                                               29

2.5.6    As pattern, revisited
The as pattern allows for binding identifiers multiple times to (parts of) the
actual argument. It can be expressed indirectly by using the theSame function


theSame x y = x , if x = y

that has an inverse on both its arguments


theSame ‘[0 ,1] x = (x , x )

With this definition, the as pattern x=pat (in Haskell: x@pat) can be expressed
by the application pattern theSame x pat.

Example.     The definition


headListTail ( list =( x : xs ) ) = x : list ++ tail

is rewritten into


headListTail ( theSame list ( x : xs ) ) = x : list ++ tail




2.5.7    Equivalence pattern, revisited
Equivalence patterns cannot be expressed by application patterns. However, the
caret notation does allow for rewriting an equivalence pattern into an identifier
pattern and one or more constant patterns. That is, suppose x occurs multiple
times in a list of patterns. Then every occurance of x except one can be replaced
by the constant pattern ^x that has the value of x. We have seen an example
already in Section 2.4.2.
    To conclude, application patterns extended with the caret notation can be
seen as a general form of all patterns except for the identifier pattern.

This overview showed how existing patterns can be seen as special cases of
application patterns. In the next section it is shown that for many standard
functions one or more inverse functions can be defined.


2.6     Standard inverse functions
In this section inverse function definitions are given for standard functions. It
is shown that for many standard functions one or more inverses exist. All their
definitions can be made part of a standard library for inverse functions.
     30                                 CHAPTER 2. APPLICATION PATTERNS

     2.6.1     Arithmetic operators
     For most arithmetic operators one or two inverses exist. For each function its
     type, as well as its inverses are given. For clearity I use alphanumeric identifiers
     but indicate the operator characters between brackets.
         The inverse definition for the modulo operator % is debatable, as well as that
     for the abs function that is more like a guard that checks for a non-negative
     argument. As discussed in Section 2.5.4 about the n+k and p*c pattern, for
     addition and multiplication the check for a positive argument is language choice.
     Here I leave these checks out.

1    || negate [ - ( prefix ) ]
2    || neg :: num → num
3    neg ‘[0] x = neg x
4

5    || addition [+]
6    || plus :: num → num → num
7    plus ‘[0] y s = s - y
8

9    plus ‘[1] x s = s - x
10

11   || subtraction [ - ( infix ) ]
12   || minus :: num → num → num
13   minus ‘[0] y s = s + y
14   minus ‘[1] x s = s - x
15

16   || multiplication [*]
17   || times :: num → num → num
18   times ‘[0] y s = s / y , if y 6= 0
19                  = 0     , if s = 0
20

21                                 6 0
     times ‘[1] x s = s / x , if x =
22                  = 0     , if s = 0
23

24   || division [/]
25   || div :: num → num → num
26   div ‘[0] y s = s * y
27

28   div ‘[1] x s = x / s , if s 6= 0
29

30   || modulo [%]
31   || mod :: num → num             → num
32   mod ‘[1] x s = hd fs ,                6 []
                                     if fs =
33                where
34                  fs = [           i | i <- [( s +1) ..]
35                        ;          (x - s ) mod i = 0    ]
36

37   || absolute value
38   || abs :: num → num
39   abs ‘[0] x = x , if x ≥ 0
     2.6. STANDARD INVERSE FUNCTIONS                                          31

40

41   || natural logaritm
42   || ln :: num → num
43   ln ‘[0] x = e ^ x
44

45   || e power
46   || exp :: num → num
47   exp ‘[0] x = ln x , if x > 0
48

49   || power [^]
50   || power :: num → num → num
51   power ‘[0] x s = s ^ (1 // x )
52

53   power ‘[1] b s = ( ln s ) // ( ln b )




     2.6.2    Goniometric functions
     Inverses for the goniometric functions are easily defined. As the arcsin and
     arccos functions may not be available (as is the case in Amanda), they are
     expressed using the arctan function.


55   || sine
56   || sin :: num → num
57   sin ‘[0] x = atan ( x // (1 - x ^2) ^0.5 ) , if abs x ≤ 1
58

59   || cosine
60   || cos :: num → num
61   cos ‘[0] x = atan ( (1 - x ^2) ^0.5 // x ) , if abs x ≤ 1
62

63   || tangent
64   || tan :: num → num
65   tan ‘[0] x = atan x
66

67   || inverse sine
68   || arcsin :: num → num
69   arcsin ‘[0] x = sin x , if abs x ≤ pi // 2
70

71   || inverse cosine
72   || arccos :: num → num
73   arccos ‘[0] x = cos x , if abs x ≤ pi // 2
74

75   || inverse tangent
76   || tan :: num → num
77   arctan ‘[0] x = tan x , if remainder x pi 6= pi // 2
     32                                CHAPTER 2. APPLICATION PATTERNS

     2.6.3    Numerical functions
     The prime, fibonacci and factorial functions are well-known examples of func-
     tions that calculate the n-th number that adheres to some condition. They can
     be defined in an easily-readable (but not necesarily efficient) way by


     prime :: num → num → num
     prime n = ( sieve [2..]) ! n
             where
               sieve ( p : x ) = p : sieve [ n | n <- x ; n mod p
                    > 0]

     fib :: num → num → num
     fib 0       = 1
     fib 1       = 1
     fib ( n +2) = fibonacci n + fibonacci ( n +1)

     fac :: num → num
     fac 0 = 1
     fac n = n * fac (n -1)

     These function have in common that, from a certain value on, they all increase
     strictly monotonically. Thus, to define the inverse prime‘[0] applied to some
     argument y, we can try for an increasing value x whether prime x evaluates
     to y. Now only a suitable starting value for x (0 would be fine), as well as
     an halting condition (for when we know that the value for x has grown too
     large) have to be defined. The same approach can be used to define the inverse
     functions fib‘[0] and fac‘[1].
         The helper definition invGenTest provides the desired functionality. It takes
     as arguments the original function (for which the inverse is required), a succes-
     sor function that increases the starting value, a testing function that indicates
     whether the starting value has grown to large, and an initial value x. It returns
     a function that takes an image y and returns Just x if there is some value of
     x for which y is the image, or Nothing is no such value for x exists. The use
     of the maybe type is to allow the inverse function to be a partial definition, so
     that its implicit in a pattern allows for refutability.


79   invGenTest :: (* → **) → (* → *) → (* → ** → bool ) → *
        → ** → maybe *
80   invGenTest f next stop x y
81    = Just x , if f x = y
82    = invGenTest f next stop ( next x ) y , if ~( stop x y )

     Now inverses for the prime, fibonacci and factorial functions are defined by


84   prime ‘[0] y = fromJust valMb , if valMb 6= Nothing
85                where
86                  valMb = invGenTest prime (+1) ( >) 0 y
87
     2.6. STANDARD INVERSE FUNCTIONS                                                 33

88                                          6 Nothing
     fib ‘[0] y = fromJust valMb , if valMb =
89                where
90                  valMb = invGenTest fib (+1) ( >) 1 y
91

92   fac ‘[0] y = fromJust valMb , if valMb 6= Nothing
93                where
94                  valMb = invGenTest fac (+1) facStop 1 y
95                  facStop x y = x -1 > log y

     Note that, since fib 0 = fib 1 and fac 0 = fac 1, the starting values for
     x starts at 1 since the fibonacci and factorial functions only increase strictly
     monotonically from 1 on. Note further that the factorial function has a rather
     efficient testing functions that increases x faster than the successor function +1.
         Finally it must be remarked that other definitions for these inverses may be
     more efficient.

     Example.     The fibonacci numbers have the property that

                                                φn − φ̂n
                                    fib n   =     √
                                                    5
     where
                                            √
                                           5+1
                                     φ=        ,
                                           √2
                                            5−1
                                      φ̂ =
                                             2
                                                                    √
     as is easily shown by induction. Since fib n approaches φn / 5 asymptotically,
     a more efficient definition for the inverse fibonacci function is


     fib ‘[0] ’ 1 = 1
     fib ‘[0] ’ n = val , if n > 1 ∧ fib val = n
                  where
                    val = ceiling ( log n // log phi )
                         where
                           phi = (1+5^0.5) // 2

      Thus, use of the invGenTest function in inverse function definitions may be
     easy, but sometimes more efficient definitions exist.

     2.6.4    List manipulation
     For many list manipulation functions inverse functions can be defined, most of
     them being straightforward.
        Note that for the join3‘[1] definition—that joins three lists—the first oc-
     curence of the separating string is choosen. That is, if the lists ^y and ^y’ are
     known while for certain lists it holds that

                   join3 x ^y z = s and          join3 x’ ^y’ z’ = s
      34                                CHAPTER 2. APPLICATION PATTERNS

      then matching join3 p ^y r against an actual argument will bind p to the
      shortest list in x and x’ (and q to the longest list in z and z’). In other words,
      join3 is non-greedy. As we will see in Section 2.7.2, this decision allows for
      simple string parsing


97    || reverse a list
98    || reverse :: [*] → [*]
99    reverse ‘[0] x = reverse x
100

101   || constitute a list from a head and a tail list
102   || cons :: * → [*] → [*]
103                                         6 []
      cons ‘[0] xs = ( hd x , tl x ) , if x =
104

105   || join two lists [++] ( a . k . a . join2 )
106   || join :: [*] → [*] → [*]
107   join ‘[0] y s = x , if y = z
108                 where
109                   (x , z ) = split ((# s ) - (# y ) ) s
110

111   join ‘[1] x s = y , if x = z
112                 where
113                   (y , z ) = split (# x ) s
114

115   || join three lists
116   || join3 :: [*] → [*] → [*] → [*]
117   join3 ‘[1] x z s = y , if x =x ’ ∧ z =z ’
118                    where
119                      (x ’ , yz ) = split (# x ) s
120                      (y , z ’) = split (# ys - # z ) ys
121

122   join3 ‘[0 ,2] y s = hd xzs , if xzs 6= []
123                        where
124                          xzs = [ (x , z )
125                                 | i <- [0..(# s - # y - 1) ]
126                                 ; (x , yz ) = split i s
127                                 ; (y ’ , z ) = split (# y ) yz
128                                 ; y = y’
129                                 ]
130   || zip a pair of lists
131   || zip :: ([*] , [**]) → [(* , **) ]
132   zip ‘[0] :: [(* , **) ] → ([*] , [**])
133   zip ‘[0] (( x , y ) : xys ) = ( x : xs , y : ys )
134                               where
135                                 ( xs , ys ) = zip −1 xys
136   zip ‘[0] []                 = ([] , [])
137

138   || zip two lists
139   || zip2 :: [*] → [**] → [(* , **) ]
140   zip2 ‘[0 ,1] xs = zip ‘[0] xs
      2.6. STANDARD INVERSE FUNCTIONS                                                35

141

142   || take the first n elements
143   || take :: num → [*] → [*]
144   take ‘[0] x s = len , if take len s = x
145                 where
146                   len = # x
147

148   || drop the first n elements
149   || drop :: num → [*] → [*]
150   drop ‘[0] y s = len , if drop len s = y
151                 where
152                   len = # y
153

154   || splits a list at a certain index
155   || split :: num → [*] → ([*] , [**])
156   split ‘[0 ,1] ( xs , ys ) = (# xs , xs ++ ys )
157

158   || get ( n +1) - th element from list [!]
159   || index :: [*] → num → *
160   index ‘[1] x s = hd is , if is 6= []
161                     where
162                       is = [ i | i <- [0..(# s -1) ]; s ! i = x ]
163

164   || repeat      an element n times
165   || rep ::      num → * → [*]
166   rep ‘[0 ,1]    :: [*] → ( num , *)
167   rep ‘[0 ,1]    [ x ] = (1 , x )
168   rep ‘[0 ,1]    ( x : rep n y ) = ( n +1 , x ) , if x = y



      2.6.5    Conversion functions
      Conversion functions mainly transform values from one type to another. Since
      this transformation is already defined in both directions, the inverse definitions
      are rather trivial. Note that the definition of lines‘[0] is recursive and rather
      symmetrical with that of unlines‘[0].


170   || transform string to integer
171   || atoi :: [ char ] → num
172   atoi ‘[0] s = itoa s
173

174   || transform integer to string
175   || itoa :: num → [ char ]
176   atoi ‘[0] s = atoi s , if filter ( member " -.0123456789")
           s = s !\\
177                              ∧ count ’. ’ s ≤ 1!\\
178                              ∧ count ’-’ ( tl s ) = 0!\\
179                where count x = (#) . filter (= x ) !\\
180
      36                                 CHAPTER 2. APPLICATION PATTERNS

181   || get character ascii code
182   || code :: char → num
183   code ‘[0] s = decode s , if 0 ≤ s ∧ s ≤ 255
184

185   || get character with certain ascii code
186   || decode :: num → char
187   decode ‘[0] s = code s
188

189   || splits a string based on newline characters
190   || lines :: [ char ] → [[ char ]]
191   lines ‘[0] ( join3 x "\ n " ( lines xs ) ) = x : xs
192   lines ‘[0] x                               = [x]
193

194   || joins a list of lists , adding newline characters
195   || unlines :: [[ char ]] → [ char ]
196   unlines ‘[0] ( x : xs ) = join3 x "\ n " ( join3 xs )
197   unlines ‘[0] []         = []

      In brief, for many standard functions an inverse can be defined.




      2.7       The use of application patterns
      In this section a brief overview of the use of application patterns is given. Be-
      sides the theoretical importance that application patterns are a general form
      (Section 2.5) they also yield practical implications.


      2.7.1      More readible definitions
      Using the application pattern, function definitions may become more readible.
      That is, if in a function definition first some trivial operation must be performed
      on an argument, this operation can be placed in the right hand side of the
      definition.

      Example. In the following definitions, first a simple operation is applied to
      an actual argument.


      f    ( sin alpha ) = . . . alpha . . .
      g    (2* n )      = ... n ...
      h    ( itoa s )    = ... s ...
      k    ( ln x )     = ... x ...

      For example, if f is applied to an actual argument a, the function sin‘[0] is
      applied to a and the result bound to alpha. Note that f is only defined for
      values between -1 and 1, inclusive. Likewise, the functions g, h and k use,
      when applied to an actual argument, the inverse functions *‘[1], itoa‘[0]
      and ln‘[0] in order to bind n, s and x, respectively.
2.7. THE USE OF APPLICATION PATTERNS                                           37

Example.     Since nested patterns are possible too, the definition like


f x = ... p ... , if abs x ≤ 1
    where
      p = 5 - arcsin x

can be written more readible as


f ( sin (5 - p ) ) = ... p ...




Example. Another example of a better readible function definition example
is the upperLeft function


upperLeft :: [( num , num ) ] → ( num , num )
upperLeft ( zip ( xs , ys ) ) = ( min xs , max ys )



2.7.2    Simple string parsing
A nice application for application patterns is simple string parsing. Suppose
that, from a long input string s, some substrings must be bound to the identifiers
x1 ,...,xk which are seperated by known substrings c1 ,...,ck−1 . Then these
identifiers can be bound by matching the pattern


join3 x1 c1 ( join3 x2 c2 (... ( join3 x k−1 c k−1 x k ) ...) )

against the input string s, since during evaluation the inverse join3‘[0,2] is
used to bind the x* ’s. If s starts or ends with a known substring, then the
beginning or end can be matched by the use of the join2 function.

Example. Consider the function vec3length that parses the length of a string
that represents a three-dimensional vector (x,y,z). For any other string it
returns zero. Informally it would be defined by


vec3length ( "(" ++ ( itoa x ) ++ " ," ++ ( itoa y ) ++ " ,"
     ++ ( itoa z ) ++ "") " )
 = ( x ^2 + y ^2 + z ^2) ^ 0.5

vec3length _ = 0

Now clearly the use of ++ will not work, but this definition can automatically
be rewritten into
38                                 CHAPTER 2. APPLICATION PATTERNS



vec3length ( join2 "("
                     ( join3 ( itoa x )
                             " ,"
                             ( join3 ( itoa y )
                                        " ,"
                                        ( join2 z ") "                  ))))
 = ( x ^2 + y ^2 + z ^2) ^ 0.5

vec3length _ 0

where the join2‘[1], join3‘[0,2] and join2‘[0] inverse functions are used
when vec3length is applied to an actual argument. With this definition, the
length of the vector represented by the string "(2,3,6)" evaluates to 7, whereas
a bad-formed string evaluates to 0.


vec3length "(2 ,3 ,6) "
 ⇒ 7

veclength " not a vector "
 ⇒ 0

 Thus, such constructions may allow for better readible and easier compre-
hendible definitions.
    Besides these considerations, inverse function definitions allow for indicating
that different functions (the function itself and its inverses) are semantically
related. In addition, the caret notation allows for some extra expressive power
in patterns. It must be noted, though, that application pattern syntax and
semantics may take some time to get used to for the programmer.


2.8     Conclusion
This chapter described application patterns. The concept of generalized inverses
was introduced, as well as a new caret notation that adds expressive power to
patterns. Application patterns together with the caret notation
Chapter 3

The Application Pattern
Compiler

3.1     Introduction
In the previous chapter application patterns were discussed. This chapter will
discuss rewriting application patterns into semantically equivalent runnable
code.
    In Section 3.2 this rewriting it is made intuitive to the reader by discussing
some examples. In Section 3.3 a general rewriting algoritm for application pat-
tern is sketched. This sketch can be seen as both providing an implementation
of rewriting the rewriting algoritm and providing the semantics of application
patterns. In Section 3.4 the implementation of this rewriting algoritm is dis-
cussed.


3.2     Intuitively rewriting application patterns
In this section I describe intuitively how an application pattern can be rewrit-
ten. In order to describe all features of the rewriting algoritm, I will take the
same approach as in Chapter 1. First rewriting of the basic application pat-
tern is described. Then refutability is added by using the maybe type. Finally
generalized inverse functions are discussed.

3.2.1    Basic pattern
This section describes rewriting a basic pattern f x. Recall the upperLeft
example from Section 2.2.1.


upperLeft :: [( num , num ) ] → ( num , num )
upperLeft ( zip ( xs , ys ) ) = ( min xs , max ys )

How would one rewrite this definition without application patterns? The idea
is that during evaluation of upperLeft a, where a is an actual argument, the
equation

                                       39
40              CHAPTER 3. THE APPLICATION PATTERN COMPILER

                              zip (xs, ys) = a
is solved for xs and ys by applying the inverse function zip‘[0] to both sides
of this equation:
                            (xs, ys) = zip‘[0] a
Now the solution proposed here for rewriting the definition of upperLeft is
to introduce a new (free) identifier, say var, that takes the role of the actual
argument. The argument (xs, ys) in the application pattern is then bound in
a where clause:


upperLeft ’ :: [( num , num ) ] → ( num , num )
upperLeft ’ var = ( min xs , max ys )
                 where
                   (xs, ys) = zip‘[0] var



3.2.2    Adding refutability
The basic rewriting procedure in the previous section does not take into account
that an application pattern may be refutable. This section describes rewriting
a basic pattern f x where f may be partially defined (yielding refutability).
Consider the definition


h ( sin a ) = a * a
h x         = x - 2

This definition uses that the inverse sine function is partially defined, namely
only for values in [−1, 1]:


sin ‘[0] x = arcsin x , if abs x ≤ 1

However, the evaluation of say sin‘[0] 2 produces a runtime exception. In
order to avoid such exceptions, first the definition of sin‘[0] is rewritten (in-
dicated by the _Mb suffix) so that it returns a value of the maybe type:


sin_Mb ‘[0] x = Just arcsin x , if abs x ≤1
              = Nothing , otherwise

This rewriting can be performed automatically, as is shown further in this chap-
ter. To apply the sin_Mb‘[0] function to an argument var, first it must be
checked that its value is not Nothing. If its value is not Nothing (that is, the
inverse function is defined for the argument var), it is Just something where
this something is the desired result.
    Thus, to rewrite the first equation in the definition of h two variables are
introduced: a var variable that replaces the pattern sin a, and a match variable
that checks whether the inverse function sin_Mb‘[0] is defined for the value of
var. This results in
3.2. INTUITIVELY REWRITING APPLICATION PATTERNS                                 41



h ’ var     = a * a , if match = Nothing
              where
                match = sin Mb[0] var
                Just var = match

h’ x           = x - 2

As the first equation now contains an identifier pattern, the second equation has
become unreachable. Thus the two equations must be merged, where care must
be taken that the arguments of h match. Here the occurence x in the second
equation can be renamed to var, resulting in


h ’ var = a * a , if match 6= Nothing
           where
             match = sin_Mb [0] var
             Just var = match

h ’ var = var - 2 , otherwise



3.2.3     Adding refutability
With refutability added in the previous section, now it is time to describe rewrit-
ing application patterns with multiple arguments. This section describes rewrit-
ing a an application pattern f x0 ... xn−1 where f may be partially defined.
Consider the definition


firstAndThird ( join5 x ^ hyph " _ "                    " -"   z)
 = "[" ++ x ++ "|" ++ z ++ "]"

hyph = " _ "

where the application pattern join5 x ^hyph "_" "-" z contains five ar-
guments. The second argument ^hyph, the third argument "_" and the fifth
argument are known, i.e. constant or retrieved from the context. The first
argument x and the fifth argument z must be bound.
   Now suppose the join5 function joins five lists


join5 a b c d e = concat [a , b , c , d , e ]

and has an inverse function defined with respect to its first, third and fifth
argument


join5 ‘[0 ,2 ,4] :: [*] → [*] → [*] → ([*] ,[*] ,[*])
join5 ‘[0 ,2 ,4] b d s = ...
42               CHAPTER 3. THE APPLICATION PATTERN COMPILER

that can be automatically be rewritten into a definition that returns the maybe
type


join5_Mb ‘[0 ,2 ,4] :: [*] → [*] → [*] → maybe ([*] ,[*] ,[*])
join5_Mb ‘[0 ,2 ,4] b d s = ...

Rewriting as definition ∗ is informally specified by


  f‘[a1 ,· · ·,ak ]x1 · · · xm            f_Mb‘[a1 ,· · ·,ak ]x1 · · · xm
  = v1 , if g1                            = Justv1 , ifg1
       ..        ..               ∗                 ..         ..
        .         .               ⇒                  .          .
  = vn , if gn                            = Justvn , ifgn
                                          = Nothing, otherwise

    and the resulting definition can be added to the existing definitions.
    Clearly we must use this inverse function so solve for the arguments x and z
in the application pattern. The first step is the same as in the previous section:
a new identifier var replaces the application pattern:


firstAndThird ’ var
 = "[" ++ x ++ "|" ++ z ++ "]"

Note that the arguments in the application pattern join5 x ^hyph "_" "-"
 z ")" can be partitioned into three lists,
     1. the arguments that are both required by join5_Mb‘[0,2,4] and known:
        ^hyph and "-";
     2. the arguments that are provided by join5_Mb‘[0,2,4] and that must be
        bound: x and z; and
     3. the arguments that are provided by join5_Mb‘[0,2,4] but are already
        known: "_". These arguments must be checked for their value.
Now the inverse join5_Mb‘[0,2,4] is applied to the arguments from the first
set, together with a fresh identifier that replaces the whole application patterns.
The result is again bound to a fresh matching identifier match


firstAndThird ’ var
 = "[" ++ x ++ "|" ++ z ++ "]" , if match ~= Nothing
 where
    match = join5 Mb‘[0,2,4] ^hyph "-" var

The arguments in the other two lists are bound using the result. For members
of the third set, arguments that are provided by join5_Mb‘[0,2,4] but are
already known: "_", new identifiers are introduced that are checked for the
right value by adding a guard to the definition. Here a new identifier var1 is
introduced that is checked for being equal to the third argument "_".
3.3. A REWRITING ALGORITM                                                      43



firstAndThird ’ var
 = "[" ++ x ++ "|" ++ z ++ "]" , if match =     6 Nothing
                                         ∧ var1 = " "
 where
   match = join5_Mb ‘[0 ,2 ,4] ^ hyph " -" var
   Just (x , var1 , z ) = match

(Note: in the next section an algoritm is presented that treats elements in the
last two lists alike).

   Finally one issue must be resolved: what if during rewriting an application
pattern one can choose between multiple inverse functions that all provide the
necessary arguments (and possibly others as well)? Some options are
Choose the first inverse that is defined. This solution is most easily imple-
    mented.
Choose the smallest set of arguments that is provided by the inverse.
Choose the largest set of arguments that is provided by the inverse.
Choose a random defined inverse.
Either of the ones above repeatedly by allowing one inverse to fail (be-
     cause it is not defined) and then try another one.
The different options may yield different evalution results, for instance when
one inverse is defined for a smaller domain than another one. The pros and
cons of each of these options are subject to further research.
   In this section an intuitive overview was given on rewriting single application
patterns. In the next section a general rewriting algoritm is discussed that
rewrites all kinds of patterns that may be nested and overlap.


3.3     A rewriting algoritm
This section sketches rewriting algoritm that can be used for rewriting code
with application patterns into code without application patterns.

3.3.1    Overview
Peyton Jones (1987) describes a compiler that translates function definitions
with pattern matching into case-expressions that can be efficiently evaluated.
This is not the approach of the algoritm described here, as this algoritm trans-
lates function definitions with pattern matching that may include application
patterns into function definitions with pattern matching that does not include
application patterns. In addition, the algoritm described here does not incor-
porate optimizations that are described by Peyton Jones such as a per-column
rewriting.
    The compiler described by Peyton Jones provides support for
   • Overlapping patterns
44               CHAPTER 3. THE APPLICATION PATTERN COMPILER

     • Nested patterns

     • Constant patterns

     • Multiple arguments

     • Non-exhaustive sets of equations

     • Conditional equations

     • Repeated variables

    The rewriting algoritm for application patterns, as described here, provides
support for all these constructions too. For ordinary (i.e., non-application) pat-
terns the algoritm translates pattern correctly, that is in accordance with the
semantics of pattern matching as described by Peyton Jones (1987). There-
fore, one may consider application patterns as an extension to current pattern
matching whose semantics are defined by the rewriting algoritm.

3.3.2     Rewriting patterns
In essence, the algoritm allows for rewriting all kinds of patterns into simpler
patterns. Patterns in the resulting code are either identifier patterns, nested tu-
ple patterns or non-nested algebraic patterns. In this section rewriting all kinds
of patterns is described (except the ones that can be expressed by application
patterns as described in Section 2.5), whereas the next section will cover rewrit-
ing function definitions. One may wonder why rewrite not just the application
patterns and leave the other patterns as they are. However, since application
patterns and all other patterns can occur nested, to avoid runtime exceptions
all patterns must be rewritten.
    In the previous section application patterns where rewritten by adding guards
and where clauses to function definitions; the rewriting algoritm is based on the
same principle. The notation


 Rewr J e K
 = e ’ C guard+ L99g
       C wheres+L99ws

means that the algoritm rewrites the pattern e is into e’, with the guard g and
the where clauses ws added to the definition in which the expression occurs.
    The predicate isKnown(·) is used to indicate that an expression is known (in
its context), i.e. that it contains no free identifiers.
    It is assumed that all identifiers that are bound in patterns are different
(but the caret notation allows for mimicking the equivalence pattern: see Sec-
tion 2.5.7). For application patterns it is assumed that the caret prefix is used
in the function name.

Constant
A constant is replaced by a new identifier whose value is compared to the con-
stant.
3.3. A REWRITING ALGORITM                                                      45




  Rewr J c K
  = var C guard+ L99var = c


    • isKnown( c )
    • var is a new identifier



Example.      The definition



fac (1 + 2 + 3 + 4 - 10) = 1


is rewritten into



fac var = 1 , if var = 1 + 2 + 3 + 4 - 10




Identifier

Rewriting the identifier pattern is trivial, as it is the identifier itself.




  Rewr J i      K
   = i

    • i is an identifier



Function application

For an application pattern the inverse is applied to its required arguments. The
arguments provided by the inverse are (in their rewritten form) bound to the
result.
46                   CHAPTER 3. THE APPLICATION PATTERN COMPILER


  Rewr J ^ f x 0 ... xn−1 K
   = var C guard+ L99match 6= Nothing
          C wheres+L99match = f_Mb ‘[ i1 , ... , ik ] x j1 ... x jm
                      Just ( Rewr J x i1 K ,... , Rewr J x ik K )
                         = match

      • x∗ ’s are patterns
      • ∀p ∈ {1, . . . , j} : isKnown( xp )
      • The inverse f‘[i1 , ...,ik ] is defined for m argumentsa
      • The indices of provided arguments i∗ and indices of required arguments
        j∗ partition the list of all argument indicesb :

                             [i1 , . . . , ik ] ∪ [j1 , . . . , jm ] = [0, . . . , n − 1]

            where the ∪ operator merges two ordered lists into a new ordered list.
      • var and match are new identifiers
     a InSection 3.2.3 it is shown how the inverse f_Mb‘[i1 , ...,ik ] can be derived automati-
cally
   b It If multiple combinations of lists fulfill this condition, multiple strategies are possible to

pick one; see Section 3.2.3

This scheme convers algebraic values, in which constructors yield an inverse on
all their arguments so that k = n, m = 0 and ip = i − 1 (see also Section 2.5.2).
This scheme also applies to tuples, lists and constants because they can be
represented by algebraic values.

Example.          The definition

gcd x             (^ x + y ) = gcd x y

contains an application pattern ^x + y of the addition function (fully written
plus), for which the first argument is known and the second to be bound. It is
rewritten into

gcd x    var
 = gcd x y , if match 6= Nothing
 where
   match = plus_Mb ‘[1] ^ x var
   Just y = match

where it is assumed that the inverse function plus‘[1] is defined.

3.3.3         Special cases in rewriting
It was shown in Section 2.5 how algebraic, tuple, list and constant patterns are
special cases of an application pattern. This means that they can be rewritten
3.3. A REWRITING ALGORITM                                                      47

using the schemas given in the previous section. However, using these schemas
may not yield the most readible code. In this section alternative rewriting
schemas are given that are more easily readible and implementable. The reader
may verify that the schemas given agree with the more general forms described
previously.

Constructor
For a constructor first the type of the constructor is checked. Then its arguments
(in their rewritten form) are bound to the actual argument using the constructor.



  Rewr J C x 0 ... xn−1 K
   = var C guard+ L99isConstr var
          C wheres+L99isConstr ( C | ...
                                      {z } ) = True
                                                n
                           isConstr _ = False
                           C Rewr J x i1 K ... Rewr J x in−1 K         = var

    • c is a constructor
    • x∗ ’s are patterns
    • var and isConstr are new identifiers

Example.     The definition


sumTree ( Node x y ) = sumTree x + sumTree y

is rewritten into


sumTree var
 = sumTree x + sumTree y , if isConstr var
 where
   isConstr ( Node _ _ ) = True
   isConstr _            = False
   Constr x y = var


    Note that a constant can be seen as a constructor without arguments. This is
also in agreement with the rewriting scheme for rewriting a function application
patterns with k = m = 0.

Tuple
For a tuple the arguments (in their rewritten form) can be rewritten directly,
since a tuple pattern is non-refutable.
48               CHAPTER 3. THE APPLICATION PATTERN COMPILER




  Rewr J ( x 0 , ... , xn−1)       K
   = ( Rewr J x i1 K , ... ,       Rewr J x in−1 K )

     • x∗ ’s are patterns

Identifier bound in the context
An identifier bound in the context is treated like a constant pattern. This is a
special case of rewriting a constant because it must hold that isKnown( ^i ) in
the context of i.



  Rewr J ^ i K
  = var C guard+ L99var = i

     • i is an identifier that is bound in the context.
     • var is a new identifier

As described earlier, in a left hand side of a function definition the context also
includes identifiers that are bound in patterns.

Example.      The definition


gcd ^ x x = x

is rewritten into


gcd var x = x , if var = x




3.3.4     Rewriting definitions
In the previous section it was described how patterns could be rewritten into
equivalent patterns without application patterns, where some extra guards and
where clauses might me added to the function definition.
   For adding these guards and where clauses to a definition, either of two cases
hold:
     • The definition’s left hand side consists of an ordinary function with one
       or more (rewritten into identifier) patterns as arguments.
       The extra guards are added to each of the existing guards. Note that the
       order is important: first the extra guards must be tested, in the left-to-
       right, outside-in order corresponding to the rewritten pattern, followed by
       the existing guards (there is one exception: as shown in Section 2.4.2 the
3.3. A REWRITING ALGORITM                                                      49

     caret notation allows for situations in which patterns are matched in a
     different order).
     The extra where clauses are added to the list of where clauses in the
     function definition.

   • The definition’s left hand side is itself a pattern in a where clause.
     The extra guards are ignored, because is is assumed that they match.
     Note that improper use may yield a runtime exception, just like for any
     other pattern used in a where clause
     The extra where clauses are added to the list of where clauses the pattern
     is part of.

All rewriting examples given so far are examples to the first case. An example
of the second case is


p ys = x + # xs
     where
       ( x : xs ) = ys

that is rewritten into


p ys = x + # xs
     where
       var
        = ys
       match
        = inv_cons_Mb_0_1 var
       Just (( x , xs ) )
        = match

Note that the pattern x:xs is replaced by the identifier var. x and xs are bound
in the same where clause as where var is bound. There is no guard that checks
whether match equals Nothing. This means that p [] would yield a runtime
exception, just like the original definition.
    Intuitively, the algoritm described above agrees with the semantics of pattern
matching as described by Peyton Jones (1987). A proof for this falls outside
the scope of this thesis.

   For functions with more than one equation it may be the case that non-
identifier patterns are rewritten into identifier patterns. This can make other
equations unreachable. Therefore the equations must be merged , which requires
that the identifiers in the function’s arguments match. This can be achieved by
renaming identifiers or binding them in a where clause.

3.3.5    Conclusion
In this section an algoritm was sketched for rewriting application patterns. This
algoritm provides support for
50              CHAPTER 3. THE APPLICATION PATTERN COMPILER

Overlapping patterns as multiple guards may evaluate to True

Nested patterns as patterns are rewritten recursively

Constant patterns as a transformation for this case is defined

Multiple arguments even within application patterns, by rewriting the argu-
    ments one by one

Non-exhaustive sets of equations which may cause all guards to evaluate
    to False

Conditional equations by the use of guards

Repeated variables supported by the use of the caret notation

The next section describes the implementation of this algoritm.


3.4     The application pattern compiler
This section describes the requirements, design and implementation of the appli-
cation pattern compiler. This compiler rewrites definitions with application pat-
terns into code witout application patterns according to the algoritm sketched
in the previous sections.


3.4.1    Requirements
This section discusses the requirements for the pattern match compiler.
    The ultimate goal of the pattern match compiler is to provide the ability
to execute code with application patterns. A working implementation would
show conclusivily that application patterns are implementable. Furthermore
it would allow for more programs written with application patterns, so that
it can be tested in real-world applications. In brief, the primary goal of the
pattern match compiler is to provide a proof-of-concept. The requirements are
summarized by

Executable code. The pattern match compiler should allow for running pro-
    grams that are specified using application patterns.

Substantial language. It should support a sufficient powerful functional lan-
    guage. Not all features have to be working, but all basic functionality
    should be available

Performance is not an issue. This is a proof-of-concept, thus performance
     is not an important factor. Using the compiler should just not take too
     long.

Not fool proof. Likewise, the compiler has not to be foolproof. It should at
     least be able to use properly written code.

With these requirements in mind, the design is discussed in the next section.
3.4. THE APPLICATION PATTERN COMPILER                                                   51

3.4.2     Design
To fullfill the requirements specified in the previous section, it is sufficient to
implement the algoritm described in Section 3.3. This algoritm must be pro-
vided with properly parsed input. The result must be written into interpretable
source code. In addition, proper use of the algoritm requires some pre- and
postprocessing.
    The output of the compiler, in the form of source code, must be interpreted
by an existing interpreter. A drawback is that debugging may be more cumber-
some, since if the original code contains errors this may result in an error during
rewriting or when the rewritten code is loaded into the interpreter. However,
since the compiler is only a proof-of-concept this is not a great advantage.

3.4.3     Implementation language
The chosen implementation language is Amanda, which supports all common
functional programming features. As input language I defined a Amanda-
corelanguage, which is a substantial subset of the Amanda language providing
support for the following features:

   • Constant expressions of type num, char and bool).
   • Compound expressions: lists, tuples, algebraic values.
   • Constant, list, tuple, algebraic and identifier patterns.
   • Identifiers and function applications.
   • Prefix and infix operator expressions with priorities.
   • Function definitions with multiple equations, clauses and (nested) where
     clauses.

However, there is no support for:
   • Record, lambda and list comprehension expressions
   • As patterns or equivalence patterns (without the caret notation)
   • Type denotations or definitions
   • Interpreter directives such as import statements
    To this language support for caret notation together with application pat-
terns are added, resulting in AmandaAP . In this language it is required that
inverse functions are defined at the top level with all its arguments mentioned
explicitly1 . In addition, inverse functions for operators must use predefined full
names.
    The AmandaAP language is definitely powerful enough to meet the require-
ments in the previous section. In 3.4.6 a sketch is given how record, lambda
and list comprehensions could be implemented, but the actual implementation
is beyond the scope of this proof-of-concept prototype.
  1 The reason is that the compiler cannot deduce types: it just counts the number of argu-

ments to deduce the total number of arguments of the function it is the inverse of
52              CHAPTER 3. THE APPLICATION PATTERN COMPILER

3.4.4    Implemenation
The complete transformation is divided in a number of steps.

Lexer. The lexer splits the input file into a list of elementary items and attaches
    a label to them. In this case, the lexer also keeps tracks of indentation
    (the offside rule).

Parser. Based on the lexer output, the parser recognizes structure in sequences
    of lexed items and represents this structure using an algebraic datatype.
    After this step, infix and prefix operators are written by their full names.

Add carets. As sometimes the use of the caret ^ prefix is optional, these carets
    are added to both nested function applications and operator function ap-
    plications in left hand sides of definitions.

Syntactic rewrite ++. An extra feature is that patterns with the ++ operator
    are automatically rewritten into application patterns with the join2 and
    join3 functions (see Section 2.7.2). This rewriting is specific to the ++
    operator.

Rename identifiers. In order to avoid problems with identifiers that are re-
    defined at multiple levels (such as in nested where clauses), all identifiers
    except the function names at the top level are renamed to a new unique
    name.

Rewrite application patterns. This is the step that actually performes the
    rewriting described by the algoritm presented in Section 3.3. The rewriting
    schemes from Section 3.3 are used almost literally.

Merge equations. After rewriting some patterns may be lost, so that equa-
    tions in function definitions become unreachable. These equations are
    merged.

Add maybe type for inverse functions. Besides the transformation itself, de-
    finitions for the inverse functions must be added (Section 3.2.3) so that
    they return the maybe type.

Create legal identifiers. Since identifiers with the backtic and caret notation
    are illegal identifiers in Amanda-core, these are systematically renamed
    into legal identifiers.

Pretty print code. Finally the resulting definitions are printed as more or
     less human readible source code.

The lexer and parser are inspired by the grammar reported by Papegaaij (2005).
For the lexer, parser, rename identifiers and rewrite application patterns, I made
extensive use of monad constructions as described by Wadler (1992).
   Together, these steps perform the complete transformation from AmandaAP
to Amanda-core. The implementation of each step is described in Appendix A.
3.4. THE APPLICATION PATTERN COMPILER                                          53

3.4.5    Results
The application pattern compilers works in rewriting code with application pat-
terns. The only problem is that Amanda crashes for larger input files due to
an unexplainable but reproducable memory problem. An example of input and
output is provided in Appendix A.3. The output is accepted by Amanda (if
the proper algebraic type definitions are added manually), the functions can be
run and produce the expected results. This shows that application patterns can
indeed be implemented and used in functional languages.


3.4.6    Extensions
The application pattern compiler provides no support for partial records, lambda
abstractions and list comprehensions. In Amanda all these expressions may con-
tain patterns. In this section I give a sketch how support for such patterns may
be provided.

Partial records
Partial records whose type definition contains n fields can be written by an n-
tuple with elements of the maybetype. Matching against fields in such a record
is matching against the expressions Just ... and Nothing.

Lambda abstractions
In amanda a lambda abstraction takes the form


 ( pat 1 → x 1 | pat 2 → x 2 | ... | pat k → x k )

where the pat∗ ’s are patterns that are matched against an actual argument.
The pipes | seperate alternatives (thus allowing for case expressions).
   Such an expression can be replaced by a free identifier, say f, that is defined
by


 f pat 1 = x 1
 f pat 2 = x 2
 ...
 f pat k = x k

Clearly this approach can also be used in the case of multiple arguments.


3.4.7    List comprehensions
List comprehensions are easily rewritten using the list monad. This monads
consists of the definitions of the unit and bind operators

                               monadLst.ama 
    54              CHAPTER 3. THE APPLICATION PATTERN COMPILER



1   unitLst x = [ x ]
2

3   bindLst ( x : xs ) f = f x : bindLst xs f
4   bindLst []         f = []

    Now a list comprehension is easily rewritten by the use of these operators and
    lambda abstractions.


    Example.     As an example, consider the lambda abstraction


    [    f x z
    |    sin p, qs) <- xs
    ;    y <- qs
    ;    check p y
    ;    z + 10 <- zs ]

    where the lists xs and zs are bound in the context. The patterns are underlined
    in this definition. First the guard check p y can be rewritten into the generator
    _ <- if (check p y)[[]] []. Now the lambda abstraction is rewritten using
    the monad operators into


         concat ( xs              $bindLst            ( ( sin p , qs ) →
         concat ( qs              $bindLst            ( y              →
         concat ( if ( check p y ) [[]] []
                                  $bindLst            ( _                   →
         concat ( zs              $bindLst            ( ( z +10)            →
         unitLst ( f x z )
                                                      |   _   →   []   ))
                                                      |   _   →   []   ))
                                                      |   _   →   []   ))
                                                      |   _   →   []   ))

    Thus, in every generator the pattern is matched against elements in the list. If
    matching fails the empty list is returned. The lambda abstractions in this new
    expression can be rewritten using the approach described above.


    3.4.8     Choose carets
    A possible extension would be to allow application patterns without carets, so
    that ‘real’ application patterns would be possible. A sketch for an algoritm is
    as follows: for a left hande side without carets one may try all possible caret
    additions. Since each identifier should occur only once without a caret, the
    number of combinations is rather limited. For each combination it can be tried
    whether a selection for inverse function exists that binds all required identifiers.
3.5. CONCLUSION                                                                55

3.4.9    Integration
The application pattern is a stand-alone application that works seperately from
the interpreter. For practical use an integration with the compiler or interpreter
would improve usability. This may be achieved by an integration with an pattern
match compiler. Other desirable features are support for a complete functional
language (not a subset), type checking and no memory limitations. In how far
application patterns allow for optimizations like in ordindary pattern matching
(see Peyton Jones, 1987) is a point of further research.


3.5     Conclusion
In this chapter a rewriting algoritm for application patterns as sketched and
described. Also the implementation of this algoritm, the Application Pattern
Compiler, was described. The next chapter discusses further research.
56   CHAPTER 3. THE APPLICATION PATTERN COMPILER
Chapter 4

The future for application
patterns

4.1     Introduction
This chapter describes the relation with other work on extensions to pattern
matching, and gives some suggestions for further research.


4.2     Related work
In this section the relation with other proposed pattern matching extensions is
discussed.
    One paper is by Tullsen (2000) who uses inverses of algebraic constructors,
but not more generally for other (non-injective) functions. In addition, his
paper has a different aim, namely introducing patterns as first class language
constructs.
    Another paper is by Broberg, Farre, and Svenningsson (2004) who propose
an extension of Haskell with regular expression patterns. Such patterns allow,
amongst other things, for more flexible string parsing. The use of join2 and
join3 as described in Section 2.7.2 are simple cases of what their regular ex-
pression patterns can handle. Whether their more complicated constructions
allow for easy translation in application patterns is a point of further research.

The paper that comes closest to the idea of application patterns is by Erwig
and Peyton Jones (2000) who propose to extend Haskell with pattern guards.
Such constructions allow for pattern matching and adding guards intertwined.
They give the example (translated to Miranda syntax) of a function that looks
up two values in a mapping,


clunky env var1 var2
 = val1 + val2 , if ok1 ∧ ok2
 = var1 + var2 , otherwise
 where
   m1 = lookup env var1

                                       57
58          CHAPTER 4. THE FUTURE FOR APPLICATION PATTERNS

     m2 = lookup env var2
     ok1 = isJust m1
     ok2 = isJust m2
     Just val1 = m1
     Just val2 = m2

Using their proposed pattern guards, this definition can be written

clunky env var1 var2
 | Just val1 <- lookup env var1
 , Just val2 <- lookup env var2
 = val1 + val2
 otherwise = var1 + var2

where the <- operator tries to fit a pattern into a value.
   Such constructions can, to some degree, be rewritten using application pat-
terns. To accomplish this we use a ‘trick’ that allows for matching patterns and
binding identifiers. The functions

soThat ‘[0 ,1] x = (x , undef )
matchPat ‘[0] x _ = x

are used for ‘creating room’ for binding arguments and for actually matching
patterns, respectively. Note that these two functions are each other’s inverse.
The definition above would translate (using infix notation) into

clunky env var1 ( var2                       $soThat (
 ( Just val1 $matchPat lookup ^ env ^ var1 ) $soThat (
 ( Just val2 $matchPat lookup ^ env ^ var2 )           )))
 = val1 + val2

clunky env var1 var2
 = var1 + var2

which strongly resembles the definition with conditional guards above (for the
caret notation see Section 2.4.2). Admittingly it is a bit combersome that the
function arguments env, var1 and var2 must be given twice, and also that var2
is enclosed by parenthesis.
    It is easy to add guards as well by using the definition

guardPat ‘[0] x _ = undef , if x

and by binding the result to the wildcard identifier. For example, the definition

f x | [ y ] <- x
    , y > 3
    , Just z <- h y
  = ...
4.2. RELATED WORK                                                          59

can be translated into



f (x                            $soThat (
       [y]    $matchPat ^ x     $soThat (
       _      $guardPat ^ y > 3 $soThat (
       Just z $matchPat ^ h ^ y           ))))
   = ...


Conversely, application patterns can also be expressed using pattern guards
by mimicking the rewriting algoritm described in Section 3.3. Consider the
definition



p ( f ( g x ) y ) ( h z 2)
 = x ^ y + z


with the inverses f‘[0,1], g‘[0], and h‘[0] defined. The rewriting algoritm
would yield



p var var1
 = x ^ y + z , if match 6= Nothing ∧ match1 6= Nothing ∧
    match2 6= Nothing
  where
     match             = f ‘[0 ,1] var
     Just ( var2 , y ) = match
     match1            = g ‘[0] var2
     Just x            = match1
     match2            = h ‘[0] 2 var1
     Just z            = match2


With pattern guards one would write



p var var1
 | Just ( var2 , y ) <- f ‘[0 ,1] var
 | Just x            <- g ‘[0] var2
 | Just z            <- h ‘[0] 2 var1
 = x ^ y + z


which can be considered as more readible than what the rewriting algoritm
produces. However, the programmer would have to choose himself which inverse
to choose and in what order patterns are matched.
    These examples suggest that with some effort application patterns and pat-
tern guards can be expressed in one another.
60           CHAPTER 4. THE FUTURE FOR APPLICATION PATTERNS

4.3      Further research
4.3.1     Lazyness and evaluation order
Current pattern matching allows for lazy evaluation: when an actual argument
is matched against a pattern, the argument is only evaluated as far as necesssary
do decide whether the pattern matches. For matching algebraic patterns this
means that first the constructor of an actual argument is computed before any
of its arguments are evaluted.
    Application patterns are a generalization of existing patterns, but when they
are used to express existing patterns they agree on lazyness behaviour during
evaluation. This can easily be verified by considering the code produced by
the application pattern described in Section 3.4. For application patterns that
are beyond existing patterns, the programmer ultimately decides how ‘lazy’ an
argument can be matched during evaluation.

4.3.2     Higher order functions
So far only application patterns with ordinary values, i.e. non-higher-order
functions are discussed. However, also some higher order functions can be re-
lated to inverse functions. Two examples are the map and function composition
functions, for which it holds that

                          (map f )−1 xs = map f −1 xs

                       (f1 ◦ · · · ◦ fn )−1 = fn−1 ◦ · · · ◦ f1−1
     Now one might consider writing (funcomp refers to function composition ◦)


!!!    map ‘[1] f ys = map f ‘[0] ys

!!!    funcomp ‘[0] g h = h . g ‘[0]
!!!    funcomp ‘[1] f h = f ‘[0] . h

but this is clearly wrong since the backtic ‘ is not an operator and thus the
identifiers f‘[0] and g‘[0] cannot be used here.
   To a very limited extend one might resolve this by introducing a function


inv :: ( $ \ alpha$ → $ \ beta$ ) → ( $ \ beta$ \ to $ \ alpha$ )

that returns the inverse for every function, so that one may write


!!!    map ‘[1] f ys = map ( inv f ) ys

!!!    funcomp ‘[0] g h = h $funcomp ( inv g )
!!!    funcomp ‘[1] f h = ( inv f ) $funcomp h

Now such an inv function would be possible in principe but can be used
only very limited because function equality is not decidable. In Hindley and
4.3. FURTHER RESEARCH                                                                             61


 Table 4.1: Several notions of function equality for g x = 2 * x in Amanda
                  g = g ⇒ True
 h1 = g           h1 = g ⇒ True
 h2 x = 2 * x h2 = g ⇒ False
 h3 y = 2 * y h3 = g ⇒ False
 h4 x = x + x h4 = g ⇒ False


Seldin (1986) the prove is mentioned that, in general, the equivalence of two λ-
expressions cannot be decided. Since functional languages are implementations
of the λ-calculus, this means that also the equality of two function definitions
cannot be decided.
    This means that the only proper approach is to use a conservative notion of
function equality. The problem is that how the interpreter or compiler decides
when two functions are equivalent is an implementation issue, not a language
issue. For example, Table 4.1 shows different notation of equality to the function
g x = 2 * x in Amanda.
    This approach is even less useful for curried functions. Suppose for a function
f that takes two arguments it holds that
             foldl f z [x1 , x2 , . . . , xn ]     = f . . . (f (f z x1 )x2 ) . . . xn := y
                                                             −1
Suppose further that f has an inverse on its first argument f[0] (in backtic
notation f‘[0]). Then it holds that
                                     −1
                              foldr f[0] y [x1 , x2 , . . . , xn ] = z
since
                   −1
             foldrf[0] y [x1 , x2 , . . . , xn ]
           −1       −1       −1          −1
        = f[0] x1 (f[0] x2 (f[0] . . . (f[0] xn y) . . .))
           −1       −1       −1          −1
        = f[0] x1 (f[0] x2 (f[0] . . . (f[0] xn (f . . . (f (f z x 1 ) x2 ) . . . xn )) . . .))
           −1       −1       −1
        = f[0] x1 (f[0] x2 (f[0] . . . (f . . . (f (f z x1 ) x2 ) . . .) . . .))
        ..
         .
            −1
        = f[0] x1 (f z x1)
        = z
Now the only way to define an inverse function for the f oldl function would
be introducing an function that gets a function that takes two arguments as
an argument and yields the inverse for that function on its first argument.
For functions that takes more arguments we would need generalized inverse
functions for each kind of cousin, with a whole family of inverse functions as
a result. Since all these functions must adhere a restrictive sense of function
equality, in my opinion it is doubtful how useful this would be. This is however
a point of further research.

4.3.3       More sophisticated pattern failures
A final point for further research is approaches that allow for more sophisticated
pattern matches and misses. Hölzenspies (2005) has written a runtime pattern
62          CHAPTER 4. THE FUTURE FOR APPLICATION PATTERNS

matcher that allows for searching for suitable inverses, together with a notion of
undefined-ness for functions. In what respect such an approach allows for more
powerful evaluation strategies is a point of further research.


4.4     Conclusion
In this chapter related work was described. The pattern guards proposal is
most related in that performing manually the rewriting algoritm described in
the previous chapter is more easily. Application patterns seem able to express
pattern guards.
   It is proposed that further research should focus on lazyness and evaluation
order issues in pattern matching. Another point that deserves attention is to
what extent application patterns are useful for higher order functions.
Appendix A

Implementation of the
Application Pattern
Compiler

This Appendix is provided as a seperate document, entitled Application Pat-
terns in Functional Languages: Appendix A: Implementation of the Application
Pattern Compiler




                                    63
64APPENDIX A. IMPLEMENTATION OF THE APPLICATION PATTERN COMPILER
     Appendix B

     Example input and output

     B.0.1   Example input
                               progIn.amapc 



1    f (2+ x ) 3 = x ^2
2

3    g ( Node x y ) = g x + g y
4    g ( Leaf x ) = x
5

6    plus ‘[0] x s = s - x , if x ≥ 0 ∧ s ≥ x
7    plus ‘[1] x s = s - x , if x ≥ 0 ∧ s ≥ x
8

9    k ( Leaf ( n +2) ) ( Node ( Leaf (1+ x ) ) ( Leaf (1+ ^ x ) ) ) = n
         ^ x
10   k _ _ = 1
11

12   l ( Leaf x ) ( Leaf (^ x + 1) ) = 3
13

14   f 1 2 = 3
15

16   h u = z ^2
17       where
18         z + ^k = x
19                where
20                  x + (^ y +2) = y ^ u
21                           where
22                             y + ^ k = u +1
23         k = 14
24

25   i p = (x , y )
26       where
27         ( Just x , Just y ) = (p , p )
28

29   j ( Just x , (y , z ) ) = x + y + z

                                      65
     66                     APPENDIX B. EXAMPLE INPUT AND OUTPUT

30

31   m u = y
32       where
33         y + ^z = z + 1 + u
34                where
35                  z = 3
36

37   n ( x +1) = fac ( fac x )
38         where
39             fac 0 = 1
40             fac n = n * fac (n -1)
41

42   fac 0 = 1
43   fac n = n * fac (n -1)
44

45   x = 3
46

47   p ys = x + # xs
48        where
49          ( x : xs ) = ys
50

51   cons ‘[0 ,1] xs = ( hd xs , tl xs ) , if xs 6= []
52

53   q ys = f ys + # ys
54        where
55          f ( x : xs ) = 1
56          f _          = 2
57

58   r ( Leaf n ) ( Node ( Leaf (^ n +2) ) ( Leaf ( x +^ n ) ) )
59    = n * x
60   r ( Leaf 2) _
61    = 3
62   r _ ( Leaf n )
63    = n ^2
64   r _ dontcare
65    = 4
66

67   t (2*2) = 3
68   t (2+ x ) = x , if x > 10
69   t _       = 0 - 1
70

71

72   w xs = (x , x )
73        where
74          x = ( fst . cons ‘[0 ,1]) xs
75

76

77   gcd x            ^x = x
78   gcd ( x + ^ y )    y = gcd x y
79   gcd x           (^ x + y ) = gcd x y
                                                         67




     B.0.2   Example output
                                     progOut.ama 



1    maybe * ::= Just * | Nothing
2

3    tree ::= Node tree tree | Leaf num
4

5    f var var1
6     = x1 ^ 2 , if ( match 6= Nothing ) ∧ ( var1 = 3)
7     = 3       , if ( var14 = 1) ∧ ( var15 = 2)
8      where
9         ( var14 , var15 )
10          = ( var , var1 )
11        match
12          = inv_plus_Mb_1 2 var
13        Just (( x1 ) )
14          = match
15

16   g var2
17    = ( g x2 ) + ( g y ) ,   if is_Node var2
18    = x3                 ,   if is_Leaf var3
19     where
20         ( var3 )
21           = ( var2 )
22         is_Node ( Node      _ _)
23           = True
24         is_Node _
25           = False
26         Node x2 y
27           = var2
28         is_Leaf ( Leaf      _)
29           = True
30         is_Leaf _
31           = False
32         Leaf x3
33           = var3
34

35   inv_plus_0 x4 s
36    = s - x4 , if ( x4 ≥ 0) ∧ ( s ≥ x4 )
37

38   inv_plus_Mb_0 x4 s
39    = Just ( s - x4 ) , if ( x4 ≥ 0) ∧ ( s ≥ x4 )
40    = Nothing         , otherwise
41

42   inv_plus_1 x5 s1
     68                  APPENDIX B. EXAMPLE INPUT AND OUTPUT

43    = s1 - x5 , if ( x5 ≥ 0) ∧ ( s1 ≥ x5 )
44

45   inv_plus_Mb_1 x5 s1
46    = Just ( s1 - x5 ) , if ( x5 ≥ 0) ∧ ( s1 ≥ x5 )
47    = Nothing          , otherwise
48

49   k var4 var6
50    = n1 ^ x6 , if ( is_Leaf1 var4 ) ∧ (( match1 6= Nothing ) ∧
           (( is_Node1 var6 ) ∧ (( is_Leaf2 var7 ) ∧ (( match2 6=
          Nothing ) ∧ (( is_Leaf3 var9 ) ∧ ( var10 = (1 + x6 ) ) ) )
          )))
51    = 1         , otherwise
52     where
53         (_ , _ )
54          = ( var4 , var6 )
55         match1
56          = inv_plus_Mb_0 2 var5
57         Just (( n1 ) )
58          = match1
59         is_Leaf1 ( Leaf _ )
60          = True
61         is_Leaf1 _
62          = False
63         Leaf var5
64          = var4
65         match2
66          = inv_plus_Mb_1 1 var8
67         Just (( x6 ) )
68          = match2
69         is_Leaf2 ( Leaf _ )
70          = True
71         is_Leaf2 _
72          = False
73         Leaf var8
74          = var7
75         is_Leaf3 ( Leaf _ )
76          = True
77         is_Leaf3 _
78          = False
79         Leaf var10
80          = var9
81         is_Node1 ( Node _ _ )
82          = True
83         is_Node1 _
84          = False
85         Node var7 var9
86          = var6
87

88   l var11 var12
                                                                 69

89     = 3 , if ( is_Leaf4 var11 ) ∧ (( is_Leaf5 var12 ) ∧ ( var13
            = ( x7 + 1) ) )
90      where
91          is_Leaf4 ( Leaf _ )
92           = True
93          is_Leaf4 _
94           = False
95          Leaf x7
96           = var11
97          is_Leaf5 ( Leaf _ )
98           = True
99          is_Leaf5 _
100          = False
101         Leaf var13
102          = var12
103

104   h u
105    = z ^ 2
106     where
107        var16
108         = x8
109        match3
110         = inv_plus_Mb_0 k1 var16
111        Just (( z ) )
112         = match3
113        var17
114         = y1 ^ u
115        match4
116         = inv_plus_Mb_0 ( y1 + 2) var17
117        Just (( x8 ) )
118         = match4
119        var18
120         = u + 1
121        match5
122         = inv_plus_Mb_0 k1 var18
123        Just (( y1 ) )
124         = match5
125        k1
126         = 14
127

128   i p1
129    = ( x9 , y2 )
130     where
131         ( var19 , var20 )
132           = ( p1 , p1 )
133         is_Just ( Just _ )
134           = True
135         is_Just _
136           = False
137         Just x9
      70                 APPENDIX B. EXAMPLE INPUT AND OUTPUT

138         = var19
139        is_Just1 ( Just _ )
140         = True
141        is_Just1 _
142         = False
143        Just y2
144         = var20
145

146   j (( var21 , ( y3 , z1 ) ) )
147    = x10 + ( y3 + z1 ) , if is_Just2 var21
148     where
149         is_Just2 ( Just _ )
150          = True
151         is_Just2 _
152          = False
153         Just x10
154          = var21
155

156   m u1
157    = y4
158     where
159         var22
160          = z2 + (1 + u1 )
161         match6
162          = inv_plus_Mb_0 z2 var22
163         Just (( y4 ) )
164          = match6
165         z2
166          = 3
167

168   n var23
169    = fac1 ( fac1 x11 ) , if match7 =6 Nothing
170     where
171        fac1 var24
172         = 1                       , if var24 = 0
173         = n2 * ( fac1 ( n2 - 1) ) , otherwise
174           where
175              ( n2 )
176                = ( var24 )
177        match7
178         = inv_plus_Mb_0 1 var23
179        Just (( x11 ) )
180         = match7
181

182   fac var25
183    = 1                      , if var25 = 0
184    = n3 * ( fac ( n3 - 1) ) , otherwise
185     where
186        ( n3 )
187          = ( var25 )
                                                                     71

188

189   x
190       = 3
191

192   p ys
193    = x12 + (# xs )
194     where
195        var26
196         = ys
197        match8
198         = inv_cons_Mb_0_1 var26
199        Just (( x12 , xs ) )
200         = match8
201

202   inv_cons_0_1 xs1
203    = ( hd xs1 , tl xs1 ) , if xs1 6= Nil
204

205   inv_cons_Mb_0_1 xs1
206    = Just (( hd xs1 , tl xs1 ) ) , if xs1 6= Nil
207    = Nothing                     , otherwise
208

209   q ys1
210    = ( f1 ys1 ) + (# ys1 )
211     where
212         f1 var27
213          = 1 , if match9 6= Nothing
214          = 2 , otherwise
215           where
216               (_)
217                = ( var27 )
218               match9
219                = inv_cons_Mb_0_1 var27
220               Just (( x13 , xs2 ) )
221                = match9
222

223   r var28 var29
224    = n4 * x14 , if ( is_Leaf6 var28 )      ∧ (( is_Node2 var29 ) ∧
            (( is_Leaf7 var30 ) ∧ (( var31     = ( n4 + 2) ) ∧ ((
           is_Leaf8 var32 ) ∧ ( match10 6=     Nothing ) ) ) ) )
225    = 3          , if ( is_Leaf9 var34 )    ∧ ( var35 = 2)
226    = n5 ^ 2 , if is_Leaf10 var36
227    = 4          , otherwise
228     where
229         (_ , dontcare )
230           = ( var28 , var29 )
231         (_ , var36 )
232           = ( var28 , var29 )
233         ( var34 , _ )
234           = ( var28 , var29 )
235         is_Leaf6 ( Leaf _ )
      72                APPENDIX B. EXAMPLE INPUT AND OUTPUT

236         = True
237        is_Leaf6 _
238         = False
239        Leaf n4
240         = var28
241        is_Leaf7 ( Leaf _ )
242         = True
243        is_Leaf7 _
244         = False
245        Leaf var31
246         = var30
247        match10
248         = inv_plus_Mb_0 n4 var33
249        Just (( x14 ) )
250         = match10
251        is_Leaf8 ( Leaf _ )
252         = True
253        is_Leaf8 _
254         = False
255        Leaf var33
256         = var32
257        is_Node2 ( Node _ _ )
258         = True
259        is_Node2 _
260         = False
261        Node var30 var32
262         = var29
263        is_Leaf9 ( Leaf _ )
264         = True
265        is_Leaf9 _
266         = False
267        Leaf var35
268         = var34
269        is_Leaf10 ( Leaf _ )
270         = True
271        is_Leaf10 _
272         = False
273        Leaf n5
274         = var36
275

276   t var37
277    = 3     , if var37 = (2 * 2)
278    = x15 , if ( match11 6= Nothing ) ∧ ( x15 > 10)
279    = 0 - 1 , otherwise
280     where
281        (_)
282          = ( var37 )
283        ( var38 )
284          = ( var37 )
285        match11
                                              73

286         = inv_plus_Mb_1 2 var38
287        Just (( x15 ) )
288         = match11
289

290   w xs3
291    = ( x16 , x16 )
292     where
293         x16
294          = ( fst . inv_cons_0_1 ) xs3
295

296   gcd x17 var39
297    = x17          , if var39 = x17
298    = gcd x18 y5 , if match12 6= Nothing
299    = gcd x19 y6 , if match13 6= Nothing
300     where
301        ( x19 , var41 )
302          = ( x17 , var39 )
303        ( var40 , y5 )
304          = ( x17 , var39 )
305        match12
306          = inv_plus_Mb_0 y5 var40
307        Just (( x18 ) )
308          = match12
309        match13
310          = inv_plus_Mb_1 x19 var41
311        Just (( y6 ) )
312          = match13
74                            APPENDIX B. EXAMPLE INPUT AND OUTPUT

B.1         Creative Commons Attribution-ShareAlike
            License Version 2.0
                            Attribution-ShareAlike 2.0

      THE WORK (AS DEFINED BELOW) IS PROVIDED UNDER THE TERMS OF
      THIS CREATIVE COMMONS PUBLIC LICENSE (“CCPL” OR “LICENSE”). THE
      WORK IS PROTECTED BY COPYRIGHT AND/OR OTHER APPLICABLE LAW.
      ANY USE OF THE WORK OTHER THAN AS AUTHORIZED UNDER THIS LI-
      CENSE OR COPYRIGHT LAW IS PROHIBITED.

      BY EXERCISING ANY RIGHTS TO THE WORK PROVIDED HERE, YOU AC-
      CEPT AND AGREE TO BE BOUND BY THE TERMS OF THIS LICENSE. THE
      LICENSOR GRANTS YOU THE RIGHTS CONTAINED HERE IN CONSIDERA-
      TION OF YOUR ACCEPTANCE OF SUCH TERMS AND CONDITIONS.

License


     1. Definitions
          1. “Collective Work” means a work, such as a periodical issue, anthology or
             encyclopedia, in which the Work in its entirety in unmodified form, along
             with a number of other contributions, constituting separate and indepen-
             dent works in themselves, are assembled into a collective whole. A work
             that constitutes a Collective Work will not be considered a Derivative Work
             (as defined below) for the purposes of this License.
          2. “Derivative Work” means a work based upon the Work or upon the Work
             and other pre-existing works, such as a translation, musical arrangement,
             dramatization, fictionalization, motion picture version, sound recording,
             art reproduction, abridgment, condensation, or any other form in which
             the Work may be recast, transformed, or adapted, except that a work that
             constitutes a Collective Work will not be considered a Derivative Work for
             the purpose of this License. For the avoidance of doubt, where the Work is
             a musical composition or sound recording, the synchronization of the Work
             in timed-relation with a moving image (“synching”) will be considered a
             Derivative Work for the purpose of this License.
          3. “Licensor” means the individual or entity that offers the Work under the
             terms of this License.
          4. “Original Author” means the individual or entity who created the Work.
          5. “Work” means the copyrightable work of authorship offered under the
             terms of this License.
          6. “You” means an individual or entity exercising rights under this License
             who has not previously violated the terms of this License with respect to
             the Work, or who has received express permission from the Licensor to
             exercise rights under this License despite a previous violation.
          7. “License Elements” means the following high-level license attributes as
             selected by Licensor and indicated in the title of this License: Attribution,
             ShareAlike.
     2. Fair Use Rights. Nothing in this license is intended to reduce, limit, or restrict
        any rights arising from fair use, first sale or other limitations on the exclusive
        rights of the copyright owner under copyright law or other applicable laws.
B.1. COPYRIGHT LICENSE                                                              75

  3. License Grant. Subject to the terms and conditions of this License, Licensor
     hereby grants You a worldwide, royalty-free, non-exclusive, perpetual (for the
     duration of the applicable copyright) license to exercise the rights in the Work
     as stated below:
       1. to reproduce the Work, to incorporate the Work into one or more Collective
          Works, and to reproduce the Work as incorporated in the Collective Works;
       2. to create and reproduce Derivative Works;
       3. to distribute copies or phonorecords of, display publicly, perform publicly,
          and perform publicly by means of a digital audio transmission the Work
          including as incorporated in Collective Works;
       4. to distribute copies or phonorecords of, display publicly, perform publicly,
          and perform publicly by means of a digital audio transmission Derivative
          Works.
       5. For the avoidance of doubt, where the work is a musical composition:
            1. Performance Royalties Under Blanket Licenses. Licensor waives the
               exclusive right to collect, whether individually or via a performance
               rights society (e.g. ASCAP, BMI, SESAC), royalties for the public
               performance or public digital performance (e.g. webcast) of the Work.
            2. Mechanical Rights and Statutory Royalties. Licensor waives the ex-
               clusive right to collect, whether individually or via a music rights
               society or designated agent (e.g. Harry Fox Agency), royalties for any
               phonorecord You create from the Work (“cover version”) and distrib-
               ute, subject to the compulsory license created by 17 USC Section 115
               of the US Copyright Act (or the equivalent in other jurisdictions).
       6. Webcasting Rights and Statutory Royalties. For the avoidance of doubt,
          where the Work is a sound recording, Licensor waives the exclusive right
          to collect, whether individually or via a performance-rights society (e.g.
          SoundExchange), royalties for the public digital performance (e.g. web-
          cast) of the Work, subject to the compulsory license created by 17 USC
          Section 114 of the US Copyright Act (or the equivalent in other jurisdic-
          tions).
     The above rights may be exercised in all media and formats whether now known
     or hereafter devised. The above rights include the right to make such modifi-
     cations as are technically necessary to exercise the rights in other media and
     formats. All rights not expressly granted by Licensor are hereby reserved.
  4. Restrictions. The license granted in Section 3 above is expressly made subject
     to and limited by the following restrictions:
       1. You may distribute, publicly display, publicly perform, or publicly digitally
          perform the Work only under the terms of this License, and You must in-
          clude a copy of, or the Uniform Resource Identifier for, this License with
          every copy or phonorecord of the Work You distribute, publicly display,
          publicly perform, or publicly digitally perform. You may not offer or im-
          pose any terms on the Work that alter or restrict the terms of this License
          or the recipients’ exercise of the rights granted hereunder. You may not
          sublicense the Work. You must keep intact all notices that refer to this
          License and to the disclaimer of warranties. You may not distribute, pub-
          licly display, publicly perform, or publicly digitally perform the Work with
          any technological measures that control access or use of the Work in a
          manner inconsistent with the terms of this License Agreement. The above
          applies to the Work as incorporated in a Collective Work, but this does not
76                         APPENDIX B. EXAMPLE INPUT AND OUTPUT

           require the Collective Work apart from the Work itself to be made subject
           to the terms of this License. If You create a Collective Work, upon notice
           from any Licensor You must, to the extent practicable, remove from the
           Collective Work any reference to such Licensor or the Original Author, as
           requested. If You create a Derivative Work, upon notice from any Licensor
           You must, to the extent practicable, remove from the Derivative Work any
           reference to such Licensor or the Original Author, as requested.
        2. You may distribute, publicly display, publicly perform, or publicly digi-
           tally perform a Derivative Work only under the terms of this License, a
           later version of this License with the same License Elements as this Li-
           cense, or a Creative Commons iCommons license that contains the same
           License Elements as this License (e.g. Attribution-ShareAlike 2.0 Japan).
           You must include a copy of, or the Uniform Resource Identifier for, this
           License or other license specified in the previous sentence with every copy
           or phonorecord of each Derivative Work You distribute, publicly display,
           publicly perform, or publicly digitally perform. You may not offer or im-
           pose any terms on the Derivative Works that alter or restrict the terms
           of this License or the recipients’ exercise of the rights granted hereunder,
           and You must keep intact all notices that refer to this License and to the
           disclaimer of warranties. You may not distribute, publicly display, pub-
           licly perform, or publicly digitally perform the Derivative Work with any
           technological measures that control access or use of the Work in a manner
           inconsistent with the terms of this License Agreement. The above applies
           to the Derivative Work as incorporated in a Collective Work, but this does
           not require the Collective Work apart from the Derivative Work itself to
           be made subject to the terms of this License.
        3. If you distribute, publicly display, publicly perform, or publicly digitally
           perform the Work or any Derivative Works or Collective Works, You must
           keep intact all copyright notices for the Work and give the Original Author
           credit reasonable to the medium or means You are utilizing by conveying
           the name (or pseudonym if applicable) of the Original Author if supplied;
           the title of the Work if supplied; to the extent reasonably practicable, the
           Uniform Resource Identifier, if any, that Licensor specifies to be associated
           with the Work, unless such URI does not refer to the copyright notice or
           licensing information for the Work; and in the case of a Derivative Work, a
           credit identifying the use of the Work in the Derivative Work (e.g., “French
           translation of the Work by Original Author,” or “Screenplay based on
           original Work by Original Author”). Such credit may be implemented in
           any reasonable manner; provided, however, that in the case of a Derivative
           Work or Collective Work, at a minimum such credit will appear where any
           other comparable authorship credit appears and in a manner at least as
           prominent as such other comparable authorship credit.
     5. Representations, Warranties and Disclaimer
        UNLESS OTHERWISE AGREED TO BY THE PARTIES IN WRITING, LI-
        CENSOR OFFERS THE WORK AS-IS AND MAKES NO REPRESENTA-
        TIONS OR WARRANTIES OF ANY KIND CONCERNING THE MATERI-
        ALS, EXPRESS, IMPLIED, STATUTORY OR OTHERWISE, INCLUDING,
        WITHOUT LIMITATION, WARRANTIES OF TITLE, MERCHANTIBILITY,
        FITNESS FOR A PARTICULAR PURPOSE, NONINFRINGEMENT, OR THE
        ABSENCE OF LATENT OR OTHER DEFECTS, ACCURACY, OR THE
        PRESENCE OF ABSENCE OF ERRORS, WHETHER OR NOT DISCOV-
        ERABLE. SOME JURISDICTIONS DO NOT ALLOW THE EXCLUSION
        OF IMPLIED WARRANTIES, SO SUCH EXCLUSION MAY NOT APPLY
B.1. COPYRIGHT LICENSE                                                               77

    TO YOU.

  6. Limitation on Liability.
     EXCEPT TO THE EXTENT REQUIRED BY APPLICABLE LAW, IN NO
     EVENT WILL LICENSOR BE LIABLE TO YOU ON ANY LEGAL THE-
     ORY FOR ANY SPECIAL, INCIDENTAL, CONSEQUENTIAL, PUNITIVE
     OR EXEMPLARY DAMAGES ARISING OUT OF THIS LICENSE OR THE
     USE OF THE WORK, EVEN IF LICENSOR HAS BEEN ADVISED OF THE
     POSSIBILITY OF SUCH DAMAGES.

  7. Termination

       1. This License and the rights granted hereunder will terminate automatically
          upon any breach by You of the terms of this License. Individuals or entities
          who have received Derivative Works or Collective Works from You under
          this License, however, will not have their licenses terminated provided
          such individuals or entities remain in full compliance with those licenses.
          Sections 1, 2, 5, 6, 7, and 8 will survive any termination of this License.

       2. Subject to the above terms and conditions, the license granted here is per-
          petual (for the duration of the applicable copyright in the Work). Notwith-
          standing the above, Licensor reserves the right to release the Work under
          different license terms or to stop distributing the Work at any time; pro-
          vided, however that any such election will not serve to withdraw this Li-
          cense (or any other license that has been, or is required to be, granted
          under the terms of this License), and this License will continue in full force
          and effect unless terminated as stated above.

  8. Miscellaneous

       1. Each time You distribute or publicly digitally perform the Work or a Col-
          lective Work, the Licensor offers to the recipient a license to the Work on
          the same terms and conditions as the license granted to You under this
          License.

       2. Each time You distribute or publicly digitally perform a Derivative Work,
          Licensor offers to the recipient a license to the original Work on the same
          terms and conditions as the license granted to You under this License.

       3. If any provision of this License is invalid or unenforceable under applicable
          law, it shall not affect the validity or enforceability of the remainder of
          the terms of this License, and without further action by the parties to
          this agreement, such provision shall be reformed to the minimum extent
          necessary to make such provision valid and enforceable.

       4. No term or provision of this License shall be deemed waived and no breach
          consented to unless such waiver or consent shall be in writing and signed
          by the party to be charged with such waiver or consent.

       5. This License constitutes the entire agreement between the parties with re-
          spect to the Work licensed here. There are no understandings, agreements
          or representations with respect to the Work not specified here. Licensor
          shall not be bound by any additional provisions that may appear in any
          communication from You. This License may not be modified without the
          mutual written agreement of the Licensor and You.
78                         APPENDIX B. EXAMPLE INPUT AND OUTPUT

Creative Commons is not a party to this License, and makes no warranty whatsoever
in connection with the Work. Creative Commons will not be liable to You or any party
on any legal theory for any damages whatsoever, including without limitation any gen-
eral, special, incidental or consequential damages arising in connection to this license.
Notwithstanding the foregoing two (2) sentences, if Creative Commons has expressly
identified itself as the Licensor hereunder, it shall have all rights and obligations of
Licensor.
Except for the limited purpose of indicating to the public that the Work is licensed
under the CCPL, neither party will use the trademark “Creative Commons” or any
related trademark or logo of Creative Commons without the prior written consent of
Creative Commons. Any permitted use will be in compliance with Creative Com-
mons’ then-current trademark usage guidelines, as may be published on its website or
otherwise made available upon request from time to time.


Creative Commons may be contacted at http://creativecommons.org/.
Bibliography

Broberg, N., Farre, A., & Svenningsson, J. (2004). Regular expression patterns.
      67–78. Retrieved on July 14, 2005, from http://www.cs.chalmers.se/
      ∼d00nibro/harp/harp.pdf.

Erwig, M., & Peyton Jones, S. (2000). Pattern guards and transformational
      patterns.    Retrieved on September 16, 2005, from http://research.
      microsoft.com/∼simonpj/Papers/pat.ps.gz.
Hindley, J. R., & Seldin, J. P. (1986). Introduction to combinators and λ-
      calculus. Cambridge University Press.
Hölzenspies, P. K. F. (2005). (personal communication)
Jones, M. P.       (1991).   Gofer 2.21 release notes.     Retrieved on July
      7, 2005, from http://www-i2.informatik.rwth-aachen.de/Teaching/
      Praktikum/SWPSS96/Gofer/rel221.dvi.
Oosterhof, N. N., Hölzenspies, P. K. F., & Kuper, J. (2005). Application pat-
      terns. In Proceedings of trends in functional programming 2005, Tallinn,
      Estonia.
Papegaaij, E. (2005). The Tina language: A report on the specification and
      implementation. (Personal communication)
Peyton Jones, S. (1987). The implementation of functional programming lan-
      guages. Retrieved on June 23, 2005, from http://research.microsoft.
      com/Users/simonpj/papers/slpj-book-1987/slpj-book-1987.pdf.
      Prentice Hall.
Peyton Jones, S. (Ed.). (2003). Haskell 98 language and libraries: The re-
      vised report. Retrieved on May 14, 2005, from http://www.haskell.
      org/definition/haskell98-report.pdf. Cambridge University Press.
Plasmeijer, R., & Eekelen, M. van. (2001). Version 2.0 language report
      [Draft]. Retrieved on June 2, 2005, from ftp://ftp.cs.kun.nl/pub/
      Clean/Clean20/doc/CleanRep2.0.pdf. Department of Software Tech-
      nology, University of Nijmegen, The Netherlands.
Plasmijer, R., & Eekelen, M. van. (1993). Functional programming and parallel
      graph rewriting. Amsterdam [etc.]: Addison-Wesley.
Thompson, S. (1995). Miranda: The Craft of Functional Programming. Addison
      Wesley.
Tullsen, M. (2000). First class patterns. In Practical aspects of declarative
      languages, second international workshop,padl 2000 (Vol. 1753, pp. 1–15).
      Springer-Verlag.
Wadler, P. (1992). Monads for functional programming. 118. Retrieved on
      June 27, 2005, from http://homepages.inf.ed.ac.uk/wadler/papers/
      marktoberdorf/marktoberdorf.pdf.


                                      79
Application Patterns in
Functional Languages
Appendix A: Implementation of the
  Application Pattern Compiler

               by
Nikolaas N. Oosterhof




     University of Twente
   Enschede, The Netherlands
              2005
                                                                              2

Copyright c 2005 Nikolaas N. Oosterhof.

This document is free; you can copy, distribute, display, perform and/or modify
it under the terms of the Creative Commons Attribution-ShareAlike License
Version 2.0. A copy of the license is included in Section A.5.

The program described in this Appendix is free software; you can redistribute
it and/or modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
    This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABIL-
ITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
Public License for more details.
    You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc., 675 Mass
Ave, Cambridge, MA 02139, USA.




The author may be contacted at n.n.oosterhof@student.uva.nl
                                                                            3

                  Human-readible summary of the
        Creative Commons Attribution-ShareAlike 2.0 License

You are free:
   • to copy, distribute, display, and perform the work

   • to make derivative works
   • to make commercial use of the work


Under the following conditions:


                   Attribution. You must give the original author credit.




                   Share Alike. If you alter, transform, or build upon this
                   work, you may distribute the resulting work only under a
                   license identical to this one.

   • For any reuse or distribution, you must make clear to others the license
     terms of this work.
   • Any of these conditions can be waived if you get permission from the
     copyright holder.

Your fair use and other rights are in no way affected by the above.


A copy of the Legal Code (the full license) is included in Appendix A.5.
Contents

A Implementation                                                                                                    5
  A.1 Introduction . . . . . . . . . . . . .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .    5
  A.2 The application pattern compiler .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .    5
      A.2.1 The main file . . . . . . . .      .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .    5
      A.2.2 The lexer . . . . . . . . . .      .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .    7
      A.2.3 The parser . . . . . . . . .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   15
      A.2.4 The preprocessor . . . . . .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   19
      A.2.5 Creating unique identifiers .      .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   21
      A.2.6 The actual rewriting . . . .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   25
      A.2.7 The postprocessing . . . . .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   31
      A.2.8 Printing the output nicely .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   34
  A.3 Introducing monads . . . . . . . .       .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   37
  A.4 Some utility functions . . . . . . .     .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   42
  A.5 Copyright license . . . . . . . . . .    .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   48




                                      4
                     Appendix A

                     Implementation of the
                     Application Pattern
                     Compiler

                     A.1      Introduction
                     This appendix contains the implementation of the Application Pattern Com-
                     piler, a compiler for the Amanda functional language that rewrites application
                     patterns. The actual implementation is given in Section A.2, describing the
                     lexer, parser, preprocessor, renaming, rewriting, postprocessing and printing.
                     The implementation makes extensive use of monads which are described in Sec-
                     tion A.3. Some general utility functions are given in Section A.4.


                     A.2      The application pattern compiler
                     A.2.1     The main file
                                                     main.ama 



1    /*   the Application Pattern Compiler : a program that translates
2     *   a functional language with application patterns into semantic
3     *   equivalent runnable code .
4     *
5     *   This is the main file .
6     *
7     *   Copyright ( c ) 2005      Nikolaas N . Oosterhof
8     *
9     *    This program is free software ; you can redistribute it and / or modify
10    *    it under the terms of the GNU General Public License as published by
11    *    the Free Software Foundation ; either version 2 of the License , or
12    *    ( at your option ) any later version .
13    *

                                                           5
                       APPENDIX A. IMPLEMENTATION                             6

14    *    This program is distributed in the hope that it will be useful ,
15    *    but WITHOUT ANY WARRANTY ; without even the implied warranty of
16    *    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE . See the
17    *    GNU General Public License for more details .
18    *
19    *    You should have received a copy of the GNU General Public License
20    *    along with this program ; if not , write to the Free Software
21    *    Foundation , Inc . , 675 Mass Ave , Cambridge , MA 02139 , USA .
22    */
23

24   # import " util . ama "
25

26   # import   " monadMb . ama "
27   # import   " monadSt . ama "
28   # import   " monadSts . ama "
29   # import   " monadId . ama "
30

31   # import   " lexer . ama "
32   # import   " parser . ama "
33   # import   " preproc . ama "
34   # import   " uniqidfs . ama "
35   # import   " rewrite . ama "
36   # import   " postproc . ama "
37   # import   " prettyPrint . ama "
38

39   || the main function
40   apc :: string → string
41   apc =   print
42         . postproc
43         . d e fs I d fProperNaming
44         . defsAddMbInverse
45         . mergeDefs
46         . rewrDefs
47         . uniqidfs
48         . preproc
49         . parser
50         . lexer
51

52

53   || reading input file and writing output file
54   || ( the required preamble is added manually )
55   apcIO fileIn fileOut
56    =        fwrite fileOut premable
57      $seq ( fappend fileOut . apc . fread ) fileIn
58    where
59      premable =     " maybe * ::= Just * | Nothing \ n \ n "
60                  ++ " thenMb Nothing _ = Nothing \ n "
61                  ++ " thenMb _       x = x\n\n"
62                  ++ " tree ::= Node tree tree | Leaf num \ n \ n "
63
                              APPENDIX A. IMPLEMENTATION                                                       7

64   || an example
65   apcIOEx
66    = apcIO " progIn . amapc " " progOut . ama "


                              A.2.2         The lexer
                                                                            lexer.ama 


1    /* the Application Pattern Compiler : a program that translates
2     * a functional language with application patterns into semantic
3     * equivalent runnable code .
4     *
5     * This file contains the lexer .
6     *
7     * Copyright ( c ) 2005 Nikolaas N . Oosterhof
8     */
9

10   /*
11    * The lexer state
12    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
13   lexerTp == ( num , string )
14

15   lexerSt * ::= {               remaining :: [*]                        ||   remaining chars to be lexed
16                 ,               pos :: num                              ||   horizontal position
17                 ,               vpos :: num                             ||   vertical position
18                 ,               offSides :: [ num ]                     ||   stack of indent positions
19                 ,               inDef :: bool                           ||   already seen the first ’= ’ - char on this
                                    line ?
20                             }
21

22   nilLexer s = { remaining = s , pos =0 , offSides =[] , vpos = 0 , inDef = False }
23

24   getLexerSt s0 = unitSts s0
25   setLexerSt s1 s0 = unitSts s10 s10
26                    where s10 = s1 & s0
27

28   /*
29    * Spotting items
30    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
31   || spot single element
32   spot c ( st ={ remaining =[]                           }) = unitSts False st
33   spot c ( st ={ remaining =( x : xs ) }) = unitSts ( c = x ) st
34

35   || spot multiple elements
36   spots [ c ]      = spot c
37   spots ( c : cs ) = spot c $bindSts ( b →
38                      ifSts b ( spots cs     )
39                             ( unitSts False )
                      APPENDIX A. IMPLEMENTATION                                        8

40                                            )
41

42   item ( st ={ remaining =( x : xs ) , pos = pos_ })
43    = [( x , st & { remaining = xs , pos = pos_ +1}) ]
44

45   item _
46    = []
47

48

49   lit c st
50    = item_st , if item_st 6= [] ∧ x = c
51    = []       , otherwise
52    where item_st = item st
53          [( x , _ ) ] = item_st
54

55   anylit cs st = concat [ lit c st | c <- nodup cs ]
56

57   lits [ c ]     = lit c $bindSts ( x → unitSts [ x ])
58

59   lits ( c : cs ) = lit c $bindSts ( x →
60                     lits cs $bindSts ( xs →
61                     unitSts ( x : xs ) ))
62

63

64

65   untilLits str
66    = ( lits str
67      ) $biasedOrSts
68      ( item $bindSts ( c → untilLits str $bindSts ( cs → unitSts ( c : cs ) ) )
69      )
70

71   /*
72    * Processing indentation
73    *
74    * Assumption : every line consists of :
75    *
76    *             blank ^* dedent ^* [ non - blank ( any ) ^*] newLine
77    *
78    * A comment is / not / a blankitem
79    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
80

81   /*     dedentLit requires sufficient dedents before any non - blank literal
82        0 1 2 3 4 5 6 7 8 9 012 34567 ...
83        ... = ...
84                    where
85                            ... = ...
86                        ... -- → { for this expression : position p =8 , stack =[14 ,6 ,4]}
87

88   */
89
                      APPENDIX A. IMPLEMENTATION                                       9

90    dedentLit ( st ={ remaining =[] , offSides =( x : xs ) })
91     = [((" dedent " , "") , st & { offSides = xs }) ]
92

93    dedentLit ( st ={ pos =p , offSides =( x : xs ) })
94     = [((" dedent " , "") , st & { offSides = xs }) ] , if p < x
95     = [] , otherwise
96

97

98    dedentLit _
99     = []
100

101

102   /* Process an indent token ( currently only "=")
103       Assumption : the first occurence of that token is indeed the indent - version
104                    this means that " f ( p =( x : xs ) ) = ..." can not be parsed
105                    to provide for this : - add a parenthesis counter to the state
106                                            - write a left / right parenthesis parser that
                                                    adjusts that counter
107                                            - give these parser higher priority dan
                                                    indentLit
108    */
109

110

111   indentLit
112    = ( biasedOrsSts . map lits . domain ) indentNames          $bindSts ( tk →
113      makeIndent tk )
114

115

116   makeIndent tk ( st ={ pos =p , offSides = offSides_ , inDef = False })
117    = fromJust
118      ( ( (
119                 ( hdMb offSides_                     $bindMb ( x →
120                          ( ( x = p )                      $guardMb (
121                             unitMb ( unitSts ( lookUp indentNames tk ++ redentSuffix , tk )
122                                                  ( st & { inDef = True }) )
123                                                                        )
124                          ) $alternativeMb
125                          ( ( x < p )                      $guardMb (
126                             unitMb ( unitSts ( lookUp indentNames tk , tk )
127                                                  ( st & { inDef = True , offSides = p : offSides_ })
                                                         )
128                                                                        )
129                          ) $orJust
130                          ( zeroSts st
131                          )                                        )
132                 ) $orJust
133                 ( unitSts ( lookUp indentNames tk , tk )
134                                ( st & { inDef = True , offSides = p : offSides_ })
135                 )                                          )
136            ) $orJust
                      APPENDIX A. IMPLEMENTATION                                        10

137              ( zeroSts st
138              )
139       )
140

141   makeIndent _ st = zeroSts st
142

143

144   whereLit      = getStateSts             $bindSts ( ( st ={ pos = pos , offSides = offSides_ }) →
145                   lits " where "          $thenSts (
146                   updStateSts ( & { inDef = False , offSides = pos : offSides_ } )
147                                           $thenSts (
148                   unitSts (" where " , " where ")                              )))
149

150

151   newLineLit = lits "\ n "        $thenSts (
152                getStateSts          $bindSts ( ( st ={ vpos = vpos }) →
153                updStateSts ( & { inDef = False , pos =0 , vpos = vpos +1} ) $thenSts (
154                unitSts (" newline " , "\ n ")                    )))
155

156

157

158   eofLit ( st ={ remaining =[] , offSides =[]}) = ( unitSts (" eof " , []) ) st
159   eofLit st                                     = zeroSts st
160

161   /*
162    * Defining operators , delimeters and keywords
163    *
164    * - is is assumed that these identifier names (" neg " , " lnot " , " length " ,
165    *       " cons " , ...) are / not defined / by the programmer
166    * - however , for inverse definitions these names / must / be used by the
167    *       programmer (" neq ‘[0]" , " lnot ‘[0]" , " length ‘[0]" , " cons ‘[0 ,1]" , ...)
168    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
169

170   prefixNames = [ (" -" , " neg ")
171                 , ("~" , " lnot ")
172                 , ("#" , " length ")
173                 ]
174

175

176   infixNames = [    (":" , " cons ")
177                ,    ("++" , " join ")
178                ,    (" - -" , " nioj ")
179                ,    ("\\/" , " lor ")
180                ,    ("∧\" , " land ")
181                ,    ("~" , " lnot ")
182                ,    (" <" , " lt ")
183                ,    (" <=" , " lte ")
184                ,    ("=" , " eq ")
185                ,    ("6=" , " neq ")
186                ,    ("≥" , " geq ")
                               APPENDIX A. IMPLEMENTATION                                    11

187                           ,   (" >" , " gt ")
188                           ,   ("+" , " plus ")
189                           ,   (" -" , " minus ")
190                           ,   ("*" , " times ")
191                           ,   (" // " ," floatdivide ")
192                           ,   ("/" , " divide ")
193                           ,   ("%" , " modulo ")
194                           ,   ( ’d ’:" iv " , " divide ") || } fake amanda parser ; it must
195                           ,   ( ’m ’:" od " , " modulo ") || } have a bad hack here
196                           ,   ("^" , " power ")
197                           ,   ("." , " funcomp ")
198                           ,   ("!" , " index ")
199                           ]
200

201   delimNames = [              ("|" ,        " pipe ")
202                ,              (";" ,        " semicolon ")
203                ,              ("=" ,        " eq ")
204                ,              ("{" ,        " lcurly ")
205                ,              ("}" ,        " rcurly ")
206                ,              ("(" ,        " lparen ")
207                ,              (") " ,       " rparen ")
208                ,              ("[" ,        " lbrack ")
209                ,              ("]" ,        " rbrack ")
210                ,              (" ," ,       " comma ")
211                ,              (" → " ,      " larrow ")
212                ,              (" < -" ,     " rarrow ")
213                ]
214

215   indentNames = [               ("::="          ,   " typeDef ")
216                 ,               ("::"           ,   " typeDecl ")
217                 ,               ("=="           ,   " typeEq ")
218                 ,               ("="            ,   " funDef ")
219                 ]
220

221   redentSuffix = " _redent "
222

223   litSuffix = ""
224

225   keywordNames = map dupl [ " if "
226                           , " otherwise "
227                           ]
228                where dupl x = (x , x )
229

230

231

232   /*
233    * Lexing standard literals
234    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
235

236   lexChar            = lexSpecialChar $biasedOrSts
                      APPENDIX A. IMPLEMENTATION                                     12

237                 ( item $checkSts (~. member "\ ’\"") )
238

239

240   lexSpecialChar = (( lit ’\\ ’) $thenSts (
241                     ( item $checkSts ( member ( domain specialChars ) ) )
242                            $doSts ( lookUp specialChars )
243                                             ))
244

245   || characters that are escaped by a backslash ’\ ’
246   specialChars = [ ( ’n ’ , ’\n ’)
247                  , ( ’b ’ , ’\b ’)
248                  , ( ’t ’ , ’\t ’)
249                  , ( ’r ’ , ’\r ’)
250                  , ( ’a ’ , ’\a ’)
251                  , ( ’\\ ’ , ’\\ ’)
252                  , ( ’\ ’ ’ , ’\ ’ ’) || note : we don ’ t allow " ’" or ’" ’;
253                                       ||        use "\ ’" and ’\" ’ instead
254                  , ( ’\" ’ , ’\" ’)
255                  ]
256

257   charLit = seqSts [ lit ’\ ’ ’
258                   , lexChar
259                   , lit ’\ ’ ’
260                   ]
261             $bindSts ( c → unitSts (" char " , c ) )
262

263

264   failLit ( st = { pos = pos_ , vpos = vpos_ , remaining = remaining_ })
265    = error errorMsg
266    where
267      errorMsg =      " Lexer : unrecognised character sequence at line "
268                  ++ itoa vpos_ ++ ":" ++ itoa pos_
269                  ++ "\ nRemaining character sequence : "
270                  ++ ( if (# remaining_ > remLength ) ( take remLength remaining_ ++ "
                         [...]")
271                                                            remaining_
272                      )
273                where remLength = 100
274

275

276

277   stringLit = seqSts [ lits "\""
278                     , oneOrMoreSts lexChar
279                     , lits "\""
280                     ]
281               $doSts concat $bindSts ( s → unitSts (" string " , s ) )
282

283

284   lexDigit = item $checkSts isDigit
285            where isDigit c = ( ’0 ’ <= c ∧ c <= ’9 ’)
                     APPENDIX A. IMPLEMENTATION                                    13

286

287

288   numLit = ( ( lit ’-’ $thenSts lexPosFloat ) $bindSts ( x →
289              unitSts (" num " , ’ - ’: x )            )
290            ) $biasedOrSts
291            ( lexPosFloat                     $bindSts ( x →
292              unitSts (" num " , x )                   )
293            )
294

295   lexPosFloat = lexNat              $bindSts ( x →
296                 ( lit ’. ’              $thenSts (
297                   lexNat                $bindSts ( y →
298                   unitSts ( x ++ "." ++ y )        ))
299                 ) $biasedOrSts
300                 ( unitSts ( x )
301                 )                            )
302

303

304   lexNat = oneOrMoreSts lexDigit
305

306   chars m n = map decode [ i | cm := code m ; cn := code n ; i < -[ cm .. cn ]]
307

308   lexIdf = startLexIdf
309            $biasedOrSts
310            anylit ( chars ’0 ’ ’9 ’
311                   ++ chars ’A ’ ’Z ’
312                   )
313

314   startLexIdf = anylit ( " _ " ++ chars ’a ’ ’z ’ )
315

316   idfLit = ( lit ’^ ’                                $thenSts (
317              startLexIdf                             $bindSts ( i →
318              zeroOrMoreSts lexIdf                      $bindSts ( is →
319              unitSts ( " ctxIdf " , i : is )                    )))
320            ) $biasedOrSts
321            ( ( anylit (" _ " ++ chars ’a ’ ’z ’) ) $bindSts ( i →
322              ( zeroOrMoreSts lexIdf )                  $bindSts ( is →
323                 ( invFunSignature                          $bindSts ( sign →
324                   unitSts (" invIdf " , i : is ++ sign )              )
325                 ) $biasedOrSts
326                 ( unitSts (" idf " , i : is )
327                 )                                               ))
328            )
329

330   invFunSignature = seqSts [ lits " ‘["
331                           , ( lexNat $encloseSts ( lits " ,") ) $doSts concat
332                           , lits "]"
333                           ]
334                     $doSts concat
335
                     APPENDIX A. IMPLEMENTATION                                  14

336

337   constrLit = ( anylit ( chars ’A ’ ’Z ’) ) $bindSts ( i →
338               ( oneOrMoreSts lexIdf )         $bindSts ( is →
339                 unitSts (" constrIdf " , i : is )             ))
340

341

342   lineCommentLit = lits "||"                               $thenSts (
343                    newLineLit                              $thenSts (
344                    unitSts (" comment " , [])                           ))
345

346   lexBlank = item $checkSts ( member " ")
347

348   blankLit = ( oneOrMoreSts lexBlank ) $thenSts (
349              unitSts (" blank " , [])           )
350

351   preprocLit = biasedOrsSts ( map lits ["# import " , "# synonym " , "# operator "])
352                                                       $bindSts ( xs          →
353                zeroOrMoreSts lexBlank                 $thenSts (
354                stringLit                              $bindSts ( (_ , ys ) →
355                zeroOrMoreSts lexBlank                 $thenSts (
356                newLineLit                             $thenSts (
357                unitSts (" preproc " , xs ++ " " ++ ys )            )))))
358

359   /*
360    * Definition of priority of literals
361    *
362    * For some items this order is / very / important ( a . o . indentation )
363    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
364

365   litMapping
366    = [ (" blank "      ++ litSuffix ,    blankLit       )
367      , (" where "      ++ litSuffix ,    whereLit       )
368      , (" indent "     ++ litSuffix ,    indentLit      )
369      , (" dedent "     ++ litSuffix ,    dedentLit      )
370      , (" lineComment "++ litSuffix ,    lineCommentLit )
371      , (" preproc "    ++ litSuffix ,    preprocLit     )
372      ] ++ makeMapping keywordNames       ++
373      [ (" idf "        ++ litSuffix ,    idfLit         )
374      ] ++ makeMapping ( prefixNames      ++ infixNames ++ delimNames ) ++
375      [ (" char "       ++ litSuffix ,    charLit        )
376      , (" stringLit " ++ litSuffix ,     stringLit      )
377      , (" num "        ++ litSuffix ,    numLit         )
378      , (" constr "     ++ litSuffix ,    constrLit      )
379      , (" newline "    ++ litSuffix ,    newLineLit     )
380      , (" fail "       ++ litSuffix ,    failLit        )
381      ]
382

383   || For this implementation , we want to ignore some literals
384   ignoreNames = [" blank " , " lineComment " , " preproc " , " newline "]
385
                          APPENDIX A. IMPLEMENTATION                                                     15

386   greaterLength (x , _ ) (y , _ ) = # x > # y
387

388   filterIgnore = filter (~. member ignoreNames . fst )
389

390   makeMapping stuff = [ ( name ++ litSuffix , lits x $thenSts ( unitSts ( name , x ) ) )
391                       | (x , name ) <- mergeSortWith greaterLength stuff ]
392                     where
393

394

395   otherMapping = [ ( name ++ litSuffix , lits x $thenSts ( unitSts ( name , x ) ) )
396                  | (x , name ) <- otherNames ]
397

398   otherNames = mergeSortWith greaterLength (                       prefixNames
399                                                                 ++ infixNames
400                                                                 ++ delimNames
401                                                                 ++ keywordNames )
402

403   programLit
404    = altStarSts ( range litMapping ) eofLit
405

406   lexer :: string → [( string , string ) ]
407   lexer = filterIgnore . fst . hd . programLit . nilLexer


                          A.2.3     The parser
                                                          parser.ama 


 1    /* the Application Pattern Compiler : a program that translates
 2     * a functional language with application patterns into semantic
 3     * equivalent runnable code .
 4     *
 5     * This file contains the parser .
 6     *
 7     * Copyright ( c ) 2005 Nikolaas N . Oosterhof
 8     */
 9

10    /*
11     * Definition of types for definitions and expressions
12     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
13    defTp
14     ::= FunDef exprTp                                               || { left hand side }
15                           [( exprTp , exprTp ) ]                    || = [{ value1 , guard1 } , ... , { valueN , guardN }]
16                           [ defTp ]                                 || where { subDef1 , ... , subDefK }
17

18    exprTp
19     ::= FA [ exprTp ]               || FA [f , x1 , ... , xN ]     is f x1 ... xN
20                                     ||    where f must be an * Idf
21        | Constr [ char ] [ exprTp ] || Constr "" [ x1 , ... , xN ] is an N - tuple
                              APPENDIX A. IMPLEMENTATION                                                       16

22                                                        ||    Constr     c    []                is the constant c
23                                                        ||    Constr     C    [ x1 , ... , xN ] is C x1 ... xN
24        | Idf [ char ]                                  ||    Idf i                             is the identifier i
25        | InvIdf [ num ] [ char ]                       ||    InvIdf     [ s1 , ... , sK ] f is f ‘[ s0 , ... , sK ]
26        | CtxIdf [ char ]                               ||    CtxIdf     i                      is the identifier ^ i
27                                                        ||                                        ( bound in context )
28

29   /*
30    * Parsing items
31    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
32   parserSt * ::= { remainingP :: [*] }
33   nilParser s = { remainingP = s }
34

35

36   token t ( st = { remainingP = (( x , y ) : xs ) })
37    = unitSts y ( st & { remainingP = xs }) , if x = t
38    = []      , otherwise
39

40   token _ _ = []
41

42   anyToken ts st = concat [ token t st | t <- nodup ts ]
43

44   /*
45    * Parsing standard literals
46    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
47

48   litExpr = anyToken [" char " , " num " , " string "] $doSts ( x → Constr x [])
49

50

51   listExpr = token " lbrack "                                  $thenSts (
52                  ( ( ( expr $separateSts ( token " comma ") )
53                               $doSts          makeListExpr
54                    )                                               $bindSts                             ( xs →
55                    token " rbrack "                                $thenSts                             (
56                    unitSts xs                                                                             ))
57                  ) $biasedOrSts
58                  ( token " rbrack "                                $thenSts                             (
59                    unitSts ( makeListExpr [] ) )                                                            )
60                                                                         )
61            where
62              makeListExpr []         = Constr " Nil " []
63              makeListExpr ( x : xs ) = FA [ Idf " cons " , x , makeListExpr                              xs ]
64

65   idfExpr = ( token " ctxIdf " $bindSts ( x →
66               unitSts ( CtxIdf x )         )
67             ) $biasedOrSts
68             ( token " invIdf " $doSts ma k e In v F un S ig n a tu r e
69             ) $biasedOrSts
70             ( token " idf " $bindSts ( x →
71               unitSts ( Idf x )        )
                        APPENDIX A. IMPLEMENTATION                                     17

72                )
73

74    faExpr          = atomExpr                      $bindSts ( i →
75                        ( oneOrMoreSts atomExpr $bindSts ( xs →
76                          unitSts ( FA ( i : xs ) )               )
77                        )       )
78

79    constrExpr = ( token " constrIdf "     $bindSts ( c →
80                   zeroOrMoreSts ( constrExpr $biasedOrSts atomExpr )
81                                           $bindSts ( xs →
82                   unitSts ( Constr c xs )            ))
83                 )
84

85    || parse an inverse function signature f ‘[...]
86    || a bit ugly , as it uses the lexerState .
87    make I nv F u nS i gn ature =   fst
88                                  . hd
89                                  . ( oneOrMoreSts lexIdf                       $bindSts ( is →
90                                        lits " ‘["                              $thenSts (
91                                        ( lexNat $separateSts ( lits " ,")
92                                                 $doSts      ( map atoi ) )     $bindSts ( sign →
93                                        lit ’] ’                                $thenSts (
94                                        unitSts ( InvIdf sign is )                         ))))
95                                     )
96                                  . nilLexer
97

98    /*
99        Priorities of prefix and infix operators
100    */
101   preinfixOps = [ ( []      , [":" , "++" , " - -"] )
102                  , ( []     , ["\\/"] )
103                  , ( []     , ["∧\"] )
104                  , ( ["~"] , [] )
105                  , ( []     , [" <" , " <=" , "=" , "6=" , "≥" , " >"] )
106                  , ( []     , ["+" , " -"] )
107                  , ( [" -"] , [])
108                  , ( []     , ["*" , " // " , "/" , ’d ’:" iv " , ’m ’:" od "])
109                  , ( []     , ["^"] )
110                  , ( []     , ["."] )
111                  , ( ["#"] , [] )
112                  , ( []     , ["!"] )
113                  ]
114

115   || quite elegant solution : -)
116   expr = makePreInfixExpr expr simpleExpr preinfixOps
117

118   makePreInfixExpr _ finalExpr []
119    = finalExpr
120

121   makePreInfixExpr curExpr finalExpr (( prefixes , infixes ) : xs )
                     APPENDIX A. IMPLEMENTATION                                18

122    = prefixExpr $biasedOrSts infixExpr
123    where
124      prefixExpr = biasedOrsSts [ token tname                $bindSts ( x →
125                                  curExpr                    $bindSts ( c →
126                                  unitSts ( FA [ Idf tname , c ])        ))
127                                | t <- prefixes
128                                ; tname := lookUp prefixNames t
129                                ]
130      infixExpr = nextExpr                   $bindSts ( c →
131                   biasedOrsSts ( [ ( token tname                 $bindSts ( x →
132                                     curExpr                      $bindSts ( d →
133                                     unitSts ( FA [ Idf tname , c , d ])    ))
134                                   )
135                                  | t <- infixes
136                                  ; tname := lookUp infixNames t
137                                  ] ++ [ unitSts c ]
138                                )                       )
139      nextExpr = makePreInfixExpr nextExpr finalExpr xs
140

141

142   simpleExpr = atomExpr $orSts faExpr $orSts constrExpr
143

144   eofExpr ( st ={ remainingP =[]})
145    = unitSts [] st
146   eofExpr st
147    = zeroSts st
148

149   atomExpr = ( token " lparen "                        $thenSts (
150                  ( token " rparen "                    $thenSts (
151                    unitSts ( Constr "" [])                        )
152                  ) $biasedOrSts
153                  ( expr                                     $bindSts ( x →
154                      ( token " comma "                            $thenSts (
155                         expr $separateSts ( token " comma ") $bindSts ( xs →
156                         token " rparen "                          $thenSts (
157                         unitSts ( Constr [] ( x : xs ) )                     )))
158                      ) $biasedOrSts
159                      ( token " rparen "                           $thenSts (
160                         unitSts x                                            )
161                      )                                                 )
162                  )                                                )
163              ) $orSts idfExpr $orSts listExpr $orSts litExpr
164

165

166   funcDefinition = expr                                 $bindSts ( x →
167                    token " funDef "                     $thenSts (
168                    funcClause $separateSts ( token " funDef_redent ")
169                                                         $bindSts ( cs →
170                      ( token " where "                      $thenSts (
171                         oneOrMoreSts funcDefinition          $bindSts ( ws →
                     APPENDIX A. IMPLEMENTATION                                     19

172                            token " dedent "                        $thenSts (
173                            token " dedent "                        $thenSts (
174                            unitSts ( FunDef x cs ws )                           ))))
175                          ) $biasedOrSts
176                          ( token " dedent "                        $thenSts (
177                            unitSts ( FunDef x cs [] )                           )
178                          )                                              )))
179

180

181   funcClause = expr            $bindSts ( x →
182                  ( token " comma "  $thenSts (
183                      ( token " if "        $thenSts (
184                        expr                $bindSts ( y →
185                        unitSts (x , y )               ))
186                      ) $biasedOrSts
187                      ( token " otherwise " $thenSts (
188                        unitSts (x , Constr " True " []) )
189                      )                        )
190                  ) $orSts
191                  ( unitSts (x , Constr " True " []) )
192                                          )
193

194   program :: stateSts ( parserSt ( string , string ) ) [ defTp ]
195   program = oneOrMoreSts funcDefinition $bindSts ( x →
196             eofExpr                        $thenSts (
197             unitSts x                                  ))
198

199   || In case of an parsing error the message is not really informative : -|
200   parser :: [( string , string ) ] → [ defTp ]
201   parser s
202    = error " Nothing to parse : empty input "            , if s = []
203    = error " Parsing error , somewhere in the program ." , if parses = []
204    = fst ( hd parses )                                   , otherwise
205    where
206      parses = program ( nilParser s )


                     A.2.4    The preprocessor
                                              preproc.ama 


 1    /* the Application Pattern Compiler : a program that translates
 2     * a functional language with application patterns into semantic
 3     * equivalent runnable code .
 4     *
 5     * This file contains the preprocessor .
 6     *
 7     * Copyright ( c ) 2005 Nikolaas N . Oosterhof
 8     */
                     APPENDIX A. IMPLEMENTATION                                          20

9

10   /*
11    * Rewriting left hand side and / or complete definitions
12    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
13

14   rewriteLHside rw ( FunDef f vgs ws )
15    = FunDef ( rw f ) vgs ( map ( rewriteLHside rw ) ws )
16

17   rewriteLRHside rw ( FunDef f vgs ws )
18    = rewriteLHside rw ( FunDef f
19                                ( map ( mapPair rw ) vgs )
20                                ( map ( rewriteLRHside rw ) ws )
21                        )
22

23

24

25

26   rewriteExpr rw ( FA fargs )      = rw ( FA ( map ( rewriteExpr rw ) fargs ) )
27   rewriteExpr rw ( Constr c args ) = rw ( Constr c ( map ( rewriteExpr rw ) args ) )
28   rewriteExpr rw i                 = rw i
29

30   /*
31    * Rewriting join operators so that e . g . the application pattern
32    *         x ++ " ," ++ y ++ " ," ++ z
33    * is rewritten into
34    *         join3 x " ," ( join3 y " ," z )
35    * making it suitable for solving for x , y and z by using the inverse join ‘[0 ,2]
36    *
37    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
38   rewriteJoin3 ( f =( FA [ CtxIdf " join " , FA [ CtxIdf " join " , x , y ] , z ]) )
39    = FA ( CtxIdf " join3 " : [x , y , z ]) , if isKnown y
40    = f , otherwise
41

42   rewriteJoin3 ( f =( FA [ CtxIdf " join " , x , FA [ CtxIdf " join " , y , z ]]) )
43    = FA ( CtxIdf " join3 " : [x , y , z ]) , if isKnown y
44    = f , otherwise
45

46   rewriteJoin3 otherExpr
47   = otherExpr
48

49

50   isKnown   ( Idf _ ) = False
51   isKnown   ( Constr _ args ) = forAll args isKnown
52   isKnown   ( FA ( _ : args ) ) = forAll args isKnown
53   isKnown   ( CtxIdf _ ) = True
54   isKnown   ( InvIdf _ _ ) = True
55

56

57   /*
58    * Add the caret in an application pattern in expressions where it
                    APPENDIX A. IMPLEMENTATION                                      21

59    * may be omitted by the programmer , i . e .
60    * - for operators
61    * - in nested function applications
62    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
63   addCtxFA nested ( FA ( i : args ) )
64    = FA ( i1 : args1 )
65    where
66        i1 = makeCtxIdf ( nested \/ isOperator ) i
67              where
68                  isOperator = ~( empty [ j | (_ , j ) <- infixNames ++ prefixNames ; Idf j = i ])
69                  makeCtxIdf True ( Idf i ) = CtxIdf i
70                  makeCtxIdf _                    i               = i
71        args1 = map ( addCtxFA True ) args
72

73   addCtxFA nested ( Constr c args )
74    = Constr c args1
75    where
76      args1 = map ( addCtxFA nested ) args
77

78   addCtxFA _ i
79    = i
80

81

82   rewrLHsides funcs =   map ( rewriteLHside ( limiterates funcs ) )
83   preproc = rewrLHsides [ addCtxFA False , rewriteJoin3 ]


                    A.2.5    Creating unique identifiers
                                              uniqidfs.ama 


1    /* the Application Pattern Compiler : a program that translates
2     * a functional language with application patterns into semantic
3     * equivalent runnable code .
4     *
5     * This file contains the part that renames identifiers to unique ones .
6     *
7     * Copyright ( c ) 2005 Nikolaas N . Oosterhof
8     */
9

10   /*
11    * Retrieving primary and secundary identifiers :
12    * - primary : the identifiers that are bound in a definition
13    * - secundary : arguments for the primary identifiers
14    *
15    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
16

17   primSecIdfs atTop ( FA ( CtxIdf f : args ) )
18    = map ( primSecIdfs atTop )           args $bindId ( idfs →
                      APPENDIX A. IMPLEMENTATION                             22

19      unitId ( concatPair ( idfs ) )          )
20

21

22   primSecIdfs atTop ( FA ( f : args ) )
23    = primSecIdfs True f                      $bindId ( idf →
24      map ( primSecIdfs False )          args $bindId ( idfs →
25      unitId ( concatPair ( idf : idfs ) )     ))
26

27   primSecIdfs _ ( CtxIdf i )
28    = ([] , [])
29

30   primSecIdfs atTop ( InvIdf _ _ )
31    = ([] , [])
32

33   primSecIdfs atTop ( Constr _ args )
34    = map ( primSecIdfs atTop ) args $bindId ( idfs →
35      unitId ( concatPair idfs ) )
36

37   primSecIdfs atTop ( Idf i )
38    = ([ i ] , []) , if atTop
39    = ([] , [ i ]) , otherwise
40

41   || assumption : all identifiers are different
42   exprPrimSecIdfs atTop f s
43    = (( mapPair ( filter ((~) . empty ) ) . primSecIdfs atTop ) f , s )
44

45

46   defsPrimSecIdfs atTop defs s
47    = ( pairAsSet ( concatPair [ fst ( exprPrimSecIdfs atTop fargs nilPair ) | FunDef
          fargs _ _ <- defs ]) , s )
48

49

50   /*
51    * Renaming identifiers so they are bound only once in the whole program .
52    * A stack is used for the different scopes .
53    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
54   popSubs (( _ : subs ) , used ) = unitSt subs ( subs , used )
55

56   pushSubs old     new ( subs , used )
57    = ( allSubs ,   ( allSubs , newUsed ) )
58    where
59      allSubs =     ( zip2 old new ) : subs
60      newUsed =     asSet ( used ++ old ++ new )
61

62

63   subsDefPrimIdfs defs ( s =( subs , _ ) )
64    = ( map ( subsDefIdfs subs ) defs , s )
65

66   subsDefIdfs subs ( FunDef f vgs ws )
                      APPENDIX A. IMPLEMENTATION                                 23

67     = FunDef ( subsExprIdf subs f ) (( map . mapPair ) ( subsExprIdf subs ) vgs ) ( map (
          subsDefIdfs subs ) ws )
68

69    subsSecIdfs f ( s =( subs , used ) )
70     = ( subsExprIdf subs f , s )
71

72

73

74    subsVgsExprIdfs vgs ( subs , used )
75     = (( map . mapPair ) ( subsExprIdf subs ) vgs , ( subs , used ) )
76

77    subsExprIdf subs ( FA fargs )
78     = FA ( map ( subsExprIdf subs ) fargs )
79

80    subsExprIdf subs ( Constr c args )
81     = Constr c ( map ( subsExprIdf subs ) args )
82

83    subsExprIdf subs ( Idf i )
84     = Idf i1 , if found 6= []
85     = Idf i , otherwise
86     where
87       found = lookUpAll ( concat subs ) i
88       ( i1 : _ ) = found
89

90    subsExprIdf subs ( CtxIdf i )
91     = CtxIdf i1 , if found 6= []
92     = CtxIdf i , otherwise
93     where
94       found = lookUpAll ( concat subs ) i
95       ( i1 : _ ) = found
96

97    subsExprIdf _ i
98     = i
99

100   /*
101       Creating fresh identifiers
102    */
103   numString n = combinations ( bcxyz : rep ( a : bcxyz ) (n -1) )
104                  where
105                    ( a : bcxyz ) = map decode [ code ’0 ’.. code ’9 ’]
106

107   bdNewIdf i ( st =( x , used ) )
108    = unitSt newIdf (x , used ++ [ newIdf ])
109    where
110      ( newIdf : _ ) = filter ((~) . member used )
111                               ( map ( i ++) ("" : concatmap numString [1..]) )
112

113

114   /*
115        The actual renaming .
                        APPENDIX A. IMPLEMENTATION                                   24

116         ( bd refers to Barendrecht without any apparant reason )
117    */
118

119   bds :: [ defTp ] → stateT ([[( string , string ) ]] , [ string ]) [ defTp ]
120   ||     < input >             < substitutions >        < bound >   < output >
121

122   bds defs
123    = defsPrimSecIdfs True defs                                 $bindSt   ( ( prim , _ ) →
124      bdNewIdfs prim                                            $bindSt   ( prim1 →
125      pushSubs prim prim1                                       $thenSt   (
126      subsDefPrimIdfs defs                                      $bindSt   ( defs1 →
127      traverse bd defs1                                         $bindSt   ( defs2 →
128      unitSt defs2         )))))
129

130   bd :: defTp → stateT ([[( string , string ) ]] , [ string ]) defTp
131   bd ( FunDef f vgs ws )
132    = exprPrimSecIdfs True f                                  $bindSt     ( (_ , sec ) →
133      bdNewIdfs sec                                           $bindSt     ( sec1 →
134      pushSubs sec sec1                                       $thenSt     (
135      bds ws                                                  $bindSt     ( ws1 →
136      subsVgsExprIdfs vgs                                     $bindSt     ( vgs1 →
137      subsSecIdfs f                                           $bindSt     ( f1 →
138      popSubs                                                 $thenSt     (
139      popSubs                                                 $thenSt     (
140      unitSt ( FunDef f1 vgs1 ws1 )                                          ))))))))
141

142   /*
143         rename definitions
144

145         renaming wildcard " _ " is necessary : if left out , the definition
146

147         f _ 0 = ...
148         f x y = ... x ... y ...
149

150         is rewritten to something like
151

152         f _ var2 = ...
153         f x y    = ... x ... y ..
154

155         which during merging leads to the where clause
156

157         ...
158          where (x , y ) = (_ , var )
159

160          so that x is not bound properly .
161    */
162

163   bddefs defs
164    = traverse bd defs ([[]] , wildCardIdfName : prim )
165    where
                               APPENDIX A. IMPLEMENTATION                                 25

166        (( prim , _ ) , _ ) = defsPrimSecIdfs True defs ([] , [])
167

168

169   bdNewIdfs = traverse bdNewIdf
170

171   uniqidfs :: stateT [ defTp ] [ string ]
172   uniqidfs defs
173    = ( used1 , defs1 )
174    where
175      ( defs1 , (_ , used1 ) ) = bddefs defs


                               A.2.6         The actual rewriting
                                                                         rewrite.ama 


 1    /* the Application Pattern Compiler : a program that translates
 2     * a functional language with application patterns into semantic
 3     * equivalent runnable code .
 4     *
 5     * This file does the actual rewriting .
 6     *
 7     * Copyright ( c ) 2005 Nikolaas N . Oosterhof
 8     */
 9

10    idfSep = " _ "
11    varPrefix = " var "
12    matchPrefix = " match "
13

14    maybeSfx = " _Mb "
15

16    invPrefix =" inv "
17

18    newIdfPrefix = " idf_ "
19

20    wildCardIdfName = " _ "
21    wildCardIdf = Idf wildCardIdfName
22

23    /*
24     * The rewriting state
25     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
26

27    patTp
28     ::= { wheres      :: [ defTp ]                            || where clauses to be added
29          , guards     :: [ exprTp ]                           || guards to be added
30          , invFunDefs :: [([ char ] , ([ num ] , [ num ]) ) ] || list of (f , i * ’s , j * ’ s
31                                                               || - i * ’ s : indices provided args
32                                                               || - j * ’ s :    "    required "
33          , usedIdfs   :: [ string ]                           || bound identifiers
                    APPENDIX A. IMPLEMENTATION                                    26

34        , provided   :: [( exprTp , exprTp ) ]            || provided identifiers and
             condition
35        , required   :: [( exprTp , exprTp ) ]            || required identifiers and
             condition
36        }
37

38   nilPat
39    = { wheres    = []
40      , guards    = []
41      , invFunDefs = []
42      , usedIdfs = []
43      , provided = []
44      , required = []
45      }
46

47   initPatSt ( used , defs )
48    =   nilPat
49      & { invFunDefs = [( i , (s , [0..# s +(# as ) -2] - - s ) )
50                         | FunDef ( FA (( InvIdf s i ) : as ) ) _ _ <- defs ]
51        , usedIdfs = used }
52

53   define f g
54    = FunDef f [( g , Constr " True " []) ] []
55

56   /*
57       Updating the state
58    */
59   addGuard x ( st ={ guards = guards })
60    = (x , st & { guards = guards ++ [ x ]})
61

62   addWheres xs ( st ={ wheres = wheres })
63    = ( xs , st & { wheres = wheres ++ xs })
64

65

66   addRequired xs g ( st ={ required = required })
67    = ( xs , st & { required = required ++ [ (i , g ) | i <- concatmap ctxIdfs xs ]})
68

69

70   addProvided xs g ( st ={ provided = provided })
71    = ( xs , st & { provided = provided ++ [ (i , g ) | i <- xs ]})
72

73   || find context identifiers ( these are the only that may cause problems )
74   ctxIdfs ( FA ( _ : args ) )
75    = concatmap ctxIdfs args
76

77   ctxIdfs ( Constr _ args )
78    = concatmap ctxIdfs args
79

80   ctxIdfs ( CtxIdf i )
81    = [ Idf i ]
                       APPENDIX A. IMPLEMENTATION                               27

82

83    ctxIdfs _
84     = []
85

86

87

88    /*
89          Adds created guards to existing guards
90          - returns new guards and created where clauses
91          - as a side effect all created guards and where clauses so far
92            are removed from the current state
93     */
94

95    gatherVgsWs vgs st
96     = unitSt ( vgs1 , ws1 ) ( st & emptySt )
97     where
98       { wheres        = wheres
99       , guards        = guards
100      , provided      = provided
101      , required      = required
102      } = st
103      vgs1 = [( v , foldr makeAnd g
104                   ( fixPatternOrder provided required guards ) )
105             | (v , g ) <- vgs ]
106      ws1 = wheres
107      emptySt = { wheres =[] , guards =[] , provided =[] , required =[]}
108

109   makeAnd x y = FA [ Idf " land " , x , y ]
110

111   /*
112         Fixes order of pattern matching , if necessary . This is only necessary for
113         identifiers used in the context that are bound in a pattern to the right
114         in of the current pattern ( in a lhs )
115

116         For example , in the definition
117

118           f (p x ^y) (q y)
119

120         first y must be resolved ( through q ‘[0] , assumed that it is defined ) ,
121         then x must be resolved ( through p ‘[0] ,    "                     " ).
122

123         The order is fixed by moving guards to the left , if necessary .
124

125         Note : there is / no check / for cyclic dependancies .
126    */
127

128   fixPatternOrder provided required guards
129    = map fst patFixed
130     where
131       patDeps = transClose [ ( reqgd , provgd )
                         APPENDIX A. IMPLEMENTATION                               28

132                                  | ( prov , provgd ) <- provided
133                                  ; ( req , reqgd ) <- required
134                                  ; prov = req
135                                  ]
136          patMDPs = [ (m , (d , p ) )
137                    | m , p <- guards , [0..]
138                    ; d := lookUpAll patDeps m
139                    ]
140          patFixed = mergeSortWith patOrd patMDPs
141

142   /*
143         for the proper order of matching patterns
144         - first consider dependencies
145         - if no dependencies exist , use the ordinary ( left - to - right ) order
146

147         in a tuple (m , (d , p ) ) : m is the matching guard
148                                      d are other matchings guards m depends on
149                                      p is the position of the pattern ( p is in [0..])
150    */
151

152   patOrd    ( m0 , ( d0 , p0 ) ) ( m1 , ( d1 , p1 ) )
153    =          ( d01 ∧ ~ d10 )
154      \/     ~( d10 ∧ ~ d01 )
155      \/       ( p1 > p0 )
156    where
157      d01    = member d1 m0
158      d10    = member d0 m1
159

160

161

162   /*
163         Create new identifier
164    */
165

166   patNewIdf prefix ( s ={ usedIdfs = usedIdfs })
167    = ( Idf newIdf , s & { usedIdfs =( newIdf : usedIdfs ) })
168    where
169      allIdfs = map ( prefix ++) ("" : concatmap numString [1..])
170      ( newIdf : _ ) = filter (~.( member usedIdfs ) ) allIdfs
171

172   patNewIdfs = traverse patNewIdf
173

174   /*
175         Find inverse function definition
176         - if none is found a runtime exception is thrown
177         - if multiple definitions are found the first is taken
178    */
179   patInvFunDef i args ( s ={ invFunDefs = invFunDefs })
180    = error (" No suitable inverse defined for " ++ i ) , if rps = []
181    = ( hd rps , s ) , otherwise
                               APPENDIX A. IMPLEMENTATION                                  29

182    where
183      rps = [           ( invIdfAsMb ( InvIdf provi i ) , prov , req )
184            |           ( provi , reqi ) <- lookUpAll invFunDefs i
185            ;           req := reqi $fromList args
186            ;           forAll req isKnown
187            ;           prov := provi $fromList args
188            ]
189

190

191   invIdfAsMb ( InvIdf c i )
192    = InvIdf c ( i ++ maybeSfx )
193

194   /*
195    * Rewriting a pattern
196    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
197

198   || Application pattern
199   rewrPat ( pat =( FA ( CtxIdf i : args ) ) )
200    = patNewIdfs [" var "]                     $bindSt ( [ var ] →
201      addGuard ( FA [ Idf " eq " , var , pat ])
202                                               $thenSt (
203      unitSt var                                         ) ) , if forAll args isKnown
204

205    = patNewIdfs [" var " , " match "]      $bindSt ( [ var , match ] →
206      unitSt ( FA [ Idf " neq " , match , Constr " Nothing " []])
207                                            $bindSt ( guard →
208      addGuard guard $thenSt (
209      patInvFunDef i args                   $bindSt ( ( finv , prov , req ) →
210      traverse rewrPat prov                 $bindSt ( prov1 →
211      addWheres [ define match
212                            ( FA ( finv : req ++[ var ]) )
213                 , define ( Constr " Just " [ Constr "" prov1 ])
214                            match
215                 ]                          $thenSt (
216      addRequired req guard                 $thenSt (
217      addProvided prov1 guard               $thenSt (
218      unitSt var                                         ))))))))
219

220   || Constant application pattern ( that binds no identifiers )
221   rewrPat ( pat =( FA ( f : args ) ) )
222    = patNewIdfs [" var "]                 $bindSt ( [ var ] →
223      addGuard ( FA [ Idf " eq " , var , pat ])
224                                           $thenSt (
225      unitSt var                                     ) ) , if forAll args isKnown
226    = error " Oops ! why rewrite function application ?" , otherwise
227

228   || Tuple
229   rewrPat ( Constr "" args )
230    = traverse rewrPat args                                         $bindSt ( args1 →
231      unitSt ( Constr "" args1 )                                             )
                               APPENDIX A. IMPLEMENTATION                       30

232

233   || Constant
234   rewrPat ( pat =( Constr c []) )
235    = patNewIdfs [" var "]                 $bindSt ( [ var ] →
236      addGuard ( FA [ Idf " eq " , var , pat ])
237                                           $thenSt (
238      unitSt var                                     ))
239

240   || Constructor with ≥ 1 argument
241   rewrPat ( Constr c args )
242    = patNewIdfs [" var " , " is_ " ++ c ] $bindSt ( [ var , isConstr ] →
243      unitSt ( FA [ isConstr , var ])      $bindSt ( guard →
244      addGuard guard                       $thenSt (
245      traverse rewrPat args                $bindSt ( args1 →
246      addWheres [ define ( FA [ isConstr , Constr c ( rep wildCardIdf (# args ) ) ])
247                            ( Constr " True " [])
248                 , define ( FA [ isConstr , wildCardIdf ])
249                            ( Constr " False " [])
250                 , define ( Constr c args1 )
251                            var
252                 ]                         $thenSt (
253      addProvided args1 guard              $thenSt (
254      unitSt var                                     ))))))
255

256   || Identifier bound from context : treat like a constant
257   rewrPat (( CtxIdf i ) )
258    = patNewIdfs [" var "]                 $bindSt ( [ var ] →
259      addGuard ( FA [ Idf " eq " , var , Idf i ])
260                                           $thenSt (
261      unitSt var                                     ))
262

263   || Any other pattern , i . e . only an identifier
264   rewrPat i
265    = unitSt i
266

267

268

269   /*
270    * Rewriting a definition
271    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
272

273   getMakePats ( pat =( FA (( CtxIdf i ) : args ) ) )
274    = ( [ pat ] , ([ p ] → p ) , False )
275

276   getMakePats ( FA ( i : args ) )
277    = ( args , ( a → FA ( i : a ) ) , True )
278

279   getMakePats pat
280    = ( [ pat ] , ([ p ] → p ) , False )
281
                      APPENDIX A. IMPLEMENTATION                            31

282   getPats expr
283    = pats
284    where
285      ( pats , _ , _ ) = getMakePats expr
286

287   rewrDef ( FunDef fun vgs ws )
288    = unitSt ( getMakePats fun )       $bindSt ( ( pats , makePat , outSide ) →
289      traverse rewrPat pats            $bindSt ( pats1 →
290      gatherVgsWs vgs                  $bindSt ( ( vgs1 , ws1 ) →
291      traverse rewrDef ws              $bindSt ( ws2 →
292      unitSt ( if outSide [( FunDef ( makePat pats1 ) vgs1 ( concat ws2 ++ ws1 ) ) ]
293                          (( FunDef ( makePat pats1 ) vgs []) : ws1 ++ concat ws2 )
294                               || note : use old vgs as we dont check for pattern match
295              )                                  ))))
296

297   rewrDefs ( ud =( used , defs ) )
298    = ( concat . fst . traverse rewrDef defs . initPatSt ) ud


                      A.2.7    The postprocessing
                                                postproc.ama 


 1    /* the Application Pattern Compiler : a program that translates
 2     * a functional language with application patterns into semantic
 3     * equivalent runnable code .
 4     *
 5     * This file contains the postprocessor .
 6     *
 7     * Copyright ( c ) 2005 Nikolaas N . Oosterhof
 8     */
 9

10

11    /*
12     * Comparing patterns to decide whether definitions must be merged .
13     *
14     * This is necessary because replacing non - identier patterns by
15     * identifier patterns can make subsequent equations in function
16     * definitions unreachable
17     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
18

19    equalPat ( FA ( f : xs ) ) ( FA ( g : ys ) )
20     = f = g ∧ and ( map2 equalPat xs ys )
21     where
22

23    equalPat ( Constr c xs ) ( Constr d ys )
24     = and ( ( c = d ) : map2 equalPat xs ys )
25

26    equalPat ( Idf _ )        ( Idf _ )       = True
                      APPENDIX A. IMPLEMENTATION                            32

27   equalPat ( CtxIdf _ )   ( CtxIdf _ )   = True
28   equalPat ( InvIdf _ _ ) ( InvIdf _ _ ) = True
29

30   equalPat _ _ = False
31

32   equalDefPat f g
33    = fp = gp ∧ equalPat x y
34    where
35      (x , y ) = mapPair getFun (f , g )
36                where
37                  getFun ( FunDef f _ _ ) = f
38      ( fp , gp ) = mapPair ( fst . primSecIdfs True ) (x , y )
39

40

41   /*
42    * Combining two definitions
43    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
44   joinDefs ( FunDef f0 vgs0 ws0 ) ( FunDef f1 vgs1 ws1 )
45    = FunDef f0
46                      ( vgs0 ++ vgs1 )
47                      ( alignPats : ws0 ++ ws1 )
48    where
49        ( pats0 , pats1 ) = mapPair getPats ( f0 , f1 )
50        alignPats = define ( Constr "" pats1 ) ( Constr "" pats0 )
51

52   combineDefs ( d : ds ) = foldl joinDefs d ds
53

54   iterateDefs f defs
55    = f [ FunDef fun vgs ( iterateDefs f ws )
56        | FunDef fun vgs ws <- defs
57        ]
58   mergeDefs :: [ defTp ] → [ defTp ]
59   mergeDefs = iterateDefs (( map combineDefs ) . ( partition equalDefPat ) )
60

61   /*
62    *   For each inverse function definition , add an extra definition
63    *   that returns a value of the maybe type
64    *
65    *   That is , for each definition
66    *
67    *       f ‘[...]    :: ... → tp
68    *       f ‘[...]    x1 ... xK
69    *          = v1 ,   if g1
70    *          ...
71    *          = vN ,   if gN
72    *
73    *   we add an extra definition
74    *
75    *       f_Mb ‘[...] :: ... → maybe tp
76    *       f_Mb ‘[...] x1 ... xK
                               APPENDIX A. IMPLEMENTATION                            33

77     *               = Just v1 , if g1
78     *               ...
79     *               = Just vN , if gN
80     *               = Nothing , otherwise
81     *
82     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
83

84    addMbInverse ( def =( FunDef ( FA (( f =( InvIdf _ _ ) ) : args ) ) vgs ws ) )
85     = [ def , defMb ]
86     where
87       defMb = FunDef ( FA (( invIdfAsMb f ) : args ) )
88                        ( map addJust vgs ++ [ nothingOtherwise ])
89                        ws || assume no inverses are defined in where clauses
90               where
91                 addJust (v , g ) = ( Constr " Just " [ v ] , g )
92                 nothingOtherwise = ( Constr " Nothing " [] , Constr " True " [])
93

94    addMbInverse def
95     = [ def ]
96

97    defsAddMbInverse :: [ defTp ] → [ defTp ]
98    defsAddMbInverse
99     = concatmap addMbInverse
100

101   /*
102    * Rename identifers of the form InvIdf and CtxIdf
103    * so that they are understood by the Amanda compiler
104    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
105   defs I df P r op e rN aming
106    = map ( rewriteLRHside ( rewriteExpr e x p rI d f Pr o pe r N am i n g ) )
107

108   expr I df P r op e rN aming ( InvIdf s i )
109    = Idf (         invPrefix
110               ++ idfSep
111               ++ i
112               ++ idfSep
113               ++ ( enclose "" idfSep "" ( map itoa s ) )
114             )
115

116   expr I df P r op e rN aming ( CtxIdf i )
117    = Idf i
118

119   expr I df P r op e rN aming i
120    = i
121

122   /*
123    * Very limited postprocessing
124    * Replace expressions " x ∧ True " and " True ∧ x " by " x "
125                                                "( x ) "               by " x "
126    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
                      APPENDIX A. IMPLEMENTATION                                34

127

128   rewrAndTrue ( FA [ Idf " land " , Constr " True " [] , x ]) = x
129

130   rewrAndTrue ( FA [ Idf " land " , x , Constr " True " []]) = x
131

132   rewrAndTrue x = x
133

134

135   rewrSingleConstr ( Constr "" [ x ]) = x
136

137   rewrSingleConstr x                    = x
138

139   postproc :: [ defTp ] → [ defTp ]
140   postproc = map ( rewriteLRHside ( limiterates ( map rewriteExpr funcs ) ) )
141            where
142              funcs = [ rewrAndTrue , rewrSingleConstr ]


                      A.2.8   Printing the output nicely
                                             prettyPrint.ama 


 1    /* the Application Pattern Compiler : a program that translates
 2     * a functional language with application patterns into semantic
 3     * equivalent runnable code .
 4     *
 5     * This file contains the prettyPrint functionality .
 6     *
 7     * Copyright ( c ) 2005 Nikolaas N . Oosterhof
 8     */
 9

10    /*
11     * Positioning of blocks of text above and next to each other
12     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
13

14    nextTo   a [] = a
15    nextTo   a [[]] = a
16    nextTo   [] b = b
17    nextTo   [[]] b = b
18    nextTo   a b = [ la ++ lb | la , lb <- filla , fillb ]
19                 where
20                   ( xa , xb ) = mapPair ( max . map #) (a , b )
21                   ( ya , yb ) = mapPair (#)            (a , b )
22                   filla = fill ( rep ’ ’ xa ) height ( map ( fill ’ ’ xa ) a )
23                   fillb = fill ( rep ’ ’ xb ) height ( map ( fill ’ ’ xb ) b )
24                   height = max2 ya yb
25

26    nextTos = foldr nextTo []
27
                        APPENDIX A. IMPLEMENTATION                         35

28   above a [] = a
29   above [] b = b
30   above a b = filla ++ fillb
31              where
32                ( xa , xb ) = mapPair ( max . map #) (a , b )
33                filla = map ( fill ’ ’ width ) a
34                fillb = map ( fill ’ ’ width ) b
35                width = max2 xa xb
36

37   aboves = foldr above []
38

39   fill atom length line = line ++ rep atom ( length - (# line ) )
40

41

42   optAbove a [] = []
43   optAbove a [[]] = [[]]
44   optAbove a b = a $above b
45

46   optNextTo a [] = []
47   optNextTo a [[]] = [[]]
48   optNextTo a b = a $nextTo b , otherwise
49

50   /*
51    * Printing definitions and expressions nicely
52    * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
53

54   || the boolean denotes whether the result must not be enclosed by parenthesis
55   generic prettyPrint :: bool → * → [ char ]
56

57   prettyPrint _ ( Idf f )
58    = f
59

60   prettyPrint _ ( CtxIdf f )
61    = ’^ ’: f
62

63   prettyPrint _ ( InvIdf sign f )
64    = f ++ " ‘" ++ ( filter (6=’ ’) . toString ) sign
65

66   prettyPrint True ( Constr [] xs )
67    = enclose "(" " , " ") " ( map ( prettyPrint True ) xs )
68

69   prettyPrint _ ( Constr i [])
70    = i
71

72   prettyPrint True ( Constr i xs )
73    = prettyPrint True (( Idf i ) : xs )
74

75   prettyPrint True ( FA [ Idf f , arg ])
76    = prettyPrint True ( Constr fshort [ arg ])
77    where
                      APPENDIX A. IMPLEMENTATION                               36

78       fshort = fromJust ( ( lookUpMb ( invert prefixNames ) f
79                           ) $orJust f
80                         )
81

82    prettyPrint True ( FA [ Idf f , arg0 , arg1 ])
83     = prettyPrint True farg01
84     where
85       farg01 = fromJust ( ( lookUpMb ( invert infixNames ) f        $bindMb ( fshort →
86                               unitMb [ arg0 , Idf fshort , arg1 ]             )
87                             ) $orJust [ Idf f , arg0 , arg1 ]
88                          )
89

90    prettyPrint True ( FA ( f : args ) )
91     = prettyPrint True ( f : args )
92

93    prettyPrint b ( FunDef f vgs ws )
94     = unlines (         [ printF ]
95                  $above printVgs
96                  $above (             [" where "]
97                            $optAbove (["    "] $optNextTo printWs )
98                         )
99               )
100    where
101      printF    = prettyPrint b f
102      printVgs = prettyPrintVgs b vgs
103      printWs = aboves ( map ( lines . prettyPrint b ) ws )
104

105   prettyPrintVgs b vgs
106    = nextTos [ rep defEq (# vgs )
107              , map ( prettyPrint b . fst ) vgs
108              , guards
109              ]
110    where
111     guards = [ guard
112              | (_ , g ) , i <- vgs , [1..]
113              ; guard := if ( g = ifTrue )
114                               ( if (# vgs = 1)
115                                    ""
116                                    ( if ( i = (# vgs ) )
117                                         " , otherwise "
118                                         (" , if " ++ prettyPrint b g )
119                                    )
120                               )
121                               (" , if " ++ prettyPrint b g )
122              ]
123      defEq = " = "
124      ifTrue = Constr " True " []
125

126   prettyPrint b (x , y )
127    = prettyPrint True x ++ " " ++ prettyPrint True y
                     APPENDIX A. IMPLEMENTATION                                37

128

129   prettyPrint b (( d = FunDef f cgs ws ) : ds )
130    = ( unlines . aboves . map ((++[" "]) . lines . prettyPrint True ) ) ( d : ds )
131

132   prettyPrint True []
133    = []
134

135   prettyPrint True ( x : xs )
136    = enclose "" " " "" ( map ( prettyPrint False ) ( x : xs ) )
137

138   prettyPrint False y
139    = "(" ++ prettyPrint True y ++ ") "
140

141   prettyPrint _ x
142    = toString x
143

144

145   || Remove spaces at the end of each line
146   crop = unlines . map cropLine . lines
147        where
148              cropLine = reverse . ( dropwhile (= ’ ’) ) . reverse
149

150

151   print :: [ defTp ] → string
152   print = crop . prettyPrint True



                     A.3     Introducing monads
                                              monadMb.ama 



 1    /*
 2     * Maybe monad
 3     *
 4     * implementation inspired by Philip Wadler (1992) , MfFP
 5     *
 6     * 11 -2005  Nikolaas N . Oosterhof
 7     */
 8

 9    maybe * ::= Nothing | Just *
10

11    unitMb :: * → maybe *
12    unitMb a = Just a
13

14    zeroMb = Nothing
15

16    bindMb :: maybe * → (* → maybe **) → maybe **
17    bindMb ( Nothing ) _ = Nothing
                     APPENDIX A. IMPLEMENTATION                                 38

18   bindMb ( Just a ) f = f a
19

20   thenMb :: maybe * → maybe ** → maybe **
21   thenMb a b = bindMb a ( _ → b )
22

23   alternativeMb ( Just a ) _ = Just a
24   alternativeMb ( Nothing ) b = b
25

26   alternativesMb = foldl alternativeMb Nothing
27

28   guardMb False _ = Nothing
29   guardMb True a = a
30

31   hdMb [] = Nothing
32   hdMb ( a : as ) = Just a
33

34   tlMb [] = Nothing
35   tlMb ( a : as ) = Just as
36

37   hdtlMb [] = Nothing
38   hdtlMb ( a : as ) = Just (a , as )
39

40

41

42   lastMb [] = Nothing
43   lastMb [ x ]      = Just x
44   lastMb ( _ : xs ) = lastMb xs
45

46   frontMb [] = Nothing
47   frontMb [ x ] = Just []
48   frontMb ( x : xs ) = frontMb xs $bindMb ( frontxs → unitMb ( x : frontxs ) )
49

50

51   fromJust ( Just x ) = x
52   fromJust _          = error " fromJust "
53

54   fromJusts = map fromJust . filter (6=Nothing )
55

56   orJust a b = a $alternativeMb ( unitMb b )
57

58   isNothing Nothing = True
59   isNothing _       = False
60

61   areNothing = and . map isNothing
62

63   lookUpMb []                 _   = Nothing
64   lookUpMb (( x , y ) : xys ) key = (( x = key ) $guardMb unitMb y )
65                                     $alternativeMb lookUpMb xys key
66

67   lookMbUpMb xs key = key                                 $bindMb ( x →
                    APPENDIX A. IMPLEMENTATION                                       39

68                            hdMb ( filter ((= x ) . fst ) xs )   $bindMb ( (_ , y ) →
69                            unitMb y                                      ))


                                                 monadSt.ama 


1    /*
2     * State - transition monad
3     *
4     * implementation inspired by Philip Wadler (1992) , MfFP
5     *
6     * 11 -2005    Nikolaas N . Oosterhof
7     */
8

9    stateT * ** == * → (** , *)
10

11   unitSt :: ** → stateT * **
12   unitSt x st = (x , st )
13

14   bindSt   :: stateT * ** → (** → stateT * ***) → stateT * ***
15   bindSt   p q s
16    = q x   s1
17    where   (x , s1 ) = p s
18

19   thenSt p q
20    = p $bindSt ( _ → q )
21

22   getSt :: stateT * **
23   getSt st = ( st , st )
24

25   setSt st _ = ( st , st )
26   updSt f = getSt          $bindSt ( s →
27             unitSt ( f s ) $bindSt ( s1 →
28             setSt s1                 ))
29

30   traverse :: (** → stateT * ***) → [**] → stateT * [***]
31   traverse f []         st = ([] , st )
32   traverse f ( x : xs ) st = ( x1 : xs2 , st2 )
33                            where
34                              ( x1 , st1 ) = f x st
35                              ( xs2 , st2 ) = traverse f xs st1


                                                monadSts.ama 


1    /*
2     * State - transition - with - choice monad
3     *
                   APPENDIX A. IMPLEMENTATION                                 40

4     * implementation inspired by Philip Wadler (1992) , MfFP
5     *
6     * 11 -2005  Nikolaas N . Oosterhof
7     */
8

9

10   stateSts * ** == * → [(** , *) ]
11

12   unitSts :: ** → stateSts * **
13   unitSts x st = [( x , st ) ]
14

15   zeroSts x = []
16

17   bindSts :: stateSts * ** → (** → stateSts * ***) → stateSts * ***
18   bindSts p q st0
19    = [ (y , st2 ) | (x , st1 ) <- p st0 ; (y , st2 ) <- q x st1 ]
20

21   thenSts :: stateSts * ** → stateSts * *** → stateSts * ***
22   thenSts p q = bindSts p ( _ → q )
23

24   getStateSts st = unitSts st st
25

26   updStateSts f st0 = setStateSts ( f st0 ) st0
27

28   setStateSts st _ = unitSts st st
29

30

31   orSts :: stateSts * ** → stateSts * ** → stateSts * **
32   orSts p q st0 = p st0 ++ q st0
33

34   biasedOrSts p q st0 = q st0 , if pst0 = []
35                       = pst0 , otherwise
36                       where pst0 = p st0
37

38   orsSts       = foldr orSts       zeroSts
39   biasedOrsSts = foldr biasedOrSts zeroSts
40

41   orUnitSts p altval = biasedOrSts p ( unitSts altval )
42

43

44   checkSts p check = p $bindSts ( x → if ( check x ) ( unitSts x ) ( zeroSts ) )
45

46   guardSts check p = checkSts p check
47

48   || parse smallest list " p p ... p q "
49   untilSts p q = ( q )
50                 $biasedOrSts
51                 ( p              $bindSts ( x →
52                    untilSts p q $bindSts ( xs →
53                    unitSts ( x : xs )       ))
                     APPENDIX A. IMPLEMENTATION                              41

54                    )
55

56

57    || parse smalles list " p p ... p q " , return pair (p ’s , q )
58    upToSts p q = ( q $bindSts ( y → unitSts ([] , y ) ) )
59                  $biasedOrSts
60                  ( p                 $bindSts ( x         →
61                     upToSts p q       $bindSts (( xs , y ) →
62                     unitSts ( x : xs , y )        ))
63                  )
64

65    || parse " p q p ... p q p "
66    encloseSts p q = p               $bindSts ( x →
67                       ( q                    $bindSts ( y →
68                         encloseSts p q $bindSts ( xs →
69                         unitSts ( x : y : xs )        ))
70                       ) $orUnitSts [ x ]         )
71

72    || parse " p q p ... p q p " , but leave out the q ’ s in the result
73

74    separateSts p q = p               $bindSts ( x →
75                      ( q                  $thenSts (
76                        separateSts p q $bindSts ( xs →
77                        unitSts ( x : xs )        ))
78                      ) $orUnitSts [ x ]      )
79

80

81    || parse p0 p1 ... pN
82

83    seqSts []         = unitSts []
84    seqSts ( p : ps ) = p             $bindSts ( x →
85                       ( seqSts ps ) $bindSts ( xs →
86                       unitSts ( x : xs )      ))
87

88    doSts p f = p $bindSts ( x → ( unitSts ( f x ) ) )
89

90    foldrSts f zero p = ( p                    $bindSts ( x →
91                          foldrSts f zero p $bindSts ( xs →
92                          unitSts ( f x xs ) )            ))
93                       $biasedOrSts ( unitSts zero )
94

95

96    zeroOrMoreSts p = oneOrMoreSts p
97                     $biasedOrSts ( unitSts [])
98

99    || parse longest list p ^+
100

101   oneOrMoreSts p = p                    $bindSts ( x →
102                        ( oneOrMoreSts p $bindSts ( xs →
103                          unitSts ( x : xs )          )
                     APPENDIX A. IMPLEMENTATION                                  42

104                        ) $biasedOrSts
105                        ( unitSts [ x ]
106                        )                       )
107

108

109

110

111   ifSts = if
112

113   || altStarSts parsers stopparser
114   altStarSts ps q
115    = ( q $thenSts ( unitSts [])
116      ) $biasedOrSts
117      ( biasedOrsSts ps $bindSts ( x →
118        altStarSts ps q $bindSts ( xs →
119        unitSts ( x : xs )       ))
120      )
121

122   valsSts = map fst


                                              monadId.ama 


 1    /*
 2     * The trivial identify monad
 3     */
 4

 5    bindId x f = f x
 6    unitId x = x



                     A.4     Some utility functions
                                               util.ama 



 1    /*
 2     * Utility functions
 3     *
 4     * 11 -2005  Nikolaas N . Oosterhof
 5     */
 6

 7    string == [ char ]
 8

 9    lookUp []                key = error (" Lookup : not found key " ++ toString key )
10    lookUp (( x , y ) : ys ) key = y             , if x = key
11                                 = lookUp ys key , otherwise
12
                     APPENDIX A. IMPLEMENTATION                                  43

13   lookUpAll []                key = []
14   lookUpAll (( x , y ) : ys ) key = y : more , if x = key
15                                   = more     , otherwise
16                                   where
17                                     more = lookUpAll ys key
18

19

20   doMapping []                key f = []
21   doMapping (( x , y ) : ys ) key f = (x , f y ) : more , if x = key
22                                     = (x , y )   : more , otherwise
23                                 where
24                                   more = doMapping ys key f
25

26   update []                key z = [( key , z ) ]
27   update (( x , y ) : ys ) key z = (x , y ) : update ys key z , if x 6= key
28                                  = (x , z ) : ys    , otherwise
29

30

31

32   unitMapping x y = [( x , y ) ]
33

34   joinMapping xs ys = [ ( key , ( nodup . concat ) ( lookUpAll ( xs ++ ys ) key ) ) | key <-
         ( nodup . opPair (++) . mapPair domain ) ( xs , ys ) ]
35

36   joinMappings = foldr joinMapping []
37

38

39   filterDomain f xys = [ (x , y ) | (x , y ) <- xys ; f x ]
40

41   filterRange f xys = [ (x , y ) | (x , y ) <- xys ; f y ]
42

43   mapMapping f xs = [ (x , f y ) | (x , y ) <- xs ]
44

45   appendMapping xs key s = doMapping xs key (++ s )
46

47   domain = map fst
48   range = map snd
49

50   invert = map swapPair
51          where swapPair (x , y ) = (y , x )
52

53   concatmap f = concat . ( map f )
54

55

56

57   front [ a ] = []
58   front ( a : as ) = a : front as
59

60   last [ a ] = a
61   last ( _ : as ) = last as
                      APPENDIX A. IMPLEMENTATION                                     44

62

63

64    nand a b = ~( a ∧ b )
65    nor a b = ~( a \/ b )
66

67    id x = x
68

69

70    asSet = sort . nodup
71

72    cup x y = asSet ( x ++ y )
73    cap x y = xy -- ( ( xy -- x ) $cup ( xy -- y ) )
74            where
75              xy = x $cup y
76

77    nilPair = ([] , [])
78    mapPair f (a , b ) = ( f a , f b )
79    opPair f (a , b ) = a $f b
80    joinPair (a , b ) (c , d ) = ( a ++ c , b ++ d )
81    concatPair = foldr joinPair nilPair
82

83    mapFst f (a , b ) = ( f a , b )
84    mapSnd f (a , b ) = (a , f b )
85

86

87    foldrPair (f , g ) (a , b ) xys = ( foldr f a xs , foldr g b ys )
88                                    where ( xs , ys ) = unzip xys
89

90

91

92    || ’ cross - product ’ of list of lists , using lists instead of tuples
93    || combinations [[1 ,2] , [3 ,4 ,5] , [6]] === [[1 , 3 , 6] , [1 , 4 , 6] , [1 , 5 , 6] , [2 ,
         3 , 6] , [2 , 4 , 6] , [2 , 5 , 6]]
94    combinations [ a ]       = [ [ x ] | x <- a ]
95    combinations ( a : as ) = [ x : y | x <- a ; y <- combinations as ]
96    combinations []          = []
97

98    unitC [ x ]      = [[ c ] | c <- x ]
99    unitC ( x : xs ) = [ i : j | i <- x ; j <- unitC xs ]
100

101   bindC [ x ]      f = [ [ f i ] | i <- x ]
102   bindC ( x : xs ) f = [ f i : j | i <- x ; j <- bindC xs f ]
103

104   unzip :: [(* , **) ] → ([*] , [**])
105   unzip []                 = ([] , [])
106   unzip (( x , y ) : xys ) = ( x : xs , y : ys )
107                            where ( xs , ys ) = unzip xys
108

109

110   sqnc []       x = x
                       APPENDIX A. IMPLEMENTATION                                      45

111   sqnc ( f : fs ) x = sqnc fs ( f x )
112

113   generic size :: * → num
114   size ( n = num ) = 1
115   size ( c = char ) = 1
116   size ( b = bool ) = 1
117   size [] = 0
118   size ( x : xs ) = size x + size xs
119   size (x , y ) = size x + size y
120

121   generic   enclose :: [ char ] → [ char ] → [ char ] → * → [ char ]
122   enclose   left mid right []         = left ++ right
123   enclose   left mid right [ x ]      = left ++ toString x ++ right
124   enclose   left mid right ( x : xs ) = left ++ toString x ++ concatmap (( mid ++) . toString
         ) xs   ++ right
125

126

127   generic toString :: * →           [ char ]
128   toString ( n = num )          =   itoa n
129   toString ( b = bool )         =   if b " True " " False "
130   toString (( c = char ) : cs ) =   c : cs
131   toString ( c = char )         =   [ ’\ ’ ’ , c , ’\ ’ ’]
132   toString []                   =   "[]"
133   toString ( x : xs )           =   enclose "[" " , " "]" ( x : xs )
134   toString (x , y )             =   concat ["(" , toString x ," , " , toString y , ") "]
135   toString (x , y , z )         =   concat ["(" , toString x ," , " , toString y , " ," , toString
         z , ") "]
136

137   idxs xs = [ i | i , j <- nats 0 , xs ]
138

139   pam []         _ = []
140   pam ( f : fs ) x = f x : pam fs x
141

142   biasedJoin [] y = y
143   biasedJoin x _ = x
144

145

146   generic equals :: * → * → bool
147   equals ( x = bool ) y = x = y
148   equals ( x = num ) y = x = y
149   equals ( x = char ) y = x = y
150   equals [] []             = True
151   equals [] _              = False
152   equals _ []              = False
153   equals ( x : xs ) ( y : ys ) = equals x y ∧ equals xs ys
154

155   pipe []         _ = []
156   pipe ( f : fs ) s = out : pipe fs s2
157                     where ( out , s2 ) = f s
158
                       APPENDIX A. IMPLEMENTATION                           46

159   limit ( x : y : ys ) = x , if x = y
160                        = limit ( y : ys ) , otherwise
161

162   limit [ x ]     = x
163

164

165

166   forAll xs f = and ( map f xs )
167

168   limiterate f = limit . ( iterate f )
169

170   limiterates [] x = x
171   limiterates ( ffs =( f : fs ) )   x
172    = x                          ,   if lims = x
173    = limiterates ffs lims ,         otherwise
174    where
175      lims = limiterates fs          ( limiterate f x )
176

177   pairAsSet = mapPair ( sort . nodup . filter ((~) . empty ) )
178

179   fromList is xs = [ xs ! i | i <- is ]
180

181   case x f = f x
182

183   splitOn :: (* → bool ) → [*] → ([*] , [*])
184   splitOn f []         = nilPair
185   splitOn f ( x : xs ) = px $joinPair splitOn f xs
186                        where
187                          px = ([ x ] , [] ) , if f x
188                              = ([] , [ x ]) , otherwise
189

190   || partitions a list of elements
191   || based on an equivalence relation
192   partition :: (* → * → bool ) → [*] → [[*]]
193   partition f []
194    = []
195

196   partition f ( x : xs )
197    = ( x : alike ) : partition f different
198    where
199      ( alike , different ) = splitOn ( f x ) xs
200

201   map2 :: (* → ** → ***) → [*] → [**] → [***]
202   map2 f xs ys = [ f x y | (x , y ) <- zip2 xs ys ]
203

204

205   mergeSortWith f [] = []
206   mergeSortWith f [ x ] = [ x ]
207   mergeSortWith f xs = ( joinListsWith f . mapPair ( mergeSortWith f ) . splitList ) xs
208                        where mapPair f (x , y ) = ( f x , f y )
                      APPENDIX A. IMPLEMENTATION                                      47

209

210   splitList xs = split (# xs /2) xs
211

212

213   joinListsWith _ ( xs , [])                 = xs
214   joinListsWith _ ([] , ys )                 = ys
215   joinListsWith f (( x : xs ) , ( y : ys ) ) = x : joinListsWith f ( xs , y : ys ) , if f x y
216                                              = y : joinListsWith f ( x : xs , ys ) , otherwise
217

218   listElemDo f g []         = []
219   listElemDo f g ( x : xs ) = g x ++ listElemDo f g xs , if f x
220                             =    x : listElemDo f g xs , otherwise
221

222

223   transStep xs = nodup ( xs ++ [( x , z ) | (x , y1 ) <- xs ; ( y2 , z ) <- xs ; y1 = y2 ])
224

225   transClose = limiterate transStep
APPENDIX A. IMPLEMENTATION                                                             48

A.5        Creative Commons Attribution-ShareAlike
           License Version 2.0
                            Attribution-ShareAlike 2.0

    THE WORK (AS DEFINED BELOW) IS PROVIDED UNDER THE TERMS OF
    THIS CREATIVE COMMONS PUBLIC LICENSE (“CCPL” OR “LICENSE”). THE
    WORK IS PROTECTED BY COPYRIGHT AND/OR OTHER APPLICABLE LAW.
    ANY USE OF THE WORK OTHER THAN AS AUTHORIZED UNDER THIS LI-
    CENSE OR COPYRIGHT LAW IS PROHIBITED.

    BY EXERCISING ANY RIGHTS TO THE WORK PROVIDED HERE, YOU AC-
    CEPT AND AGREE TO BE BOUND BY THE TERMS OF THIS LICENSE. THE
    LICENSOR GRANTS YOU THE RIGHTS CONTAINED HERE IN CONSIDERA-
    TION OF YOUR ACCEPTANCE OF SUCH TERMS AND CONDITIONS.

License


   1. Definitions
          1. “Collective Work” means a work, such as a periodical issue, anthology or
             encyclopedia, in which the Work in its entirety in unmodified form, along
             with a number of other contributions, constituting separate and indepen-
             dent works in themselves, are assembled into a collective whole. A work
             that constitutes a Collective Work will not be considered a Derivative Work
             (as defined below) for the purposes of this License.
          2. “Derivative Work” means a work based upon the Work or upon the Work
             and other pre-existing works, such as a translation, musical arrangement,
             dramatization, fictionalization, motion picture version, sound recording,
             art reproduction, abridgment, condensation, or any other form in which
             the Work may be recast, transformed, or adapted, except that a work that
             constitutes a Collective Work will not be considered a Derivative Work for
             the purpose of this License. For the avoidance of doubt, where the Work is
             a musical composition or sound recording, the synchronization of the Work
             in timed-relation with a moving image (“synching”) will be considered a
             Derivative Work for the purpose of this License.
          3. “Licensor” means the individual or entity that offers the Work under the
             terms of this License.
          4. “Original Author” means the individual or entity who created the Work.
          5. “Work” means the copyrightable work of authorship offered under the
             terms of this License.
          6. “You” means an individual or entity exercising rights under this License
             who has not previously violated the terms of this License with respect to
             the Work, or who has received express permission from the Licensor to
             exercise rights under this License despite a previous violation.
          7. “License Elements” means the following high-level license attributes as
             selected by Licensor and indicated in the title of this License: Attribution,
             ShareAlike.
   2. Fair Use Rights. Nothing in this license is intended to reduce, limit, or restrict
      any rights arising from fair use, first sale or other limitations on the exclusive
      rights of the copyright owner under copyright law or other applicable laws.
APPENDIX A. IMPLEMENTATION                                                         49

 3. License Grant. Subject to the terms and conditions of this License, Licensor
    hereby grants You a worldwide, royalty-free, non-exclusive, perpetual (for the
    duration of the applicable copyright) license to exercise the rights in the Work
    as stated below:
      1. to reproduce the Work, to incorporate the Work into one or more Collective
         Works, and to reproduce the Work as incorporated in the Collective Works;
      2. to create and reproduce Derivative Works;
      3. to distribute copies or phonorecords of, display publicly, perform publicly,
         and perform publicly by means of a digital audio transmission the Work
         including as incorporated in Collective Works;
      4. to distribute copies or phonorecords of, display publicly, perform publicly,
         and perform publicly by means of a digital audio transmission Derivative
         Works.
      5. For the avoidance of doubt, where the work is a musical composition:
           1. Performance Royalties Under Blanket Licenses. Licensor waives the
              exclusive right to collect, whether individually or via a performance
              rights society (e.g. ASCAP, BMI, SESAC), royalties for the public
              performance or public digital performance (e.g. webcast) of the Work.
           2. Mechanical Rights and Statutory Royalties. Licensor waives the ex-
              clusive right to collect, whether individually or via a music rights
              society or designated agent (e.g. Harry Fox Agency), royalties for any
              phonorecord You create from the Work (“cover version”) and distrib-
              ute, subject to the compulsory license created by 17 USC Section 115
              of the US Copyright Act (or the equivalent in other jurisdictions).
      6. Webcasting Rights and Statutory Royalties. For the avoidance of doubt,
         where the Work is a sound recording, Licensor waives the exclusive right
         to collect, whether individually or via a performance-rights society (e.g.
         SoundExchange), royalties for the public digital performance (e.g. web-
         cast) of the Work, subject to the compulsory license created by 17 USC
         Section 114 of the US Copyright Act (or the equivalent in other jurisdic-
         tions).
    The above rights may be exercised in all media and formats whether now known
    or hereafter devised. The above rights include the right to make such modifi-
    cations as are technically necessary to exercise the rights in other media and
    formats. All rights not expressly granted by Licensor are hereby reserved.
 4. Restrictions. The license granted in Section 3 above is expressly made subject
    to and limited by the following restrictions:
      1. You may distribute, publicly display, publicly perform, or publicly digitally
         perform the Work only under the terms of this License, and You must in-
         clude a copy of, or the Uniform Resource Identifier for, this License with
         every copy or phonorecord of the Work You distribute, publicly display,
         publicly perform, or publicly digitally perform. You may not offer or im-
         pose any terms on the Work that alter or restrict the terms of this License
         or the recipients’ exercise of the rights granted hereunder. You may not
         sublicense the Work. You must keep intact all notices that refer to this
         License and to the disclaimer of warranties. You may not distribute, pub-
         licly display, publicly perform, or publicly digitally perform the Work with
         any technological measures that control access or use of the Work in a
         manner inconsistent with the terms of this License Agreement. The above
         applies to the Work as incorporated in a Collective Work, but this does not
APPENDIX A. IMPLEMENTATION                                                        50

        require the Collective Work apart from the Work itself to be made subject
        to the terms of this License. If You create a Collective Work, upon notice
        from any Licensor You must, to the extent practicable, remove from the
        Collective Work any reference to such Licensor or the Original Author, as
        requested. If You create a Derivative Work, upon notice from any Licensor
        You must, to the extent practicable, remove from the Derivative Work any
        reference to such Licensor or the Original Author, as requested.
     2. You may distribute, publicly display, publicly perform, or publicly digi-
        tally perform a Derivative Work only under the terms of this License, a
        later version of this License with the same License Elements as this Li-
        cense, or a Creative Commons iCommons license that contains the same
        License Elements as this License (e.g. Attribution-ShareAlike 2.0 Japan).
        You must include a copy of, or the Uniform Resource Identifier for, this
        License or other license specified in the previous sentence with every copy
        or phonorecord of each Derivative Work You distribute, publicly display,
        publicly perform, or publicly digitally perform. You may not offer or im-
        pose any terms on the Derivative Works that alter or restrict the terms
        of this License or the recipients’ exercise of the rights granted hereunder,
        and You must keep intact all notices that refer to this License and to the
        disclaimer of warranties. You may not distribute, publicly display, pub-
        licly perform, or publicly digitally perform the Derivative Work with any
        technological measures that control access or use of the Work in a manner
        inconsistent with the terms of this License Agreement. The above applies
        to the Derivative Work as incorporated in a Collective Work, but this does
        not require the Collective Work apart from the Derivative Work itself to
        be made subject to the terms of this License.
     3. If you distribute, publicly display, publicly perform, or publicly digitally
        perform the Work or any Derivative Works or Collective Works, You must
        keep intact all copyright notices for the Work and give the Original Author
        credit reasonable to the medium or means You are utilizing by conveying
        the name (or pseudonym if applicable) of the Original Author if supplied;
        the title of the Work if supplied; to the extent reasonably practicable, the
        Uniform Resource Identifier, if any, that Licensor specifies to be associated
        with the Work, unless such URI does not refer to the copyright notice or
        licensing information for the Work; and in the case of a Derivative Work, a
        credit identifying the use of the Work in the Derivative Work (e.g., “French
        translation of the Work by Original Author,” or “Screenplay based on
        original Work by Original Author”). Such credit may be implemented in
        any reasonable manner; provided, however, that in the case of a Derivative
        Work or Collective Work, at a minimum such credit will appear where any
        other comparable authorship credit appears and in a manner at least as
        prominent as such other comparable authorship credit.
 5. Representations, Warranties and Disclaimer
    UNLESS OTHERWISE AGREED TO BY THE PARTIES IN WRITING, LI-
    CENSOR OFFERS THE WORK AS-IS AND MAKES NO REPRESENTA-
    TIONS OR WARRANTIES OF ANY KIND CONCERNING THE MATERI-
    ALS, EXPRESS, IMPLIED, STATUTORY OR OTHERWISE, INCLUDING,
    WITHOUT LIMITATION, WARRANTIES OF TITLE, MERCHANTIBILITY,
    FITNESS FOR A PARTICULAR PURPOSE, NONINFRINGEMENT, OR THE
    ABSENCE OF LATENT OR OTHER DEFECTS, ACCURACY, OR THE
    PRESENCE OF ABSENCE OF ERRORS, WHETHER OR NOT DISCOV-
    ERABLE. SOME JURISDICTIONS DO NOT ALLOW THE EXCLUSION
    OF IMPLIED WARRANTIES, SO SUCH EXCLUSION MAY NOT APPLY
APPENDIX A. IMPLEMENTATION                                                          51

   TO YOU.
 6. Limitation on Liability.
    EXCEPT TO THE EXTENT REQUIRED BY APPLICABLE LAW, IN NO
    EVENT WILL LICENSOR BE LIABLE TO YOU ON ANY LEGAL THE-
    ORY FOR ANY SPECIAL, INCIDENTAL, CONSEQUENTIAL, PUNITIVE
    OR EXEMPLARY DAMAGES ARISING OUT OF THIS LICENSE OR THE
    USE OF THE WORK, EVEN IF LICENSOR HAS BEEN ADVISED OF THE
    POSSIBILITY OF SUCH DAMAGES.
 7. Termination
      1. This License and the rights granted hereunder will terminate automatically
         upon any breach by You of the terms of this License. Individuals or entities
         who have received Derivative Works or Collective Works from You under
         this License, however, will not have their licenses terminated provided
         such individuals or entities remain in full compliance with those licenses.
         Sections 1, 2, 5, 6, 7, and 8 will survive any termination of this License.
      2. Subject to the above terms and conditions, the license granted here is per-
         petual (for the duration of the applicable copyright in the Work). Notwith-
         standing the above, Licensor reserves the right to release the Work under
         different license terms or to stop distributing the Work at any time; pro-
         vided, however that any such election will not serve to withdraw this Li-
         cense (or any other license that has been, or is required to be, granted
         under the terms of this License), and this License will continue in full force
         and effect unless terminated as stated above.
 8. Miscellaneous
      1. Each time You distribute or publicly digitally perform the Work or a Col-
         lective Work, the Licensor offers to the recipient a license to the Work on
         the same terms and conditions as the license granted to You under this
         License.
      2. Each time You distribute or publicly digitally perform a Derivative Work,
         Licensor offers to the recipient a license to the original Work on the same
         terms and conditions as the license granted to You under this License.
      3. If any provision of this License is invalid or unenforceable under applicable
         law, it shall not affect the validity or enforceability of the remainder of
         the terms of this License, and without further action by the parties to
         this agreement, such provision shall be reformed to the minimum extent
         necessary to make such provision valid and enforceable.
      4. No term or provision of this License shall be deemed waived and no breach
         consented to unless such waiver or consent shall be in writing and signed
         by the party to be charged with such waiver or consent.
      5. This License constitutes the entire agreement between the parties with re-
         spect to the Work licensed here. There are no understandings, agreements
         or representations with respect to the Work not specified here. Licensor
         shall not be bound by any additional provisions that may appear in any
         communication from You. This License may not be modified without the
         mutual written agreement of the Licensor and You.
APPENDIX A. IMPLEMENTATION                                                           52

Creative Commons is not a party to this License, and makes no warranty whatsoever
in connection with the Work. Creative Commons will not be liable to You or any party
on any legal theory for any damages whatsoever, including without limitation any gen-
eral, special, incidental or consequential damages arising in connection to this license.
Notwithstanding the foregoing two (2) sentences, if Creative Commons has expressly
identified itself as the Licensor hereunder, it shall have all rights and obligations of
Licensor.
Except for the limited purpose of indicating to the public that the Work is licensed
under the CCPL, neither party will use the trademark “Creative Commons” or any
related trademark or logo of Creative Commons without the prior written consent of
Creative Commons. Any permitted use will be in compliance with Creative Com-
mons’ then-current trademark usage guidelines, as may be published on its website or
otherwise made available upon request from time to time.


Creative Commons may be contacted at http://creativecommons.org/.