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

relaxed the restrictions on planet requires in the teaching languages to allow the new forms

Browse Source
This commit is contained in:
Robby Findler 2011-10-07 07:47:40 -05:00
parent 57deb86f7b
commit a40f288e48
2 changed files with 35 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
collects/lang/private/teach.rkt
View File

@ -1550,29 +1550,39 @@
'stepper-black-box-expr 'stepper-black-box-expr
stx)]))] stx)]))]
[(_ (planet . rest)) [(_ (planet . rest))
(syntax-case stx (planet) (let ([go
[(_ (planet s1 (s2 s3 n1 n2))) (λ ()
(and (string? (syntax-e #'s1)) ;; use the original `planet', so that it binds correctly:
(string? (syntax-e #'s2)) (syntax-case stx ()
(string? (syntax-e #'s3)) [(_ ms) (stepper-syntax-property
(version-number? (syntax-e #'n1)) #'(require ms)
(version-number? (syntax-e #'n2))) 'stepper-black-box-expr
(begin stx)]))])
(check-string-form stx #'s1) (syntax-case stx (planet)
(check-string-form stx #'s2) [(_ (planet s1 (s2 s3 n1 n2)))
(check-string-form stx #'s3) (and (string? (syntax-e #'s1))
;; use the original `planet', so that it binds correctly: (string? (syntax-e #'s2))
(syntax-case stx () (string? (syntax-e #'s3))
[(_ ms) (stepper-syntax-property (version-number? (syntax-e #'n1))
#'(require ms) (version-number? (syntax-e #'n2)))
'stepper-black-box-expr (begin
stx)]))] (check-string-form stx #'s1)
[_else (check-string-form stx #'s2)
(teach-syntax-error (check-string-form stx #'s3)
'require (go))]
stx [(_ (planet a))
#f (or (string? (syntax-e #'a))
"not a valid planet path; should be: (require (planet STRING (STRING STRING NUMBER NUMBER)))")])] (symbol? (syntax-e #'a)))
(go)]
[_else
(teach-syntax-error
'require
stx
#f
(string-append
"not a valid planet path; should be:"
" (require (planet STRING (STRING STRING NUMBER NUMBER)))"
" (require (planet STRING)) or (require (planet SYMBOL))"))]))]
[(_ thing) [(_ thing)
(teach-syntax-error (teach-syntax-error
'require 'require

2
collects/tests/htdp-lang/beg-adv.rktl
View File

@ -247,6 +247,8 @@
(htdp-syntax-test #'(require (lib "a" "b/")) #rx"end with a slash") (htdp-syntax-test #'(require (lib "a" "b/")) #rx"end with a slash")
(htdp-syntax-test #'(require (lib "a" 2)) #rx"string for a lib path") (htdp-syntax-test #'(require (lib "a" 2)) #rx"string for a lib path")
(htdp-syntax-test #'(require (planet "a" 2)) #rx"not a valid planet path") (htdp-syntax-test #'(require (planet "a" 2)) #rx"not a valid planet path")
(htdp-syntax-test #'(require (planet "test-connectionλ.ss" ("planet" "test-connection.plt" 1 0)))
#rx"string can contain only")
(define rx:dots-error "found a template") (define rx:dots-error "found a template")