diff --git a/tests/ffi/ffi-tests.scm b/tests/ffi/ffi-tests.scm
index 96ad908a..69522465 100644
--- a/tests/ffi/ffi-tests.scm
+++ b/tests/ffi/ffi-tests.scm
@@ -405,6 +405,65 @@ struct point3d {
  (test '(12 11 10)
      (match (make-point3d 10 11 12)
        ((@ point3d (z a) (y b) (x c)) (list a b c))))
+ (test '(13 14 15 42)
+     (let ((pt (make-point3d 13 14 15)))
+       (match pt
+         ((@ point3d (y b) (z (and (set! set-z!) orig-z)) (x c))
+          (set-z! 42)
+          (list c b orig-z (point3d-z pt))))))
  )
 
+(test-ffi
+ "virtual accessors"
+ (begin
+   (c-declare "
+struct VirtComplex {
+  double r, phi;
+};
+double complex_real(struct VirtComplex* c) {
+  return c->r * cos(c->phi);
+}
+double complex_imag(struct VirtComplex* c) {
+  return c->r * sin(c->phi);
+}
+void complex_set(struct VirtComplex* c, double x, double y) {
+  c->r = sqrt(x*x + y*y);
+  c->phi = atan2(y, x);
+}
+void complex_real_set(struct VirtComplex* c, double x) {
+  complex_set(c, x, complex_imag(c));
+}
+void complex_imag_set(struct VirtComplex* c, double y) {
+  complex_set(c, complex_real(c), y);
+}
+")
+   (define-c-struct VirtComplex
+     predicate: virt-complex?
+     constructor: (make-virt-complex real imag)
+     (double real
+             (virt-complex-real function: "complex_real")
+             (virt-complex-real-set! function: "complex_real_set"))
+     (double imag
+             (virt-complex-imag function: "complex_imag")
+             (virt-complex-imag-set! function: "complex_imag_set"))
+     ))
+ (test-assert (virt-complex? (make-virt-complex 1.0 2.0)))
+ (test 1.0 (virt-complex-real (make-virt-complex 1.0 2.0)))
+ (test 2.0 (virt-complex-imag (make-virt-complex 1.0 2.0)))
+ (let ((c (make-virt-complex 1.0 2.0)))
+   (test 1.0 (virt-complex-real c))
+   (virt-complex-real-set! c 3.0)
+   (test 3.0 (virt-complex-real c))
+   (test 2.0 (virt-complex-imag c)))
+ (test '(5 6 7)
+     (let ((c (make-virt-complex 5.0 6.0)))
+       (match c
+         ((@ VirtComplex (real r) (imag (and (set! set-imag!) orig-i)))
+          (set-imag! 7.0)
+          (map inexact->exact
+               (map round (list r orig-i (virt-complex-imag c))))))))
+ )
+
+;; TODO: virtual method accessors
+
 (test-end)
diff --git a/tools/chibi-ffi b/tools/chibi-ffi
index a68e484e..64203351 100755
--- a/tools/chibi-ffi
+++ b/tools/chibi-ffi
@@ -1587,67 +1587,107 @@
                     "  sexp_env_define(ctx, env, name, tmp);\n")))))))))
 
 (define (type-getter-name type name field)
-  (string-append "sexp_" (x->string (type-name (parse-type name)))
-                 "_get_" (x->string (type-base (parse-type (cadr field))))))
+  (let ((c-name (if (pair? (cadr field)) (cadr (cadr field)) (cadr field))))
+    (string-append "sexp_" (x->string (type-name (parse-type name)))
+                   "_get_" (x->string c-name)))
+  ;; (string-append "sexp_" (x->string (type-name (parse-type name)))
+  ;;                "_get_" (x->string (type-base (parse-type (cadr field)))))
+  )
+
+(define (verify-accessor field)
+  (if (and (pair? field)
+           (not (and (= 3 (length field))
+                     (memq (cadr field) '(function: method:)))))
+      (error "accessor should be a single symbol or (scheme-name function:|method: c-name) but got" field)))
 
 (define (write-type-getter type name field)
-  (cat "static sexp " (type-getter-name type name field)
-       " (sexp ctx, sexp self, sexp_sint_t n, sexp x) {\n"
-       (lambda () (write-validator "x" (parse-type name 0)))
-       "  return "
-       (lambda ()
-         (c->scheme-converter
-          (car field)
-          (string-append (if (type-struct? (car field)) "&" "")
-                         "((" (x->string (or (type-struct-type name) ""))
-                         " " (mangle name) "*)"
-                         "sexp_cpointer_value(x))" "->"
-                         (x->string (cadr field)))
-          (and (or (type-struct? (car field)) (type-link? (car field))) "x")))
-       ";\n"
-       "}\n\n"))
+  (let* ((get (car (cddr field)))
+         (_ (verify-accessor get))
+         (c-name (if (pair? (cadr field)) (cadr (cadr field)) (cadr field)))
+         (ptr (string-append
+               "((" (x->string (or (type-struct-type name) ""))
+               " " (mangle name) "*)"
+               "sexp_cpointer_value(x))")))
+    (cat "static sexp " (type-getter-name type name field)
+         " (sexp ctx, sexp self, sexp_sint_t n, sexp x) {\n"
+         (lambda () (write-validator "x" (parse-type name 0)))
+         "  return "
+         (lambda ()
+           (c->scheme-converter
+            (car field)
+            (cond
+             ((and (pair? get) (eq? 'function: (cadr get)))
+              (string-append (car (cddr get)) "(" ptr ")"))
+             ((and (pair? get) (eq? 'method: (cadr get)))
+              (string-append ptr "->" (car (cddr get)) "()"))
+             ((pair? get)
+              (error "invalid getter" get))
+             (else
+              (string-append
+               (if (type-struct? (car field)) "&" "")
+               ptr "->" (x->string c-name))))
+            (and (or (type-struct? (car field)) (type-link? (car field)))
+                 "x")))
+         ";\n"
+         "}\n\n")))
 
 (define (type-setter-name type name field)
-  (string-append "sexp_" (x->string (type-name (parse-type name)))
-                 "_set_" (x->string (type-base (parse-type (cadr field))))))
+  (let ((c-name (if (pair? (cadr field)) (cadr (cadr field)) (cadr field))))
+    (string-append "sexp_" (x->string (type-name (parse-type name)))
+                   "_set_" (x->string c-name))))
 
 (define (write-type-setter-assignment type name field dst val)
-  (cond
-   ((type-struct? (car field))
-    ;; assign to a nested struct - copy field-by-field
-    (let ((field-type
-           (cond ((lookup-type (type-name (car field)))
-                  => (lambda (x) (cddr (cdr x))))
-                 (else (cdr field)))))
+  (let* ((set (cadr (cddr field)))
+         (_ (verify-accessor set))
+         (c-name (if (pair? (cadr field)) (cadr (cadr field)) (cadr field)))
+         (ptr (string-append
+               "((" (x->string (or (type-struct-type name) ""))
+               " " (mangle name) "*)"
+               "sexp_cpointer_value(" (x->string dst) "))")))
+    (cond
+     ((and (pair? set) (eq? 'function: (cadr set)))
       (lambda ()
-        (for-each
-         (lambda (subfield)
-           (let ((subname (x->string (cadr subfield))))
-             (cat
-              "  "
-              (string-append dst "." (x->string (cadr subfield)))
-              " = "
-              (string-append
-               "((" (x->string (or (type-struct-type (type-name (car field))) ""))
-               " " (mangle (type-name (car field))) "*)" "sexp_cpointer_value(" val "))"
-               "->" (x->string (cadr subfield)))
-              ";\n")))
-         (struct-fields field-type)))))
-   (else
-    (lambda ()
-      (cat "  " dst " = " (lambda () (scheme->c-converter (car field) val)) ";\n")))))
+        (cat (car (cddr set)) "(" ptr ", "
+             (lambda () (scheme->c-converter (car field) val)) ");\n")))
+     ((and (pair? set) (eq? 'method: (cadr set)))
+      (lambda ()
+        (cat ptr "->" (car (cddr set)) "("
+             (lambda () (scheme->c-converter (car field) val)) ");\n")))
+     ((pair? set)
+      (error "invalid setter" set))
+     ((type-struct? (car field))
+      ;; assign to a nested struct - copy field-by-field
+      (let ((field-type
+             (cond ((lookup-type (type-name (car field)))
+                    => (lambda (x) (cddr (cdr x))))
+                   (else (cdr field)))))
+        (lambda ()
+          (for-each
+           (lambda (subfield)
+             (let ((subname (x->string (cadr subfield))))
+               (cat
+                "  "
+                (string-append dst "." (x->string (cadr subfield)))
+                " = "
+                (string-append
+                 "((" (x->string (or (type-struct-type (type-name (car field)))
+                                     ""))
+                 " " (mangle (type-name (car field))) "*)"
+                 "sexp_cpointer_value(" val "))"
+                 "->" (x->string (cadr subfield)))
+                ";\n")))
+           (struct-fields field-type)))))
+     (else
+      (lambda ()
+        (cat "  " ptr "->" c-name " = "
+             (lambda () (scheme->c-converter (car field) val)) ";\n"))))))
 
 (define (write-type-setter type name field)
   (cat "static sexp " (type-setter-name type name field)
        " (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp v) {\n"
        (lambda () (write-validator "x" (parse-type name 0)))
        (lambda () (write-validator "v" (parse-type (car field) 1)))
-       (write-type-setter-assignment
-        type name field
-        (string-append "((" (x->string (or (type-struct-type name) ""))
-                       " " (mangle name) "*)" "sexp_cpointer_value(x))"
-                        "->" (x->string (cadr field)))
-        "v")
+       (write-type-setter-assignment type name field "x" "v")
        "  return SEXP_VOID;\n"
        "}\n\n"))
 
@@ -1718,15 +1758,18 @@
                       (let* ((a (car ls))
                              (field
                               (find (lambda (f) (and (pair? f) (eq? a (cadr f))))
-                                    (cddr x))))
-                        (if field
-                            (cat "  r->" (cadr field) " = "
-                                 (lambda ()
-                                   (scheme->c-converter
-                                    (car field)
-                                    (string-append "arg"
-                                                   (number->string i))))
-                                 ";\n"))
+                                    (cddr x)))
+                             (arg (string-append "arg" (number->string i))))
+                        (cond
+                         ((and field (>= (length field) 4))
+                          (cat
+                           (write-type-setter-assignment
+                            type name field "res" arg)))
+                         (field
+                          (cat "  r->" (cadr field) " = "
+                               (lambda ()
+                                 (scheme->c-converter (car field) arg))
+                               ";\n")))
                         (lp (cdr ls) (+ i 1)))))))
                 "  sexp_gc_release1(ctx);\n"
                 "  return res;\n"
@@ -1752,35 +1795,41 @@
              (get+set (cddr field)))
         (cond
          ((and (pair? get+set) (car get+set))
-          (write-type-getter type name field)
-          (set! *funcs*
-                (cons (parse-func
-                       `(,(car field)
-                         (,(car get+set)
-                          #f
-                          ,(type-getter-name type name field))
-                         (,name)))
-                      *funcs*))
-          (if (type-struct-type name)
-              (set! *type-getters*
-                    (cons `(,(car get+set) ,name ,i) *type-getters*))))
+          (let ((get-name (if (pair? (car get+set))
+                              (caar get+set)
+                              (car get+set))))
+            (write-type-getter type name field)
+            (set! *funcs*
+                  (cons (parse-func
+                         `(,(car field)
+                           (,get-name
+                            #f
+                            ,(type-getter-name type name field))
+                           (,name)))
+                        *funcs*))
+            (if (type-struct-type name)
+                (set! *type-getters*
+                      (cons `(,get-name ,name ,i) *type-getters*)))))
          (else "SEXP_FALSE"))
         (cond
          ((and (pair? get+set)
                (pair? (cdr get+set))
                (cadr get+set))
-          (write-type-setter type name field)
-          (set! *funcs*
-                (cons (parse-func
-                       `(,(car field)
-                         (,(cadr get+set)
-                          #f
-                          ,(type-setter-name type name field))
-                         (,name ,(car field))))
-                      *funcs*))
-          (if (type-struct-type name)
-              (set! *type-setters*
-                    (cons `(,(cadr get+set) ,name ,i) *type-setters*))))))
+          (let ((set-name (if (pair? (cadr get+set))
+                              (car (cadr get+set))
+                              (cadr get+set))))
+            (write-type-setter type name field)
+            (set! *funcs*
+                  (cons (parse-func
+                         `(,(car field)
+                           (,set-name
+                            #f
+                            ,(type-setter-name type name field))
+                           (,name ,(car field))))
+                        *funcs*))
+            (if (type-struct-type name)
+                (set! *type-setters*
+                      (cons `(,set-name ,name ,i) *type-setters*)))))))
       (lp (cdr ls) (+ i 1))))))
 
 (define (write-type-funcs orig-type)