parameters.rkt (1896B)
1 #lang racket/base 2 3 (require (for-syntax racket/base)) 4 5 (provide (for-syntax eh-first-accumulate 6 eh-first-accumulate! 7 eh-pre-accumulate 8 eh-pre-accumulate! 9 eh-post-accumulate 10 eh-post-accumulate! 11 eh-post-group 12 eh-post-group! 13 clause-counter 14 get-new-clause! 15 is-clause-id-sym? 16 lift-rest 17 lift-rest!)) 18 19 (define-syntax-rule (define-dynamic-accumulator-parameter parameter-name name!) 20 (begin 21 (define-for-syntax parameter-name (make-parameter #f)) 22 (define-for-syntax (name! name . args) 23 (unless (parameter-name) 24 (raise-syntax-error name 25 (string-append (symbol->string name) 26 " used outside of ~seq-no-order"))) 27 (apply (parameter-name) args)))) 28 29 (define-dynamic-accumulator-parameter eh-first-accumulate eh-first-accumulate!) 30 (define-dynamic-accumulator-parameter eh-pre-accumulate eh-pre-accumulate!) 31 (define-dynamic-accumulator-parameter eh-post-group eh-post-group!) 32 (define-dynamic-accumulator-parameter eh-post-accumulate eh-post-accumulate!) 33 (define-dynamic-accumulator-parameter lift-rest lift-rest!) 34 35 ;; This is a crude hack. 36 (define-for-syntax (is-clause-id-sym? id-sym) 37 (and (symbol? id-sym) 38 (regexp-match #px"^ -clause-.* $" (symbol->string id-sym)))) 39 40 (define-for-syntax clause-counter (make-parameter #f)) 41 (define-for-syntax (get-new-clause!) 42 (unless clause-counter 43 (error "Use get-new-clause! within (parameterize ([clause-counter …]) …)")) 44 (datum->syntax #'here 45 ;; keep the spaces, they allow us to recognize clauses later. 46 (string->symbol (format " -clause-~a " ((clause-counter))))))