mbutterick
/
brag
1
0
Fork 0
Code Issues 3 Pull Requests 1 Projects Releases Wiki Activity

Run `resyntax` over everything

Browse Source
remotes/jackfirth/master
Jack Firth 3 years ago
parent e18a3399fe
commit 9d48ab7152
23 changed files with 380 additions and 408 deletions
Show Stats Download Patch File Download Diff File

8
codegen/flatten.rkt
Unescape Escape View File

@ -7,10 +7,10 @@
prim-rule)
(define (make-fresh-name)
(let ([n 0])
(define n 0)
(λ ()
(set! n (add1 n))
(string->symbol (format "%rule~a" n)))))
(string->symbol (format "%rule~a" n))))
(define default-fresh-name (make-fresh-name))
@ -161,10 +161,10 @@
;; Then the pattern-inference process treats them separately.
(define (pattern->hash-key a-pat)
(let loop ([x a-pat])
(let ([maybe-stx-list (syntax->list x)])
(define maybe-stx-list (syntax->list x))
(if maybe-stx-list
(cons (syntax-property x 'hide) (map loop maybe-stx-list))
(syntax->datum x)))))
(syntax->datum x))))
;; Returns true if the pattern looks primitive

5
codegen/runtime.rkt
Unescape Escape View File

@ -147,11 +147,10 @@
(lex:position-line start-pos)
(lex:position-col start-pos)
(lex:position-offset start-pos)
(if (and (number? (lex:position-offset end-pos))
(and (and (number? (lex:position-offset end-pos))
(number? (lex:position-offset start-pos)))
(- (lex:position-offset end-pos)
(lex:position-offset start-pos))
#f)))
(lex:position-offset start-pos)))))
#|
MB: the next three functions control the parse tree output.

47
parser-tools/cfg-parser.rkt
Unescape Escape View File

@ -70,13 +70,14 @@
(let loop ()
(when (ormap-all #f
(λ (nt pats)
(let ([old (bound-identifier-mapping-get nts nt)])
(let ([new (proc nt pats old)])
(if (equal? old new)
#f
(begin
(define old (bound-identifier-mapping-get nts nt))
(define new (proc nt pats old))
(cond
[(equal? old new)
#f]
[else
(bound-identifier-mapping-put! nts nt new)
#t)))))
#t]))
nt-ids patss)
(loop))))
@ -334,13 +335,11 @@
null))
#,(loop (cdr pat) (add1 pos)))))
stream last-consumed-token depth
#,(let ([cnt (apply +
(map (λ (item)
#,(let ([cnt (for/sum ([item (in-list (cdr pat))])
(cond
[(bound-identifier-mapping-get nts item (λ () #f))
=> (λ (l) (car l))]
[else 1]))
(cdr pat)))])
[else 1]))])
#`(- end #,cnt))
success-k fail-k max-depth tasks)]
[else
@ -523,21 +522,21 @@
(nt-fixpoint
nts
(λ (nt pats old-list)
(let ([new-cnt
(define new-cnt
(apply min (for/list ([pat (in-list pats)])
(for/sum ([elem (in-list pat)])
(car (bound-identifier-mapping-get
nts elem (λ () (list 1)))))))])
nts elem (λ () (list 1))))))))
(if (new-cnt . > . (car old-list))
(cons new-cnt (cdr old-list))
old-list)))
old-list))
nt-ids patss)
;; Compute set of toks that must appear at the beginning
;; for a non-terminal
(nt-fixpoint
nts
(λ (nt pats old-list)
(let ([new-list
(define new-list
(apply
append
(for/list ([pat (in-list pats)])
@ -555,24 +554,24 @@
(if (zero? (car l))
(append (cdr l) (loop (cdr pat)))
(cdr l)))
null))))])
(let ([new (filter (λ (id)
null)))))
(define new
(filter (λ (id)
(andmap (λ (id2)
(not (eq? id id2)))
(cdr old-list)))
new-list)])
new-list))
(if (pair? new)
;; Drop dups in new list:
(let ([new (let loop ([new new])
(if (null? (cdr new))
new
(if (ormap (λ (id)
(cond
[(null? (cdr new)) new]
[(ormap (λ (id)
(eq? (car new) id))
(cdr new))
(loop (cdr new))
(cons (car new) (loop (cdr new))))))])
(cdr new)) (loop (cdr new))]
[else (cons (car new) (loop (cdr new)))]))])
(cons (car old-list) (append new (cdr old-list))))
old-list))))
old-list))
nt-ids patss)
;; Determine left-recursive clauses:
(for-each (λ (nt pats)

4
parser-tools/lex-sre.rkt
Unescape Escape View File

@ -83,12 +83,12 @@
[(_ RANGE ...)
(let ([chars
(apply append (for/list ([r (in-list (syntax->list #'(RANGE ...)))])
(let ([x (syntax-e r)])
(define x (syntax-e r))
(cond
[(char? x) (list x)]
[(string? x) (string->list x)]
[else
(raise-syntax-error #f "not a char or string" stx r)]))))])
(raise-syntax-error #f "not a char or string" stx r)])))])
(unless (even? (length chars))
(raise-syntax-error #f "not given an even number of characters" stx))
#`(/-only-chars #,@chars))]))

10
parser-tools/lex.rkt
Unescape Escape View File

@ -127,7 +127,7 @@
[(ACT ...) (map (λ (a) (wrap-action a src-loc-style)) acts)]
[(ACT-NAME ...) (vector->list action-names)]
[SPEC-ACT-STX (wrap-action spec-act src-loc-style)]
[HAS-COMMENT-ACT?-STX (if (syntax-e spec-comment-act) #t #f)]
[HAS-COMMENT-ACT?-STX (and (syntax-e spec-comment-act) #t)]
[SPEC-COMMENT-ACT-STX (wrap-action spec-comment-act src-loc-style)]
[EOF-ACT-STX (wrap-action eof-act src-loc-style)])
(syntax/loc stx (let ([NAME ACT] ...)
@ -200,7 +200,7 @@
(define r1 (vector-ref el 0))
(define r2 (vector-ref el 1))
(cond
[(and (>= char r1) (<= char r2)) (vector-ref el 2)]
[(<= r1 char r2) (vector-ref el 2)]
[(< char r1) (get-next-state-helper char min try table)]
[else (get-next-state-helper char (add1 try) max table)])]))
@ -351,9 +351,7 @@
(with-syntax ([(CHAR ...) (string->list (syntax-e #'STR))])
#'(union CHAR ...))]))
(define-syntax provide-lex-keyword
(syntax-rules ()
[(_ ID ...)
(define-syntax-rule (provide-lex-keyword ID ...)
(begin
(define-syntax-parameter ID
(make-set!-transformer
@ -363,6 +361,6 @@
(format "use of a lexer keyword (~a) is not in an appropriate lexer action" 'ID)
stx))))
...
(provide ID ...))]))
(provide ID ...)))
(provide-lex-keyword start-pos end-pos lexeme lexeme-srcloc input-port return-without-pos return-without-srcloc)

8
parser-tools/private-lex/deriv.rkt
Unescape Escape View File

@ -279,14 +279,12 @@
(printf "number of states: ~a\n" (dfa-num-states x))
(printf "start state: ~a\n" (dfa-start-state x))
(printf "final states: ~a\n" (map car (dfa-final-states/actions x)))
(for-each (λ (trans)
(for ([trans (in-list (dfa-transitions x))])
(printf "state: ~a\n" (car trans))
(for-each (λ (rule)
(for ([rule (in-list (cdr trans))])
(printf " -~a-> ~a\n"
(is:integer-set-contents (car rule))
(cdr rule)))
(cdr trans)))
(dfa-transitions x)))
(cdr rule)))))
(define (build-test-dfa rs)
(define c (make-cache))

8
parser-tools/private-lex/front.rkt
Unescape Escape View File

@ -10,12 +10,10 @@
(provide build-lexer)
(define-syntax time-label
(syntax-rules ()
((_ l e ...)
(define-syntax-rule (time-label l e ...)
(begin
(printf "~a: " l)
(time (begin e ...))))))
(time (begin e ...))))
;; A table is either
;; - (vector-of (union #f nat))
@ -89,7 +87,7 @@
(vector-set! no-look (car trans) #f))
no-look)
(test-block ((d1 (dfa 1 1 (list) (list)))
(test-block ((d1 (dfa 1 1 '() '()))
(d2 (dfa 4 1 (list (cons 2 2) (cons 3 3))
(list (cons 1 (list (cons (is:make-range 49 50) 1)
(cons (is:make-range 51) 2)))

9
parser-tools/private-lex/re.rkt
Unescape Escape View File

@ -81,7 +81,8 @@
[`(intersection ,rs ...)
(build-and (flatten-res (map (λ (r) (->re r cache)) rs)
andR? andR-res (λ (a b)
(let-values (((i _ __) (loc:split a b))) i))
(define-values (i _ __) (loc:split a b))
i)
cache)
cache)]
[`(complement ,r) (build-neg (->re r cache) cache)]
@ -316,9 +317,9 @@
orR? orR-res is:union c))))
(isc (is:make-range (char->integer #\1) (char->integer #\7))))
((flatten-res `(,r1 ,r2) andR? andR-res (λ (x y)
(let-values (((i _ __)
(is:split x y)))
i))
(define-values (i _ __)
(is:split x y))
i)
c)
(list z)))

16
parser-tools/private-lex/stx.rkt
Unescape Escape View File

@ -36,12 +36,12 @@
(let loop ([stx stx]
;; seen-lex-abbrevs: id-table
[seen-lex-abbrevs (make-immutable-free-id-table)])
(let ([recur (λ (s)
(define (recur s)
(loop (syntax-rearm s stx)
seen-lex-abbrevs))]
[recur/abbrev (λ (s id)
seen-lex-abbrevs))
(define (recur/abbrev s id)
(loop (syntax-rearm s stx)
(free-id-table-set seen-lex-abbrevs id id)))])
(free-id-table-set seen-lex-abbrevs id id)))
(syntax-case (disarm stx) (repetition union intersection complement concatenation
char-range char-complement)
[_
@ -92,11 +92,11 @@
(let ((arg-list (syntax->list #'(ARG ...))))
(unless (= 2 (length arg-list))
(bad-args stx 2))
(let ([i1 (char-range-arg (car arg-list) stx)]
[i2 (char-range-arg (cadr arg-list) stx)])
(define i1 (char-range-arg (car arg-list) stx))
(define i2 (char-range-arg (cadr arg-list) stx))
(if (<= i1 i2)
`(char-range ,(integer->char i1) ,(integer->char i2))
(raise-syntax-error #f "the first argument does not precede or equal second argument" stx))))]
(raise-syntax-error #f "the first argument does not precede or equal second argument" stx)))]
[(char-complement ARG ...)
(let ([arg-list (syntax->list #'(ARG ...))])
(unless (= 1 (length arg-list))
@ -115,7 +115,7 @@
(raise-syntax-error 'regular-expression "not a lex-trans" stx)]
[else
(raise-syntax-error 'regular-expression "undefined operator" stx)])))
[_ (raise-syntax-error 'regular-expression "not a char, string, identifier, or (op args ...)" stx)]))))
[_ (raise-syntax-error 'regular-expression "not a char, string, identifier, or (op args ...)" stx)])))

9
parser-tools/private-lex/util.rkt
Unescape Escape View File

@ -32,12 +32,9 @@
;; returned.
;; Xs are compared with equal?
(define (make-cache)
(let ([table (make-hash)])
(define table (make-hash))
(λ (key build)
(hash-ref table key (λ ()
(let ([new (build)])
(hash-set! table key new)
new))))))
(hash-ref! table key build)))
(module+ test
(define cache (make-cache))
@ -94,7 +91,7 @@
;; Sorts l according to index and removes the entries with duplicate
;; indexes.
(define (do-simple-equiv l index)
(define ordered (sort l (λ (a b) (< (index a) (index b)))))
(define ordered (sort l < #:key index))
(remove-dups ordered index null))
(module+ test

6
parser-tools/private-yacc/grammar.rkt
Unescape Escape View File

@ -88,11 +88,11 @@
;; print-item: LR-item ->
(define (item->string it)
(define print-sym (λ (i)
(let ((gs (vector-ref (prod-rhs (item-prod it)) i)))
(define (print-sym i)
(define gs (vector-ref (prod-rhs (item-prod it)) i))
(cond
((term? gs) (format "~a " (term-sym gs)))
(else (format "~a " (non-term-sym gs)))))))
(else (format "~a " (non-term-sym gs)))))
(string-append
(format "~a -> " (non-term-sym (prod-lhs (item-prod it))))
(let loop ((i 0))

3
parser-tools/private-yacc/graph.rkt
Unescape Escape View File

@ -31,14 +31,13 @@
(define d (depth))
(set-N x d)
(hash-set! results x (f- x))
(for-each (λ (y)
(for ([y (in-list (edges x))])
(when (= 0 (get-N y))
(traverse y))
(hash-set! results
x
(union (f x) (f y)))
(set-N x (min (get-N x) (get-N y))))
(edges x))
(when (= d (get-N x))
(let loop ([p (pop)])
(set-N p +inf.0)

5
parser-tools/private-yacc/input-file-parser.rkt
Unescape Escape View File

@ -219,12 +219,11 @@
p
#f
(let loop ([i (sub1 (vector-length p))])
(if (>= i 0)
(and (>= i 0)
(let ([gs (vector-ref p i)])
(if (term? gs)
(term-prec gs)
(loop (sub1 i))))
#f))
(loop (sub1 i))))))
(parse-action #'PROD-RHS #'ACTION)))]
[(PROD-RHS (PREC TERM) ACTION)
(identifier? #'TERM)

23
parser-tools/private-yacc/lalr.rkt
Unescape Escape View File

@ -140,35 +140,29 @@
(printf "~a:\n" name)
(send a for-each-state
(λ (state)
(for-each
(λ (non-term)
(let ([res (f (trans-key state non-term))])
(for ([non-term (in-list (send g get-non-terms))])
(define res (f (trans-key state non-term)))
(when (not (null? res))
(printf "~a(~a, ~a) = ~a\n"
name
state
(gram-sym-symbol non-term)
(print-output res)))))
(send g get-non-terms))))
(print-output res))))))
(newline))
(define (print-input-st-prod f name a g print-output)
(printf "~a:\n" name)
(send a for-each-state
(λ (state)
(for-each
(λ (non-term)
(for-each
(λ (prod)
(let ([res (f state prod)])
(for ([non-term (in-list (send g get-non-terms))])
(for ([prod (in-list (send g get-prods-for-non-term non-term))])
(define res (f state prod))
(when (not (null? res))
(printf "~a(~a, ~a) = ~a\n"
name
(kernel-index state)
(prod-index prod)
(print-output res)))))
(send g get-prods-for-non-term non-term)))
(send g get-non-terms)))))
(print-output res))))))))
(define (print-output-terms r)
(map gram-sym-symbol r))
@ -232,12 +226,11 @@
(let ([d (depth)])
(set-N x d)
(set-f x (f- x))
(for-each (λ (y)
(for ([y (in-list (edges x))])
(when (= 0 (get-N y))
(traverse y))
(set-f x (bitwise-ior (get-f x) (get-f y)))
(set-N x (min (get-N x) (get-N y))))
(edges x))
(when (= d (get-N x))
(let loop ([p (pop)])
(set-N p +inf.0)

8
parser-tools/private-yacc/lr0.rkt
Unescape Escape View File

@ -30,13 +30,13 @@
(cond
[(null? sorted) null]
[(null? (cdr sorted)) sorted]
[else
(if (and (= (non-term-index (trans-key-gs (car sorted)))
[(and (= (non-term-index (trans-key-gs (car sorted)))
(non-term-index (trans-key-gs (cadr sorted))))
(= (kernel-index (trans-key-st (car sorted)))
(kernel-index (trans-key-st (cadr sorted)))))
(loop (cdr sorted))
(cons (car sorted) (loop (cdr sorted))))])))
(loop (cdr sorted))]
[else
(cons (car sorted) (loop (cdr sorted)))])))
;; build-transition-table : int (listof (cons/c trans-key X) ->

14
parser-tools/private-yacc/table.rkt
Unescape Escape View File

@ -147,13 +147,13 @@
(define RR-conflicts 0)
(define table (table-map
(λ (gs actions)
(let-values ([(action SR? RR?)
(resolve-conflict actions)])
(define-values (action SR? RR?)
(resolve-conflict actions))
(when SR?
(set! SR-conflicts (add1 SR-conflicts)))
(when RR?
(set! RR-conflicts (add1 RR-conflicts)))
action))
action)
grouped-table))
(unless suppress
(when (> SR-conflicts 0)
@ -237,15 +237,11 @@
(bit-vector-for-each
(λ (term-index)
(unless (start-item? item)
(let ((r (hash-ref reduce-cache item-prod
(λ ()
(let ((r (reduce item-prod)))
(hash-set! reduce-cache item-prod r)
r)))))
(define r (hash-ref! reduce-cache item-prod (λ () (reduce item-prod))))
(table-add! table
(kernel-index state)
(vector-ref term-vector term-index)
r))))
r)))
(get-lookahead state item-prod))))))
(define grouped-table (resolve-prec-conflicts table))

4
parser-tools/yacc-to-scheme.rkt
Unescape Escape View File

@ -115,8 +115,8 @@
(begin0
(let ([gram ((parse-grammar enter-term enter-empty-term enter-non-term)
(λ ()
(let ((t (get-token-grammar i)))
t)))])
(define t (get-token-grammar i))
t))])
`(begin
(define-tokens t ,(sort (hash-map terms (λ (k v) k)) symbol<?))
(define-empty-tokens et ,(sort (hash-map eterms (λ (k v) k)) symbol<?))

30
parser-tools/yacc.rkt
Unescape Escape View File

@ -78,14 +78,14 @@
(for ([sym (in-list symbols)]
#:unless (identifier? sym))
(raise-syntax-error #f "End token must be a symbol" stx sym))
(let ([d (duplicate-list? (map syntax-e symbols))])
(define d (duplicate-list? (map syntax-e symbols)))
(when d
(raise-syntax-error #f (format "Duplicate end token definition for ~a" d) stx arg))
(when (null? symbols)
(raise-syntax-error #f "end declaration must contain at least 1 token" stx arg))
(when end
(raise-syntax-error #f "Multiple end declarations" stx))
(set! end symbols)))]
(set! end symbols))]
[(precs DECLS ...)
(if precs
(raise-syntax-error #f "Multiple precs declarations" stx)
@ -113,7 +113,7 @@
(raise-syntax-error #f "missing end declaration" stx))
(unless start
(raise-syntax-error #f "missing start declaration" stx))
(let-values ([(table all-term-syms actions check-syntax-fix)
(define-values (table all-term-syms actions check-syntax-fix)
(build-parser (if debug debug "")
src-pos
suppress
@ -121,7 +121,7 @@
start
end
precs
grammar)])
grammar))
(when (and yacc-output (not (string=? yacc-output "")))
(with-handlers [(exn:fail:filesystem?
(λ (e) (eprintf "Cannot write yacc-output to file \"~a\"\n" yacc-output)))]
@ -144,7 +144,7 @@
[src-pos src-pos])
#'(begin
check-syntax-fix
(parser-body debug err (quote starts) (quote ends) table all-term-syms actions src-pos)))))]
(parser-body debug err (quote starts) (quote ends) table all-term-syms actions src-pos))))]
[_ (raise-syntax-error #f "parser must have the form (parser args ...)" stx)]))
(define (reduce-stack stack num ret-vals src-pos)
@ -237,11 +237,9 @@
stack)]
[else
;; (printf "discard input:~a\n" tok)
(let-values ([(tok val start-pos end-pos)
(extract (get-token))])
(remove-input tok val start-pos end-pos))])))))
(call-with-values (λ () (extract (get-token))) remove-input)])))))
(let remove-states ()
(let ([a (find-action stack 'error #f start-pos end-pos)])
(define a (find-action stack 'error #f start-pos end-pos))
(cond
[(runtime-shift? a)
;; (printf "shift:~a\n" (runtime-shift-state a))
@ -261,7 +259,7 @@
#f #f #f #f #f)]
[else
(set! stack (cdr stack))
(remove-states)])])))))
(remove-states)])]))))
(define (find-action stack tok val start-pos end-pos)
(unless (hash-ref all-term-syms tok #f)
@ -278,8 +276,8 @@
(error 'get-token "expected a nullary procedure, got ~e" get-token))
(let parsing-loop ([stack (make-empty-stack start-number)]
[ip (get-token)])
(let-values ([(tok val start-pos end-pos) (extract ip)])
(let ([action (find-action stack tok val start-pos end-pos)])
(define-values (tok val start-pos end-pos) (extract ip))
(define action (find-action stack tok val start-pos end-pos))
(cond
[(runtime-shift? action)
;; (printf "shift:~a\n" (runtime-shift-state action))
@ -296,11 +294,11 @@
(runtime-reduce-rhs-length action)
null
src-pos)])
(let ([goto
(define goto
(runtime-goto-state
(hash-ref
(vector-ref table (stack-frame-state (car new-stack)))
(runtime-reduce-lhs action)))])
(runtime-reduce-lhs action))))
(parsing-loop
(cons
(if src-pos
@ -317,7 +315,7 @@
#f
#f))
new-stack)
ip)))]
ip))]
[(runtime-accept? action)
;; (printf "accept\n")
(stack-frame-value (car stack))]
@ -326,7 +324,7 @@
(err #t tok val start-pos end-pos)
(err #t tok val))
(parsing-loop (fix-error stack tok val start-pos end-pos get-token)
(get-token))]))))))
(get-token))]))))
(cond
[(null? (cdr starts)) (make-parser 0)]
[else

4
private/colorer.rkt
Unescape Escape View File

@ -38,8 +38,8 @@
(define-syntax-rule (values->list EXPR) (call-with-values (λ () EXPR) list))
(define (apply-colorer str)
(for/list ([annotation (in-port (λ (p)
(let ([xs (values->list (color-brag p))])
(if (eof-object? (car xs)) eof xs)))
(define xs (values->list (color-brag p)))
(if (eof-object? (car xs)) eof xs))
(open-input-string str))])
annotation))

7
rules/parser.rkt
Unescape Escape View File

@ -169,7 +169,7 @@
[(list all min range? max) (let* ([min (if min (string->number min) 0)]
[max (cond
[(and range? max) (string->number max)]
[(and (not range?) (not max)) (if (zero? min)
[(not (or range? max)) (if (zero? min)
#f ; {} -> {0,}
min)] ; {3} -> {3,3}
[else #f])])
@ -298,8 +298,7 @@
(pos-line start-pos)
(pos-col start-pos)
(pos-offset start-pos)
(if (and (number? (pos-offset end-pos))
(and (and (number? (pos-offset end-pos))
(number? (pos-offset start-pos)))
(- (pos-offset end-pos)
(pos-offset start-pos))
#f))))))))
(pos-offset start-pos))))))))))

10
rules/stx.rkt
Unescape Escape View File

@ -14,21 +14,19 @@
(pos-line (lhs-id-start (rule-lhs a-rule)))
(pos-col (lhs-id-start (rule-lhs a-rule)))
(pos-offset (lhs-id-start (rule-lhs a-rule)))
(if (and (number? (pos-offset (lhs-id-start (rule-lhs a-rule))))
(and (and (number? (pos-offset (lhs-id-start (rule-lhs a-rule))))
(number? (pos-offset (lhs-id-end (rule-lhs a-rule)))))
(- (pos-offset (lhs-id-end (rule-lhs a-rule)))
(pos-offset (lhs-id-start (rule-lhs a-rule))))
#f)))
(pos-offset (lhs-id-start (rule-lhs a-rule)))))))
'hide-or-splice-lhs-id (lhs-id-splice (rule-lhs a-rule))))
(define pattern-stx (pattern->stx source (rule-pattern a-rule)))
(define line (pos-line (rule-start a-rule)))
(define column (pos-col (rule-start a-rule)))
(define position (pos-offset (rule-start a-rule)))
(define span (if (and (number? (pos-offset (rule-start a-rule)))
(define span (and (and (number? (pos-offset (rule-start a-rule)))
(number? (pos-offset (rule-end a-rule))))
(- (pos-offset (rule-end a-rule))
(pos-offset (rule-start a-rule)))
#f))
(pos-offset (rule-start a-rule)))))
(datum->syntax #f
`(rule ,id-stx ,pattern-stx)
(list source line column position span)))

4
tests/test-flatten.rkt
Unescape Escape View File

@ -8,10 +8,10 @@
(define (make-fresh-name)
(let ([n 0])
(define n 0)
(lambda ()
(set! n (add1 n))
(string->symbol (format "r~a" n)))))
(string->symbol (format "r~a" n))))
;; Simple literals

6
token.rkt
Unescape Escape View File

@ -46,16 +46,16 @@
'token
(λ (this)
(append (list (token-type this))
(if (token-value this) (list (token-value this)) (list))
(if (token-value this) (list (token-value this)) '())
(if (token-location this)
(list
(sequence-markup
(list (unquoted-printing-string "#:location") (token-location this))))
(list))
'())
(if (token-skip? this)
(list
(sequence-markup (list (unquoted-printing-string "#:skip?") (token-skip? this))))
(list))))))])
'())))))])
(define (source-location #:source [source #false]

Write Preview
Loading…
Cancel
Save