suzanne.soy/debug-scopes
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

Omit sli= when not transforming

Browse Source
This commit is contained in:
Georges Dupéron 2017-02-01 07:54:29 +01:00
parent c50e014c78
commit 4c07fc08b7
1 changed files with 28 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
superscripts.rkt
View File

@ -118,29 +118,34 @@
(define (sli/use whole-stx) (define (sli/use whole-stx)
;(…)ˢˡⁱ⁼ ᵘˢᵉ⁼ ;(…)ˢˡⁱ⁼ ᵘˢᵉ⁼
;(…)ₛₗᵢ₌ ᵤₛₑ₌ ;(…)ₛₗᵢ₌ ᵤₛₑ₌
(let* ([stx (datum->syntax whole-stx 'to-id)] (if (syntax-transforming?)
[sli (syntax-local-introduce stx)] (let* ([stx (datum->syntax whole-stx 'to-id)]
[stx-ids (extract-scope-ids stx)] [sli (syntax-local-introduce stx)]
[sli-ids (extract-scope-ids sli)] [stx-ids (extract-scope-ids stx)]
[stx-slb (syntax-local-identifier-as-binding stx)] [sli-ids (extract-scope-ids sli)]
[sli-slb (syntax-local-identifier-as-binding sli)] [stx-slb (syntax-local-identifier-as-binding stx)]
[stx-binding (extract-scope-ids stx-slb)] [sli-slb (syntax-local-identifier-as-binding sli)]
[sli-binding (extract-scope-ids sli-slb)] [stx-binding (extract-scope-ids stx-slb)]
[use (append (set-symmetric-difference stx-ids stx-binding) [sli-binding (extract-scope-ids sli-slb)]
(set-symmetric-difference sli-ids sli-binding))] [use (append (set-symmetric-difference stx-ids stx-binding)
[stx/sli-use (set-subtract (set-symmetric-difference stx-ids sli-ids) (set-symmetric-difference sli-ids sli-binding))]
use)]) [stx/sli-use (set-subtract (set-symmetric-difference stx-ids
(format "ˢˡⁱ⁼~a⁺ᵘˢᵉ⁼~a~a" sli-ids)
(string-join (map digits->superscripts (map ~a stx/sli-use)) " ") use)])
(string-join (map digits->superscripts (map ~a use)) " ") (format "ˢˡⁱ⁼~a⁺ᵘˢᵉ⁼~a~a"
(if (sli-scopes) (string-join (map digits->superscripts (map ~a stx/sli-use))
(let* ([named ((sli-scopes) (datum->syntax #f 'zero))] " ")
[named-scope-id (extract-scope-ids named)]) (string-join (map digits->superscripts (map ~a use))
(format "⁽ⁿᵃᵐᵉᵈ⁼~a⁾" " ")
(string-join (map digits->superscripts (if (sli-scopes)
(map ~a named-scope-id)) (let* ([named ((sli-scopes) (datum->syntax #f 'zero))]
" "))) [named-scope-id (extract-scope-ids named)])
"")))) (format "⁽ⁿᵃᵐᵉᵈ⁼~a⁾"
(string-join (map digits->superscripts
(map ~a named-scope-id))
" ")))
"")))
""))
(define (+scopes stx) (define (+scopes stx)
(format "~a~a" (format "~a~a"