www

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

test-check-variable-visible.rkt (2311B)

      1 #lang racket
      2 
      3 ;; This is a quick experiment to check that a set of identifiers (syntax
      4 ;; transformers) can be maintained using a stack, while ensuring that when
      5 ;; the set is queried at compile-time, only those identifiers which are within
      6 ;; scope are returned.
      7 ;;
      8 ;; It is necessary to understand this in order to internally build a stack of
      9 ;; definitions of pattern variables, and correctly pop pvars from the stack when
     10 ;; they go out of scope.
     11 
     12 (require rackunit)
     13 
     14 (define-for-syntax order '())
     15 (define-for-syntax (record-order x)
     16   (set! order (cons x order)))
     17 
     18 
     19 (define-for-syntax stack '())
     20 (define-for-syntax (push! e)
     21   (set! stack (cons e stack)))
     22 (define-for-syntax (peek)
     23   (car stack))
     24 (define-for-syntax (pop!)
     25   (set! stack (cdr stack)))
     26 (define-for-syntax (pop…!)
     27   (when (not (null? stack))
     28     (unless (syntax-local-value (car stack) (λ () #f))
     29       ;(displayln (syntax->datum #`(pop #,(car stack))))
     30       (pop!)
     31       (pop…!))))
     32 
     33 (define-syntax (def stx)
     34   (syntax-case stx ()
     35     [(_ var)
     36      (begin
     37        (pop…!)
     38        (push! #'var)
     39        #'(define-syntax var 42))]))
     40 
     41 (define-syntax (query stx)
     42   (syntax-case stx ()
     43     [(_ msg)
     44      (begin
     45        (pop…!)
     46        (record-order (syntax->datum #`(msg . #,stack)))
     47        #'(void))]))
     48 
     49 (define (expr x) (void))
     50 
     51 
     52 (define-syntax (macro stx)
     53   #'(def v2))
     54 
     55 (def v1)
     56 (macro)
     57 (let ()
     58   (def v6.1)
     59   (query q6.2)
     60   (expr (query q6.4))
     61   (let ()
     62     (def v6.5.1)
     63     (void))
     64   (let ()
     65     (def v6.6.1)
     66     ;; These queries must *not* contain v6.5.1.
     67     (query q6.6.2)
     68     (expr (query q6.6.3))
     69     (void))
     70   (let ()
     71     (def v6.7.1)
     72     ;; These queries must *not* contain v6.5.1 nor v6.6.1.
     73     (query q6.7.2)
     74     (expr (query q6.7.3))
     75     (void))
     76   (def v6.3)
     77   (void))
     78 (query q3)
     79 (expr (query q7))
     80 (def v4)
     81 (query q5)
     82 (expr (query q8))
     83 
     84 (check-equal? (let-syntax ([get (λ (stx) #`'#,(reverse order))])
     85                 get)
     86               '((q3 v2 v1)
     87                 (q5 v4 v2 v1)
     88                 (q6.2 v6.1 v4 v2 v1)
     89                 (q6.4 v6.3 v6.1 v4 v2 v1)
     90                 (q6.6.2 v6.6.1 v6.3 v6.1 v4 v2 v1)
     91                 (q6.6.3 v6.6.1 v6.3 v6.1 v4 v2 v1)
     92                 (q6.7.2 v6.7.1 v6.3 v6.1 v4 v2 v1)
     93                 (q6.7.3 v6.7.1 v6.3 v6.1 v4 v2 v1)
     94                 (q7 v4 v2 v1)
     95                 (q8 v4 v2 v1)))