www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README

same-syntax-typed.rkt (1008B)

      1 #lang typed/racket
      2 
      3 (require "annotate-syntax-typed.rkt"
      4          tr-immutable/typed-syntax
      5          rackunit)
      6 
      7 (require typed/racket/unsafe)
      8 (unsafe-require/typed sexp-diff
      9                       [sexp-diff (case→
     10                                   (→ Sexp Sexp Sexp)
     11                                   (→ Sexp/Non Sexp/Non Sexp/Non)
     12                                   (→ (Sexpof Any) (Sexpof Any) (Sexpof Any)))])
     13 
     14 (provide check-same-syntax)
     15 
     16 (: same-syntax! (→ ISyntax/Non ISyntax/Non Boolean))
     17 (define (same-syntax! a b)
     18   (define answer (equal? (annotate-syntax a #:srcloc+scopes? #f)
     19                          (annotate-syntax b #:srcloc+scopes? #f)))
     20   (unless answer
     21     (pretty-write
     22      (sexp-diff (annotate-syntax a)
     23                 (annotate-syntax b)))
     24     (displayln a)
     25     (displayln b))
     26   answer)
     27 
     28 (define-syntax (check-same-syntax stx)
     29   (syntax-case stx ()
     30     [(_ a b)
     31      (datum->syntax #'here
     32                     `(check-true (same-syntax! ,#'a ,#'b))
     33                     stx)]))