Add syntax-within? to unstable/syntax.

collects/tests/unstable/syntax.rkt

@@ -54,4 +54,21 @@
        (test-case "identifier"
          (check bound-identifier=?
                 (with-syntax* ([a #'id] [b #'a]) #'b)
-                #'id))))))
+                #'id))))
+
+   (test-suite "syntax-within?"
+     (let* ([a #'a]
+            [b #'b]
+            [c #'(a b c)]
+            [c1 (car (syntax->list c))]
+            [c2 (cadr (syntax->list c))])
+       (test-case "reflexive"
+         (check-equal? (syntax-within? a a) #t))
+       (test-case "unrelated"
+         (check-equal? (syntax-within? a b) #f))
+       (test-case "child"
+         (check-equal? (syntax-within? c1 c) #t))
+       (test-case "parent"
+         (check-equal? (syntax-within? c c1) #f))
+       (test-case "sibling"
+         (check-equal? (syntax-within? c2 c1) #f))))))

collects/unstable/scribblings/syntax.scrbl

@@ -34,7 +34,7 @@ resolved module path or @racket[#f] for the ``self'' module.
 
 @;{----}
 
-@margin-note{This binding was added by Vincent St-Amour.}
+@addition{@author+email["Vincent St-Amour" "stamourv@racket-lang.org"]}
 @defproc[(format-unique-id [lctx (or/c syntax? #f)]
                     	   [fmt string?]
                     	   [v (or/c string? symbol? identifier? keyword? char? number?)] ...
@@ -44,6 +44,11 @@ resolved module path or @racket[#f] for the ``self'' module.
          identifier?]{
 Like @racket[format-id], but returned identifiers are guaranteed to be unique.
 }
+@defproc[(syntax-within? [a syntax?] [b syntax?])
+         boolean?]{
+Returns true is syntax @racket[a] is within syntax @racket[b] in the source.
+Bounds are inclusive.
+}
 
 @;{----}
 

collects/unstable/syntax.rkt

@@ -12,6 +12,7 @@
 
          ;; by stamourv:
          format-unique-id
+         syntax-within?
 
          ;; by ryanc
          explode-module-path-index)
@@ -62,6 +63,17 @@
                                    lctx #:source src #:props props #:cert cert
                                    fmt args)))
 
+;; is syntax a contained within syntax b, inclusively
+(define (syntax-within? a b)
+  (let ([pos-a  (syntax-position a)]
+        [span-a (syntax-span a)]
+        [pos-b  (syntax-position b)]
+        [span-b (syntax-span b)])
+    (and pos-a span-a pos-b span-b
+         (<= pos-b pos-a)
+         (>= (+ pos-b span-b) (+ pos-a span-a)))))
+
+
 ;; by ryanc
 
 (define (explode-module-path-index mpi)