Simpler and prettier
This commit is contained in:
parent
401e3973ee
commit
5edcca1e7f
|
@ -23,59 +23,60 @@
|
||||||
(struct vertical-mode (mode item) #:transparent)
|
(struct vertical-mode (mode item) #:transparent)
|
||||||
|
|
||||||
(struct separated (items separator terminator) #: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)
|
(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))
|
(let loop ((vs vs) (need-sep #f))
|
||||||
(match vs
|
(match vs
|
||||||
['()
|
['()
|
||||||
(when need-sep (display ter (emitter-port e)))]
|
(when need-sep (display ter p))
|
||||||
|
(when cl (display cl p))]
|
||||||
[(cons v vs)
|
[(cons v vs)
|
||||||
(when need-sep (display sep (emitter-port e)))
|
(when need-sep (display sep p))
|
||||||
(emit* v e indent mode)
|
(emit* v e indent mode)
|
||||||
(loop vs #t)])))
|
(loop vs #t)])))
|
||||||
|
|
||||||
(define (emit-vertical print-indent-if-vertical? vs sep ter e indent mode)
|
(define (emit-vertical op vs sep ter cl e indent mode)
|
||||||
(when print-indent-if-vertical? (display indent (emitter-port e)))
|
(define inner-indent (if op (string-append indent (emitter-indentation e)) indent))
|
||||||
(emit-seq vs (string-append (trim-delimiter sep) indent) (trim-delimiter ter) e indent mode))
|
(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]+"))
|
(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
|
(call-with-output-string
|
||||||
(lambda (p)
|
(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
|
(match mode
|
||||||
['never (emit-seq vs sep ter e indent mode) #f]
|
['never (emit-seq op vs sep ter cl e indent mode)]
|
||||||
['variable (let ((s (try-horizontal vs sep ter e indent mode)))
|
['variable (let ((s (try-horizontal op vs sep ter cl e indent mode)))
|
||||||
(if (> (string-length s) (pretty-print-columns))
|
(if (> (string-length s) (pretty-print-columns))
|
||||||
(begin (emit-vertical print-indent-if-vertical? vs sep ter e indent mode) #t)
|
(emit-vertical op vs sep ter cl e indent mode)
|
||||||
(begin (display s (emitter-port e)) #f)))]
|
(display s (emitter-port e))))]
|
||||||
['always (emit-vertical print-indent-if-vertical? vs sep ter e indent mode) #t]
|
['always (emit-vertical op vs sep ter cl e indent mode)]
|
||||||
['extra-newline (emit-vertical print-indent-if-vertical?
|
['extra-newline (let ((sep (string-append sep "\n")))
|
||||||
vs
|
(emit-vertical op vs sep ter cl e indent mode))]))
|
||||||
(and sep (string-append sep "\n"))
|
|
||||||
ter
|
|
||||||
e
|
|
||||||
indent
|
|
||||||
mode) #t]))
|
|
||||||
|
|
||||||
(define (emit* v e indent mode)
|
(define (emit* v e indent mode)
|
||||||
(define (w v) (emit* v e indent mode))
|
(define (w v) (emit* v e indent mode))
|
||||||
(match v
|
(match v
|
||||||
[(? string? s) (display s (emitter-port e))]
|
[(? string? s) (display s (emitter-port e))]
|
||||||
[(? list? vs) (map w vs)]
|
[(? list? vs) (map w vs)]
|
||||||
[(grouped vs sep ter op cl)
|
[(separated vs sep ter) (emit-separated #f vs sep ter #f e indent mode)]
|
||||||
(display op (emitter-port e))
|
[(grouped vs sep ter op cl) (emit-separated op vs sep ter cl e indent mode)]
|
||||||
(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)]
|
|
||||||
[(vertical-mode new-mode v) (emit* v e indent new-mode)]))
|
[(vertical-mode new-mode v) (emit* v e indent new-mode)]))
|
||||||
|
|
||||||
(define (emit v [o (current-output-port)]
|
(define (emit v [o (current-output-port)]
|
||||||
|
|
|
@ -7,6 +7,7 @@
|
||||||
preserve->pexpr
|
preserve->pexpr
|
||||||
|
|
||||||
write-pexpr
|
write-pexpr
|
||||||
|
write-pexprs
|
||||||
|
|
||||||
COMMA
|
COMMA
|
||||||
SEMICOLON
|
SEMICOLON
|
||||||
|
@ -231,34 +232,34 @@
|
||||||
[v v])))
|
[v v])))
|
||||||
|
|
||||||
(define (write-pexpr v0 [o (current-output-port)]
|
(define (write-pexpr v0 [o (current-output-port)]
|
||||||
#:indent [indent-amount0 4]
|
#:outer-sequence? [outer-sequence? #f]
|
||||||
#:encode-embedded [encode-embedded0 #f]
|
#:indent [indent-amount 4]
|
||||||
|
#:encode-embedded [encode-embedded #f]
|
||||||
#:write-annotations? [write-annotations? #t])
|
#:write-annotations? [write-annotations? #t])
|
||||||
(local-require "block-write.rkt")
|
(local-require "block-write.rkt")
|
||||||
(local-require "write-text.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 (convert-inner vs)
|
||||||
(define (finish-span span spans)
|
(define (finish-span span spans)
|
||||||
(if (null? span)
|
(if (null? span)
|
||||||
spans
|
spans
|
||||||
(cons (reverse 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 '()))
|
(let loop ((es (map convert vs)) (spans '()) (span '()))
|
||||||
(match es
|
(match es
|
||||||
['() (reverse (finish-span span spans))]
|
['() (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 (finish-span (cons "," span) spans) '())]
|
[(cons "," more) (loop more (finish-span (cons "," span) spans) '())]
|
||||||
[(cons ":" more) (loop more spans (cons ":" span))]
|
[(cons ":" more) (loop more spans (cons ":" span))]
|
||||||
[(cons (? string? (? colons? s)) (cons (? string? (? colons? e)) more))
|
[(cons (? string? s) more) (loop more spans (cons s (space span)))]
|
||||||
(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 (? separated? e) more) (loop more (finish-span span spans) (list e))]
|
[(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))])))
|
[(cons e more) (loop more spans (cons e span))])))
|
||||||
|
|
||||||
(define (convert v)
|
(define (convert v)
|
||||||
|
@ -275,11 +276,25 @@
|
||||||
[(? list? ps) (grouped (convert-inner ps) " " "" "[" "]")]
|
[(? list? ps) (grouped (convert-inner ps) " " "" "[" "]")]
|
||||||
[(RECORD ps ...) (grouped (convert-inner ps) " " "" "<" ">")]
|
[(RECORD ps ...) (grouped (convert-inner ps) " " "" "<" ">")]
|
||||||
[(GROUP ps ...) (grouped (convert-inner ps) " " "" "(" ")")]
|
[(GROUP ps ...) (grouped (convert-inner ps) " " "" "(" ")")]
|
||||||
[(BLOCK ps ...) (grouped (convert-inner ps) " " "" "{" "}")]
|
[(BLOCK ps ...) (grouped (convert-inner ps) " " "" "{ " " }")]
|
||||||
[(SET ps ...) (grouped (convert-inner ps) " " "" "#{" "}")]
|
[(SET ps ...) (grouped (convert-inner ps) " " "" "#{ " " }")]
|
||||||
[(TRAILER-ANCHOR) ""]
|
[(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)]
|
[(strip-annotations (record 'p (list s))) (symbol->string s)]
|
||||||
[v (preserve->string v)]))
|
[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?))
|
||||||
|
|
|
@ -17,5 +17,99 @@
|
||||||
ENDDOC
|
ENDDOC
|
||||||
)
|
)
|
||||||
|
|
||||||
(parameterize ((pretty-print-columns 80)) (write-pexpr (string->pexprs P #:read-syntax? #t)) (newline))
|
(define Q #<<ENDDOC
|
||||||
(parameterize ((pretty-print-columns 10)) (write-pexpr (string->pexprs P #:read-syntax? #t)) (newline))
|
{
|
||||||
|
setUp();
|
||||||
|
# Now enter the loop
|
||||||
|
loop: {
|
||||||
|
greet("World");
|
||||||
|
}
|
||||||
|
tearDown();
|
||||||
|
}
|
||||||
|
ENDDOC
|
||||||
|
)
|
||||||
|
|
||||||
|
(define R #<<ENDDOC
|
||||||
|
define ?ds (newDataspace);
|
||||||
|
|
||||||
|
define ?space (subspace (?ds: $ds) {
|
||||||
|
$ds ::= 999;
|
||||||
|
|
||||||
|
print {
|
||||||
|
1: 2,
|
||||||
|
3: 4,
|
||||||
|
};
|
||||||
|
|
||||||
|
print <record 1 2 3 +>;
|
||||||
|
|
||||||
|
$ds during ?a {
|
||||||
|
onStop print <retracted $a>;
|
||||||
|
print <asserted $a>;
|
||||||
|
}
|
||||||
|
|
||||||
|
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 <message $x>;
|
||||||
|
snapshot $space (
|
||||||
|
?outcome:
|
||||||
|
# TODO: save outcome?
|
||||||
|
printFlat <post-snap $outcome>;
|
||||||
|
unpause $space;
|
||||||
|
turn $root (: $ds ::= =ready2);
|
||||||
|
)
|
||||||
|
$ds ::= =ready1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
ENDDOC
|
||||||
|
)
|
||||||
|
|
||||||
|
(define S #<<ENDDOC
|
||||||
|
# SPDX-License-Identifier: GPL-3.0-or-later
|
||||||
|
# SPDX-FileCopyrightText: Copyright © 2016-2023 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||||||
|
|
||||||
|
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))
|
||||||
|
|
Loading…
Reference in New Issue