(define-macro (make-method methods method-sources args)
  `(let ((new-method
    (eval-string
      (string-append "(lambda " (cadr ,args) " " (caddr ,args) ")"))))
    (set! ,method-sources
      (assq-set! ,method-sources (car ,args) (cdr ,args)))
    (set! methods
      (assq-set! ,methods (car ,args) new-method))))

(define make-object (lambda (properties method-sources)
  (define methods '())
  (define dispatcher (lambda (selector . args)
    (cond
      ((eq? selector 'properties) properties)
      ((eq? selector 'methods) methods)
      ((eq? selector 'method-sources) method-sources)
      ((eq? selector 'property-set)
        (set! properties
          (assq-set! properties (car args) (cadr args))))
      ((eq? selector 'method-set) (make-method methods method-sources args))
      ((assq selector methods) =>
        (lambda (handler-ass)
          (apply (cdr handler-ass) (cons dispatcher args))))
      (else (error "Unknown method" selector)))))
    (for-each (lambda (meth)
      (make-method methods method-sources meth))
      method-sources)
    dispatcher))

(define obj (make-object '() '() ))

(obj 'property-set 'x 1)
(obj 'properties)
(obj 'method-set 'meth "(self)" "(list 1 2)")
(obj 'meth)

(define string-write
  (lambda (obj) (call-with-output-string
    (lambda (port) (write obj port)))))

(define stringify-object (lambda (object)
  (define pre-post-string-write (lambda (pre obj post)
    (string-append pre (string-write obj) post)))
  (apply string-append `(,"(make-object \n '(\n"
    ,@(map
        (lambda (i) (pre-post-string-write "    " i "\n"))
        (object 'properties))
    ,"  )\n '(\n"
    ,@(map
        (lambda (i) (pre-post-string-write "    " i "\n"))
        (object 'method-sources))
    ,"))\n") )))

(display (stringify-object obj))

(define obj2 (make-object '((x . 1)) '((meth "(self)" "(list 1 2)")) ))

(obj2 'properties)
(obj2 'meth)

(define save-object (lambda (object filename)
  (let ((fout (open-file filename "w")))
    (display (stringify-object object) fout)
    (close-port fout))))

(define load-object (lambda (filename)
  (let ((fin (open-file filename "r")))
    (define ret (read fin))
    (close-port fin)
    (primitive-eval ret))))