blob: efd4287b4954b4ec766310c24000346f1222741f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
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))))))
...)))
|
