fixed a totally misleading error message in big-bang; MUST GO INTO RELEASE

This commit is contained in:
Matthias Felleisen 2011-07-22 10:34:00 -04:00
parent 8711aa6c5d
commit ed7f16c872
2 changed files with 15 additions and 6 deletions

View File

@ -7,8 +7,17 @@
(error-print-source-location #f)
(define legal "big-bang: ~a clauses are not allowed when using big-bang")
(define double
"big-bang: the on-tick clause appears twice")
(define double "big-bang: the on-tick clause appears twice")
(define atleast "big-bang: expects a [to-draw handler] clause, missing")
;; is the mandatort to-draw clause specified
(with-handlers ((exn:fail:syntax?
(lambda (x)
(unless (string=? (exn-message x) atleast) (raise x)))))
(eval '(module a scheme
(require 2htdp/universe)
(local ((define (run) (big-bang 0 (on-tick add1))))
10))))
(with-handlers ((exn:fail:syntax?
(lambda (x)

View File

@ -225,7 +225,7 @@
"wheel-down"))
(define-syntax (big-bang stx)
(define world0 "expects an expression for the initial world and at least one clause, but nothing's there")
(define world0 "expects an expression for the initial world and at least one clause")
(syntax-case stx ()
[(big-bang) (raise-syntax-error #f world0 stx)]
[(big-bang w clause ...)
@ -241,7 +241,7 @@
[dom (syntax->list #'(clause ...))])
(cond
[(and (not (contains-clause? #'to-draw dom)) (not (contains-clause? #'on-draw dom)))
(raise-syntax-error #f "expects at least one clause after the initial world, but nothing's there" stx)]
(raise-syntax-error #f "expects a [to-draw handler] clause, missing" stx)]
[else
(stepper-syntax-property
#`(run-it ((new-world (if #,rec? aworld% world%)) w #,@args))
@ -321,8 +321,8 @@
(define-syntax (universe stx)
(syntax-case stx ()
[(universe) (raise-syntax-error #f "expects an expression for the initial world and at least one clause, but nothing's there" stx)]
[(universe u) (raise-syntax-error #f "expects at least one clause after the initial world, but nothing's there" stx)]
[(universe) (raise-syntax-error #f "expects an expression for the initial world" stx)]
[(universe u) (raise-syntax-error #f "expects at least an on-new and an on-msg clause after the initial world" stx)]
[(universe u bind ...)
(let* ([args (->args 'universe stx #'u #'(bind ...) UniSpec void)]
[dom (syntax->list #'(bind ...))])