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 #lang racket/base
(provide subscript-equal? (provide subscript-equal?
extract-subscripts
drop-subscripts drop-subscripts
find-subscript-binders) find-subscript-binders)
@ -15,8 +16,11 @@
(define/contract (extract-subscripts id) (define/contract (extract-subscripts id)
(-> identifier? string?) (-> identifier? string?)
(cadr (regexp-match #px".(_.+|[ₐₑₕᵢⱼₖₗₘₙₒₚᵣₛₜᵤᵥₓᵦᵧᵨᵩᵪ]*)$" (let ([match (regexp-match #px".(_.+|[ₐₑₕᵢⱼₖₗₘₙₒₚᵣₛₜᵤᵥₓᵦᵧᵨᵩᵪ]*)$"
(symbol->string (syntax-e id))))) (symbol->string (syntax-e id)))])
(if (>= (length match) 2)
(cadr match)
"")))
(define/contract (string-replace* str from* to*) (define/contract (string-replace* str from* to*)
(->i ([str string?] (->i ([str string?]

11
private/template-subscripts.rkt
View File

@ -269,18 +269,19 @@
;; Draw arrows in DrRacket. ;; Draw arrows in DrRacket.
(with-arrows (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)) (define bound-id-str (identifier->string #'bound))
(for ([binder (in-list (syntax->list #'(binder₀ binderᵢ …)))]) (for ([binder (in-list (syntax->list #'(binder₀ binderᵢ …)))])
(define binder-id-str (identifier->string binder)) (define binder-id-str (identifier->string binder))
(record-sub-range-binders! (vector #'bound (record-sub-range-binders! (vector #'bound
(- (string-length bound-id-str) (- (string-length bound-id-str)
(string-length subscripts)) (string-length bound-subscripts))
(string-length subscripts) (string-length bound-subscripts)
binder binder
(- (string-length binder-id-str) (- (string-length binder-id-str)
(string-length subscripts)) (string-length binder-subscripts))
(string-length subscripts)))) (string-length binder-subscripts))))
#;(define binder0-id-str (identifier->string #'binder0)) #;(define binder0-id-str (identifier->string #'binder0))
#;(record-sub-range-binders! (vector #'bound #;(record-sub-range-binders! (vector #'bound
(- (string-length bound-id-str) (- (string-length bound-id-str)