diff options
| author | W. Kosior <koszko@koszko.org> | 2025-03-04 13:56:26 +0100 |
|---|---|---|
| committer | W. Kosior <koszko@koszko.org> | 2025-03-04 17:02:31 +0100 |
| commit | 9f336a25c5a49f5ce2e4ff5a9384f59ab56e487b (patch) | |
| tree | ee186a828d25c28973f3c478e0f2b0899b3332c6 | |
| parent | 77472c6943378eed9f9b3ee6bf534407cfda9bd7 (diff) | |
| download | de-paul-records-9f336a25c5a49f5ce2e4ff5a9384f59ab56e487b.tar.gz de-paul-records-9f336a25c5a49f5ce2e4ff5a9384f59ab56e487b.zip | |
Generate alist serializer and deserializer procedures.
| -rw-r--r-- | README.md | 1 | ||||
| -rw-r--r-- | src/guile/de-paul-records.scm | 33 | ||||
| -rw-r--r-- | tests/guile/de-paul-records-test.scm | 29 |
3 files changed, 61 insertions, 2 deletions
@@ -29,6 +29,7 @@ other tasks. Features include - support for default field values, - support for programmer-supplied record finalizer procedures, - syntax for creation of a record object based on an existing one, +- automatic generation of alist<->record (de)serialization procedures, - optional automatic export of generated getters and other variables, - and amended variants of `(ice-9 match)` forms with (unhygienic) record matcher that allows fields to be matched **by name**. diff --git a/src/guile/de-paul-records.scm b/src/guile/de-paul-records.scm index 102ff87..7fcd3a0 100644 --- a/src/guile/de-paul-records.scm +++ b/src/guile/de-paul-records.scm @@ -205,7 +205,13 @@ (%null-record (format-identifiers "%null-~a" record-name)) (*record (format-identifiers "*~a" record-name)) (--finalize-record (format-identifiers "--finalize-~a" - record-name))) + record-name)) + (record->alist (format-identifiers "~a->alist" + record-name)) + (*alist->record (format-identifiers "*alist->~a" + record-name)) + (alist->record (format-identifiers "alist->~a" + record-name))) #`(begin (define-immutable-record-type <record> (--make-record) record? #,@(map (match-lambda @@ -235,9 +241,34 @@ (define-syntax-rule (#,record-name . body-rest) (--finalize-record (*record . body-rest))) + (define (*alist->record alist) + (*record + #,@(map (match-lambda + ((= field-spec-name field-name) + #`(#,field-name + (or (and=> (assq '#,field-name alist) + cdr) + (#,(format-identifiers "~a-~a" + record-name field-name) + %null-record))))) + field-specs))) + + (define (alist->record alist) + (--finalize-record (*alist->record alist))) + + (define (record->alist record) + `(#,@(map (match-lambda + ((= field-spec-name field-name) + #`(#,field-name + . ,(#,(format-identifiers "~a-~a" + record-name field-name) + record)))) + field-specs))) + #,@(if (eq? export? #t) (list #`(export <record> #,record-name record? %null-record + *alist->record alist->record record->alist #,@(append-map (match-lambda ((= field-spec-name field-name) diff --git a/tests/guile/de-paul-records-test.scm b/tests/guile/de-paul-records-test.scm index 275d1a3..011c438 100644 --- a/tests/guile/de-paul-records-test.scm +++ b/tests/guile/de-paul-records-test.scm @@ -20,7 +20,7 @@ (or (eval '(begin (define-module (de-paul-records-test lisp) #:use-module ((de-paul-records) #:select - (deftype match set-field))) + (deftype match match-lambda set-field))) (deftype lisp (name) @@ -131,6 +131,33 @@ (match %paren-3004 (($* lisp is-scheme? is-syntactically-scoped?) (list is-scheme? is-syntactically-scoped?)))) + (test-env 'lisp)))) + + (test-group "lisp paren-3005" + (tu:test-equal '((name . "paren-3005") + (is-scheme? . #f) + (is-syntactically-scoped? . #t)) + (eval + '(lisp->alist (lisp (name "paren-3005") + (is-syntactically-scoped? #t) + (is-scheme? #f))) + (test-env 'lisp)))) + + (test-group "lisp paren-3006" + (tu:test-equal '((name "paren-3006" is? #t iss? #f) + (name "paren-3006" is? #t iss? #t)) + (eval + '(map (compose + (match-lambda + (($* lisp name is-scheme? is-syntactically-scoped?) + (list 'name name + 'is? is-scheme? + 'iss? is-syntactically-scoped?))) + (lambda (proc) + (proc `((is-scheme? . #t) + (extra-key . 'dummy) + (name . "paren-3006"))))) + (list *alist->lisp alist->lisp)) (test-env 'lisp))))) (test-group "match behavior" |