(require 'stdlib)

(defmacro defclass (#!rest args)
  ;; TODO write expansion from defclass to 'make-person' below
  (let ((name (car args))
        (decl (cdr args)))
    (printf "defclass: %s\n" name)
    (dolist (d decl)
      (printf "decl: %s\n" (car d)))))

;; ----------------------------------------------------------------------
;; the result of defclass should look like this

(defmacro set-attr (name value)
  `(rplacd (assoc ',name attributes) ,value))
(defmacro get-attr (name)
  `(cdr (assoc ',name attributes)))
(defmacro add-attr (name value)
  `(nconc attributes '((,name . ,value))))

;; a-* attribute; TODO put attrs in an alist (better: use environments)
;; p-* parameter
;; m-* method
(define (make-person p-name p-age p-sex)
  (let ((a-name p-name)
        (a-age p-age)
        (a-sex p-sex)
        job spouse)

    ;; attribute accessor
    (define (m-name #!optional new-name)
      (cond ((null new-name) a-name)
            (t (setq a-name new-name))))

    ;; generic method
    (define (income date)
      (map assert list-of-pre-conditions)
      (* 100 (year-of date))
      (map assert list-of-post-conditions)
      (map assert list-of-invariants))

    ;; dispatcher
    (lambda args
      (apply
       (case (car args)
         ((name) m-name)
         (t (error "person: invalid method")))
       (cdr args)))))

(let ((p (make-person "Jack" 28 'male)))
  (puts (p 'name))
  (p 'name "Jill")
  (puts (p 'name)))

;; ----------------------------------------------------------------------
;; experiment with defclass

(defclass person
  (attributes name age sex job wife husband)
  ;;(attributes name (read age) (read/write sex) job spouse)
  ;;(attributes name (read-only age) (writable sex) job spouse)
  (invariant (for-all (p1 p2)
                      (implies (/= p1 p2)
                               (/= (p1 'name) (p2 'name)))))
  (invariant (and (implies (not-empty wife)
                           (> (wife 'age) 18))
                  (implies (not-empty husband)
                           (> (husband 'age) 18))))
  (defmethod (income date)
    (pre-condition t)
    (post-condition 500))
  (defmethod (marry-to person)
    (pre-condition (and (implies (= sex 'male)
                                 (= (person 'sex) 'female))
                        (implies (= sex 'female)
                                 (= (person 'sex) 'male))))
    (pre-condition (and (empty wife)
                        (empty husband)))
    (case sex
      ((male) (setq wife person))
      ((female) (setq husband person)))
    (post-condition (or (not-empty wife)
                        (not-empty husband)))))

;;(let ((jack (make-person "Jack" 28 'male))
;;      (jill (make-person "Jill" 16 'female)))
;;  (jack 'marry-to jill))