1 files changed, 34 insertions, 0 deletions
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))))))
+      ...)))