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)
;(…)ˢˡⁱ⁼ ᵘˢᵉ⁼
;(…)ₛₗᵢ₌ ᵤₛₑ₌
(let* ([stx (datum->syntax whole-stx 'to-id)]
[sli (syntax-local-introduce stx)]
[stx-ids (extract-scope-ids stx)]
[sli-ids (extract-scope-ids sli)]
[stx-slb (syntax-local-identifier-as-binding stx)]
[sli-slb (syntax-local-identifier-as-binding sli)]
[stx-binding (extract-scope-ids stx-slb)]
[sli-binding (extract-scope-ids sli-slb)]
[use (append (set-symmetric-difference stx-ids stx-binding)
(set-symmetric-difference sli-ids sli-binding))]
[stx/sli-use (set-subtract (set-symmetric-difference stx-ids sli-ids)
use)])
(format "ˢˡⁱ⁼~a⁺ᵘˢᵉ⁼~a~a"
(string-join (map digits->superscripts (map ~a stx/sli-use)) " ")
(string-join (map digits->superscripts (map ~a use)) " ")
(if (sli-scopes)
(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))
" ")))
""))))
(if (syntax-transforming?)
(let* ([stx (datum->syntax whole-stx 'to-id)]
[sli (syntax-local-introduce stx)]
[stx-ids (extract-scope-ids stx)]
[sli-ids (extract-scope-ids sli)]
[stx-slb (syntax-local-identifier-as-binding stx)]
[sli-slb (syntax-local-identifier-as-binding sli)]
[stx-binding (extract-scope-ids stx-slb)]
[sli-binding (extract-scope-ids sli-slb)]
[use (append (set-symmetric-difference stx-ids stx-binding)
(set-symmetric-difference sli-ids sli-binding))]
[stx/sli-use (set-subtract (set-symmetric-difference stx-ids
sli-ids)
use)])
(format "ˢˡⁱ⁼~a⁺ᵘˢᵉ⁼~a~a"
(string-join (map digits->superscripts (map ~a stx/sli-use))
" ")
(string-join (map digits->superscripts (map ~a use))
" ")
(if (sli-scopes)
(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)
(format "~a~a"