(use srfi-1 coops)

(define (print-crt)
  (and-let* [(crt (current-read-table))
	     (t1 (##sys#slot crt 1))]
    (for-each
     (lambda (i)
       (if (##sys#slot t1 i)
	   (print "'"(integer->char i) "' " (##sys#slot t1 i))))
     (iota 256))))

(define (dot-macro . forms)
   (assert (eq? 2 (length forms)) forms)
   (let [(first (string->symbol
		 (substring (symbol->string (first forms))
			    1)))]
     `(slot-value ,(second forms) ',first)))

 (define (prepend-input-port char port)
   (letrec [(first? #t)
	    (read* (lambda ()
		     (if first?
			 (begin
			   (set! first? #f)
			   char)
			 (read-char port))))
	    (ready?* (lambda ()
		       (if first?
			   #t
			   (ready? port))))
	    (close* (lambda () (close port)))]
     (make-input-port read* ready?* close*)))

 (define (conv exp)
   (cond
    ((and (pair? exp))
     (if (symbol? (first exp))
	 (let [(first-char (string-ref (symbol->string (first exp)) 0))]
	   (if (eq? #\. first-char)
	       (apply dot-macro exp)
	       (map conv exp)))
	 (map conv exp)))
    (else exp)))

 (letrec [(this (lambda (port)
		  ;;(print-crt)
		  (set-read-syntax! #\( #f)
		  (let* [(exp (read (prepend-input-port #\( port)))
			 (res (conv exp))]
		    (set-read-syntax! #\( this)
		    res)))]
   (set-read-syntax! #\( this))

(define-class <foo> ()
  ((bar 1)
   (x 2)))

(print (.bar (make <foo>)) " " (.x (make <foo>)))

;; output: 1 2