From f94d2a3c9f961d9860df0ff5377044542399019a Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Fri, 10 May 2013 16:30:25 -0400 Subject: [PATCH] struct-map for simple cases of transparent as well as prefab by default --- marketplace/struct-map.rkt | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/marketplace/struct-map.rkt b/marketplace/struct-map.rkt index 60cfc0a..890af91 100644 --- a/marketplace/struct-map.rkt +++ b/marketplace/struct-map.rkt @@ -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))