suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

better stx errs for/fold and for*/fold

Browse Source
This commit is contained in:
Andrew Kent 2017-10-08 16:33:16 -04:00
parent 1e38918aa9
commit 3119c5b732
2 changed files with 53 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
pkgs/racket-test-core/tests/racket/for.rktl
View File

@ -567,8 +567,24 @@
exn:fail:contract?
#rx"starting index less than stopping index, but given a negative step")
;; for/fold syntax checking
(syntax-test #'(for/fold () bad 1) #rx".*bad sequence binding clauses.*")
;; for/fold & for*/fold syntax checking
(syntax-test #'(for/fold () bad 1)
#rx".*for/fold:.*bad sequence binding clauses.*")
(syntax-test #'(for/fold () ([42 '()]) 1)
#rx".*for/fold:.*bad sequence binding clause.*")
(syntax-test #'(for/fold ([0 42] [x 42]) ([z '()]) 1)
#rx".*for/fold:.*expected an identifier to bind.*")
(syntax-test #'(for/fold ([x 42] [x 42]) ([z '()]) 1)
#rx".*for/fold:.*duplicate identifier as accumulator binding.*")
(syntax-test #'(for*/fold () bad 1)
#rx".*for\\*/fold:.*bad sequence binding clauses.*")
(syntax-test #'(for*/fold () ([42 '()]) 1)
#rx".*for\\*/fold:.*bad sequence binding clause.*")
(syntax-test #'(for*/fold ([0 42] [x 42]) ([z '()]) 1)
#rx".*for\\*/fold:.*expected an identifier to bind.*")
(syntax-test #'(for*/fold ([x 42] [x 42]) ([z '()]) 1)
#rx".*for\\*/fold:.*duplicate identifier as accumulator binding.*")
(syntax-test #'(for/vector ()) #rx".*missing body.*")

55
racket/collects/racket/private/for.rkt
View File

@ -204,6 +204,22 @@
(define sequence-specialization-logger
(make-logger 'sequence-specialization (current-logger)))
(define (check-identifier-bindings orig-stx ids-stx kind result)
(let ([ids (syntax->list ids-stx)])
(for-each (lambda (id)
(unless (identifier? id)
(raise-syntax-error
#f
"expected an identifier to bind"
orig-stx
id)))
ids)
(let ([dup (check-duplicate-identifier ids)])
(when dup
(raise-syntax-error #f
(format "duplicate identifier as ~a binding" kind) orig-stx dup)))
result))
(define (expand-clause orig-stx clause)
(define (unpack stx)
(syntax-case stx ()
@ -219,20 +235,7 @@
(define unpacked-clause (unpack clause))
(syntax-case unpacked-clause (values in-parallel stop-before stop-after :do-in)
[[(id ...) rhs]
(let ([ids (syntax->list #'(id ...))])
(for-each (lambda (id)
(unless (identifier? id)
(raise-syntax-error
#f
"expected an identifier to bind"
orig-stx
id)))
ids)
(let ([dup (check-duplicate-identifier (syntax->list #'(id ...)))])
(when dup
(raise-syntax-error #f
"duplicate identifier as sequence binding" orig-stx dup)))
#f)
(check-identifier-bindings orig-stx #'(id ...) "sequence" #f)
'just-checking]
[[(id ...) (form . rest)]
(and use-transformer?
@ -1539,15 +1542,27 @@
;; Otherwise, allow compilation as nested loops, which can be slightly faster:
#'(for/foldX/derived [orig-stx #f nested? #f ()] fold-bind done-k done-k #f . rest)]))
(define-syntax for/fold/derived
(syntax-rules ()
(define-syntax (for/fold/derived stx)
(syntax-case stx ()
[(_ orig-stx ([fold-var finid-init] ...) . rest)
(for/foldX/derived/final [orig-stx #f] ([fold-var finid-init] ...) (values* fold-var ...) . rest)]))
(check-identifier-bindings #'orig-stx #'(fold-var ...) "accumulator" #t)
(syntax/loc #'orig-stx
(for/foldX/derived/final [orig-stx #f] ([fold-var finid-init] ...) (values* fold-var ...) . rest))]
[(_ orig-stx (bindings ...) . rst)
(raise-syntax-error #f "invalid accumulator binding clause(s)" #'orig-stx #'(bindings ...))]
[(_ orig-stx . rst)
(raise-syntax-error #f "bad syntax" #'orig-stx)]))
(define-syntax for*/fold/derived
(syntax-rules ()
(define-syntax (for*/fold/derived stx)
(syntax-case stx ()
[(_ orig-stx ([fold-var finid-init] ...) . rest)
(for/foldX/derived/final [orig-stx #t] ([fold-var finid-init] ...) (values* fold-var ...) . rest)]))
(check-identifier-bindings #'orig-stx #'(fold-var ...) "accumulator" #t)
(syntax/loc #'orig-stx
(for/foldX/derived/final [orig-stx #t] ([fold-var finid-init] ...) (values* fold-var ...) . rest))]
[(_ orig-stx (bindings ...) . rst)
(raise-syntax-error #f "invalid accumulator binding clause(s)" #'orig-stx #'(bindings ...))]
[(_ orig-stx . rst)
(raise-syntax-error #f "bad syntax" #'orig-stx)]))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; derived `for' syntax