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

add syntax error check when the arrow in a reduction

Browse Source 
relation isn't just an identifier

add a syntax error check when an identifier appears
under two different ellipses depths in the same pattern
This commit is contained in:
Robby Findler 2012-09-20 07:02:35 -05:00
parent e4f03a4045
commit 0e7688349e
2 changed files with 28 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/redex/private/reduction-semantics.rkt
View File

@ -546,14 +546,14 @@
"malformed shortcut"
stx shortcut)]))
shortcuts)
(for-each (λ (rule)
(syntax-case rule ()
[(arrow . rst)
(begin
(set! all-top-levels (cons #'arrow all-top-levels))
(table-cons! ht (syntax arrow) rule))]))
rules)
(for ([rule (in-list rules)])
(syntax-case rule ()
[(arrow . rst)
(begin
(unless (identifier? #'arrow)
(raise-syntax-error orig-name "expected a reduction relation arrow" stx #'arrow))
(set! all-top-levels (cons #'arrow all-top-levels))
(table-cons! ht (syntax arrow) rule))]))
;; signal a syntax error if there are shortcuts defined, but no rules that use them
(unless (null? shortcuts)

25
collects/redex/private/rewrite-side-conditions.rkt
View File

@ -40,6 +40,7 @@
(if (and par (not (eq? chd par))) (recur par (hash-ref sets par #f)) chd)))
(define last-contexts (make-hasheq))
(define last-stx (make-hasheq)) ;; used for syntax error reporting
(define assignments #hasheq())
(define (record-binder pat-stx under)
(define pat-sym (syntax->datum pat-stx))
@ -47,11 +48,25 @@
(if (null? under)
assignments
(let ([last (hash-ref last-contexts pat-sym #f)])
(if last
(foldl (λ (cur last asgns) (union cur last asgns)) assignments under last)
(begin
(hash-set! last-contexts pat-sym under)
assignments))))))
(hash-set! last-stx pat-sym (cons pat-stx (hash-ref last-stx pat-sym '())))
(cond
[last
(unless (equal? (length last) (length under))
(define stxs (hash-ref last-stx pat-sym))
(raise-syntax-error what
(format "found ~a under ~a ellips~as in one place and ~a ellips~as in another"
pat-sym
(length last)
(if (= 1 (length last)) "i" "e")
(length under)
(if (= 1 (length under)) "i" "e"))
orig-stx
(car stxs)
(cdr stxs)))
(foldl (λ (cur last asgns) (union cur last asgns)) assignments under last)]
[else
(hash-set! last-contexts pat-sym under)
assignments])))))
(define ellipsis-number 0)