diff options
author | David Thompson <dthompson2@worcester.edu> | 2024-04-10 14:49:03 -0400 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2024-04-10 14:49:03 -0400 |
commit | 6696a0b5fcb1b17895285d80d9636defb2df3f9d (patch) | |
tree | 2cce306afcd7776925f725a382ae1a834513636c /strigoform/type.scm | |
parent | 20b4e7c566cd268f8fafd3e2d3846513e31949e7 (diff) |
Sloppily refactor into modules.
Diffstat (limited to 'strigoform/type.scm')
-rw-r--r-- | strigoform/type.scm | 34 |
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)))))) + ...))) |