diff --git a/d-/oop.scm b/d-/oop.scm new file mode 100644 index 0000000..fe5d2d4 --- /dev/null +++ b/d-/oop.scm @@ -0,0 +1,28 @@ +(define-module (d- oop) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) + #:export (define-record)) + + +;; Super quick record definition +(define-syntax define-record + (lambda (ctx) + (define (syntax-append id . syns) + (datum->syntax id (apply symbol-append (map syntax->datum syns)))) + (syntax-case ctx () + [(_ name field ...) + (with-syntax ([rec-name (syntax-append #'name #'< #'name #'>)] + [ctor (syntax-append #'name #'make- #'name)] + [pred (syntax-append #'name #'name #'?)] + [(proc ...) (map (lambda (f) (syntax-append f #'name #'- f)) + #'(field ...))] + [(getter ...) (map (lambda (f) (syntax-append f #'name #'- f #'-ref)) + #'(field ...))] + [(setter ...) (map (lambda (f) (syntax-append f #'name #'- f #'-set!)) + #'(field ...))]) + #'(begin + (define-record-type rec-name + (ctor field ...) + pred + (field getter setter) ...) + (define proc (make-procedure-with-setter getter setter)) ...))])))