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

fixed a bug in extended languages & the _ check

Browse Source
This commit is contained in:
Robby Findler 2010-10-13 17:43:06 -05:00
parent 3e9858b001
commit 2652237559
2 changed files with 12 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1844,7 +1844,7 @@
(raise-syntax-error 'define-extended-language "expected an identifier" stx #'orig-lang))
(check-rhss-not-empty stx (cdddr (syntax->list stx)))
(let ([old-names (language-id-nts #'orig-lang 'define-extended-language)])
(with-syntax ([((new-nt-names orig) ...) (append (pull-out-names 'define-language stx #'(names ...))
(with-syntax ([((new-nt-names orig) ...) (append (pull-out-names 'define-extended-language stx #'(names ...))
(map (λ (x) #`(#,x #f)) old-names))])
#'(begin
(define define-language-name (extend-language orig-lang (names rhs ...) ...))
@ -1877,7 +1877,9 @@
(syntax->list (syntax/loc stx (name ...)))))
(with-syntax ([((r-rhs ...) ...) (map (lambda (rhss) (map (λ (x) (rewrite-side-conditions/check-errs
(append (language-id-nts #'lang 'define-extended-language)
(syntax->datum #'(name ...)))
(map (λ (x) (syntax-case x ()
[(x y) (syntax-e #'x)]))
(pull-out-names 'define-extended-language stx #'(name ...))))
'define-extended-language
#f
x))

8
collects/redex/tests/tl-test.rkt
View File

@ -313,6 +313,14 @@
(term (f 1)))
(test rhs-eval-count 2))
(let ()
(define-language L)
(define-extended-language E L
(v ((bar X_1) X_1))
((X Y) any))
(test (and (redex-match E v (term ((bar 1) 1))) #t) #t)
(test (redex-match E v (term ((bar 1) 2))) #f))
;
;
; ;;; ;