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