;;; Implementing Rational Numbers and Generic Arithmetic (Part III)
;;; Message Passing

;;; October 3, 2001
;;; Stewart M. Clamen

;;; USAGE NOTE: This file is formatted to be loadable into a running
;;; Scheme session.  As arguments are made incrementally, though, you
;;; might want to pass the definitions into the Scheme interpreter one
;;; at a time.

;; This lecture offers an alternative implementation strategy from our
;; previous tagged object implementation.  The tagged implementation
;; suffered from the following deficiency:  whenever we introduced a
;; new data type, the generic operators had to be reimplented to
;; accomodate it.  The following implementation does not have that
;; problem. 


;; Consider this radical implementation of our (now well-known)
;; rational and integer interfaces:

(define (make-rat n d)
  (let ((g (gcd n d)))
    (let ((numerator (/ n g))
	  (denominator (/ d g)))
      (lambda (msg)
	(cond ((equal? msg 'numer) numerator)
	      ((equal? msg 'denom) denominator)
	      ((equal? msg 'print)
	       (display numerator)
	       (display "/")
	       (display denominator)
	       (newline))
	      (else "ERROR: rat does not support such an operation"))))))

(define (numer rat)
  (rat 'numer))

(define (denom rat)
  (rat 'denom))

(define (print-rat rat)
  (rat 'print))


;; Instead of using a pair or a tagged object to represent rationals,
;; we've chosen this time to represent rationals as procedures!  These
;; procedures take a single argument, which can be viewed as a
;; "message", directing how the rational should respond.  Although
;; this representation make seem strange, the interface (MAKE-RAT,
;; NUMER, DENOM) is consistent, and can be used with the arithmetic
;; procedures (RAT+, RAT-, etc.) we've used all week.  You are
;; encouraged to experiment with them and see.

(define (rat+ rat1 rat2)
  (make-rat (+ (* (numer rat1) (denom rat2))
	       (* (numer rat2) (denom rat1)))
	    (* (denom rat1) (denom rat2))))

;; See what happens when you evaluate:
;; (print-rat (rat+ (make-rat 1 2) (make-rat 1 3)))


;; Here are Integers defined similarly:

(define (make-int primitive-int)
  (lambda (msg)
    (cond ((equal? msg 'value) primitive-int)
	  ((equal? msg 'print) 
	   (display primitive-int)
	   (newline))
	  
	  (else "ERROR: integer does not support such an operation"))))

(define (integer-value int)
  (int 'value))

(define (print-int int)
  (int 'print))


;; Look at the implementations of the two type-specific print procedures
;; above (PRINT-RAT, PRINT-INT).  They are very similar, so similar,
;; in fact, that the generic print procedure is simply:

(define (print-obj obj)
  (obj 'print))


;; Suppose we now (re)introduce strings into our little world.

(define (make-string primitive-string)
  (lambda (msg)
    (cond ((equal? msg 'value) primitive-string)
	  ((equal? msg 'print) 
	   (display primitive-string)
	   (newline))
	  
	  (else "ERROR: integer does not support such an operation"))))

(define (string-value str)
  (str 'value))

(define (print-string str)
  (str 'print))


;; If we evaluate (PRINT-OBJ (MAKE-STRING "Hi!")) at this point,
;; it works.  Even though PRINT-OBJ was written before strings were
;; brought into the picture, it can operate on them.  That is because
;; in this implementation of our objects, the generic PRINT-OBJ
;; doesn't need to determine the type of the object, it just relies on
;; the ability of the abstract object to accept the message 'PRINT.

;; We seem to have achieved our goal of being able to introduce new
;; data types and have them work with the generic operators without
;; redefinition.  Before we get too smug, however, let us consider 
;; the task of implementing generic addition.

;; Unlike printing, addition requires two objects of like type (two
;; "instances") to operate.  Our objects, however, are procedures that
;; take only one argument, the message denoting which operation to
;; perform.  How can we pass in the second addend?

;; The solution to our problem lies in higher-order procedures, again.
;; Our objects, instead of directly returning the answer, will return
;; a procedure which can accept the second addend.

;; It will be easier to first see how this will be used, and then to
;; see the implementation.  Here is the definition of the generic
;; addition procedure:

(define (obj+ obj1 obj2)
  ((obj1 'add) obj2))

;; Notice that it sends the 'ADD message to the first object, and then
;; passes the second object to resulting procedure, which will do the
;; actual addition. 

;; OK, enough pussy-footing.  How do we implement this?

(define (make-rat n d)
  (let ((g (gcd n d)))
    (let ((numerator (/ n g))
	  (denominator (/ d g)))
      (lambda (msg)
	(cond ((equal? msg 'numer) numerator)
	      ((equal? msg 'denom) denominator)
	      ((equal? msg 'print)
	       (display numerator)
	       (display "/")
	       (display denominator)
	       (newline))

	      ((equal? msg 'add)
	       (lambda (rat2)
		 (make-rat (+ (* numerator (denom rat2))
			      (* (numer rat2) denominator))
			   (* denominator (denom rat2)))))

	      (else "ERROR: rat does not support such an operation"))))))


(define (make-int primitive-int)
  (lambda (msg)
    (cond ((equal? msg 'value) primitive-int)
	  ((equal? msg 'print) 
	   (display primitive-int)
	   (newline))

	  ((equal? msg 'add)
	   (lambda (int2)
	     (make-int (+ primitive-int (integer-value int2)))))

	  (else "ERROR: integer does not support such an operation"))))

(define (make-string primitive-string)
  (lambda (msg)
    (cond ((equal? msg 'value) primitive-string)
	  ((equal? msg 'print) 
	   (display primitive-string)
	   (newline))
	  
	  ((equal? msg 'add)
	   (lambda (str2)
	     (make-string (string-append primitive-string
					 (string-value str2)))))

	  (else "ERROR: integer does not support such an operation"))))


;; Introduce these definitions into your scheme interpreter and
;; evaluate the following epxressions to test:
;; (print-obj (obj+ (make-rat 1 2) (make-rat 1 3)))
;; (print-obj (obj+ (make-int 1) (make-int 4)))
;; (print-obj (obj+ (make-string "a") (make-string "BN")))



;; You might have noticed a similarity between this "Message Passing"
;; implementation for data types and the object-oriented style for
;; defining data types in C++.  In fact, they are essentially the same
;; thing ("message-passing" is old terminology).  One of the first
;; object-oriented languages, Smalltalk, incorporates Message Passing
;; into the language, making it a part of every procedure (i.e.,
;; method) call.  We'll be studying Smalltalk later this semester.


;; One more thing before we are done.  It is somewhat unsatifying that
;; we had to reimplement our type-specific addition procedures inside
;; our classes just so we could make generic addition work.  While
;; this is not any different from how we would have to do it in C++,
;; there is an alternative implementation for MAKE-RAT, et. al. that
;; would let us just call RAT+, INT+, STRING+ instead.

;; What we need is something like C++'s "this", the special variable
;; that let's one view the current object from the outside of its
;; interface.   

;; Where is the "this" in our implementation.  It's the procedure that
;; we return.  Let's store it in a temporary variable so we can refer
;; to it by name.


(define (make-rat n d)
  (let ((g (gcd n d)))
    (let ((numerator (/ n g))
	  (denominator (/ d g)))
      (let ((this (lambda (msg)
		    (cond ((equal? msg 'numer) numerator)
			  ((equal? msg 'denom) denominator)
			  ((equal? msg 'print)
			   (display numerator)
			   (display "/")
			   (display denominator)
			   (newline))
			  
			  ((equal? msg 'add)
			   (lambda (another-rat)
			     (rat+ this another-rat)))
			  
			  (else "error: rat doesnot support such an operation")))))
	this))))

;; If we try to use this definition however, we will see that it
;; produces an error.

;;  (print-obj (obj+ (make-rat 1 2) (make-rat 1 2)))

;; Error: undefined variable
;;       this
;;       (package user)


;; What is going on?  The error states that "this" is undefined.

;; The problem is tied to the semantics of LET.  LET introduces a new
;; variable binding.  In this case the variable "this" is bound to the
;; procedure (the "lambda").  Our bug is using "this" inside the
;; procedure and assuming that it would refer to the same "this".
;; However, LET evaluates the values it is binding outside the LET.
;; (Refer to the lecture notes on higher-order procedures for an
;; explanation.)  

;; Fortunately, Scheme provides a "magic" variant of LET, LETREC, that
;; solves our problem.  It is just like LET, except that it supports
;; the recursive definition we need to introduce.


(define (make-rat n d)
  (let ((g (gcd n d)))
    (let ((numerator (/ n g))
	  (denominator (/ d g)))
      (letrec ((this (lambda (msg)
		       (cond ((equal? msg 'numer) numerator)
			     ((equal? msg 'denom) denominator)
			     ((equal? msg 'print)
			      (display numerator)
			      (display "/")
			      (display denominator)
			      (newline))
			     
			     ((equal? msg 'add)
			      (lambda (another-rat)
				(rat+ this another-rat)))
			     
			     (else "error: rat doesnot support such an operation")))))
	this))))


;; (print-obj (obj+ (make-rat 1 2) (make-rat 1 2)))
;; ==> 1/1