From 482816bf34578b7ff4755d05701a732492fc419a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 2 Jul 2009 14:49:59 +0000 Subject: [PATCH] restore use of atomic rewriters for literals svn: r15363 --- collects/redex/private/core-layout.ss | 38 +++++++++++++++------------ 1 file changed, 21 insertions(+), 17 deletions(-) diff --git a/collects/redex/private/core-layout.ss b/collects/redex/private/core-layout.ss index 005e345b8f..16135c571f 100644 --- a/collects/redex/private/core-layout.ss +++ b/collects/redex/private/core-layout.ss @@ -704,28 +704,32 @@ (memq atom '(number variable variable-except variable-not-otherwise-mentioned))) (list (non-terminal->token col span (format "~s" atom)))] [(symbol? atom) - (list (make-string-token col span (symbol->string atom) (literal-style)))] + (list (or (rewrite-atomic col span atom) + (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 (rewrite-atomic col span e) + (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 #f])) + (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))]))) + (or (rewrite-atomic col span e) + (make-string-token col + span + str + (non-terminal-style))))) (define (pick-font lst fallback) (let ([fl (get-face-list 'all)])