fix the handling of subscripts and superscripts

the previous version didn't work right if there was a ^ in the name of the non-terminal

Author: rfindler

redex-pict-lib/redex/private/core-layout.rkt

@@ -777,25 +777,38 @@
                                ((current-text) (if (string? atom) atom (format "~a" atom))
                                                pink-code-font
                                                (default-font-size)))))]
-      [(and (symbol? atom)
-            (not (equal? atom '_))
-            (regexp-match #rx"^([^_^]*)_([^^]*)\\^?(.*)$" (symbol->string atom)))
-       =>
-       (match-lambda
-           [(list _ nt sub sup)
-            (let* ([sub-pict (if (regexp-match? #rx"^′+$" sub)
-                                 (basic-text sub (non-terminal-style))
-                                 (basic-text sub (non-terminal-subscript-style)))]
-                   [sup-pict (basic-text sup (non-terminal-superscript-style))]
-                   [sub+sup (lbl-superimpose sub-pict sup-pict)])
-              (list (non-terminal->token col span nt)
-                    (make-pict-token (+ col span) 0 sub+sup)))])]
-      [(or (memq atom all-nts)
-           (memq atom underscore-allowed))
-       (list (non-terminal->token col span (symbol->string atom)))]
       [(symbol? atom)
-       (list (or (rewrite-atomic col span atom literal-style)
-                 (make-string-token col span (symbol->string atom) (literal-style))))]
+       (define (not-nt)
+         (list (or (rewrite-atomic col span atom literal-style)
+                   (make-string-token col span (symbol->string atom) (literal-style)))))
+       (define nt-m (regexp-match #rx"^([^_]*)_(.*)$" (symbol->string atom)))
+       (cond
+         [nt-m
+          (define nt-name (list-ref nt-m 1))
+          (define after-underscore (list-ref nt-m 2))
+          (define nt-name-sym (string->symbol nt-name))
+          (cond
+            [(or (memq nt-name-sym all-nts)
+                 (memq nt-name-sym underscore-allowed))
+             (define subsup-m (regexp-match #rx"^([^^]*)\\^(.*)$" after-underscore))
+             (define-values (sub sup)
+               (cond
+                 [subsup-m (values (list-ref subsup-m 1) (list-ref subsup-m 2))]
+                 [else (values after-underscore "")]))
+             (define sub-pict (if (regexp-match? #rx"^′+$" sub)
+                                  (basic-text sub (non-terminal-style))
+                                  (basic-text sub (non-terminal-subscript-style))))
+             (define sup-pict (basic-text sup (non-terminal-superscript-style)))
+             (define sub+sup (lbl-superimpose sub-pict sup-pict))
+             (list (non-terminal->token col span nt-name)
+                   (make-pict-token (+ col span) 0 sub+sup))]
+            [else
+             (not-nt)])]
+         [(or (memq atom all-nts)
+              (memq atom underscore-allowed))
+          (list (non-terminal->token col span (symbol->string atom)))]
+         [else
+          (not-nt)])]
       [(or (member atom '("(" ")" "[" "]" "{" "}"))
            ;; Typeset keywords in the same font as parentheses:
            (and (string? atom)

redex-test/redex/tests/bitmap-test.rkt

@@ -202,12 +202,24 @@
          (render-metafunction T))
        "metafunction-T.png")
 
+(define-language lang-lw-test
+  (e (e e) 
+     x
+     (λ (x) e)
+     number)
+  (v number (λ (x) e))
+  (K^ e)
+  ((x y) variable-not-otherwise-mentioned))
 ;; in this test, the `x' is italic and the 'z' is sf, since 'x' is in the grammar, and 'z' is not.
-(btest (render-lw 
-        lang 
+(btest (render-lw
+        lang-lw-test
         (to-lw ((λ (x) (x x))
                 (λ (z) (z z)))))
        "lw.png")
+(btest (render-lw
+        lang-lw-test
+        (to-lw (e e_1 e_′ e_′′ e_^1 K^ K^_1 )))
+       "lw2.png")
 
 (define-metafunction lang
   [(TL 1) (a