suzanne.soy/extensible-parser-specifications
1
0
Fork 0
Code Issues 2 Pull Requests Actions Packages Projects Releases Wiki Activity

Compatibility with v6.5

Browse Source
This commit is contained in:
Georges Dupéron 2016-09-08 14:40:36 +02:00
parent 23eba12634
commit e628554a48
1 changed files with 56 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

113
private/no-order.rkt
View File

@ -66,7 +66,7 @@
(define-for-syntax (fix-disappeared-uses) (define-for-syntax (fix-disappeared-uses)
;; Fix for https://github.com/racket/racket/issues/1452 ;; Fix for https://github.com/racket/racket/issues/1452
(let ([dis (current-recorded-disappeared-uses)]) (let ([dis (current-recorded-disappeared-uses)])
#`{~do #,(with-disappeared-uses #`{~do #,(with-disappeared-uses*
(record-disappeared-uses dis) (record-disappeared-uses dis)
#'(void))})) #'(void))}))
@ -78,62 +78,61 @@
(λ (stx) (λ (stx)
(syntax-case stx () (syntax-case stx ()
[(self pat ...) [(self pat ...)
(with-disappeared-uses (with-disappeared-uses*
(let () (define counter 0)
(define counter 0) (define (increment-counter)
(define (increment-counter) (begin0 counter
(begin0 counter (set! counter (add1 counter))))
(set! counter (add1 counter)))) ;; post-acc gathers some a-patterns which will be added after the
;; post-acc gathers some a-patterns which will be added after the ;; (~seq (~or ) ...)
;; (~seq (~or ) ...) (define post-acc '())
(define post-acc '()) (define (add-to-post! v) (set! post-acc (cons v post-acc)))
(define (add-to-post! v) (set! post-acc (cons v post-acc))) ;; post-groups-acc gathers some attributes that have to be grouped
;; post-groups-acc gathers some attributes that have to be grouped (define post-groups-acc '())
(define post-groups-acc '()) (define (add-to-post-groups! . v)
(define (add-to-post-groups! . v) (set! post-groups-acc (cons v post-groups-acc)))
(set! post-groups-acc (cons v post-groups-acc))) ;; expand EH alternatives:
;; expand EH alternatives: (parameterize ([eh-post-accumulate add-to-post!]
(parameterize ([eh-post-accumulate add-to-post!] [eh-post-group add-to-post-groups!]
[eh-post-group add-to-post-groups!] [clause-counter increment-counter])
[clause-counter increment-counter]) (define alts
(define alts (expand-all-eh-mixin-expanders #'(~or pat ...)))
(expand-all-eh-mixin-expanders #'(~or pat ...))) (define post-group-bindings
(define post-group-bindings (for/list ([group (group-by car
(for/list ([group (group-by car post-groups-acc
post-groups-acc free-identifier=?)])
free-identifier=?)]) ;; each item in `group` is a four-element list:
;; each item in `group` is a four-element list: ;; (list result-id aggregate-function attribute)
;; (list result-id aggregate-function attribute) (define/with-syntax name (first (car group))
(define/with-syntax name (first (car group)) #;(syntax-local-introduce
#;(syntax-local-introduce (datum->syntax #'here
(datum->syntax #'here (first (car group)))))
(first (car group))))) (define/with-syntax f (second (car group)))
(define/with-syntax f (second (car group))) #`[name (f . #,(map (λ (i) #`(attribute #,(third i)))
#`[name (f . #,(map (λ (i) #`(attribute #,(third i))) group))]))
group))])) (define/with-syntax whole-clause (get-new-clause!))
(define/with-syntax whole-clause (get-new-clause!)) (define/with-syntax parse-seq-order-sym-id
(define/with-syntax parse-seq-order-sym-id (datum->syntax (parse-seq-order-sym-introducer
(datum->syntax (parse-seq-order-sym-introducer (syntax-local-introduce #'here))
(syntax-local-introduce #'here)) 'parse-seq-order-sym))
'parse-seq-order-sym)) #`(~delimit-cut
#`(~delimit-cut (~and #,(fix-disappeared-uses)
(~and #,(fix-disappeared-uses) {~seq whole-clause (… …)}
{~seq whole-clause (… …)} {~do (define parse-seq-order-sym-id
{~do (define parse-seq-order-sym-id (gensym 'parse-seq-order))}
(gensym 'parse-seq-order))} {~parse ({~seq #,alts (… …)})
{~parse ({~seq #,alts (… …)}) #`#,(for/list
#`#,(for/list ([xi (in-syntax #'(whole-clause (… …)))]
([xi (in-syntax #'(whole-clause (… …)))] [i (in-naturals)])
[i (in-naturals)]) ;; Add a syntax property before parsing,
;; Add a syntax property before parsing, ;; to track the position of matched elements
;; to track the position of matched elements ;; using ~order-point
;; using ~order-point (syntax-property xi
(syntax-property xi parse-seq-order-sym-id
parse-seq-order-sym-id i))}
i))} ~!
~! (~bind #,@post-group-bindings)
(~bind #,@post-group-bindings) #,@post-acc))))]))))
#,@post-acc)))))]))))
(define-syntax ~no-order (define-syntax ~no-order
(pattern-expander (pattern-expander