[PATCH] runtime: Support immutable records.

[Adam Faiz]

From 1d5103224d34d6eb436f4376196626467a9779bf Mon Sep 17 00:00:00 2001
From: AwesomeAdam54321 <adam.f...@disroot.org>
Date: Wed, 30 Sep 2026 15:01:48 +0800
Subject: [PATCH] runtime: Support immutable records.
* src/runtime/mit-macros.scm: Define `define-immutable-record-type`.
* src/runtime/runtime.pkg: Export it.
---
 src/runtime/mit-macros.scm | 43 +++++++++++++++++++++++++++++++++++++-
 src/runtime/runtime.pkg    |  6 +++++-
 2 files changed, 47 insertions(+), 2 deletions(-)

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index 941cadc4..48e9bdc6 100644
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -470,6 +470,47 @@ USA.
        (syntax-rules ()
         ((_ arg ...) expr))))))
 
+(define-syntax $define-immutable-record-type
+  (syntax-rules ()
+    ((_ type record pred clause ...)
+     (begin
+       ($define-record type pred record)
+       ($define-fields type clause ...)))))
+
+(define-syntax $define-record
+  (syntax-rules ()
+    ((_ type pred (name field ...))
+     (begin
+       (define type (make-record-type (symbol->string 'name) '(field ...)))
+       (define name (record-constructor type '(field ...)))
+       (define pred (record-predicate type))))))
+
+(define *field-table* '())
+(define-syntax $define-fields
+  (syntax-rules ()
+    ((_ type) type)
+    ((_ type (field accessor) clause ...)
+     (begin
+       (define accessor (record-accessor type 'field))
+       (set! *field-table*
+            (cons (cons `(,type accessor) (record-modifier type 'field))
+                  *field-table*))
+       ($define-fields type clause ...)))))
+
+(define-syntax $set-fields
+  (syntax-rules ()
+    ((_ record clause ...)
+     (let ((%set-field
+           (lambda (c rec)
+             ((cdr (assoc `(,(record-type-descriptor rec) ,(caar c)) 
*field-table*))
+              rec (eval (cadr c) user-initial-environment))
+             rec)))
+       (fold %set-field (copy-record record) '(clause ...))))))
+
+(define-syntax $set-field
+  (syntax-rules ()
+    ((_ record field val) ($set-fields record (field val)))))
+
 (define $guard
   (spar-transformer->runtime
    (delay
@@ -1117,4 +1158,4 @@ USA.
                       (append req opt (list rest)))
                (apply scons-call
                       (scons-call racc robj)
-                      (append req opt)))))))))
\ No newline at end of file
+                      (append req opt)))))))))
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 829bafd0..9e35a253 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5249,6 +5249,10 @@ USA.
          (define-record-type $define-record-type) ;(scheme base)
          (define-values $define-values) ;(scheme base)
          (define-syntax-rule $define-syntax-rule)
+         (define-immutable-record-type $define-immutable-record-type)
+         *field-table*
+         (set-fields $set-fields)
+         (set-field $set-field)
          (delay $delay)                ;(scheme lazy)
          (delay-force $delay-force)    ;(scheme lazy)
          (do $do)                      ;(scheme base)
@@ -7096,4 +7100,4 @@ USA.
   (export (runtime procedure)
          apply-hook-type-code)
   (export (runtime types)
-         apply-hook-type-code))
\ No newline at end of file
+         apply-hook-type-code))
--
2.54.0