blob: 217d2e8d7c09e148f0b5e671e916e6a8c3457fef (
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
35
36
37
38
39
40
41
42
|
(library (struct)
(export struct base-struct struct->alist struct-get)
(import (rnrs) (sweet-macros))
;; ex: (remove-dupl '(1 2 3 1 5 2 4))
(define (remove-dupl eq? lst)
(reverse
(fold-left
(lambda (acc el)
(define (is-el? x) (eq? x el))
(if (find is-el? acc); duplicate
acc
(cons el acc))) '() lst)))
(define (append-unique eq? . lists)
(remove-dupl eq? (apply append lists)))
(define (base-struct k)
(case k
((->keys) '())
(else (error 'struct-key-error "Missing key" k))))
(def-syntax struct
(syntax-match ()
(sub (struct (name value) ...)
#'(struct base-struct (name value) ...))
(sub (struct parent (name value) ...)
#'(lambda (k)
(case k
((->keys) (append-unique eq? '(name ...) (parent '->keys)))
((name) value) ...
(else (parent k))))
(for-all identifier? #'(name ...)))
))
(define (struct->alist s)
(map (lambda (k) (list k (s k))) (s '->keys)))
(def-syntax (struct-get s name default)
#'(let ((value (s 'name)))
(if (eq? value struct-null) default value)))
)
|
