CS217 Day 22 Wednesday, May 17, 2000

Defined OOL, School -- Scheme OOL

• A Simple OOL -- new productions for our defined language - in 6.3

• The simplest implementation, interp6-3ool.scm

• Some OOL examples -- ool-examples.scm

• Tracing a simple OOL program

• School -- Scheme Object-Oriented Language
  • A School class is the value of a class constructor defined with define-class and ask macros.

    (define-syntax define-class
      (syntax-rules (super this cinit init)
        ((_ (class-name cvarlist ivarlist superval)
    	((cvar1 cval1) ...)
    	((cvar2 cval2) ...)
    	(cinit cinitval)
    	((ivar1 ival1) ...)
    	((ivar2 ival2) ...)
    	(init initval))
         (define class-name
           (lambda cvarlist
    	 (let* ((cvar1 cval1) ...)
    	   (letrec ((cvar2 cval2) ...)
    	     (let ((cinit cinitval)
    		   (super superval))
    	       (cinit)
    	       (lambda ivarlist
    		 (let* ((ivar1 ival1) ...
    			(init initval))
    		   (init)
    		   (letrec ((ivar2 ival2) ...
    			    (me
    			     (lambda (msg . args)
    			       (case msg
    				 ((cvar2) (apply cvar2 args)) ...
    				 ((ivar2) (apply ivar2 args)) ...
    				 (else
    				  (apply super (cons msg args)))))))
    		     (set! this me)
    		     me)))))))))))
    
    (define-syntax ask
      (syntax-rules ()
        ((_ obj msg arg ...)
         (obj 'msg arg ...))))
    

    where

    cvarlist -- variables for arguments of class constructor
    ivarlist -- variables for arguements of object constructor
    superval -- an instance of the super class
    
    cvar1 -- class field
    cvar2 -- class method
    cinit -- procedure evaluated when class is defined
    
    ivar1 -- instance field
    ivar2 -- instance method
    init -- procedure evalued when an object is created
    

  • Example School class constructors

    A class for defining "cons" cells

    (define-class (kons-class (kount) (kar kdr) (baseclass))
      ((count kount))
      ((get-count (lambda () count)))
      (cinit (lambda () (writeln "count = " count)))
      ((my-car kar)
       (my-cdr kdr))
      ((get-my-car (lambda ()
    		 (set! count (+ count 1))
    		 my-car))
       (get-my-cdr (lambda ()
    		 (set! count (+ count 1))
    		 my-cdr))
       (get-this (lambda () this))
       (show (lambda ()
    	   (display "(")
    	   (if (or (number? my-car)
    		   (null? my-car))
    	       (display my-car)
    	       (my-car 'show))
    	   (display " . ")
    	   (if (or (number? my-cdr)
    		   (null? my-cdr))
    	       (display my-cdr)
    	       (my-cdr 'show))
    	   (display ")")))
       )
      (init (lambda ()
    	  (writeln
    	    (list "count =  " count)
    	    (list "my-car = " my-car)
    	    (list "my-cdr = " my-cdr)))))
    

    Sample code for kons-class.

    (define kons (kons-class 10))
    (define k1 (kons 2 3))
    (define k2 (kons 4 5))
    (k1 'get-my-car)
    (k1 'get-my-cdr)
    (k2 'get-my-car)
    (k1 'get-this)
    ((k1 'get-this) 'get-count)
    (ask k1 show)
    (ask k2 show)
    

    Two simple classes

    (define-class (c-class () () (baseclass))
      ()
      ()
      (cinit (lambda () (writeln "c-class defined")))
      ((x 1))
      ((getx (lambda () x)))
      (init (lambda () (writeln "c object defined"))))
    
    (define-class (d-class () () ((c-class)))
      ()
      ()
      (cinit (lambda () (writeln "d-class defined")))
      ((y 2))
      ((gety (lambda () y)))
      (init (lambda () (writeln "d object defined"))))
    

    Sample code for c-class, d-class

    
    (define c (c-class))
    (define d (d-class))
    
    (define o1 (c))
    (define o2 (d))
    
    (ask o1 getx)
    (ask o2 gety)
    (ask o2 getx)
    

    Part of example in 6.2, p203.

    (define-class (c1-class () () (baseclass))
      ()
      ()
      (cinit (lambda () (writeln "class c1 defined")))
      ((x 0)
       (y 0))
      ((setx1 (lambda (v) (set! x v)))
       (sety1 (lambda (v) (set! y v)))
       (getx1 (lambda () x))
       (gety1 (lambda () y)))
      (init (lambda ()
    	  (writeln "init c1"))))
    

  • Code and examples school.scm
  xxx