Implement struct macros/functions

1 files changed, 65 insertions, 0 deletions

diff --git a/weeb/struct.scm b/weeb/struct.scm
new file mode 100644
index 0000000..64349ef
--- /dev/null
+++ b/weeb/struct.scm
@@ -0,0 +1,65 @@
+;;; Weeb --- Web microframework for GNU Guile
+;;; Copyright © 2026 Jakob Kreuze <zerodaysfordays@sdf.org>
+;;;
+;;; This file is part of Weeb.
+;;;
+;;; Weeb is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU Affero General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; Weeb is distributed in the hope that it will be useful, but WITHOUT
+;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General
+;;; Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with Weeb. If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (weeb struct)
+  #:use-module (ice-9 regex)
+  #:export (define-struct
+            make-struct
+            with-accessors
+            call-with-slots))
+
+;; Define a new record type with the given NAME and FIELDS.
+(define-syntax define-struct
+  (lambda (stx)
+    (syntax-case stx ()
+      ((_ name field* ...)
+       #'(define name
+           (let* ((type-string (symbol->string (quote name)))
+                  (type-representation (match:substring
+                                        (string-match "[^<> ]+" type-string))))
+             (make-record-type (symbol->string (quote name))
+                               (quote (field* ...)))))))))
+
+(define (make-struct type . args)
+  "Create a new instance of the record type TYPE using ARGS to
+instantiate the record's fields."
+  (apply (record-constructor type) args))
+
+;; Bind the accessors for the fields of the record RTD to local
+;; variables in BODY. RTD must be a record type descriptor.
+(define-syntax with-accessors
+  (syntax-rules ()
+    ((with-accessors (rtd field ...)
+        body ...)
+     (let ((rtd-eval rtd))
+       (let ((field ((record-accessor (record-type-descriptor rtd) 'field) rtd))
+             ...)
+         body ...)))))
+
+;; Bind the slots of the record RTD to the named variables in LAMBDA.
+;; This allows for pattern-matching-like access to the fields of the
+;; record.
+(define-syntax call-with-slots
+  (syntax-rules ()
+    ((call-with-slots rtd
+        (lambda (field ...)
+          body ...))
+     (let ((rtd-eval rtd))
+       (let ((field ((record-accessor (record-type-descriptor rtd) 'field) rtd))
+             ...)
+         body ...)))))