From 6696a0b5fcb1b17895285d80d9636defb2df3f9d Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 10 Apr 2024 14:49:03 -0400
Subject: Sloppily refactor into modules.

---
 strigoform/type.scm | 34 ++++++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)
 create mode 100644 strigoform/type.scm

(limited to 'strigoform/type.scm')

diff --git a/strigoform/type.scm b/strigoform/type.scm
new file mode 100644
index 0000000..efd4287
--- /dev/null
+++ b/strigoform/type.scm
@@ -0,0 +1,34 @@
+(library (strigoform type)
+  (export define-type)
+  (import (scheme base)
+          (hoot match)
+          (only (hoot syntax) define-syntax-rule))
+
+  ;; Record types are only just beginning to be added to Hoot and
+  ;; there isn't support for mutable structs, yet. So, tagged
+  ;; vectors will have to do.
+  (define-syntax-rule (define-type name
+                        constructor
+                        predicate
+                        (field getter setter) ...)
+    (begin
+      (define (constructor field ...)
+        (vector 'name field ...))
+      (define (predicate obj)
+        (match obj
+          (#('name field ...) #t)
+          (_ #f)))
+      (define (getter obj)
+        (match obj
+          (#('name field ...)
+           field)))
+      ...
+      (define setter
+        (let ((i (+ (- (length '(field ...))
+                       (length (memq 'field '(field ...))))
+                    1)))
+          (lambda (obj val)
+            (match obj
+              (#('name field ...)
+               (vector-set! obj i val))))))
+      ...)))
-- 
cgit v1.2.3