suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed the way atomic rewriters work so that non-terminals with underscores render properly

Browse Source 
svn: r15332
This commit is contained in:
Robby Findler 2009-06-30 04:18:34 +00:00
parent 5b794816c1
commit fa0f182e80
3 changed files with 20 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
collects/redex/private/bmps/language.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 5.7 KiB

After

Width:  |  Height:  |  Size: 5.7 KiB

BIN
collects/redex/private/bmps/metafunction-multi-arg.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 8.4 KiB

After

Width:  |  Height:  |  Size: 8.4 KiB

34
collects/redex/private/core-layout.ss
View File

@ -188,15 +188,6 @@
(define (ar/e e line line-span col col-span)
(cond
[(and (symbol? e) (assoc e (atomic-rewrite-table)))
=>
(λ (m)
(when (eq? (cadr m) e)
(error 'apply-rewrites "rewritten version of ~s is still ~s" e e))
(let ([p (cadr m)])
(if (procedure? p)
(p)
p)))]
[(symbol? e) e]
[(string? e) e]
[(pict? e) e]
@ -704,23 +695,38 @@
[second-part (caddr m)]
[first-span (- span (string-length first-part))])
(list
(make-string-token col
first-span
first-part
(non-terminal-style))
(non-terminal->token col first-span first-part)
(make-string-token (+ col first-span)
(- span first-span)
second-part
(non-terminal-subscript-style)))))]
[(or (memq atom all-nts)
(memq atom '(number variable variable-except variable-not-otherwise-mentioned)))
(list (make-string-token col span (format "~s" atom) (non-terminal-style)))]
(list (non-terminal->token col span (format "~s" atom)))]
[(symbol? atom)
(list (make-string-token col span (symbol->string atom) (literal-style)))]
[(string? atom)
(list (make-string-token col span atom (default-style)))]
[else (error 'atom->tokens "unk ~s" atom)]))
(define (non-terminal->token col span str)
(let ([e (string->symbol str)])
(cond
[(assoc e (atomic-rewrite-table))
=>
(λ (m)
(when (eq? (cadr m) e)
(error 'apply-rewrites "rewritten version of ~s is still ~s" e e))
(let ([p (cadr m)])
(if (procedure? p)
(make-pict-token col span (p))
(make-string-token col span p (non-terminal-style)))))]
[else
(make-string-token col
span
str
(non-terminal-style))])))
(define (pick-font lst fallback)
(let ([fl (get-face-list 'all)])
(let loop ([lst lst])