Scheme Object System

sos.scm

(define (Maybe . m)
  `(((nothing? . ,(lambda () (null? m)))
     (value . ,(lambda () (if (null? m)
                            (error "Nothing has no value")
                            (car m))))
    (show . ,(lambda () (if (null? m) 
                          'Nothing 
                          `(Just ,(car m))))))))

(define (Just x) (Maybe x))
(define (Nothing) (Maybe))

(define j3 (Just 3))

;(    (
; ) () )
;
;Scheme Object System

(define (search-hash key hash)

  (cond
    ((null? hash) '())
    ((eq? key (caar hash)) (list (cdar hash)))
    (else (search-hash key (cdr hash)))))

(define (search-table key table)
  (if (null? table) 
    '()
    (let ((val (search-hash key (car table))))
      (if (not (null? val))
        val
        (search-table key (cdr table))))))

(define (body-of property obj)
  (let ((result (search-table property obj)))
    (if (null? result)
      (error "Object doesn't have property")
      (car result))))

(define (call-property obj property args)
  (apply (body-of property obj) args))

(define-syntax &
  (syntax-rules (-)
    [(_ obj - property args ...)
     (call-property obj (quote property) (args ...))]))

;(define-syntax resolve-lambda
;  (syntax-rules ()
;    [(_ ((name args ...) body ...))
;     ((quote name) . (lambda (args ...) body ...))]))

;(define-syntax define-class-help
;  (syntax-rules ()
;    [(_ call (compiled-method ...) ())
;     (define call
;       (list (list compiled-method ...)))]
;    [(_ call (compiled-method ...) (method remain ...))
;     (define-class-method
;       (compiled-method ... (resolve-lambda method))
;       (remain ...))]))

;(define-syntax define-class
;  (syntax-rules ()
;    [(_ call method ...)
;     (define-class-help call () (method ...))]))

;(define-class (Maybe . m)
;  [(nothing?)
;   (null? m)]
;  [(value)
;   (if (null? m)
;     (error "Nothing has no value")
;     (car m))]
;  [(show)
;   (if (null? m)
;     'Nothing
;     `(Just ,(car m)))])