diff --git a/brag/brag/codegen/runtime.rkt b/brag/brag/codegen/runtime.rkt index b0b2828..54cbd9c 100755 --- a/brag/brag/codegen/runtime.rkt +++ b/brag/brag/codegen/runtime.rkt @@ -158,21 +158,32 @@ This would be the place to check a syntax property for hiding. (datum->syntax #f d (positions->srcloc start-pos end-pos) stx-with-original?-property)) +(require sugar/debug) + ;; rule-components->syntax: (U symbol false) (listof stx) ... #:srcloc (U #f (list src line column offset span)) -> stx ;; Creates an stx out of the rule name and 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 (remove-rule-name cs) (cdr (syntax->list cs))) + (define (remove-rule-name cs) + ;; 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) + ;; todo: distinguish hiding and splicing behavior. + ;; 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. + (let* ([cs-list (syntax->list cs)] + [rule-name (syntax->datum (car cs-list))] + [elements (cdr cs-list)]) + (map (λ(e) (syntax-property e rule-name #t)) elements))) (define spliced-componentss (apply append (for/list ([css (in-list componentss)]) (list (cond [(and (pair? css) (eq? (syntax-property (car css) 'hide-or-splice) 'hide)) - (list (remove-rule-name (car css)))] ; hidden version still contained in sublist + (list (remove-rule-name (car css)))] ; hidden version still contained in `list` [(and (pair? css) (or (eq? (syntax-property (car css) 'hide-or-splice) 'splice) (syntax-property (car css) 'splice-rh-id))) - (remove-rule-name (car css))] ; spliced version is "unlisted" + (remove-rule-name (car css))] ; spliced version is "delisted" [else css]))))) (syntax-property (datum->syntax #f diff --git a/brag/brag/test/test-baby-json-hider.rkt b/brag/brag/test/test-baby-json-hider.rkt index 65209dd..1cfc9a5 100755 --- a/brag/brag/test/test-baby-json-hider.rkt +++ b/brag/brag/test/test-baby-json-hider.rkt @@ -3,15 +3,15 @@ brag/support rackunit) -(check-equal? - (syntax->datum - (parse (list "{" +(define parse-result (parse (list "{" (token 'ID "message") ":" (token 'STRING "'hello world'") "}"))) - '(json ":")) +(check-equal? (syntax->datum parse-result) '(json ":")) +(define syntaxed-colon (cadr (syntax->list parse-result))) +(check-true (syntax-property syntaxed-colon 'kvpair)) (check-equal? (syntax->datum