tiny refac

pull/14/head
Matthew Butterick 7 years ago
parent 4f225cc740
commit 0d4a350d2c

@ -174,24 +174,19 @@ This would be the place to check a syntax property for hiding.
(define (remove-rule-name component-stx #:splice? [splice #f]) (define (remove-rule-name component-stx #:splice? [splice #f])
;; 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)
(with-syntax ([(name . subcomponents) component-stx]) (syntax-case component-stx ()
[(name . subcomponents)
(let ([name-datum (syntax->datum #'name)]) (let ([name-datum (syntax->datum #'name)])
(if splice (if splice
;; when splicing, returned list is a regular list, with each element having the property. ;; when splicing, returned list is a regular list, with each element having the property.
(map (λ(sc) (syntax-property sc name-datum #'name)) (syntax->list #'subcomponents)) (map (λ(sc) (syntax-property sc name-datum #'name)) (syntax->list #'subcomponents))
;; when hiding, returned list should be a syntaxed list with the property ;; when hiding, returned list should be a syntaxed list with the property
;; iow, basically the same as `component-stx`, minus the name ;; iow, basically the same as `component-stx`, minus the name
(syntax-property (datum->syntax component-stx #'subcomponents component-stx component-stx) name-datum #'name))))) (syntax-property (datum->syntax component-stx #'subcomponents component-stx component-stx) name-datum #'name)))]
[_ (raise-syntax-error 'remove-rule-name "component has no name" component-stx)]))
(define (preprocess-component-lists component-lists) (define (preprocess-component component-stx)
; "preprocess" means splicing and rule-name-hiding where indicated
(append*
;; each `component-list` is a list that's either empty, or has a single component-stx object
;; inside `component-stx` is a name followed by subcomponents
(for*/list ([component-list (in-list component-lists)]
[component-stx (in-list component-list)]) ; this has the effect of omitting any empty `component-list`
(list
(cond (cond
;; test splice first in case both hiding and splicing are set, for instance: ;; test splice first in case both hiding and splicing are set, for instance:
;; /rule : thing @rule ;; /rule : thing @rule
@ -201,7 +196,16 @@ This would be the place to check a syntax property for hiding.
(remove-rule-name component-stx #:splice? #t)] ; spliced version is lifted out of the sublist (remove-rule-name component-stx #:splice? #t)] ; spliced version is lifted out of the sublist
[(eq? (syntax-property component-stx 'hide-or-splice) 'hide) [(eq? (syntax-property component-stx 'hide-or-splice) 'hide)
(list (remove-rule-name component-stx))] ; hidden version still wrapped in a sublist (list (remove-rule-name component-stx))] ; hidden version still wrapped in a sublist
[else (list component-stx)]))))) [else (list component-stx)]))
(define (preprocess-component-lists component-stxss)
; "preprocess" means splicing and rule-name-hiding where indicated
;; inside `component-stx` is a rule name followed by subcomponents
(append*
(for*/list ([component-stxs (in-list component-stxss)]
[component-stx (in-list component-stxs)])
(preprocess-component component-stx))))
;; rule-components->syntax: (U symbol false) (listof stx) ... #:srcloc (U #f (list src line column offset span)) -> stx ;; rule-components->syntax: (U symbol false) (listof stx) ... #:srcloc (U #f (list src line column offset span)) -> stx
@ -209,7 +213,7 @@ This would be the place to check a syntax property for hiding.
;; 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] . component-lists) (define (rule-components->syntax rule-name/false #:srcloc [srcloc #f] #:hide-or-splice? [hide-or-splice #f] . component-lists)
(define new-rule-name (datum->syntax #f rule-name/false srcloc stx-with-original?-property)) (define new-rule-name (datum->syntax #f rule-name/false srcloc stx-with-original?-property))
(define new-rule-components (append* (preprocess-component-lists component-lists))) (define new-rule-components (preprocess-component-lists component-lists))
(define rule-result (cons new-rule-name new-rule-components)) (define rule-result (cons new-rule-name new-rule-components))
(define syntaxed-rule-result (datum->syntax #f rule-result srcloc stx-with-original?-property)) (define syntaxed-rule-result (datum->syntax #f rule-result srcloc stx-with-original?-property))
;; not 'hide-or-splice-lhs-id, because this will now become a (right-hand) component in a different (left-hand) rule ;; not 'hide-or-splice-lhs-id, because this will now become a (right-hand) component in a different (left-hand) rule

Loading…
Cancel
Save