sd

buffer.rkt

@@ -2,10 +2,8 @@
 (require racket/generic
          racket/match
          racket/contract/base
-         (prefix-in A: ansi))
+         (prefix-in A: ansi)
-
+         "struct-define.rkt")
-;; XXX these programs really need remix syntax or something like
-;; define-generics-object
 
 (define-generics buffer
   (buffer-resize! buffer rows cols)
@@ -148,10 +146,8 @@
 (struct output-buffer (op [cells #:mutable])
   #:methods gen:buffer
   [(define (buffer-resize! buf new-rows new-cols)
-     (set-output-buffer-cells!
+     (struct-define output-buffer buf)
-      buf
+     (set! cells (maybe-make-cells cells new-rows new-cols)))
-      (maybe-make-cells (output-buffer-cells buf)
-                        new-rows new-cols)))
    (define (buffer-start! buf draw-rows draw-cols)
      (buffer-resize! buf draw-rows draw-cols)
      (define cs (output-buffer-cells buf))

struct-define.rkt

@@ -0,0 +1,43 @@
+#lang racket/base
+(require (for-syntax racket/base
+                     racket/struct-info
+                     syntax/parse))
+
+(define-syntax (struct-define stx)
+  (syntax-parse stx
+    [(_ the-struct the-instance:expr)
+     #:declare the-struct
+     (static struct-info? "structure type transformer binding")
+     #:do [(define struct+-len
+             (add1 (string-length (symbol->string (syntax->datum #'the-struct)))))
+           (define si (extract-struct-info (attribute the-struct.value)))]
+     #:with ([field-name field-ref field-set!] ...)
+     (for/list ([field-ref (in-list (list-ref si 3))]
+                [field-set (in-list (list-ref si 4))])
+       (define field-ref-s
+         (symbol->string (syntax->datum field-ref)))
+       (define field-name-s
+         (substring field-ref-s struct+-len))
+       (define field-name
+         (datum->syntax stx (string->symbol field-name-s)))
+       (list field-name field-ref field-set))
+     #:with (field-val-id ...)
+     (generate-temporaries #'(field-name ...))
+     
+     (syntax/loc stx
+       (begin (define the-instance-id the-instance)
+              (define-syntax field-name
+                (make-set!-transformer
+                 (lambda (stx)
+                   (syntax-case stx (set!)
+                     [(set! id v)
+                      (if (syntax->datum #'field-set!)
+                        (quasisyntax/loc stx
+                          (field-set! the-instance-id v))
+                        (raise-syntax-error 'set! "field not mutable" stx #'id))]
+                     [id (identifier? #'id)
+                         (syntax/loc stx
+                           (field-ref the-instance-id))]))))
+              ...))]))
+
+(provide struct-define)