Initial commit.

15 files changed, 904 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..378c6c0
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,15 @@
+# SPDX-License-Identifier: CC0-1.0
+#
+# Copyright (C) 2023 Wojtek Kosior <koszko@koszko.org>
+
+*.go
+Makefile
+Makefile.in
+aclocal.m4
+autom4te.cache
+autotools-aux
+config.log
+config.status
+configure
+configure~
+de-paul-records-*.tar.gz
diff --git a/.reuse/dep5 b/.reuse/dep5
new file mode 100644
index 0000000..0220193
--- /dev/null
+++ b/.reuse/dep5
@@ -0,0 +1,4 @@
+Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
+Upstream-Name: de Paul records
+Upstream-Contact: Wojtek Kosior <koszko@koszko.org>
+Source: https://git.koszko.org/de-paul-records/about
diff --git a/LICENSES/CC0-1.0.txt b/LICENSES/CC0-1.0.txt
new file mode 100644
index 0000000..0e259d4
--- /dev/null
+++ b/LICENSES/CC0-1.0.txt
@@ -0,0 +1,121 @@
+Creative Commons Legal Code
+
+CC0 1.0 Universal
+
+    CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE
+    LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN
+    ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS
+    INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES
+    REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS
+    PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM
+    THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED
+    HEREUNDER.
+
+Statement of Purpose
+
+The laws of most jurisdictions throughout the world automatically confer
+exclusive Copyright and Related Rights (defined below) upon the creator
+and subsequent owner(s) (each and all, an "owner") of an original work of
+authorship and/or a database (each, a "Work").
+
+Certain owners wish to permanently relinquish those rights to a Work for
+the purpose of contributing to a commons of creative, cultural and
+scientific works ("Commons") that the public can reliably and without fear
+of later claims of infringement build upon, modify, incorporate in other
+works, reuse and redistribute as freely as possible in any form whatsoever
+and for any purposes, including without limitation commercial purposes.
+These owners may contribute to the Commons to promote the ideal of a free
+culture and the further production of creative, cultural and scientific
+works, or to gain reputation or greater distribution for their Work in
+part through the use and efforts of others.
+
+For these and/or other purposes and motivations, and without any
+expectation of additional consideration or compensation, the person
+associating CC0 with a Work (the "Affirmer"), to the extent that he or she
+is an owner of Copyright and Related Rights in the Work, voluntarily
+elects to apply CC0 to the Work and publicly distribute the Work under its
+terms, with knowledge of his or her Copyright and Related Rights in the
+Work and the meaning and intended legal effect of CC0 on those rights.
+
+1. Copyright and Related Rights. A Work made available under CC0 may be
+protected by copyright and related or neighboring rights ("Copyright and
+Related Rights"). Copyright and Related Rights include, but are not
+limited to, the following:
+
+  i. the right to reproduce, adapt, distribute, perform, display,
+     communicate, and translate a Work;
+ ii. moral rights retained by the original author(s) and/or performer(s);
+iii. publicity and privacy rights pertaining to a person's image or
+     likeness depicted in a Work;
+ iv. rights protecting against unfair competition in regards to a Work,
+     subject to the limitations in paragraph 4(a), below;
+  v. rights protecting the extraction, dissemination, use and reuse of data
+     in a Work;
+ vi. database rights (such as those arising under Directive 96/9/EC of the
+     European Parliament and of the Council of 11 March 1996 on the legal
+     protection of databases, and under any national implementation
+     thereof, including any amended or successor version of such
+     directive); and
+vii. other similar, equivalent or corresponding rights throughout the
+     world based on applicable law or treaty, and any national
+     implementations thereof.
+
+2. Waiver. To the greatest extent permitted by, but not in contravention
+of, applicable law, Affirmer hereby overtly, fully, permanently,
+irrevocably and unconditionally waives, abandons, and surrenders all of
+Affirmer's Copyright and Related Rights and associated claims and causes
+of action, whether now known or unknown (including existing as well as
+future claims and causes of action), in the Work (i) in all territories
+worldwide, (ii) for the maximum duration provided by applicable law or
+treaty (including future time extensions), (iii) in any current or future
+medium and for any number of copies, and (iv) for any purpose whatsoever,
+including without limitation commercial, advertising or promotional
+purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each
+member of the public at large and to the detriment of Affirmer's heirs and
+successors, fully intending that such Waiver shall not be subject to
+revocation, rescission, cancellation, termination, or any other legal or
+equitable action to disrupt the quiet enjoyment of the Work by the public
+as contemplated by Affirmer's express Statement of Purpose.
+
+3. Public License Fallback. Should any part of the Waiver for any reason
+be judged legally invalid or ineffective under applicable law, then the
+Waiver shall be preserved to the maximum extent permitted taking into
+account Affirmer's express Statement of Purpose. In addition, to the
+extent the Waiver is so judged Affirmer hereby grants to each affected
+person a royalty-free, non transferable, non sublicensable, non exclusive,
+irrevocable and unconditional license to exercise Affirmer's Copyright and
+Related Rights in the Work (i) in all territories worldwide, (ii) for the
+maximum duration provided by applicable law or treaty (including future
+time extensions), (iii) in any current or future medium and for any number
+of copies, and (iv) for any purpose whatsoever, including without
+limitation commercial, advertising or promotional purposes (the
+"License"). The License shall be deemed effective as of the date CC0 was
+applied by Affirmer to the Work. Should any part of the License for any
+reason be judged legally invalid or ineffective under applicable law, such
+partial invalidity or ineffectiveness shall not invalidate the remainder
+of the License, and in such case Affirmer hereby affirms that he or she
+will not (i) exercise any of his or her remaining Copyright and Related
+Rights in the Work or (ii) assert any associated claims and causes of
+action with respect to the Work, in either case contrary to Affirmer's
+express Statement of Purpose.
+
+4. Limitations and Disclaimers.
+
+ a. No trademark or patent rights held by Affirmer are waived, abandoned,
+    surrendered, licensed or otherwise affected by this document.
+ b. Affirmer offers the Work as-is and makes no representations or
+    warranties of any kind concerning the Work, express, implied,
+    statutory or otherwise, including without limitation warranties of
+    title, merchantability, fitness for a particular purpose, non
+    infringement, or the absence of latent or other defects, accuracy, or
+    the present or absence of errors, whether or not discoverable, all to
+    the greatest extent permissible under applicable law.
+ c. Affirmer disclaims responsibility for clearing rights of other persons
+    that may apply to the Work or any use thereof, including without
+    limitation any person's Copyright and Related Rights in the Work.
+    Further, Affirmer disclaims responsibility for obtaining any necessary
+    consents, permissions or other rights required for any use of the
+    Work.
+ d. Affirmer understands and acknowledges that Creative Commons is not a
+    party to this document and has no duty or obligation with respect to
+    this CC0 or use of the Work.
diff --git a/Makefile.am b/Makefile.am
new file mode 100644
index 0000000..df2368c
--- /dev/null
+++ b/Makefile.am
@@ -0,0 +1,13 @@
+# SPDX-License-Identifier: CC0-1.0
+#
+# Copyright (C) 2023 Wojtek Kosior <koszko@koszko.org>
+
+SUBDIRS = src/guile tests/guile
+
+EXTRA_DIST = \
+	LICENSES/CC0-1.0.txt \
+	.reuse/dep5 \
+	guix-devshell \
+	bootstrap \
+	.gitignore \
+	README.md.license
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..93f5a40
--- /dev/null
+++ b/README.md
@@ -0,0 +1,56 @@
+# de Paul records
+
+Software freedom empowers sharing.  Let's dedicate our libre software projects
+to saints known for fostering sharing!
+
+This Guile records library is dedicated to St. Vincent de Paul, a french priest
+from 17th century who served the poor.  Being a great organizer, he managed to
+encourage even high-rank nobles to participate in charity work.  Apparently, he
+had more success than we have with encouraging state authorities to start caring
+about digital freedom…
+
+## Why another records API?
+
+GNU Guile implements SRFI-9 which already provides a records API.  Guile also
+includes a GNU extension in `(srfi srfi-9 gnu)` which provides an API for purely
+functional records.
+
+What these APIs lack is a nice syntax for record construction.  The constructor
+procedures they generate do — at the time of writing — only accept positional
+arguments which makes their use error-prone.  A solution would be to — for every
+record type defined — define one "null" record object and then construct
+subsequent records of this type by cloning and modifying that null record.
+
+This library builds upon @code{(srfi srfi-9 gnu)} to aid with this and also with
+other tasks.  Features include
+
+- automatic deriving of getter names from field names,
+- automatic generation of record constructor macros,
+- support for default field values,
+- support for programmer-supplied record finalizer procedures,
+- syntax for creation of a record object based on an existing one,
+- optional automatic export of generated getters and other variables,
+- and amended variants of `(ice-9 match)` forms with (unhygienic) record
+  matcher that allows fields to be matched **by name**.
+
+This library is inspired by the Guix records API but follows purely functional
+approach.
+
+## Use examples
+
+Please look into the test suite in `tests/guile/`.
+
+## Building & installation
+
+This software has a Guix package definition in Wojtek's [personal
+channel](https://git.koszko.org/guix/about).  That can serve you as a point of
+reference.
+
+## Copying
+
+The source code of this package is available under CC0 v1.0.  The repository is
+kept compliant with the [REUSE](https://reuse.software/) specification, version
+3.0.
+
+Note that the uderlying GNU Guile language is covered by the GNU GPL and hence
+any binary redistribution of *de Paul records* shall be covered by it as well.
diff --git a/README.md.license b/README.md.license
new file mode 100644
index 0000000..e54bf4d
--- /dev/null
+++ b/README.md.license
@@ -0,0 +1,3 @@
+SPDX-License-Identifier: CC0-1.0
+
+Copyright (C) 2023 Wojtek Kosior <koszko@koszko.org>
diff --git a/autotools-aux/config.rpath b/autotools-aux/config.rpath
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/autotools-aux/config.rpath
diff --git a/bootstrap b/bootstrap
new file mode 100755
index 0000000..0040cd3
--- /dev/null
+++ b/bootstrap
@@ -0,0 +1,8 @@
+#!/bin/sh
+
+# SPDX-License-Identifier: CC0-1.0
+#
+# Copyright (C) 2023 Wojtek Kosior <koszko@koszko.org>
+
+cd "$(dirname "$0")"
+autoreconf --install
diff --git a/configure.ac b/configure.ac
new file mode 100644
index 0000000..470e267
--- /dev/null
+++ b/configure.ac
@@ -0,0 +1,24 @@
+# SPDX-License-Identifier: CC0-1.0
+#
+# Copyright (C) 2023 Wojtek Kosior <koszko@koszko.org>
+
+AC_INIT([de-paul-records], [0.1], [koszko@koszko.org])
+
+AC_CONFIG_SRCDIR([src/guile/de-paul-records.scm])
+
+m4_pattern_forbid([^GUILE_])
+m4_pattern_allow([^GUILE_PKG_ERRORS$])
+
+GUILE_PKG([3.0])
+GUILE_PROGS
+
+AC_PATH_PROG([GUILE_TEST_DRIVER], [guile-test-driver])
+
+AC_CONFIG_AUX_DIR([autotools-aux])
+
+AM_INIT_AUTOMAKE([-Wall -Werror foreign])
+
+AC_CONFIG_FILES([Makefile src/guile/Makefile tests/guile/Makefile])
+AX_ADD_GUILE_PRE_INST_ENV()
+
+AC_OUTPUT
diff --git a/guix-devshell b/guix-devshell
new file mode 100644
index 0000000..85d8c91
--- /dev/null
+++ b/guix-devshell
@@ -0,0 +1,22 @@
+#!/bin/sh
+
+# SPDX-License-Identifier: CC0-1.0
+#
+# Copyright (C) 2023 Wojtek Kosior <koszko@koszko.org>
+
+set -eu
+
+SOURCE_DIR="$(cd "$(dirname "$0")" && pwd -P)"
+GUIX_SCM="$SOURCE_DIR"/guix.scm
+
+EXTRA_PACKAGES="reuse texinfo man-db"
+
+if test 0 = "$#"
+then :
+     printf 'guix shell -Df '\''%s'\'' %s\n' "$GUIX_SCM" "$EXTRA_PACKAGES"
+     guix shell -Df "$GUIX_SCM" $PACKAGES
+else :
+     shift
+     printf 'guix shell -Df '\''%s'\'' %s -- %s\n' "$PACKAGES" "$*"
+     guix shell -Df "$GUIX_SCM" $PACKAGES -- "$@"
+fi
diff --git a/guix.scm b/guix.scm
new file mode 100644
index 0000000..663e291
--- /dev/null
+++ b/guix.scm
@@ -0,0 +1,13 @@
+;;; SPDX-License-Identifier: CC0-1.0
+;;;
+;;; Copyright (C) Wojtek Kosior <koszko@koszko.org>
+
+(use-modules ((guix inferior) #:select (inferior-for-channels))
+             ((guix channels) #:select (channel)))
+
+(define inferior
+  (inferior-for-channels (list (channel
+                                (name 'guix)
+                                (url "https://git.koszko.org/guix")))))
+
+(car (lookup-inferior-packages inferior "guile-de-paul-records"))
diff --git a/src/guile/Makefile.am b/src/guile/Makefile.am
new file mode 100644
index 0000000..743ce74
--- /dev/null
+++ b/src/guile/Makefile.am
@@ -0,0 +1,20 @@
+# SPDX-License-Identifier: CC0-1.0
+#
+# Copyright (C) 2023 Wojtek Kosior <koszko@koszko.org>
+
+GUILE_SOURCE_FILES = \
+	$(PACKAGE).scm
+
+GUILE_OBJECT_FILES = \
+	$(GUILE_SOURCE_FILES:.scm=.go)
+
+gobjdir = $(libdir)/guile/@GUILE_EFFECTIVE_VERSION@/site-ccache
+nobase_gobj_DATA = $(GUILE_OBJECT_FILES)
+
+scmdir = $(datarootdir)/guile/site/@GUILE_EFFECTIVE_VERSION@
+nobase_dist_scm_DATA = $(GUILE_SOURCE_FILES)
+
+.scm.go:
+	$(top_builddir)/pre-inst-env $(GUILD) compile --output=$@ $<
+
+MOSTLYCLEANFILES = $(GUILE_OBJECT_FILES)
diff --git a/src/guile/de-paul-records.scm b/src/guile/de-paul-records.scm
new file mode 100644
index 0000000..57d65e5
--- /dev/null
+++ b/src/guile/de-paul-records.scm
@@ -0,0 +1,351 @@
+;;; SPDX-License-Identifier: CC0-1.0
+;;;
+;;; Copyright (C) 2023 Wojtek Kosior <koszko@koszko.org>
+
+(define-module (de-paul-records)
+  #:use-module ((srfi srfi-1) #:select (append-map))
+  #:use-module ((srfi srfi-9 gnu)
+                #:select (define-immutable-record-type set-field set-fields))
+  #:use-module ((srfi srfi-26) #:select (cut))
+  #:use-module ((ice-9 format) #:select (format))
+  #:use-module ((ice-9 match) #:select (match match-lambda))
+  #:use-module ((ice-9 match) #:prefix ice-9-match:)
+  #:re-export (set-field set-fields)
+  #:export ((match-override . match)
+            (match-lambda-override . match-lambda)
+            (match-lambda*-override . match-lambda*)
+            (match-let-override . match-let)
+            (match-let*-override . match-let*)
+            (match-letrec-override . match-letrec)
+
+            define-immutable-record-type*))
+
+(eval-when (compile load eval)
+  (define (get-first-identifier list-of-identifiers-and-other)
+    (let loop ((items list-of-identifiers-and-other))
+      (match items
+        (()
+         (throw 'programming-error))
+        (((? identifier? item) . _)
+         item)
+        ((_ . rest)
+         (loop rest)))))
+
+  (define* (format-identifiers fmt #:rest args)
+    (let* ((first-identifier (get-first-identifier args))
+           (processed-args (map (match-lambda
+                                  ((? identifier? identifier)
+                                   (symbol->string (syntax->datum identifier)))
+                                  (other
+                                   other))
+                                args))
+           (formatted-string (apply format #f fmt processed-args)))
+      (datum->syntax first-identifier (string->symbol formatted-string))))
+
+  (define-immutable-record-type <field-spec> (make-field-spec) field-spec?
+    (name    field-spec-name    field-spec-set-name)
+    (default field-spec-default field-spec-set-default))
+
+  (define %null-field-spec
+    (set-field (make-field-spec)
+      (field-spec-default) #'#f))
+
+  (define (syntax->field-spec x)
+    (syntax-case x ()
+      (field-name
+       (identifier? #'field-name)
+       (syntax->field-spec #'(field-name)))
+      ((field-name . field-args)
+       (let loop ((field-spec %null-field-spec)
+                  (args #'field-args))
+         (syntax-case args ()
+           (()
+            (field-spec-set-name field-spec #'field-name))
+           ((#:default default . args-rest)
+            (eq? (field-spec-default field-spec)
+                 (field-spec-default %null-field-spec))
+            (loop (field-spec-set-default field-spec #'default)
+                  #'args-rest)))))))
+
+  (define-immutable-record-type <record-spec> (make-record-spec) record-spec?
+    (name     record-spec-name     record-spec-set-name)
+    (fields   record-spec-fields   record-spec-set-fields)
+    (export?  record-spec-export?  record-spec-set-export?)
+    (finalize record-spec-finalize record-spec-set-finalize))
+
+  (define %null-record-spec
+    (set-fields (make-record-spec)
+      ((record-spec-fields) '())
+      ((record-spec-export?) 'false-by-default)))
+
+  (define (syntax->record-spec x)
+    (syntax-case x ()
+      ((_ record-name . record-args)
+       (identifier? #'record-name)
+       (let loop ((record-spec %null-record-spec)
+                  (args #'record-args))
+         (syntax-case args ()
+           (()
+            (set-fields record-spec
+              ((record-spec-name) #'record-name)
+              ((record-spec-fields) (reverse (record-spec-fields
+                                              record-spec)))))
+           ((#:export? export? . args-rest)
+            (eq? (record-spec-export? record-spec) 'false-by-default)
+            (loop (record-spec-set-export? record-spec
+                    (and (syntax->datum #'export?) #t))
+                  #'args-rest))
+           ((#:finalize finalizer . args-rest)
+            (not (record-spec-finalize record-spec))
+            (loop (record-spec-set-finalize record-spec
+                    #'finalizer)
+                  #'args-rest))
+           ((field-def . args-rest)
+            (loop (record-spec-set-fields record-spec
+                    (cons (syntax->field-spec #'field-def)
+                          (record-spec-fields record-spec)))
+                  #'args-rest)))))))
+
+  (define-immutable-record-type <field-init> (make-field-init) field-init?
+    (name       field-init-name       field-init-set-name)
+    (value-expr field-init-value-expr field-init-set-value-expr))
+
+  (define %null-field-init
+    (make-field-init))
+
+  (define (syntax->field-init x)
+    (syntax-case x ()
+      ((field-name value-expr)
+       (identifier? #'field-name)
+       (set-fields %null-field-init
+         ((field-init-name) #'field-name)
+         ((field-init-value-expr) #'value-expr)))
+      (field-name
+       (identifier? #'field-name)
+       (syntax->field-init #'(field-name field-name)))))
+
+  (define-immutable-record-type <record-init> (make-record-init) record-init?
+    (inherit record-init-inherit record-init-set-inherit)
+    (fields  record-init-fields  record-init-set-fields))
+
+  (define %null-record-init
+    (set-fields (make-record-init)
+      ((record-init-inherit) #f)
+      ((record-init-fields) '())))
+
+  (define (syntax->record-init x)
+    (syntax-case x ()
+      ((_ . init-args)
+       (let loop ((record-init %null-record-init)
+                  (args #'init-args))
+         (syntax-case args ()
+           (()
+            (set-field record-init
+              (record-init-fields) (reverse (record-init-fields record-init))))
+           ((#:<- base . args-rest)
+            (not (record-init-inherit record-init))
+            (loop (record-init-set-inherit record-init #'base)
+                  #'args-rest))
+           ((field-init . args-rest)
+            (loop (record-init-set-fields record-init
+                    (cons (syntax->field-init #'field-init)
+                          (record-init-fields record-init)))
+                  #'args-rest)))))))
+
+  (define (transform-record-init record-name %null-record init-form)
+    (match init-form
+      ((= syntax->record-init (and (= record-init-inherit inherit)
+                                   (= record-init-fields  field-inits)))
+       #`(let* (#,@(map (match-lambda
+                          ((and (= field-init-name       field-name)
+                                (= field-init-value-expr value-expr))
+                           #`(#,field-name #,value-expr)))
+                        field-inits))
+           (set-fields #,(or inherit %null-record)
+             #,@(map (match-lambda
+                       ((= field-init-name field-name)
+                        #`((#,(format-identifiers "~a-~a"
+                                record-name field-name))
+                           #,field-name)))
+                     field-inits))))))
+
+  (define-syntax define-immutable-record-type*
+    (match-lambda
+      ((= syntax->record-spec (and my-record-spec
+                                   (= record-spec-name     record-name)
+                                   (= record-spec-fields   field-specs)
+                                   (= record-spec-export?  export?)
+                                   (= record-spec-finalize finalize)))
+       (with-syntax ((<record> (format-identifiers "<~a>" record-name))
+                     (--make-record (format-identifiers "--make-~a"
+                                      record-name))
+                     (record? (format-identifiers "~a?" record-name))
+                     (%null-record (format-identifiers "%null-~a" record-name))
+                     (*record (format-identifiers "*~a" record-name))
+                     (--finalize-record (format-identifiers "--finalize-~a"
+                                          record-name)))
+         #`(begin
+             (define-immutable-record-type <record> (--make-record) record?
+               #,@(map (match-lambda
+                         ((= field-spec-name field-name)
+                          #`(#,field-name
+                             #,@(map (cut format-identifiers <>
+                                          record-name field-name)
+                                     '("~a-~a" "~a-set-~a")))))
+                       field-specs))
+
+             (define %null-record
+               (set-fields (--make-record)
+                 #,@(map (match-lambda
+                           ((and (= field-spec-name field-name)
+                                 (= field-spec-default default))
+                            #`((#,(format-identifiers "~a-~a"
+                                    record-name field-name))
+                               #,default)))
+                         field-specs)))
+
+             (define-syntax *record
+               (cut transform-record-init #'#,record-name #'%null-record <>))
+
+             (define --finalize-record
+               #,(or finalize #'identity))
+
+             (define-syntax-rule (#,record-name . body-rest)
+               (--finalize-record (*record . body-rest)))
+
+             #,@(if (eq? export? #t)
+                    (list
+                     #`(export <record> #,record-name record? %null-record
+                               #,@(append-map
+                                   (match-lambda
+                                     ((= field-spec-name field-name)
+                                      (map (cut format-identifiers <>
+                                                record-name field-name)
+                                           '("~a-~a" "~a-set-~a"))))
+                                   field-specs)))
+                    #'()))))))
+
+  (define (map-syntax proc syntax-list)
+    (syntax-case syntax-list ()
+      (()
+       '())
+      ((item . rest)
+       (cons (proc #'item) (map-syntax proc #'rest)))))
+
+  (define (transform-match-field record-name-base field-form)
+    (syntax-case field-form ()
+      (field-name
+       (identifier? #'field-name)
+       (transform-match-field record-name-base #'(field-name field-name)))
+      ((field-name pat pats ...)
+       (identifier? #'field-name)
+       (with-syntax ((record-field (format-identifiers "~a-~a"
+                                     record-name-base #'field-name)))
+         #`(= record-field
+              (and #,@(map-syntax transform-match-pat #'(pat pats ...))))))))
+
+  (define (transform-match-pat pat-form)
+    (syntax-case pat-form ($* = ? quote quasiquote)
+      ((quote something)
+       #'(quote something))
+      ((quasiquote something)
+       #`(quasiquote #,(transform-quasiquoted-match-pat #'something)))
+      (#(pats ...)
+       (with-syntax (((pats* ...) #`(#,@(map-syntax transform-match-pat
+                                                    #'(pats ...)))))
+         #'#(pats* ...)))
+      (($* record-name-base pats ...)
+       (identifier? #'record-name-base)
+       (with-syntax ((record? (format-identifiers "~a?" #'record-name-base)))
+         #`(? record? #,@(map-syntax (cut transform-match-field
+                                          #'record-name-base <>)
+                                     #'(pats ...)))))
+      ((= field pat)
+       #`(= field #,(transform-match-pat #'pat)))
+      ((? pred pats ...)
+       #`(? pred #,@(map-syntax transform-match-pat #'(pats ...))))
+      ((head . tail)
+       #`(#,(transform-match-pat #'head) . #,(transform-match-pat #'tail)))
+      (other
+       #'other)))
+
+  (define (transform-quasiquoted-match-pat pat-form)
+    (syntax-case pat-form (unquote unquote-splicing)
+      ((unquote something)
+       #`(unquote #,(transform-match-pat #'something)))
+      ((unquote-splicing something)
+       #`(unquote-splicing #,(transform-match-pat #'something)))
+      ((head . tail)
+       #`(#,(transform-quasiquoted-match-pat #'head)
+          . #,(transform-quasiquoted-match-pat #'tail)))
+      (#(pats ...)
+       (with-syntax (((pats* ...) #`(#,@(map-syntax
+                                         transform-quasiquoted-match-pat
+                                         #'(pats ...)))))
+         #'#(pats* ...)))
+      (other
+       #'other)))
+
+  (define (transform-match-clauses clauses-forms)
+    #`(#,@(map-syntax (lambda (clause-form)
+                        (syntax-case clause-form ()
+                          ((pat . body)
+                           #`(#,(transform-match-pat #'pat) . body))))
+                      clauses-forms)))
+
+  (define-syntax match-override
+    (lambda (x)
+      (syntax-case x ()
+        ((_ expr . clauses)
+         #`(ice-9-match:match expr . #,(transform-match-clauses #'clauses))))))
+
+  (define-syntax match-lambda-override
+    (lambda (x)
+      (syntax-case x ()
+        ((_ . clauses)
+         #`(ice-9-match:match-lambda
+            . #,(transform-match-clauses #'clauses))))))
+
+  (define-syntax match-lambda*-override
+    (lambda (x)
+      (syntax-case x ()
+        ((_ . clauses)
+         #`(ice-9-match:match-lambda*
+            . #,(transform-match-clauses #'clauses))))))
+
+  (define transform-match-bindings
+    transform-match-clauses)
+
+  (define-syntax match-let-override
+    (lambda (x)
+      (syntax-case x ()
+        ((_ variable bindings . body)
+         (identifier? #'variable)
+         #`(ice-9-match:match-let variable
+                                  #,(transform-match-bindings #'bindings)
+                                  . body))
+        ((_ bindings . body)
+         #`(ice-9-match:match-let #,(transform-match-bindings #'bindings)
+                                  . body)))))
+
+  (define-syntax match-let*-override
+    (lambda (x)
+      (syntax-case x ()
+        ((_ bindings . body)
+         #`(ice-9-match:match-let* #,(transform-match-bindings #'bindings)
+                                   . body)))))
+
+  (define-syntax match-letrec-override
+    (lambda (x)
+      (syntax-case x ()
+        ((_ bindings . body)
+         #`(ice-9-match:match-letrec #,(transform-match-bindings #'bindings)
+                                     . body))))))
+
+;;; Local Variables:
+;;; eval: (put 'format-identifiers 'scheme-indent-function 1)
+;;; eval: (put 'record-spec-set-finalize 'scheme-indent-function 1)
+;;; eval: (put 'record-spec-set-export? 'scheme-indent-function 1)
+;;; eval: (put 'record-spec-set-fields 'scheme-indent-function 1)
+;;; eval: (put 'record-init-set-fields 'scheme-indent-function 1)
+;;; End:
diff --git a/tests/guile/Makefile.am b/tests/guile/Makefile.am
new file mode 100644
index 0000000..4dd1658
--- /dev/null
+++ b/tests/guile/Makefile.am
@@ -0,0 +1,25 @@
+# SPDX-License-Identifier: CC0-1.0
+#
+# Copyright (C) 2023 Wojtek Kosior <koszko@koszko.org>
+
+GUILE_SOURCE_FILES = \
+	$(PACKAGE)-test.scm
+
+GUILE_OBJECT_FILES = $(GUILE_SOURCE_FILES:.scm=.go)
+
+
+TEST_EXTENSIONS = .scm
+
+SCM_LOG_DRIVER = $(top_builddir)/pre-inst-env $(GUILE_TEST_DRIVER)
+
+TESTS = $(GUILE_SOURCE_FILES)
+
+
+dist_noinst_DATA = $(GUILE_SOURCE_FILES)
+
+check_DATA = $(GUILE_OBJECT_FILES)
+
+MOSTLYCLEANFILES = $(GUILE_OBJECT_FILES)
+
+.scm.go:
+	$(top_builddir)/pre-inst-env $(GUILD) compile --output=$@ $<
diff --git a/tests/guile/de-paul-records-test.scm b/tests/guile/de-paul-records-test.scm
new file mode 100644
index 0000000..d8970a4
--- /dev/null
+++ b/tests/guile/de-paul-records-test.scm
@@ -0,0 +1,229 @@
+;;; SPDX-License-Identifier: CC0-1.0
+;;;
+;;; Copyright (C) 2023 Wojtek Kosior <koszko@koszko.org>
+
+(use-modules ((srfi srfi-35) #:select (extract-condition condition-ref))
+             ((ice-9 safe-r5rs) #:select (null-environment))
+             ((srfi srfi-64) #:select (test-group))
+             ((myra-test-utils) #:prefix tu:))
+
+(define (make-env)
+  (let ((env (null-environment 5)))
+    (module-use! env (resolve-interface '(guile)))
+    env))
+
+(define (test-env name)
+  (resolve-module `(de-paul-records-test ,name)))
+
+(test-group "exported record <lisp>"
+  (tu:test-assert
+   (or (eval '(begin
+                (define-module (de-paul-records-test lisp)
+                  #:use-module ((de-paul-records)))
+
+                (define-immutable-record-type* lisp
+                  (name)
+                  is-scheme?
+                  #:export? yes,ofcourse
+                  (is-syntactically-scoped? #:default #f)
+                  #:finalize (lambda (the-lisp)
+                               (set-field the-lisp
+                                          (lisp-is-syntactically-scoped?)
+                                          (or (lisp-is-syntactically-scoped?
+                                               the-lisp)
+                                              (lisp-is-scheme? the-lisp))))))
+             (make-env))
+       #t))
+
+  (tu:test-assert (macro? (module-ref (resolve-interface
+                                       '(de-paul-records-test lisp))
+                                      'lisp)))
+
+  (tu:test-error (lambda (condition)
+                   (let ((subcond (extract-condition
+                                   condition
+                                   &exception-with-kind-and-args)))
+                     (eq? 'misc-error (condition-ref subcond 'kind))))
+                 (module-ref (resolve-interface
+                              '(de-paul-records-test lisp))
+                             '*lisp))
+
+  (test-group "lisp paren-3001"
+    (tu:test-equal '(#f "paren-3001" #f)
+                   (eval '(begin
+                            (define %paren-3001
+                              (lisp (is-scheme? #f)
+                                    (name "paren-3001")))
+
+                            (match %paren-3001
+                              (($* lisp
+                                   is-syntactically-scoped?
+                                   name
+                                   is-scheme?)
+                               (list is-syntactically-scoped?
+                                     name
+                                     is-scheme?))))
+                         (test-env 'lisp)))
+
+    (tu:test-equal '(iss? #f is? #f)
+                   (eval '(match %paren-3001
+                            (($* lisp
+                                 (is-syntactically-scoped? iss?)
+                                 (name "paren-3001")
+                                 (is-scheme? is? $f))
+                             (list 'iss? iss? 'is? is?)))
+                         (test-env 'lisp))))
+
+  (test-group "lisp paren-3002"
+    (tu:test-equal '#t
+                   (eval
+                    '(begin
+                       (define %paren-3002
+                         (lisp #:<- %paren-3001
+                               (name "paren-3002")
+                               (is-syntactically-scoped? #t)))
+
+                       (match `(a . ,%paren-3002)
+                         (`(a . ,($* lisp is-syntactically-scoped?))
+                          is-syntactically-scoped?)))
+                    (test-env 'lisp)))
+
+    (tu:test-equal '(#f "paren-3002")
+                   (eval
+                    '(match (vector %paren-3002)
+                       (#(($* lisp is-scheme? name))
+                        (list is-scheme? name)))
+                    (test-env 'lisp))))
+
+  (test-group "lisp paren-3003"
+    (tu:test-equal '(#t #t)
+                   (eval
+                    '(begin
+                       (define %paren-3003
+                         (let ((name "paren-3003"))
+                             (lisp #:<- (lisp)
+                                   name
+                                   (is-scheme? (string-suffix? "-3003" name)))))
+
+                       (match %paren-3003
+                         (($* lisp is-scheme? is-syntactically-scoped?)
+                          (list is-scheme? is-syntactically-scoped?))))
+                    (test-env 'lisp)))
+
+    (tu:test-equal "paren-3003"
+                   (eval '(lisp-name %paren-3003)
+                         (test-env 'lisp))))
+
+  (test-group "lisp paren-3004"
+    (tu:test-equal '(#t #f)
+                   (eval
+                    '(begin
+                       (define %paren-3004
+                         ;; (*lisp ...) form is a "primitive" variant of the
+                         ;; (lisp ...) form — it shall not call the finalizer.
+                         (*lisp #:<- (lisp)
+                                (name "paren-3004")
+                                (is-scheme? #t)))
+
+                       (match %paren-3004
+                         (($* lisp is-scheme? is-syntactically-scoped?)
+                          (list is-scheme? is-syntactically-scoped?))))
+                    (test-env 'lisp)))))
+
+(test-group "match behavior"
+  (tu:test-assert
+   (or (eval '(begin
+                (define-module (de-paul-records-test match)
+                  #:use-module ((de-paul-records)))
+
+                (define (some-record? _)
+                  #f))
+             (make-env))
+       #t))
+
+  (tu:test-error (lambda (condition)
+                   (let ((subcond (extract-condition
+                                   condition
+                                   &exception-with-kind-and-args)))
+                     (eq? 'match-error (condition-ref subcond 'kind))))
+                 (eval '(match (list 'a 'b)
+                          (($* some-record)
+                           "should not match"))
+                       (test-env 'match)))
+
+  (tu:test-error (lambda (condition)
+                   (let ((subcond (extract-condition
+                                   condition
+                                   &exception-with-kind-and-args)))
+                     (eq? 'unbound-variable (condition-ref subcond 'kind))))
+                 (eval '(match (list 'a 'b)
+                          (($* nonexistent-record)
+                           "should error out"))
+                       (test-env 'match)))
+
+  (tu:test-equal 'sth2
+                 (eval '(match `(($* sth1 sth2) . b)
+                          (`(($* sth1 ,second-sth) . b)
+                           second-sth))
+                       (test-env 'match)))
+
+  (tu:test-equal "matched with predicate"
+                 (eval '(match "matched with predicate"
+                          ((? (lambda (_)
+                                ;; $* form shall not get altered by match
+                                ;; because it's inside a predicate form of
+                                ;; (? pred pat ooo)
+                                (define ($* a b)
+                                  b)
+
+                                ($* 'dummy #t))
+                              matched-value)
+                           matched-value))
+                       (test-env 'match)))
+
+  (tu:test-equal "matched with 'getter'"
+                 (eval '(match "'getter'"
+                          ((= (lambda (string)
+                                ;; $* form shall not get altered by match
+                                ;; because it's inside a field form of
+                                ;; (= field pat)
+                                (define ($* a b)
+                                  b)
+
+                                ($* 'dummy (string-append "matched with "
+                                                          string)))
+                              produced-value)
+                           produced-value))
+                       (test-env 'match))))
+
+(test-group "non-exported record <rsa-secret-key>"
+  (tu:test-assert
+   (or (eval '(begin
+                (define-module (de-paul-records-test rsa-secret-key-1)
+                  #:use-module ((de-paul-records)))
+
+                (define-immutable-record-type* rsa-secret-key
+                  (bytes)
+                  #:export? #f))
+             (make-env))
+       #t))
+
+  (tu:test-eq 'absent (module-ref (resolve-interface
+                                   '(de-paul-records-test rsa-secret-key-1))
+                                  'rsa-secret-key
+                                  'absent))
+
+  (tu:test-assert
+   (or (eval '(begin
+                (define-module (de-paul-records-test rsa-secret-key-2)
+                  #:use-module ((de-paul-records)))
+
+                (define-immutable-record-type* rsa-secret-key
+                  (bytes)))
+             (make-env))
+       #t))
+
+  (tu:test-eq 'absent (module-ref (resolve-interface
+                                   '(de-paul-records-test rsa-secret-key-2))
+                                  'rsa-secret-key-bytes
+                                  'absent)))