From 5edcca1e7f331b384ad18eaf20ff0cd0e72e6025 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Tue, 7 Nov 2023 20:54:01 +0100 Subject: [PATCH] Simpler and prettier --- .../preserves/preserves/block-write.rkt | 59 +++++------ .../racket/preserves/preserves/pexprs.rkt | 47 ++++++--- .../preserves/preserves/tests/test-pexprs.rkt | 98 ++++++++++++++++++- 3 files changed, 157 insertions(+), 47 deletions(-) diff --git a/implementations/racket/preserves/preserves/block-write.rkt b/implementations/racket/preserves/preserves/block-write.rkt index 0500c99..8101e94 100644 --- a/implementations/racket/preserves/preserves/block-write.rkt +++ b/implementations/racket/preserves/preserves/block-write.rkt @@ -23,59 +23,60 @@ (struct vertical-mode (mode item) #:transparent) (struct separated (items separator terminator) #:transparent) -(struct grouped separated (opener closer) #:transparent) +(struct grouped (items separator terminator opener closer) #:transparent) (struct emitter (port indentation) #:transparent) -(define (emit-seq vs sep ter e indent mode) +(define (emit-seq op vs sep ter cl e indent mode) + (define p (emitter-port e)) + (when op (display op p)) (let loop ((vs vs) (need-sep #f)) (match vs ['() - (when need-sep (display ter (emitter-port e)))] + (when need-sep (display ter p)) + (when cl (display cl p))] [(cons v vs) - (when need-sep (display sep (emitter-port e))) + (when need-sep (display sep p)) (emit* v e indent mode) (loop vs #t)]))) -(define (emit-vertical print-indent-if-vertical? vs sep ter e indent mode) - (when print-indent-if-vertical? (display indent (emitter-port e))) - (emit-seq vs (string-append (trim-delimiter sep) indent) (trim-delimiter ter) e indent mode)) +(define (emit-vertical op vs sep ter cl e indent mode) + (define inner-indent (if op (string-append indent (emitter-indentation e)) indent)) + (let ((sep (string-append (trim-delimiter-right sep) inner-indent)) + (ter (trim-delimiter-right ter)) + (op (and op (string-append (trim-delimiter-right op) inner-indent))) + (cl (and cl (string-append indent (trim-delimiter-left cl))))) + (emit-seq op vs sep ter cl e inner-indent mode))) -(define (trim-delimiter s) +(define (trim-delimiter-right s) (string-trim #:left? #f s #px"[ \t\f\v]+")) -(define (try-horizontal vs sep ter e indent mode) +(define (trim-delimiter-left s) + (string-trim #:right? #f s #px"[ \t\f\v]+")) + +(define (try-horizontal op vs sep ter cl e indent mode) (call-with-output-string (lambda (p) - (emit-seq vs sep ter (emitter p (emitter-indentation e)) indent 'never)))) + (emit-seq op vs sep ter cl (emitter p (emitter-indentation e)) indent 'never)))) -(define (emit-separated print-indent-if-vertical? vs sep ter e indent mode) +(define (emit-separated op vs sep ter cl e indent mode) (match mode - ['never (emit-seq vs sep ter e indent mode) #f] - ['variable (let ((s (try-horizontal vs sep ter e indent mode))) + ['never (emit-seq op vs sep ter cl e indent mode)] + ['variable (let ((s (try-horizontal op vs sep ter cl e indent mode))) (if (> (string-length s) (pretty-print-columns)) - (begin (emit-vertical print-indent-if-vertical? vs sep ter e indent mode) #t) - (begin (display s (emitter-port e)) #f)))] - ['always (emit-vertical print-indent-if-vertical? vs sep ter e indent mode) #t] - ['extra-newline (emit-vertical print-indent-if-vertical? - vs - (and sep (string-append sep "\n")) - ter - e - indent - mode) #t])) + (emit-vertical op vs sep ter cl e indent mode) + (display s (emitter-port e))))] + ['always (emit-vertical op vs sep ter cl e indent mode)] + ['extra-newline (let ((sep (string-append sep "\n"))) + (emit-vertical op vs sep ter cl e indent mode))])) (define (emit* v e indent mode) (define (w v) (emit* v e indent mode)) (match v [(? string? s) (display s (emitter-port e))] [(? list? vs) (map w vs)] - [(grouped vs sep ter op cl) - (display op (emitter-port e)) - (when (emit-separated #t vs sep ter e (string-append indent (emitter-indentation e)) mode) - (display indent (emitter-port e))) - (display cl (emitter-port e))] - [(separated vs sep ter) (emit-separated #f vs sep ter e indent mode)] + [(separated vs sep ter) (emit-separated #f vs sep ter #f e indent mode)] + [(grouped vs sep ter op cl) (emit-separated op vs sep ter cl e indent mode)] [(vertical-mode new-mode v) (emit* v e indent new-mode)])) (define (emit v [o (current-output-port)] diff --git a/implementations/racket/preserves/preserves/pexprs.rkt b/implementations/racket/preserves/preserves/pexprs.rkt index ff14356..e8016d8 100644 --- a/implementations/racket/preserves/preserves/pexprs.rkt +++ b/implementations/racket/preserves/preserves/pexprs.rkt @@ -7,6 +7,7 @@ preserve->pexpr write-pexpr + write-pexprs COMMA SEMICOLON @@ -231,34 +232,34 @@ [v v]))) (define (write-pexpr v0 [o (current-output-port)] - #:indent [indent-amount0 4] - #:encode-embedded [encode-embedded0 #f] + #:outer-sequence? [outer-sequence? #f] + #:indent [indent-amount 4] + #:encode-embedded [encode-embedded #f] #:write-annotations? [write-annotations? #t]) (local-require "block-write.rkt") (local-require "write-text.rkt") - (local-require (only-in racket/string string-prefix?)) + + (define (space span) + (if (null? span) + '() + (cons " " span))) (define (convert-inner vs) (define (finish-span span spans) (if (null? span) spans (cons (reverse span) spans))) - (define (colons? s) - (string-prefix? s ":")) - (define (starts-with-delimiter? s) - (and (not (zero? (string-length s))) - (preserves-delimiter? (string-ref s 0)))) (let loop ((es (map convert vs)) (spans '()) (span '())) (match es ['() (reverse (finish-span span spans))] [(cons ";" more) (loop more (finish-span (cons ";" span) spans) '())] [(cons "," more) (loop more (finish-span (cons "," span) spans) '())] [(cons ":" more) (loop more spans (cons ":" span))] - [(cons (? string? (? colons? s)) (cons (? string? (? colons? e)) more)) - (loop (cons e more) spans (cons " " (cons s span)))] - [(cons (? string? (? starts-with-delimiter? s)) more) (loop more spans (cons s span))] - [(cons (? string? s) more) (loop more spans (cons s (if (null? span) '() (cons " " span))))] + [(cons (? string? s) more) (loop more spans (cons s (space span)))] [(cons (? separated? e) more) (loop more (finish-span span spans) (list e))] + [(cons (and e (grouped _ _ _ "{ " " }")) more) (loop more (finish-span (cons e (space span)) spans) '())] + [(cons (and e (grouped _ _ _ "<" ">")) more) (loop more spans (cons e (space span)))] + [(cons (and e (grouped _ _ _ "[" "]")) more) (loop more spans (cons e (space span)))] [(cons e more) (loop more spans (cons e span))]))) (define (convert v) @@ -275,11 +276,25 @@ [(? list? ps) (grouped (convert-inner ps) " " "" "[" "]")] [(RECORD ps ...) (grouped (convert-inner ps) " " "" "<" ">")] [(GROUP ps ...) (grouped (convert-inner ps) " " "" "(" ")")] - [(BLOCK ps ...) (grouped (convert-inner ps) " " "" "{" "}")] - [(SET ps ...) (grouped (convert-inner ps) " " "" "#{" "}")] + [(BLOCK ps ...) (grouped (convert-inner ps) " " "" "{ " " }")] + [(SET ps ...) (grouped (convert-inner ps) " " "" "#{ " " }")] [(TRAILER-ANCHOR) ""] - [(embedded v) (list "#!" (convert (encode-embedded0 v)))] + [(embedded v) (list "#!" (convert (encode-embedded v)))] [(strip-annotations (record 'p (list s))) (symbol->string s)] [v (preserve->string v)])) - (emit (convert v0) o #:indentation indent-amount0)) + (emit (if outer-sequence? + (separated (convert-inner v0) " " "") + (convert v0)) + o + #:indentation indent-amount)) + +(define (write-pexprs vs [o (current-output-port)] + #:indent [indent-amount 4] + #:encode-embedded [encode-embedded #f] + #:write-annotations? [write-annotations? #t]) + (write-pexpr vs o + #:outer-sequence? #t + #:indent indent-amount + #:encode-embedded encode-embedded + #:write-annotations? write-annotations?)) diff --git a/implementations/racket/preserves/preserves/tests/test-pexprs.rkt b/implementations/racket/preserves/preserves/tests/test-pexprs.rkt index f5346a0..412d954 100644 --- a/implementations/racket/preserves/preserves/tests/test-pexprs.rkt +++ b/implementations/racket/preserves/preserves/tests/test-pexprs.rkt @@ -17,5 +17,99 @@ ENDDOC ) -(parameterize ((pretty-print-columns 80)) (write-pexpr (string->pexprs P #:read-syntax? #t)) (newline)) -(parameterize ((pretty-print-columns 10)) (write-pexpr (string->pexprs P #:read-syntax? #t)) (newline)) +(define Q #<; + + $ds during ?a { + onStop print ; + print ; + } + + spawn { + define ?root (currentFacet); + $ds during =ready1 { + $ds .= 123; + $ds during =ready2 { + $ds .= 123.5; + stop $root; + } + $ds ::= 234; + } + + spawn { + print "hi there"; + } + } +}); + +spawn { + define ?root (currentFacet); + $ds on message ?x { + print ; + snapshot $space ( + ?outcome: + # TODO: save outcome? + printFlat ; + unpause $space; + turn $root (: $ds ::= =ready2); + ) + $ds ::= =ready1; + } +} +ENDDOC + ) + +(define S #< + +import { SyndicateRollup } from "../../rollup.js"; +const r = new SyndicateRollup("syndicate", { globalName: "Syndicate" }); +export default [ + r.config("lib/index.js", r.umd, { + output: { + globals: { + "crypto": "crypto", + }, + }, + }), + r.config("lib/index.js", r.es6, { + resolve: { + moduleDirectories: ["stubs", "node_modules"], + }, + }), +]; +ENDDOC + ) + +(parameterize ((pretty-print-columns 80)) (write-pexprs (string->pexprs P #:read-syntax? #t)) (newline)) +(parameterize ((pretty-print-columns 10)) (write-pexprs (string->pexprs P #:read-syntax? #t)) (newline)) + +(parameterize ((pretty-print-columns 80)) (write-pexprs (string->pexprs Q #:read-syntax? #t)) (newline)) +(parameterize ((pretty-print-columns 10)) (write-pexprs (string->pexprs Q #:read-syntax? #t)) (newline)) + +(parameterize ((pretty-print-columns 40)) (write-pexprs (string->pexprs R #:read-syntax? #t)) (newline)) + +(parameterize ((pretty-print-columns 40)) (write-pexprs (string->pexprs S #:read-syntax? #t)) (newline))