mbutterick
/
beautiful-racket
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

tests still pass

Browse Source
dev-elider
Matthew Butterick 9 years ago
parent 3504667b83
commit 44d25659de
1 changed files with 3 additions and 7 deletions
Show Stats Download Patch File Download Diff File

10
beautiful-racket-ragg/br/ragg/codegen/flatten.rkt
Unescape Escape View File

@ -1,4 +1,4 @@
#lang racket/base #lang br
(require br/ragg/rules/stx-types (require br/ragg/rules/stx-types
(for-syntax racket/base)) (for-syntax racket/base))
@ -139,7 +139,7 @@
;; Returns true if the pattern looks primitive ;; Returns true if the pattern looks primitive
(define (primitive-pattern? a-pat) (define (primitive-pattern? a-pat)
(syntax-case a-pat (id lit token choice elide repeat maybe seq elide) (syntax-case a-pat (id lit token choice repeat maybe seq)
[(id val) [(id val)
#t] #t]
[(lit val) [(lit val)
@ -153,8 +153,6 @@
[(maybe sub-pat) [(maybe sub-pat)
#f] #f]
[(seq sub-pat ...) [(seq sub-pat ...)
(andmap primitive-pattern? (syntax->list #'(sub-pat ...)))]
[(elide sub-pat ...)
(andmap primitive-pattern? (syntax->list #'(sub-pat ...)))])) (andmap primitive-pattern? (syntax->list #'(sub-pat ...)))]))
@ -163,7 +161,7 @@
;; and tokens. ;; and tokens.
(define (linearize-primitive-pattern a-pat) (define (linearize-primitive-pattern a-pat)
(define (traverse a-pat acc) (define (traverse a-pat acc)
(syntax-case a-pat (id inferred-id lit token seq elide) (syntax-case a-pat (id inferred-id lit token seq)
[(id val) [(id val)
(cons a-pat acc)] (cons a-pat acc)]
[(inferred-id val reason) [(inferred-id val reason)
@ -173,8 +171,6 @@
[(token val) [(token val)
(cons a-pat acc)] (cons a-pat acc)]
[(seq vals ...) [(seq vals ...)
(foldl traverse acc (syntax->list #'(vals ...)))]
[(elide vals ...)
(foldl traverse acc (syntax->list #'(vals ...)))])) (foldl traverse acc (syntax->list #'(vals ...)))]))
(reverse (traverse a-pat '()))) (reverse (traverse a-pat '())))

Write Preview
Loading…
Cancel
Save