Make syntax replacement contract stricter (#498)

Author: jackfirth

private/source.rkt

@@ -231,8 +231,20 @@
 
     (define visited
       (transduce (build-vector original-visits)
+                 (peeking
+                  (λ (visit)
+                    (unless (syntax-original-path visit)
+                      (raise-arguments-error
+                       'source-analyze "pre-enriched visit is missing original path"
+                       "visited syntax" visit))))
                  (deduplicating #:key syntax-original-path)
                  (mapping enrich)
+                 (peeking
+                  (λ (visit)
+                    (unless (syntax-original-path visit)
+                      (raise-arguments-error
+                       'source-analyze "post-enriched visit is missing original path"
+                       "visited syntax" visit))))
                  (sorting syntax-path<=> #:key syntax-original-path)
                  #:into into-list))
 

private/syntax-neighbors.rkt

@@ -16,6 +16,7 @@
 (provide
  (contract-out
   [syntax-original-path (-> syntax? (or/c syntax-path? #false))]
+  [syntax-has-original-path? (-> syntax? boolean?)]
   [syntax-label-original-paths (-> syntax? syntax?)]
   [syntax-originally-neighbors? (-> syntax? syntax? boolean?)]
   [syntax-extract-originals-from-pair (-> syntax? syntax? (values syntax? syntax?))]))
@@ -47,6 +48,10 @@
   (syntax-label-paths stx original-syntax-path-key))
 
 
+(define (syntax-has-original-path? stx)
+  (and (syntax-property stx original-syntax-path-key) #true))
+
+
 (define (syntax-original-path stx)
   ; The property value will be a cons tree if a macro produced a syntax object with the path property
   ; set. The main way this occurs is via `(begin x ...)`, as each of the `x` subforms counts as an

private/syntax-replacement.rkt

@@ -8,13 +8,14 @@
  (contract-out
   [syntax-replacement? (-> any/c boolean?)]
   [syntax-replacement
-   (-> #:original-syntax (and/c syntax? syntax-original?)
+   (-> #:original-syntax (and/c syntax? syntax-original? syntax-has-original-path?)
        #:new-syntax syntax?
        #:source source?
        #:introduction-scope (->* (syntax?) ((or/c 'flip 'add 'remove)) syntax?)
        syntax-replacement?)]
   [syntax-replacement-render (-> syntax-replacement? string-replacement?)]
-  [syntax-replacement-original-syntax (-> syntax-replacement? (and/c syntax? syntax-original?))]
+  [syntax-replacement-original-syntax
+   (-> syntax-replacement? (and/c syntax? syntax-has-original-path?))]
   [syntax-replacement-new-syntax (-> syntax-replacement? syntax?)]
   [syntax-replacement-source (-> syntax-replacement? source?)]
   [syntax-replacement-introduction-scope
@@ -242,7 +243,7 @@
 (module+ test
   (test-case (name-string syntax-replacement-render)
     (define orig-code "(+ 1 (+ 2 3))")
-    (define orig-stx (with-input-from-string orig-code read-syntax))
+    (define orig-stx (syntax-label-original-paths (with-input-from-string orig-code read-syntax)))
     (define orig-start (sub1 (syntax-position orig-stx)))
     (define flip (make-syntax-introducer))
     (define new-stx