;;; Implementing Rational Numbers and Generic Arithmetic (Part II)
;;; Tagging

;;; October 1, 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 is a different implementation of rationals and generic
;; arithmetic from what we did the other day.  However, once we
;; implement the abstract interface, the arithmetic routines from the
;; other day (ie., rat+, rat-, etc.) will run on top of it.


;; Before we introduce rationals and other data types, we need to
;; implement a lower-level data type, which a so-called TAGGED-OBJECT.
;; A tagged-object prepends a "tag", an arbitrary token, "in front" of
;; the value.  The tagging will make it easier for us to identify the
;; abstract type of the value we store. 

(define (tag-object tag value)
  (cons tag value))

(define (object-tag tagged-object)
  (car tagged-object))

(define (object-value tagged-object)
  (cdr tagged-object))

(define (tagged-object? tagged-object)
  (pair? tagged-object))


;; Now, let us implement rationals on top of the TAGGED-OBJECT
;; interface.

(define rational-tag 'RATIONAL)

(define (make-rat n d)
  (let ((value (let ((g (gcd n d)))
		 (cons (/ n g)
		       (/ d g)))))
    (tag-object rational-tag value)))

(define (tagged-rational? obj)
  (equal? (object-tag obj) rational-tag))

(define (numer rat)
  (if (tagged-rational? rat)
      (car (object-value rat))
      "ERROR: Not a rational"))

(define (denom rat)
  (if (tagged-rational? rat)
      (cdr (object-value rat))
      "ERROR: Not a rational"))

;; Let's define a few type-specific operations on rationals: 
;; printing and addition

(define (print-rat rat)
  (display (numer rat))
  (display "/")
  (display (denom rat))
  (newline))

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

;; 
;; This is a good time to make an interesting point about abstract
;; interface and implementation.  Our rationals are implemented in
;; terms of the tagged-object interface.  Our arithmetic operators
;; from the other day (see: "generic-arithmetic1.scm") were
;; implemented in terms of our rational interface.  From the
;; point-of-view of PRINT-RAT, RAT+, RAT-, etc., rationals are
;; abstract.  From the point-of-view of MAKE-RAT, NUMER, and DENOM,
;; tagged objects are abstract.  Tagged objects, in turn, are
;; implemented in terms of the pairs interface (CONS/CAR/CDR).  Each
;; abstraction level is oblivious to the implementation details of the
;; interface it is a client of.

;; OK, let us define a second tagged object type: INTEGERS

(define integer-tag 'INTEGER)

(define (make-int simple-integer)
  (tag-object integer-tag simple-integer))

(define (tagged-integer? obj)
  (equal? (object-tag obj) integer-tag))

(define (integer-value int)
  (object-value int))

(define (print-int int)
  (if (tagged-integer? int)
      (begin
	(display (integer-value int))
	(newline))
      "Not an integer"))

(define (int+ int1 int2)
  (make-int
   (+ (integer-value int1) (integer-value int2))))


;; Now that we have two data types, defined let's define generic print
;; and add, in terms of the type interfaces and the type-specific
;; procedures:

(define (print-object obj)
  (if (tagged-object? obj)
      (cond ((rat? obj) (print-rat obj))
	    ((tagged-integer? obj) (print-int obj))
	    (else "unrecognized type tag"))
      "object is not tagged"))

(define (add-object obj1 obj2)
  ;; Check to see if objects are of same tag (type)
  (if (and (tagged-object? obj1)
	   (tagged-object? obj2)
	   (equal? (object-tag obj1) (object-tag obj2))
	   )
      ;; call appropriate addition procedure
      (cond ((tagged-rational? obj1) (rat+ obj1 obj2))
	    ((tagged-integer? obj1) (int+ obj1 obj2))
	    (else "unrecognized type tag"))
      "Objects are not tagged, or not of same type"))


;; Now consider what happens when we introduce a third data type:

;; Tagged strings
(define string-tag 'STRING)

(define (make-string simple-string)
  (tag-object string-tag simple-string))

(define (tagged-string? obj)
  (equal? (object-tag obj) string-tag))

(define (string-value str)
  (if (tagged-string? str)
      (object-value str)
      "Not a string"))

(define (print-string str)
  (if (tagged-string? str)
      (begin
	(display (string-value str))
	(newline))
      "Not a string"))

;; Let's define addition on strings as being concatenation
(define (string+ str1 str2)
  (make-string
   (string-append (string-value str1) (string-value str2))))


;; The generic print and addition procedures are now incomplete, as
;; they don't support our new data type, strings.  We need to redefine
;; them with strings in mind:

(define (print-object obj)
  (if (tagged-object? obj)
      (cond ((rat? obj) (print-rat obj))
	    ((tagged-integer? obj) (print-int obj))
	    ((tagged-string? obj) (print-string obj))
	    (else "unrecognized type tag"))
      "object is not tagged"))

(define (add-object obj1 obj2)
  ;; Check to see if objects are of same tag (type)
  (if (and (tagged-object? obj1)
	   (tagged-object? obj2)
	   (equal? (object-tag obj1) (object-tag obj2))
	   )
      ;; call appropriate addition procedure
      (cond ((tagged-rational? obj1) (rat+ obj1 obj2))
	    ((tagged-integer? obj1) (int+ obj1 obj2))
	    ((tagged-string? obj1) (string+ obj1 obj2))
	    (else "unrecognized type tag"))
      "Objects are not tagged, or not of same type"))



;; Higher-order procedures

(define (double-object obj)
  (if (tagged-object? obj)
      (cond ((tagged-rational? obj) (double-rat obj obj))
	    ((tagged-integer? obj) (double-int obj obj))
	    ((tagged-string? obj) (double-string obj obj))
	    (else "unrecognized type tag"))
      "object is not tagged"))

(define (make-generic-unary-operation rat-op int-op string-op)
  (lambda (obj)
    (if (tagged-object? obj)    
      (cond ((tagged-rational? obj) (rat-op obj))
	    ((tagged-integer? obj) (int-op obj))
	    ((tagged-string? obj) (string-op obj))
	    (else "unrecognized type tag"))
      "object is not tagged")))


(define print-object
  (make-generic-unary-operation print-rat print-int print-string)) 


(define (make-generic-binary-operation rat-op int-op string-op)
  (lambda (obj1 obj2)
  (if (and (tagged-object? obj1)
	   (tagged-object? obj2)
	   (equal? (object-tag obj1) (object-tag obj2))
	   )
      (cond ((tagged-rational? obj1) (rat-op obj1 obj2))
	    ((tagged-integer? obj1) (int-op obj1 obj2))
	    ((tagged-string? obj1) (string-op obj1 obj2))
	    (else "unrecognized type tag"))
      "object is not tagged")))

(define add-object
  (make-generic-binary-operation rat+ int+ string+))

(define subtract-object
  (make-generic-binary-operation rat- int- string-))