From 0410d1eb0732467c16e8dcf8135fc97a7bbd408b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Sat, 4 Feb 2017 07:45:01 +0100
Subject: [PATCH] Fixed arrows in DrRacket, fixed bug with empty || identifier

---
 private/subscripts.rkt          |  8 ++++++--
 private/template-subscripts.rkt | 11 ++++++-----
 2 files changed, 12 insertions(+), 7 deletions(-)

diff --git a/private/subscripts.rkt b/private/subscripts.rkt
index 3bd0f31..975f5db 100644
--- a/private/subscripts.rkt
+++ b/private/subscripts.rkt
@@ -1,6 +1,7 @@
 #lang racket/base
 
 (provide subscript-equal?
+         extract-subscripts
          drop-subscripts
          find-subscript-binders)
 
@@ -15,8 +16,11 @@
 
 (define/contract (extract-subscripts id)
   (-> identifier? string?)
-  (cadr (regexp-match #px".(_.+|[ₐₑₕᵢⱼₖₗₘₙₒₚᵣₛₜᵤᵥₓᵦᵧᵨᵩᵪ]*)$"
-                     (symbol->string (syntax-e id)))))
+  (let ([match (regexp-match #px".(_.+|[ₐₑₕᵢⱼₖₗₘₙₒₚᵣₛₜᵤᵥₓᵦᵧᵨᵩᵪ]*)$"
+                             (symbol->string (syntax-e id)))])
+     (if (>= (length match) 2)
+         (cadr match)
+         "")))
 
 (define/contract (string-replace* str from* to*)
   (->i ([str string?]
diff --git a/private/template-subscripts.rkt b/private/template-subscripts.rkt
index 6482003..1b5adf0 100644
--- a/private/template-subscripts.rkt
+++ b/private/template-subscripts.rkt
@@ -269,18 +269,19 @@
 
   ;; Draw arrows in DrRacket.
   (with-arrows
-   (define subscripts (subscript-equal? #'bound #'binder₀))
+   (define bound-subscripts (extract-subscripts #'bound))
+   (define binder-subscripts (extract-subscripts #'binder₀))
    (define bound-id-str (identifier->string #'bound))
    (for ([binder (in-list (syntax->list #'(binder₀ binderᵢ …)))])
      (define binder-id-str (identifier->string binder))
      (record-sub-range-binders! (vector #'bound
                                         (- (string-length bound-id-str)
-                                           (string-length subscripts))
-                                        (string-length subscripts)
+                                           (string-length bound-subscripts))
+                                        (string-length bound-subscripts)
                                         binder
                                         (- (string-length binder-id-str)
-                                           (string-length subscripts))
-                                        (string-length subscripts))))
+                                           (string-length binder-subscripts))
+                                        (string-length binder-subscripts))))
    #;(define binder0-id-str (identifier->string #'binder0))
    #;(record-sub-range-binders! (vector #'bound
                                         (- (string-length bound-id-str)