Added zero-scopes? scopes-equal? has-all-scopes? has-any-scope?
This commit is contained in:
parent
b38676e7f1
commit
c76663a689
35
main.rkt
35
main.rkt
|
@ -12,13 +12,17 @@
|
||||||
scopes-intersect
|
scopes-intersect
|
||||||
(rename-out [scopes-flip scopes-symmetric-difference])
|
(rename-out [scopes-flip scopes-symmetric-difference])
|
||||||
single-scope?
|
single-scope?
|
||||||
|
zero-scopes?
|
||||||
|
scopes-equal?
|
||||||
scope-kind
|
scope-kind
|
||||||
use-site-scope?
|
use-site-scope?
|
||||||
macro-scope?
|
macro-scope?
|
||||||
module-scope?
|
module-scope?
|
||||||
intdef-scope?
|
intdef-scope?
|
||||||
local-scope?
|
local-scope?
|
||||||
top-scope?)
|
top-scope?
|
||||||
|
has-all-scopes?
|
||||||
|
has-any-scope?)
|
||||||
|
|
||||||
(define scopes/c
|
(define scopes/c
|
||||||
(->* (syntax?) ([or/c 'add 'remove 'flip]) syntax?))
|
(->* (syntax?) ([or/c 'add 'remove 'flip]) syntax?))
|
||||||
|
@ -65,7 +69,19 @@
|
||||||
(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))
|
||||||
'context))))
|
'context))
|
||||||
|
1))
|
||||||
|
|
||||||
|
(define/contract (zero-scopes? sc)
|
||||||
|
(-> (or/c syntax? scopes/c) boolean?)
|
||||||
|
(= (length (hash-ref (syntax-debug-info ((→scopes* sc) empty-scopes))
|
||||||
|
'context))
|
||||||
|
0))
|
||||||
|
|
||||||
|
(define/contract (scopes-equal? sc1 sc2)
|
||||||
|
(-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) boolean?)
|
||||||
|
(bound-identifier=? ((→scopes* sc1) (datum->syntax #f 'test))
|
||||||
|
((→scopes* sc2) (datum->syntax #f 'test))))
|
||||||
|
|
||||||
(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?)
|
||||||
|
@ -92,9 +108,18 @@
|
||||||
(-> (and/c (or/c syntax? scopes/c) single-scope?) boolean?)
|
(-> (and/c (or/c syntax? scopes/c) single-scope?) boolean?)
|
||||||
(eq? (scope-kind sc) 'local))
|
(eq? (scope-kind sc) 'local))
|
||||||
|
|
||||||
;; Untested, I've seen this once, but can't remember where exactly. I think it
|
;; This appears on the #'module identifier itself, when expanding a module
|
||||||
;; occured while expanding a module with local-expand, and injecting the
|
;; Run the macro stepper on an empty #lang racket program, and click on the
|
||||||
;; expanded body somewhere else.
|
;; #'module identifier, then on the "syntax object" tab to see it.
|
||||||
|
;; (Stepper → View syntax properties to enable the "syntax object" tab).
|
||||||
(define/contract (top-scope? sc)
|
(define/contract (top-scope? sc)
|
||||||
(-> (and/c (or/c syntax? scopes/c) single-scope?) boolean?)
|
(-> (and/c (or/c syntax? scopes/c) single-scope?) boolean?)
|
||||||
(eq? (scope-kind sc) 'top))
|
(eq? (scope-kind sc) 'top))
|
||||||
|
|
||||||
|
(define/contract (has-all-scopes? sc1 sc2)
|
||||||
|
(-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) boolean?)
|
||||||
|
(zero-scopes? (scopes-remove sc2 sc1)))
|
||||||
|
|
||||||
|
(define/contract (has-any-scope? sc1 sc2)
|
||||||
|
(-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) boolean?)
|
||||||
|
(not (zero-scopes? (scopes-intersect sc1 sc2))))
|
||||||
|
|
|
@ -71,10 +71,22 @@
|
||||||
scopes/c]{Set intersection of the given sets of scopes.}
|
scopes/c]{Set intersection of the given sets of scopes.}
|
||||||
|
|
||||||
|
|
||||||
@defproc[(single-scope? [sc (or/c syntax? scopes/c)]) boolean?]{
|
@defproc[(single-scopes? [sc (or/c syntax? scopes/c)]) boolean?]{
|
||||||
Predicate which returns @racket[#true] iff the given set of scopes contains
|
Predicate which returns @racket[#true] iff the given set of scopes contains
|
||||||
only a single scope.}
|
only a single scope.}
|
||||||
|
|
||||||
|
@defproc[(zero-scope? [sc (or/c syntax? scopes/c)]) boolean?]{
|
||||||
|
Predicate which returns @racket[#true] iff the given set of scopes contains
|
||||||
|
no scopes (e.g. because sc has been created with
|
||||||
|
@racket[(datum->syntax #f 'id)]).}
|
||||||
|
|
||||||
|
@defproc[(scopes-equal? [sc1 (or/c syntax? scopes/c)]
|
||||||
|
[sc2 (or/c syntax? scopes/c)]) boolean?]{
|
||||||
|
Predicate which returns @racket[#true] iff the two given sets of scopes contain
|
||||||
|
the same scopes. It is a generalised form of @racket[bound-identifier=?], which
|
||||||
|
also works for scopes represented as functions like the ones created by
|
||||||
|
@racket[make-syntax-introducer] and @racket[make-syntax-delta-introducer].}
|
||||||
|
|
||||||
@defproc[(scope-kind [sc (and/c (or/c syntax? scopes/c) single-scope?)])
|
@defproc[(scope-kind [sc (and/c (or/c syntax? scopes/c) single-scope?)])
|
||||||
symbol?]{
|
symbol?]{
|
||||||
Returns the kind of the single scope in @racket[sc]. To my knowledge, this
|
Returns the kind of the single scope in @racket[sc]. To my knowledge, this
|
||||||
|
@ -93,3 +105,13 @@
|
||||||
boolean?]{A shorthand for @racket[(eq? (scope-kind sc) 'local)]}
|
boolean?]{A shorthand for @racket[(eq? (scope-kind sc) 'local)]}
|
||||||
@defproc[(top-scope? [sc (and/c (or/c syntax? scopes/c) single-scope?)])
|
@defproc[(top-scope? [sc (and/c (or/c syntax? scopes/c) single-scope?)])
|
||||||
boolean?]{A shorthand for @racket[(eq? (scope-kind sc) 'top)]}
|
boolean?]{A shorthand for @racket[(eq? (scope-kind sc) 'top)]}
|
||||||
|
|
||||||
|
@defproc[(has-all-scopes? [sc1 (or/c syntax? scopes/c)]
|
||||||
|
[sc2 (or/c syntax? scopes/c)]) boolean?]{
|
||||||
|
Predicate which returns @racket[#true] iff all the scopes contained within the
|
||||||
|
set of scopes @racket[sc1] are present in the set of scopes @racket[sc2].}
|
||||||
|
|
||||||
|
@defproc[(has-any-scope? [sc1 (or/c syntax? scopes/c)]
|
||||||
|
[sc2 (or/c syntax? scopes/c)]) boolean?]{
|
||||||
|
Predicate which returns @racket[#true] iff any of the scopes contained within
|
||||||
|
the set of scopes @racket[sc1] are present in the set of scopes @racket[sc2].}
|
Loading…
Reference in New Issue
Block a user