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

Bugfixes

Browse Source
This commit is contained in:
Georges Dupéron 2017-01-29 20:26:39 +01:00
parent d4e37ffaea
commit e508ad1feb
2 changed files with 22 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
main.rkt
View File

@ -6,6 +6,7 @@
(rename-out [→scopes ->scopes] (rename-out [→scopes ->scopes]
[→scopes* ->scopes*]) [→scopes* ->scopes*])
empty-scopes empty-scopes
empty-scopes-syntax
scopes-add scopes-add
scopes-remove scopes-remove
scopes-flip scopes-flip
@ -27,14 +28,18 @@
(define scopes/c (define scopes/c
(->* (syntax?) ([or/c 'add 'remove 'flip]) syntax?)) (->* (syntax?) ([or/c 'add 'remove 'flip]) syntax?))
(define/contract empty-scopes-syntax
syntax?
(datum->syntax #f 'zero))
(define/contract (→scopes stx) (define/contract (→scopes stx)
(-> syntax? scopes/c) (-> syntax? scopes/c)
(make-syntax-delta-introducer (datum->syntax stx 'stx) (make-syntax-delta-introducer (datum->syntax stx 'stx)
(datum->syntax #f 'zero))) empty-scopes-syntax))
(define/contract empty-scopes (define/contract empty-scopes
scopes/c scopes/c
(→scopes (datum->syntax #f 'zero))) (→scopes empty-scopes-syntax))
(define/contract (→scopes* stx) (define/contract (→scopes* stx)
(-> (or/c syntax? scopes/c) scopes/c) (-> (or/c syntax? scopes/c) scopes/c)
@ -44,17 +49,17 @@
(define/contract (scopes-add sc1 sc2) (define/contract (scopes-add sc1 sc2)
(-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) scopes/c) (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) scopes/c)
(→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes) (→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes-syntax)
'add))) 'add)))
(define/contract (scopes-remove sc1 sc2) (define/contract (scopes-remove sc1 sc2)
(-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) scopes/c) (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) scopes/c)
(→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes) (→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes-syntax)
'remove))) 'remove)))
(define/contract (scopes-flip sc1 sc2) (define/contract (scopes-flip sc1 sc2)
(-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) scopes/c) (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) scopes/c)
(→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes) (→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes-syntax)
'flip))) 'flip)))
(define/contract (scopes-intersect sc1 sc2) (define/contract (scopes-intersect sc1 sc2)
@ -68,24 +73,26 @@
(define/contract (single-scope? sc) (define/contract (single-scope? sc)
(-> (or/c syntax? scopes/c) boolean?) (-> (or/c syntax? scopes/c) boolean?)
(= (length (hash-ref (syntax-debug-info ((→scopes* sc) empty-scopes)) (= (length (hash-ref (syntax-debug-info
((→scopes* sc) empty-scopes-syntax))
'context)) 'context))
1)) 1))
(define/contract (zero-scopes? sc) (define/contract (zero-scopes? sc)
(-> (or/c syntax? scopes/c) boolean?) (-> (or/c syntax? scopes/c) boolean?)
(= (length (hash-ref (syntax-debug-info ((→scopes* sc) empty-scopes)) (= (length (hash-ref (syntax-debug-info
((→scopes* sc) empty-scopes-syntax))
'context)) 'context))
0)) 0))
(define/contract (scopes-equal? sc1 sc2) (define/contract (scopes-equal? sc1 sc2)
(-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) boolean?) (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) boolean?)
(bound-identifier=? ((→scopes* sc1) (datum->syntax #f 'test)) (bound-identifier=? ((→scopes* sc1) empty-scopes-syntax)
((→scopes* sc2) (datum->syntax #f 'test)))) ((→scopes* sc2) empty-scopes-syntax)))
(define/contract (scope-kind sc) (define/contract (scope-kind sc)
(-> (and/c (or/c syntax? scopes/c) single-scope?) symbol?) (-> (and/c (or/c syntax? scopes/c) single-scope?) symbol?)
(define stx ((→scopes* sc) empty-scopes)) (define stx ((→scopes* sc) empty-scopes-syntax))
(vector-ref (list-ref (hash-ref (syntax-debug-info stx) 'context) 0) 1)) (vector-ref (list-ref (hash-ref (syntax-debug-info stx) 'context) 0) 1))
(define/contract (use-site-scope? sc) (define/contract (use-site-scope? sc)

5
scribblings/scope-operations.scrbl
View File

@ -39,6 +39,11 @@
@racketblock[(→scopes (datum->syntax #f 'zero))] @racketblock[(→scopes (datum->syntax #f 'zero))]
} }
@defthing[empty-scopes-syntax]{
A syntax object with an empty set of scopes, as produced by:
@racketblock[(datum->syntax #f 'zero)]
}
@defproc[(scopes-add [sc1 (or/c syntax? scopes/c)] @defproc[(scopes-add [sc1 (or/c syntax? scopes/c)]
[sc2 (or/c syntax? scopes/c)]) [sc2 (or/c syntax? scopes/c)])
scopes/c]{Set union of the given sets of scopes.} scopes/c]{Set union of the given sets of scopes.}