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