;;; OBJECT: ;;; ;;; General form: ;;; ;;; (object [init-var-1 ... init-var-k] ;;; [[var-1 init-1] ... [var-n init-n]] ;;; [ ] ;;; [ ] ;;; ... ;;; [ ]) (define OBJECT (letrec [[define-message (lambda [name] '(define ,name (lambda args (((first args) ,^name) . (rest args)))))]] (mlambda [call] (letseq [[state-vars (arg 1 call)] [inited-vars (arg 2 call)] [pairs (tail 2 (pargs call))] [fun-names (map (lambda [pair] (acons)) pairs)]] '(begin ,(map (lambda [pair] (define-message (first pair))) pairs) (lambda ,state-vars (let ,inited-vars (letrec ,(map (lambda [pair fun-name] '[,fun-name ,(second pair)]) pairs fun-names) (lambda [message] (cond . ,(map (lambda [pair fun-name] '[(= message ,^(first pair)) ,fun-name]) pairs fun-names)))))))))))