weeb/struct.scm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70

;;; 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
            instance-of?
            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 (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))

(define (instance-of? type rtd)
  "Returns true if RTD is an instance of TYPE."
  ((record-predicate type) rtd))

;; 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 ...)))))