From b4af4dc9907f61fdd7006fd34a2573bf98f1bd64 Mon Sep 17 00:00:00 2001 From: Dane Johnson Date: Mon, 23 Feb 2026 09:51:00 -0600 Subject: [PATCH] add oop submodule --- d-/oop.scm | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 d-/oop.scm 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)) ...))])))