groworld/plant-eyes/test-scripts/serialise-test.scm

47 lines
1.5 KiB
Scheme
Raw Normal View History

2009-09-28 08:57:29 +00:00
#lang scheme
(define (value->string a)
(cond
((number? a) (string-append "n:" (number->string a)))
((string? a) (string-append "s:" a))
((vector? a) (string-append "v:" (number->string (vector-ref a 0)) ","
(number->string (vector-ref a 1)) ","
(number->string (vector-ref a 2))))
((symbol? a) (string-append "y:" (symbol->string a)))
(else (error "unsupported arg type for " a))))
(define (nvpairs->string l s)
(cond
((null? l) s)
(else
(nvpairs->string (cdr l) (string-append s (symbol->string (caar l)) "="
(value->string (cadr (car l))) " ")))))
(define (string->value a)
(cond
((string=? (car a) "n") (string->number (cadr a)))
((string=? (car a) "s") (cadr a))
((string=? (car a) "v")
(let ((v (string-split (cadr a) #\,)))
(vector (string->number (list-ref v 0))
(string->number (list-ref v 1))
(string->number (list-ref v 2)))))
((string=? (car a) "y") (string->symbol (cadr a)))
(else (error "unsupported value type for " a))))
(define (string->nvpairs s l)
(map
(lambda (pair)
(let ((nv (string-split pair #\=)))
(list (string->symbol (car nv))
(string->value (string-split (cadr nv) #\:)))))
(string-split s #\ )))
(define ser (nvpairs->string (list
(list 'one 2)
(list 'two "three")
(list 'three (vector 1 2 3))
(list 'four 'hello)) ""))
(string->nvpairs ser '())