1#lang racket/base
2(require "syntax.rkt"
3         "taint-object.rkt")
4
5(provide taint-content
6
7         syntax-tainted?
8         syntax-clean?
9         syntax-taint
10
11         struct-copy/t)
12
13(define-syntax struct-copy/t
14  (syntax-rules (syntax taint props)
15    [(struct-copy/t syntax s [taint v])
16     (let* ([stx s]
17            [t v]
18            [content* (syntax-content* stx)]
19            [content (if (modified-content? content*)
20                         (modified-content-content content*)
21                         content*)]
22            [p (and (modified-content? content*)
23                    (modified-content-scope-propagations+taint content*))])
24       (struct-copy syntax stx
25                    [content*
26                     (let ([new-p (if (taint? p)
27                                      t
28                                      ((propagation-set-taint-ref p) p t))])
29                       (if new-p
30                           (modified-content content new-p)
31                           content))]))]))
32
33(define (taint-content d)
34  (non-syntax-map d
35                  (lambda (tail? x) x)
36                  (lambda (sub-s)
37                    (cond
38                     [(syntax-taintness sub-s) sub-s]
39                     [else (struct-copy/t syntax sub-s
40                                          [taint
41                                           (tainted-for-content (syntax-content sub-s))])]))))
42
43(define (syntax-tainted? s)
44  (and (syntax-taintness s) #t))
45
46(define (syntax-clean? s)
47  (not (syntax-taintness s)))
48
49(define (syntax-taint s)
50  (if (syntax-taintness s)
51      s
52      (struct-copy/t syntax s
53                     [taint (tainted-for-content (syntax-content s))])))
54