diff --git a/implementations/racket/preserves/main.rkt b/implementations/racket/preserves/main.rkt index ac6921f..3b75d7a 100644 --- a/implementations/racket/preserves/main.rkt +++ b/implementations/racket/preserves/main.rkt @@ -568,9 +568,24 @@ ;;--------------------------------------------------------------------------- -(define (write-preserve v0 [o (current-output-port)]) +(define (write-preserve v0 [o (current-output-port)] #:indent [indent-amount0 #f]) + (define indent-amount (match indent-amount0 + [#f #f] + [#t 2] ;; a default + [other other])) + (define indenting? (and indent-amount #t)) + (define-syntax-rule (! fmt arg ...) (fprintf o fmt arg ...)) + (define (!indent distance) + (when indenting? + (! "\n~a" (make-string distance #\space)))) + + (define (!indent* distance) + (if indenting? + (!indent distance) + (! " "))) + (define (write-stringlike-char c [default (lambda (c) (! "~a" c))]) (match c [#\\ (! "\\\\")] @@ -581,37 +596,65 @@ [#\u09 (! "\\t")] [_ (default c)])) - (define (write-sequence opener comma closer item-writer vs) + (define (write-sequence outer-distance opener comma closer item-writer vs) + (define inner-distance (+ outer-distance indent-amount)) (! "~a" opener) (match vs ['() (void)] [(cons v0 vs) - (item-writer v0) + (!indent inner-distance) + (item-writer inner-distance v0) (for [(v (in-list vs))] (! "~a" comma) - (item-writer v))]) + (!indent* inner-distance) + (item-writer inner-distance v)) + (!indent outer-distance)]) (! "~a" closer)) - (define (write-record label fields) + (define (write-record outer-distance label fields) (! "<") - (write-value label) - (for [(f (in-list fields))] + (write-value outer-distance label) + (for ([f (in-list fields)]) (! " ") - (write-value f)) + (write-value outer-distance f)) (! ">")) - (define (write-key-value kv) + ;; (define (write-record outer-distance label fields) + ;; (define simple-label? (or (boolean? label) (number? label) (string? label) + ;; (bytes? label) (symbol? label))) + ;; (define inner-distance (+ outer-distance + ;; (if simple-label? + ;; (+ 2 (string-length (preserve->string label #:indent #f))) + ;; indent-amount))) + ;; (define (write-fields fields) + ;; (for ([f (in-list fields)]) + ;; (!indent* inner-distance) + ;; (write-value inner-distance f))) + ;; + ;; (! "<") + ;; (write-value inner-distance label) + ;; (if simple-label? + ;; (match fields + ;; ['() (void)] + ;; [(cons field0 fields) + ;; (! " ") + ;; (write-value inner-distance field0) + ;; (write-fields fields)]) + ;; (write-fields fields)) + ;; (! ">")) + + (define (write-key-value distance kv) (match-define (cons k v) kv) - (write-value k) + (write-value distance k) (! ": ") - (write-value v)) + (write-value distance v)) (define (binunescaped? b) (or (<= #x20 b #x21) (<= #x23 b #x5b) (<= #x5d b #x7e))) - (define (write-value v) + (define (write-value distance v) (match v [#f (! "#false")] [#t (! "#true")] @@ -648,22 +691,22 @@ [(== PIPE) (! "\\|")] [_ (write-stringlike-char c)])) (! "|")))] - [(record label fields) (write-record label fields)] + [(record label fields) (write-record distance label fields)] [(? non-object-struct?) (define key (prefab-struct-key v)) (when (not key) (error 'encode-value "Cannot encode non-prefab struct ~v" v)) - (write-record key (cdr (vector->list (struct->vector v))))] + (write-record distance key (cdr (vector->list (struct->vector v))))] - [(? list?) (write-sequence "[" ", " "]" write-value v)] - [(? set?) (write-sequence "#set{" ", " "}" write-value (set->list v))] - [(? dict?) (write-sequence "{" ", " "}" write-key-value (dict->list v))] + [(? list?) (write-sequence distance "[" "," "]" write-value v)] + [(? set?) (write-sequence distance "#set{" "," "}" write-value (set->list v))] + [(? dict?) (write-sequence distance "{" "," "}" write-key-value (dict->list v))] [_ (error 'write-preserve "Cannot encode value ~v" v)])) - (write-value v0)) + (write-value 0 v0)) -(define (preserve->string v0) - (with-output-to-string (lambda () (write-preserve v0)))) +(define (preserve->string v0 #:indent [indent-amount #f]) + (with-output-to-string (lambda () (write-preserve v0 #:indent indent-amount)))) ;;--------------------------------------------------------------------------- @@ -891,7 +934,10 @@ read-preserve))) (local-require racket/pretty) (for [((t-name _t-name-anns t t-anns) (in-hash/annotations tests test-annotations))] - (pretty-print (list t-name t t-anns)) - (write-preserve t) - (newline))) + (newline) + (newline) + (write-preserve t #:indent #t) + (newline) + (newline) + (pretty-print (list t-name t t-anns)))) )