pre.rkt (1855B)
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 (all-from-out "private/litconv.rkt") 10 (all-from-out "private/lib.rkt") 11 syntax-parse-state-ref 12 syntax-parse-state-set! 13 syntax-parse-state-update! 14 syntax-parse-state-cons! 15 syntax-parse-track-literals) 16 17 (define not-given (gensym)) 18 19 (define (state-ref who key default) 20 (define state (current-state)) 21 (if (eq? default not-given) 22 (if (hash-has-key? state key) 23 (hash-ref state key) 24 (error who "no value found for key\n key: ~e" key)) 25 (hash-ref state key default))) 26 27 (define (syntax-parse-state-ref key [default not-given]) 28 (state-ref 'syntax-parse-state-ref key default)) 29 30 (define (check-update who) 31 (unless (current-state-writable?) 32 (error who "cannot update syntax-parse state outside of ~~do/#:do block"))) 33 34 (define (syntax-parse-state-set! key value) 35 (check-update 'syntax-parse-state-set!) 36 (current-state (hash-set (current-state) key value))) 37 38 (define (syntax-parse-state-update! key update [default not-given]) 39 (check-update 'syntax-parse-state-update!) 40 (define old (state-ref 'syntax-parse-state-update! key default)) 41 (current-state (hash-set (current-state) key (update old)))) 42 43 (define (syntax-parse-state-cons! key value [default null]) 44 (check-update 'syntax-parse-state-cons!) 45 (define old (hash-ref (current-state) key default)) 46 (current-state (hash-set (current-state) key (cons value old)))) 47 48 (define (syntax-parse-track-literals stx #:introduce? [introduce? #t]) 49 (track-literals 'syntax-parse-track-literals stx #:introduce? introduce?))