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

Labels Milestones

New Pull Request

define-macro: check that ... only follow wildcards #10

Merged
bennn merged 1 commits from defmac-ellipses into master 7 years ago
Conversation 1 Commits 1 Files Changed 2
2 changed files with 38 additions and 3 deletions
Show Stats Download Patch File Download Diff File

2
beautiful-racket-lib/br/define.rkt
Unescape Escape View File

@ -141,6 +141,8 @@
[(_ id:id leading-pat:expr ... else-pat:else-clause trailing-pat0:expr trailing-pat:expr ...) [(_ id:id leading-pat:expr ... else-pat:else-clause trailing-pat0:expr trailing-pat:expr ...)
(raise-syntax-error 'define-macro-cases "`else` clause must be last" (syntax->datum #'id))] (raise-syntax-error 'define-macro-cases "`else` clause must be last" (syntax->datum #'id))]
[(_ id:id (pat:expr . result-exprs:expr) ... else-clause:else-clause) [(_ id:id (pat:expr . result-exprs:expr) ... else-clause:else-clause)
(unless (all-...-follow-wildcards #'(pat ...))
(raise-syntax-error 'define-macro-cases "found ellipses after non-wildcard variable" (syntax->datum stx)))
(with-syntax ([(LITERAL ...) (generate-literals #'(pat ...))]) (with-syntax ([(LITERAL ...) (generate-literals #'(pat ...))])
#'(define-macro id #'(define-macro id
(λ (stx) (λ (stx)

37
beautiful-racket-lib/br/private/generate-literals.rkt
Unescape Escape View File

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require "syntax-flatten.rkt") (require "syntax-flatten.rkt")
(provide generate-literals) (provide all-...-follow-wildcards generate-literals)
(define (literal-identifier? pat-datum) (define (literal-identifier? pat-datum)
(and (symbol? pat-datum) (and (symbol? pat-datum)
@ -9,6 +9,11 @@
(or (not (regexp-match #rx"[A-Z]" pat-str)) ; either doesn't contain at least one uppercase letter ... (or (not (regexp-match #rx"[A-Z]" pat-str)) ; either doesn't contain at least one uppercase letter ...
(not (equal? (string-upcase pat-str) pat-str)))))) ;... or doesn't contain all uppercase letters (not (equal? (string-upcase pat-str) pat-str)))))) ;... or doesn't contain all uppercase letters
(define (wildcard-identifier? pat-datum)
(and (symbol? pat-datum)
(not (literal-identifier? pat-datum))
(not (memq pat-datum '(... _)))))
;; generate literals for any symbols that are not ... or _ and not IN_CAPS ;; generate literals for any symbols that are not ... or _ and not IN_CAPS
(define (generate-literals pats) (define (generate-literals pats)
(for*/list ([pat-arg (in-list (syntax-flatten pats))] (for*/list ([pat-arg (in-list (syntax-flatten pats))]
@ -16,6 +21,34 @@
#:when (literal-identifier? pat-datum)) #:when (literal-identifier? pat-datum))
pat-arg)) pat-arg))
(define (all-...-follow-wildcards pats)
(define prev-datum (box #f))
(and
(for*/and ([pat-arg (in-list (syntax-flatten pats))]
[pat-datum (in-value (syntax->datum pat-arg))])
;; OK if there's no previous datum,
(and
(when (eq? pat-datum '...)
(wildcard-identifier? (unbox prev-datum)))
(set-box! prev-datum pat-datum)))
#true))
(module+ test (module+ test
(require rackunit) (require rackunit)
bennn commented 7 years ago (Migrated from github.com)
Review

Oops, this comment shoudn't be here

Oops, this comment shoudn't be here
mbutterick commented 7 years ago (Migrated from github.com)
Review

BTW, what is the reason to use box and set!-box to mutate prev-datum rather than just mutating the variable itself?

BTW, what is the reason to use `box` and `set!-box` to mutate `prev-datum` rather than just mutating the variable itself?
bennn commented 7 years ago (Migrated from github.com)
Review

I'm prejudiced against set!. I like box to communicate my intentions.

But this is your code so you should do what you want.

I'm prejudiced against `set!`. I like `box` to communicate my intentions. But this is your code so you should do what you want.
mbutterick commented 7 years ago (Migrated from github.com)
Review

Oh no, I can’t mess with perfection.

I was just trying to understand what box is for. IIUC it’s a way of saving the costs of allocation & GC across function calls by passing what’s essentially a reference to a value rather than the value itself. But, if that’s so, then I don’t understand the benefit of putting a Boolean or symbol in a box, since they’re so tiny to begin with.

Oh no, I can’t mess with perfection. I was just trying to understand what `box` is for. IIUC it’s a way of saving the costs of allocation & GC across function calls by passing what’s essentially a reference to a value rather than the value itself. But, if that’s so, then I don’t understand the benefit of putting a Boolean or symbol in a box, since they’re so tiny to begin with.
bennn commented 7 years ago (Migrated from github.com)
Review

I think the compiler puts set!'d variables into a box (or the moral equivalent of a box). If that's true, then I don't think there's performance savings either way.

(This is based on what I remember from talking to Leif)

To me, a box is for saying "this variable is going to be mutated".

I think the compiler puts `set!`'d variables into a box (or the moral equivalent of a box). If that's true, then I don't think there's performance savings either way. (This is based on what I remember from talking to Leif) To me, a box is for saying "this variable is going to be mutated".
(check-equal? (map syntax->datum (generate-literals #'(foo 42 BAR _ (... ...) bar <=> 3Bar 3bar))) '(foo bar <=> 3Bar 3bar))) (check-equal? (map syntax->datum (generate-literals #'(foo 42 BAR _ (... ...) bar <=> 3Bar 3bar))) '(foo bar <=> 3Bar 3bar))
(test-case "wildcard-identifier?"
(check-true (wildcard-identifier? 'FOO))
(check-true (wildcard-identifier? 'TOPPING))
(check-false (wildcard-identifier? 'piZZa))
(check-false (wildcard-identifier? 'please)))
(test-case "all-...-follow-wildcards"
(check-true (all-...-follow-wildcards #'()))
(check-true (all-...-follow-wildcards (datum->syntax #f '(a b))))
(check-true (all-...-follow-wildcards (datum->syntax #f '(a b C ...))))
(check-false (all-...-follow-wildcards (datum->syntax #f '(...))))
(check-false (all-...-follow-wildcards (datum->syntax #f '(a ...))))
(check-false (all-...-follow-wildcards (datum->syntax #f '(A ... b ...))))))

Write Preview
Loading…
Cancel
Save