MASSACHVSETTS INSTITVTE OF TECHNOLOGY
      Department of Electrical Engineering and Computer Science

                          6.891 Spring 2006
                            Problem Set 3

  Issued: Wed. 22 Feb. 2006                    Due: Wed. 1 Mar. 2006


Reading: SICP Section 4.4, especially 4.4.4.3 and 4.4.4.4

Code: matcher.scm, attached

		  Pattern Matching and Instantiation

One of the most important techniques in advanced symbolic programming
is the use of patterns.  We can match patterns against data objects,
and we can instantiate a pattern to make a data object.  For example,
the elementary laws of algebra are usually expressed as patterns and
instantiations:

		   a * (b + c) <==> a * b  +  a * c

This is the distributive law of multiplication over addition.  It says
that we can replace one side with the other without changing the value
of the expression.  

Each side of the law is a pattern, with particular pattern variables
a, b, c, and pattern constants *, +.  More precisely, what the law
says is that if we find an algebraic expression which is the product
of something and a sum of terms, we can replace it with a sum of two
products, and vice versa.

In this problem set we will investigate how to organize programs based
on pattern-match.  A key idea will be compilation of patterns into
combinators that are the pieces of a matcher.  In the next problem set
we will study building this into a simple rule system.


			A Language of Patterns

The first job is to make up our language of patterns.  We will start
with something simple.  We will make our patterns out of Lisp (Scheme)
lists.  Unlike the mathematical example above, we will not have
reserved symbols, such as * and +, so we will have to distinguish
pattern variables from pattern constants.  Constants can be
represented by symbols and pattern variables can be represented by
lists beginning with the query symbol: "?".  This is a traditional
choice.  So in this language the patterns that make up the
distributive law may be represented as follows, assuming that we are
manipulating Lisp prefix mathematical expressions:

		      (* (? a) (+ (? b) (? c)))

		 (+ (* (? a) (? b)) (* (? a) (? c)))

You might complain that we could have used distinguished symbols, such
as "?a" instead of the long-winded (? a).  That would be fine, but
that choice will make it a bit harder to extend, say if we want a
variable that is restricted to match only numbers.  Of course, we can
add syntax later if it is helpful, but remember Alan Perlis's maxim:
"Syntactic sugar causes cancer of the semicolon."

One constraint on our design of the matcher is that the second pattern
above should match

                (+ (* (cos x) (exp y)) (* (cos x) (sin z)))

where a=(cos x), b=(exp y), and c=(sin z).  It should not match

                (+ (* (cos x) (exp y)) (* (cos (+ x y)) (sin z)))

because there is no consistent assignment possible for (? a) (unless,
somehow x=x+y.  We will learn about that sort of stuff later when
we study unification matching.  Here we will decide that there is no
match possible.)

Another constraint, which will have important influence on the
structure of the matcher, is the requirement for "segment variables."
Suppose we want to find instances of particular patterns in a sequence
of many terms.  For example, suppose we want to make a rule to find
combinations of squares of sines and cosines and replace them with 1:

   (+ ... (expt (sin theta) 2) ... (expt (cos theta) 2) ...)

     ==> (+ 1 ... ... ...)

The "..." here may stand for many terms.  We will need segment
variables, with the prefix "??" that can match many terms, so the
pattern we will write is:

 (+ (?? t1) (expt (sin (? x)) 2) (?? t2) (expt (cos (? x)) 2) (?? t3))

   ==> (+ 1 (?? t1) (?? t2) (?? t3))

Segment variables have a profound effect, because we don't know how
long a segment is until we find the next part that matches, and we may
be able to match the same data item many ways.  For example, there may
be both squares of sines and cosines of angles theta and phi in the
same sum.  Even simpler, the pattern

       (a (?? x) (?? y) (?? x) c)

can match the datum 

       (a b b b b b b c)

in four different ways.  (Notice that the segment variable x must eat
up the same number of "b"s in the two places it appears in the
pattern.)  So the matcher must do a search over the space of possible
assignments to the segment variables.

			Design of the Matcher

A matcher for a particular pattern is constructed from a family of
mix-and-match combinators that can be combined to make combinators of
the same type.  Each primitive element of the pattern is represented
by a primitive combinator and the only combination, list, is
represented by a combinator that combines combinators to make a
compound one.

The match combinators are procedures that take three arguments: data
to be matched, a dictionary of bindings of pattern variables, and a
procedure to be called if the match is successful.  The arguments to
the succeed procedure must be the new dictionary resulting from the
match and the number of data items eaten from the input data by this
matcher.  A match combinator returns #f if the match is unsuccessful.

In general, a match combinator that is expected to match a single
object, such as a symbol or a list, will eat the car of the data given
to it and report that it ate one thing.  However, a segment matcher
may eat more than one thing, and it must report the number it ate.
There are four basic match combinators.  Let's go through them one by
one.


The match procedure match:eqv takes a pattern constant and produces a
match combinator.  It succeeds if and only if the data is a pair whose
car is equal (using eqv?) to the pattern constant.  If successful, it
does not add to the dictionary and absorbs one item from the data.

(define (match:eqv pattern-constant)
  (define (eqv-match data dictionary succeed)
    (and (pair? data)
	 (eqv? (car data) pattern-constant)
	 (succeed dictionary 1)))
  eqv-match)


The match procedure match:element is used to make a match combinator
for an ordinary pattern variable, such as (? x).  Such a variable
wants to eat up exactly one item from the input data.  There are
two cases.  If the variable already has a value in the dictionary the
combinator succeeds only if the value is equal (using equal?) to the
car of the data.  If the variable has no value, the combinator
succeeds with the new dictionary resulting from binding the variable
to the car of the data in the given dictionary.

(define (match:element variable)
  (define (element-match data dictionary succeed)
    (and (pair? data)
	 (let ((vcell (match:lookup variable dictionary)))
	   (if vcell
	       (and (equal? (match:value vcell) (car data))
		    (succeed dictionary 1))
	       (succeed (match:bind variable (car data) dictionary)
                        1)))))
  element-match)

A segment variable procedure makes a more interesting combinator.

(define (match:segment variable)
  (define (segment-match data dictionary succeed)
    (and (list? data)
	 (let ((vcell (match:lookup variable dictionary)))
	   (if vcell
	       (let lp ((data data)
			(pattern (match:value vcell))
			(n 0))
		 (cond ((pair? pattern)
			(if (and (pair? data)
				 (equal? (car data) (car pattern)))
			    (lp (cdr data) (cdr pattern) (+ n 1))
			    #f))
		       ((not (null? pattern)) #f)
		       (else (succeed dictionary n))))
	       (let ((n (length data)))
		 (let lp ((i 0))
		   (if (<= i n)
		       (or (succeed (match:bind variable
						(list-head data i)
						dictionary)
				    i)
			   (lp (+ i 1)))
		       #f)))))))
  segment-match)

Here the input data must be a list, so we can compute its length.
Again, there are two possibilities, either the variable already has a
value or it does not yet have a value.  If it has a value, each item
of the value must be the same as a corresponding item from the data.
If this is true, the match succeeds, eating a number of items from the
input data equal to the number in the stored value.  If the segment
variable does not yet have a value it must be given one.  The
segment-variable match combinator starts by assuming that the segment
will eat no items from the data.  However, if that success ultimately
leads to a later failure in the match, the segment tries to eat one
more element than it had already tried.  (This is accomplished by
executing (lp (+ i 1)).)  If the segment variable runs out of data
items, it fails to match.

Finally, there is the list matcher:

(define (match:list . match-combinators)
  (define (list-match data dictionary succeed)
    (and (pair? data)
	 (let lp ((data (car data))
		  (matchers match-combinators)
		  (dictionary dictionary))
	   (cond ((pair? matchers)
		  ((car matchers) data dictionary
		      (lambda (new-dictionary n)
			(lp (list-tail data n)
			    (cdr matchers)
			    new-dictionary))))
		 ((pair? data) #f)
		 (else (succeed dictionary 1))))))
  list-match)

The list match procedure takes match combinators and makes a list
combinator that matches a list, which is the car of the given data, if
and only if the match combinators it is given eat up all of the
elements in the data list.  It applies the combinators in succession.
When a match combinator succeeds it tells the list combinator how many
items to jump over before passing the result to the next combinator.
Notice that the list combinator has exactly the same interface as the
other three, allowing it to be incorporated into a combination.




The dictionary we will use is just an alist of variable-value pairs:

(define (match:bind variable data-object dictionary)
  (cons (list variable data-object) dictionary))

(define (match:lookup variable dictionary)
  (assq variable dictionary))

(define (match:value vcell)
  (cadr vcell))




		       Using Match Combinators

For example, we can make a combinator that matches a list of any
number of elements, starting with the symbol a, ending with the symbol
b, and with a segment variable (?? x) between them by the combination:

  (match:list (match:eqv 'a) (match:segment 'x) (match:eqv 'b))

We can apply it to data.  The initial dictionary is the empty list. 

((match:list (match:eqv 'a) (match:segment 'x) (match:eqv 'b))
 '((a 1 2 b))
 '()
 list)
;Value: ((x (1 2)) 1)

This was a successful match.
The dictionary returned has exactly one entry: x=(1 2).  
The match ate exactly one element, the list (a 1 2 b) from the input.

((match:list (match:eqv 'a) (match:segment 'x) (match:eqv 'b))
 '((a 1 2 b 3))
 '()
 (lambda (d n) d))
;Value: #f

This was a failure, because there was nothing to match the 3 after the
b in the input data.

We can automate the construction of pattern matchers from patterns
with an elementary compiler:

     (define (match:->combinators pattern)
       (define (compile pattern)
	 (cond ((match:element? pattern)
		(match:element (match:variable-name pattern)))
	       ((match:segment? pattern)
		(match:segment (match:variable-name pattern)))
	       ((list? pattern)
		(apply match:list (map compile pattern)))
	       (else (match:eqv pattern))))
       (compile pattern))

     (define (match:element? pattern)
       (and (pair? pattern)
	    (eq? (car pattern) '?)))

     (define (match:segment? pattern)
       (and (pair? pattern)
	    (eq? (car pattern) '??)))

     (define (match:variable-name pattern)
       (cadr pattern))

By varying this compiler, we can change the syntax of patterns, if we
like. 

The compiler produces as its value a match combinator appropriate for
the pattern it is given: it has exactly the same interface as the
elementary combinators given.  Some simple examples are:

     ((match:->combinators '(a ((? b) 2 3) (? b) c))
      '((a (1 2 3) 2 c))
      '()
       (lambda (x y) `(succeed ,x ,y)))
     ;Value: #f

     ((match:->combinators '(a ((? b) 2 3) (? b) c))
      '((a (1 2 3) 1 c))
      '()
       (lambda (x y) `(succeed ,x ,y)))
     ;Value: (succeed ((b 1)) 1)

Some patterns involving segment variables may match in many ways.  We
can elicit all of the matches by failing back into the matcher to
select the next one, until they are all exhausted:

     ((match:->combinators '(a (?? x) (?? y) (?? x) c))
      '((a b b b b b b c))
      '()
      (lambda (dict y)
	(pp `(succeed ,dict ,y))
	#f))
     (succeed ((y (b b b b b b)) (x ())) 1)
     (succeed ((y (b b b b)) (x (b))) 1)
     (succeed ((y (b b)) (x (b b))) 1)
     (succeed ((y ()) (x (b b b))) 1)
     ;Value: #f

This interface is not very nice for using the matcher.  It is
convenient for building into other systems that need this flexibility.
However, for playing with the matcher it is convenient to use:

     (define (matcher pattern)
       (let ((match-combinator (match:->combinators pattern)))
	 (lambda (datum)
	   (match-combinator
	    (list datum)
	    '()
	    (lambda (dictionary number-of-items-eaten)
	      (and (= number-of-items-eaten 1)
		   dictionary))))))

With this interface we explicitly give the pattern to get the matcher
procedure.  We give the matcher procedure the datum the pattern is to
match, and we get either a dictionary or #f.

((matcher '(a ((? b) 2 3) (? b) c))
 '(a (1 2 3) 1 c))
;Value: ((b 1))

Quite often we want to restrict the kind of object that can be matched
by a pattern variable.  For example, we may want to make a pattern
where a variable can only match a positive integer.  For example, we
may be interested in finding positive integer powers of sine
functions.  We could write the pattern we want as follows:

    (expt (sin (? x)) (? n positive-integer?))

But there are a number of complications here, not the least of which
is that expt and sin are pattern constants, but positive-integer? must
be evaluated.  Let's worry about that later.  First we need a matcher
procedure that can be used to make a matcher combinator satisfying
this requirement.  One way to do this is to make match:element take an
extra argument, perhaps optional, which is the predicate for testing
the datum for acceptability.  Alternatively, we can make an entirely
new matcher procedure, say match:element-restricted, which takes two
arguments: the name of a variable and the restriction predicate. It
should return an appropriate match combinator.

-------------
Problem 3.1:

Choose one of these strategies and make a new matcher procedure or
modify an existing matcher procedure so as to implement pattern
variables with restrictions.

Demonstrate your modification.
-------------


There is this nasty problem of evaluation of the predicate expression
with the compilation of the new matcher syntax, alluded to earlier.


-------------
Problem 3.2:

How do you want to solve this problem?  One way is to use the
quasiquote mechanism built into Scheme (and every other Lisp).
Another way is to do an explicit evaluation in the compiler.  I (GJS)
like the first way.  Explain how this works, and demonstrate it on a
real problem.
-------------


-------------
Problem 3.3:

In an example above we got multiple matches, by returning #f from a
success procedure.  (The pattern was (a (?? x) (?? y) (?? x) c).)
This was probably pretty mysterious.  How does it work?  Explain, in a
short but concise paragraph, how the sequence of matches is generated.
-------------

Now, it would be fun to be able to define a palindrome-testing matcher
in terms of patterns.  Perhaps we could write

     (define (even-palindrome? x)
       ((match:->combinators '((?? x) ($$ x)))
	(list x) '() (lambda (x y) (= y 1))))
     ;Value: even-palindrome?

     (even-palindrome? '(a b c c b a))
     ;Value: #t

     (even-palindrome? '(a b c c a b))
     ;Value: #f

where ($$ x) is a pattern element that matches only the reversed
segment matched by the segment variable (?? x).

-------------
Problem 3.4:

Build a new matcher procedure that produces the reversed segment
combinator needed for this to work.  Also, augment the compiler to
allow "$$" variables.  Test your code on the palindrome problem
described above.

Of course, even-palindrome? will not be able to find odd palindromes,
such as (a b c d c b a).  Write an odd-palindrome matcher and put
these together to produce a predicate that is true only when there is
a palindrome, either even or odd.
-------------

;;;; Matcher based on match combinators, CPH/GJS style.
;;;     Idea is in Hewitt's PhD thesis (1969).

(declare (usual-integrations))

;;; There are match procedures that can be applied to data items.  A
;;; match procedure either accepts or rejects the data it is applied
;;; to.  Match procedures can be combined to apply to compound data
;;; items.

;;; A match procedure takes a list containing a data item, a
;;; dictionary, and a success continuation.  The dictionary
;;; accumulates the assignments of match variables to values found in
;;; the data.  The success continuation takes two arguments: the new
;;; dictionary, and the number of items absorbed from the list by the
;;; match.  If a match procedure fails it returns #f.

;;; Primitive match procedures:

(define (match:eqv pattern-constant)
  (define (eqv-match data dictionary succeed)
    (and (pair? data)
	 (eqv? (car data) pattern-constant)
	 (succeed dictionary 1)))
  eqv-match)

(define (match:element variable)
  (define (element-match data dictionary succeed)
    (and (pair? data)
	 (let ((vcell (match:lookup variable dictionary)))
	   (if vcell
	       (and (equal? (match:value vcell) (car data))
		    (succeed dictionary 1))
	       (succeed (match:bind variable (car data) dictionary)
			1)))))
  element-match)


;;; Support for the dictionary.

(define (match:bind variable data-object dictionary)
  (cons (list variable data-object) dictionary))

(define (match:lookup variable dictionary)
  (assq variable dictionary))

(define (match:value vcell)
  (cadr vcell))

(define (match:segment variable)
  (define (segment-match data dictionary succeed)
    (and (list? data)
	 (let ((vcell (match:lookup variable dictionary)))
	   (if vcell
	       (let lp ((data data)
			(pattern (match:value vcell))
			(n 0))
		 (cond ((pair? pattern)
			(if (and (pair? data)
				 (equal? (car data) (car pattern)))
			    (lp (cdr data) (cdr pattern) (+ n 1))
			    #f))
		       ((not (null? pattern)) #f)
		       (else (succeed dictionary n))))
	       (let ((n (length data)))
		 (let lp ((i 0))
		   (if (<= i n)
		       (or (succeed (match:bind variable
						(list-head data i)
						dictionary)
				    i)
			   (lp (+ i 1)))
		       #f)))))))
  segment-match)

(define (match:list . match-combinators)
  (define (list-match data dictionary succeed)
    (and (pair? data)
	 (let lp ((data (car data))
		  (matchers match-combinators)
		  (dictionary dictionary))
	   (cond ((pair? matchers)
		  ((car matchers) data dictionary
		      (lambda (new-dictionary n)
			(if (> n (length data))
			    (error "Matcher ate too much." n))
			(lp (list-tail data n)
			    (cdr matchers)
			    new-dictionary))))
		 ((pair? data) #f)
		 (else (succeed dictionary 1))))))
  list-match)

;;; Syntax of matching is determined here.

(define (match:->combinators pattern)
  (define (compile pattern)
    (cond ((match:element? pattern)
	   (match:element (match:variable-name pattern)))
	  ((match:segment? pattern)
	   (match:segment (match:variable-name pattern)))
	  ((list? pattern)
	   (apply match:list (map compile pattern)))
	  (else (match:eqv pattern))))
  (compile pattern))



(define (match:element? pattern)
  (and (pair? pattern)
       (eq? (car pattern) '?)))

(define (match:segment? pattern)
  (and (pair? pattern)
       (eq? (car pattern) '??)))

(define (match:variable-name pattern)
  (cadr pattern))



(define (matcher pattern)
  (let ((match-combinator (match:->combinators pattern)))
    (lambda (datum)
      (match-combinator
       (list datum)
       '()
       (lambda (dictionary number-of-items-eaten)
	 (and (= number-of-items-eaten 1)
	      dictionary))))))

#|
((match:->combinators '(a ((? b) 2 3) 1 c))
 '((a (1 2 3) 1 c))
 '()
  (lambda (x y) `(succeed ,x ,y)))
;Value: (succeed ((b 1)) 1)

((match:->combinators '(a ((? b) 2 3) (? b) c))
 '((a (1 2 3) 2 c))
 '()
  (lambda (x y) `(succeed ,x ,y)))
;Value: #f

((match:->combinators '(a ((? b) 2 3) (? b) c))
 '((a (1 2 3) 1 c))
 '()
  (lambda (x y) `(succeed ,x ,y)))
;Value: (succeed ((b 1)) 1)


((match:->combinators '(a (?? x) (?? y) (?? x) c))
 '((a b b b b b b c))
 '()
 (lambda (x y)
   (pp `(succeed ,x ,y))
   #f))
(succeed ((y (b b b b b b)) (x ())) 1)
(succeed ((y (b b b b)) (x (b))) 1)
(succeed ((y (b b)) (x (b b))) 1)
(succeed ((y ()) (x (b b b))) 1)
;Value: #f

((matcher '(a ((? b) 2 3) (? b) c))
 '(a (1 2 3) 1 c))
;Value: ((b 1))
|#