refactoring

pull/2/head
Matthew Butterick 9 years ago
parent 12f7a3d332
commit 146e460a8f

@ -164,32 +164,36 @@ This would be the place to check a syntax property for hiding.
;; Creates an stx out of the rule name and its components. ;; Creates an stx out of the rule name and its components.
;; The location information of the rule spans that of its components. ;; The location information of the rule spans that of its components.
(define (rule-components->syntax rule-name/false #:srcloc [srcloc #f] #:hide-or-splice? [hide-or-splice #f] . componentss) (define (rule-components->syntax rule-name/false #:srcloc [srcloc #f] #:hide-or-splice? [hide-or-splice #f] . componentss)
(define (remove-rule-name cs) (define (remove-rule-name components-stx)
;; when removing a rule name, we apply it as a syntax property to the remaining elements ;; when removing a rule name, we apply it as a syntax property to the remaining elements
;; for possible later usage (aka, why throw away information) ;; for possible later usage (aka, why throw away information)
;; todo: distinguish hiding and splicing behavior. ;; todo: distinguish hiding and splicing behavior.
;; when hiding, returned list should be a syntaxed list with the property. ;; when hiding, returned list should be a syntaxed list with the property (?)
;; when splicing, returned list should be a regualr list, with each element having the property. ;; when splicing, returned list should be a regular list, with each element having the property.
(let* ([cs-list (syntax->list cs)] (let* ([name+elements (syntax->list components-stx)]
[rule-name (syntax->datum (car cs-list))] [name-datum (syntax->datum (car name+elements))]
[elements (cdr cs-list)]) [elements (cdr name+elements)])
(map (λ(e) (syntax-property e rule-name #t)) elements))) (map (λ(e) (syntax-property e name-datum #t)) elements)))
(define spliced-componentss (define componentss-hoisted
(apply append (apply append
(for/list ([css (in-list componentss)]) (for/list ([css (in-list componentss)])
(list (list
(cond ;; each `css` is a list that's either empty, or has a single syntaxed component list
[(and (pair? css) (eq? (syntax-property (car css) 'hide-or-splice) 'hide)) (let ([components-stx (and (pair? css) (car css))])
(list (remove-rule-name (car css)))] ; hidden version still contained in `list` (if components-stx
[(and (pair? css) (or (eq? (syntax-property (car css) 'hide-or-splice) 'splice) (cond
(syntax-property (car css) 'splice-rh-id))) [(eq? (syntax-property components-stx 'hide-or-splice) 'hide)
(remove-rule-name (car css))] ; spliced version is "delisted" (list (remove-rule-name components-stx))] ; hidden version still wrapped in a sub-`list`
[else css]))))) [(or (eq? (syntax-property components-stx 'hide-or-splice) 'splice)
(syntax-property components-stx 'splice-rh-id))
(remove-rule-name components-stx)] ; spliced version is "delisted"
[else css])
css))))))
(syntax-property (syntax-property
(datum->syntax #f (datum->syntax #f
(cons (cons
(datum->syntax #f rule-name/false srcloc stx-with-original?-property) (datum->syntax #f rule-name/false srcloc stx-with-original?-property)
(apply append spliced-componentss)) (apply append componentss-hoisted))
srcloc srcloc
stx-with-original?-property) stx-with-original?-property)
;; not 'hide-or-splice-lhs-id, because it is now a component in a different rule ;; not 'hide-or-splice-lhs-id, because it is now a component in a different rule

@ -4,10 +4,10 @@
rackunit) rackunit)
(define parse-result (parse (list "{" (define parse-result (parse (list "{"
(token 'ID "message") (token 'ID "message")
":" ":"
(token 'STRING "'hello world'") (token 'STRING "'hello world'")
"}"))) "}")))
(check-equal? (syntax->datum parse-result) '(json ":")) (check-equal? (syntax->datum parse-result) '(json ":"))
(define syntaxed-colon (cadr (syntax->list parse-result))) (define syntaxed-colon (cadr (syntax->list parse-result)))

Loading…
Cancel
Save