Riddle. Emulate Smalltalk-72 with Scheme Macro. Works with Gauche.

Smalltalk-72.scm

;;;; Smalltalk-72.scm      ;;;;
;;;; Minori Yamashita 2012 ;;;;

(define Z (lambda (f) ((lambda (p)
 (f (lambda (a) ((p p) a))))
 (lambda (p)
   (f (lambda (a) ((p p) a)))))))

;;Unhygenic anaphoric macro
(define-macro (to class args body)
  `(define ,class (lambda ,args 
      (Z (lambda (SELF) (lambda (⇒) ,body))))))
;;hygenic macro
(define-syntax ᗉ
  (syntax-rules ()
    ((_ x y a b) (if (equal? x y) a b))))
(define-syntax ☞ (syntax-rules (← ⠄ ፡)
  ((_ x ← y) (define x y))
  ((_ x ← ፡ ⠄ body) (lambda (x) body))))
(define-syntax ⇑
  (syntax-rules ()
    ((_ x) x)))



;;;Example 1: point
(to point (x y)
  (ᗉ 'x   ⇒ (⇑ x)
  (ᗉ 'y   ⇒ (⇑ y)
  (ᗉ '+   ⇒ (☞ a ← ፡ ⠄ (⇑ (point (+ x (a 'x)) (+ y (a 'y)))))
  (ᗉ '-   ⇒ (☞ a ← ፡ ⠄ (⇑ (point (- x (a 'x)) (+ y (a 'y)))))
  (ᗉ '=   ⇒ (☞ a ← ፡ ⠄ (⇑ (and (= x (a 'x)) (= x (a 'y)))))
  '()))))))

(☞ pt1 ← (point 5 6))
(☞ pt2 ← (point 7 8))
(☞ pt3 ← ((pt1 '+) pt2))
(pt3 'x)
(pt3 'y)


;;Example 2: Sammy the Python
(to animal (name) 
  (ᗉ 'name ⇒ (⇑ name) 
  (ᗉ 'talk ⇒ (⇑ (string-append (SELF 'name) ": 'Hello'"))
  '())))

(☞ sam ← (animal "Sammy the Python"))
(sam 'talk)


;;Appendix A: Unicode Symbols
;ះঃः፡ៈ⟟⦑⦓⦅⦂⦪⦞⦨♙⨟ᗉ⇑


;;Appendix B: ASCII version
;(define-macro (to class args body)
;  `(define ,class (lambda ,args 
;      (Z (lambda (SELF) (lambda (=>) ,body))))))
;(define-syntax <o
;  (syntax-rules ()
;    ((_ x y a b) (if (equal? x y) a b))))
;(define-syntax o- (syntax-rules (<- -- %)
;  ((_ x <- y) (define x y))
;  ((_ x <- % -- body) (lambda (x) body))))
;(define-syntax ^
;  (syntax-rules ()
;    ((_ x) x)))


;;Appendix C: ことえり
;; ← いん
;; ᗉ め
;; ⇒ いふ
;; ፡ ていく
;; ⠄ どっと
;; ⇑ りたーん
;; ☞ くおーと


;;Appendix D: token-eating
;(to point (x y)
;  (ᗉ 'x ⇒ (☞ ⇒ ← ፡ ⠄ (ᗉ '<- ⇒ (☞ v ← ፡ ⠄ (set! x v)) x)) 
;  (ᗉ 'y ⇒ (☞ ⇒ ← ፡ ⠄ (ᗉ '<- ⇒ (☞ v ← ፡ ⠄ (set! y v)) y))
;  '())))