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

Fixed arrows in DrRacket, fixed bug with empty || identifier

Browse Source
This commit is contained in:
Georges Dupéron 2017-02-04 07:45:01 +01:00
parent 62b5459e05
commit 0410d1eb07
2 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
private/subscripts.rkt
View File

@ -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?]

11
private/template-subscripts.rkt
View File

@ -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)