syndicate-lang
/
marketplace-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

struct-map for simple cases of transparent as well as prefab by default

This commit is contained in:
Tony Garnock-Jones 2013-05-10 16:30:25 -04:00
parent a6d66194d1
commit f94d2a3c9f
1 changed files with 12 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
marketplace/struct-map.rkt
View File

@ -23,6 +23,10 @@
(define m (cond
[(struct-mappable? x) (extract-struct-mapper x)]
[(prefab-struct-key x) => prefab-struct-mapper]
[(struct? x)
(define-values (struct-type skipped?) (struct-info x))
(when skipped? (error name "Partial struct-info for ~v" x))
(transparent-struct-mapper struct-type)]
[else (error name "No struct-map property or mapper for ~v" x)]))
(m f seed x))
@ -33,3 +37,11 @@
(define-values (new-field new-seed) (f old-field old-seed))
(values (cons new-field new-fields) new-seed)))
(values (apply make-prefab-struct key (reverse new-fields)) final-seed))
(define ((transparent-struct-mapper struct-type) f initial-seed x)
(define-values (new-fields final-seed)
(for/fold ([new-fields '()] [old-seed initial-seed])
([old-field (cdr (vector->list (struct->vector x)))])
(define-values (new-field new-seed) (f old-field old-seed))
(values (cons new-field new-fields) new-seed)))
(values (apply (struct-type-make-constructor struct-type) (reverse new-fields)) final-seed))