pre.rkt (1887B)
1 #lang racket/base 2 (require "private/sc.rkt" 3 "private/litconv.rkt" 4 "private/lib.rkt" 5 "private/residual.rkt") 6 (provide (except-out (all-from-out "private/sc.rkt") 7 define-integrable-syntax-class 8 syntax-parser/template 9 parser/rhs) 10 (all-from-out "private/litconv.rkt") 11 (all-from-out "private/lib.rkt") 12 syntax-parse-state-ref 13 syntax-parse-state-set! 14 syntax-parse-state-update! 15 syntax-parse-state-cons! 16 syntax-parse-track-literals) 17 18 (define not-given (gensym)) 19 20 (define (state-ref who key default) 21 (define state (current-state)) 22 (if (eq? default not-given) 23 (if (hash-has-key? state key) 24 (hash-ref state key) 25 (error who "no value found for key\n key: ~e" key)) 26 (hash-ref state key default))) 27 28 (define (syntax-parse-state-ref key [default not-given]) 29 (state-ref 'syntax-parse-state-ref key default)) 30 31 (define (check-update who) 32 (unless (current-state-writable?) 33 (error who "cannot update syntax-parse state outside of ~~do/#:do block"))) 34 35 (define (syntax-parse-state-set! key value) 36 (check-update 'syntax-parse-state-set!) 37 (current-state (hash-set (current-state) key value))) 38 39 (define (syntax-parse-state-update! key update [default not-given]) 40 (check-update 'syntax-parse-state-update!) 41 (define old (state-ref 'syntax-parse-state-update! key default)) 42 (current-state (hash-set (current-state) key (update old)))) 43 44 (define (syntax-parse-state-cons! key value [default null]) 45 (check-update 'syntax-parse-state-cons!) 46 (define old (hash-ref (current-state) key default)) 47 (current-state (hash-set (current-state) key (cons value old)))) 48 49 (define (syntax-parse-track-literals stx #:introduce? [introduce? #t]) 50 (track-literals 'syntax-parse-track-literals stx #:introduce? introduce?))