diff --git a/collects/browser/private/hyper.ss b/collects/browser/private/hyper.ss index 700bed7061..68670015ff 100644 --- a/collects/browser/private/hyper.ss +++ b/collects/browser/private/hyper.ss @@ -168,7 +168,7 @@ A test case: (let ([new-tag (make-hypertag name pos)]) (set! hypertags-list (let insert-loop ([tags-left hypertags-list]) - (cond [(null? tags-left)(cons new-tag ())] + (cond [(null? tags-left)(cons new-tag '())] [(> pos (hypertag-position (car tags-left))) (cons new-tag tags-left)] [else (cons (car tags-left) diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss index c6e440aedc..93bb4776c3 100644 --- a/collects/drscheme/private/unit.ss +++ b/collects/drscheme/private/unit.ss @@ -3637,7 +3637,7 @@ module browser threading seems wrong. ;; lambda-snipclass is for backwards compatibility ;; (define lambda-snipclass - (make-object (class snip-class% () + (make-object (class snip-class% (define/override (read p) (make-object string-snip% "λ")) (super-new)))) (send lambda-snipclass set-version 1) diff --git a/collects/framework/private/exit.ss b/collects/framework/private/exit.ss index 7b3df1762c..e850351e8e 100644 --- a/collects/framework/private/exit.ss +++ b/collects/framework/private/exit.ss @@ -20,7 +20,7 @@ (set! can?-callbacks (let loop ([cb-list can?-callbacks]) (cond - [(null? cb-list) ()] + [(null? cb-list) '()] [(eq? cb (car cb-list)) (cdr cb-list)] [else (cons (car cb-list) (loop (cdr cb-list)))])))))) @@ -31,7 +31,7 @@ (set! on-callbacks (let loop ([cb-list on-callbacks]) (cond - [(null? cb-list) ()] + [(null? cb-list) '()] [(eq? cb (car cb-list)) (cdr cb-list)] [else (cons (car cb-list) (loop (cdr cb-list)))])))))) diff --git a/collects/mzlib/string.ss b/collects/mzlib/string.ss index e764e5180c..32841c1095 100644 --- a/collects/mzlib/string.ss +++ b/collects/mzlib/string.ss @@ -8,7 +8,7 @@ regexp-match-peek-positions* regexp-split regexp-match-exact? - regexp-match/fail-without-reading) + regexp-try-match) "kw.ss") (provide string-lowercase! @@ -17,7 +17,8 @@ read-from-string read-from-string-all expr->string - (all-from scheme/base) + (all-from-except scheme/base regexp-try-match) + (rename regexp-try-match regexp-match/fail-without-reading) glob->regexp) diff --git a/collects/scheme/private/kw.ss b/collects/scheme/private/kw.ss index 6c79e0336d..3b8c3690c2 100644 --- a/collects/scheme/private/kw.ss +++ b/collects/scheme/private/kw.ss @@ -605,8 +605,14 @@ #f "illegal use" stx) - (quasisyntax/loc stx - (#%app . #,(cdr (syntax-e stx))))) + (if (and (pair? l) + (null? (cdr l))) + (raise-syntax-error + #f + "missing procedure expression; probably originally (), which is an illegal empty application" + stx) + (quasisyntax/loc stx + (#%app . #,(cdr (syntax-e stx)))))) ;; keyword app (maybe) (let ([exprs (let ([kw-ht (make-hash-table)]) diff --git a/collects/scheme/private/list.ss b/collects/scheme/private/list.ss index 1427379397..9d716760c3 100644 --- a/collects/scheme/private/list.ss +++ b/collects/scheme/private/list.ss @@ -130,7 +130,7 @@ (raise-type-error who "list" list)) (let loop ([list list]) (cond - [(null? list) ()] + [(null? list) null] [(equal? item (car list)) (cdr list)] [else (cons (car list) (loop (cdr list)))]))) diff --git a/collects/scheme/private/string.ss b/collects/scheme/private/string.ss index 7ec40ca504..74da38ca3e 100644 --- a/collects/scheme/private/string.ss +++ b/collects/scheme/private/string.ss @@ -8,7 +8,7 @@ regexp-match-peek-positions* regexp-split regexp-match-exact? - regexp-match/fail-without-reading) + regexp-try-match) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -59,12 +59,12 @@ (regexp-replace* #rx#"[&\\]" s #"\\\\&") (regexp-replace* #rx"[&\\]" s "\\\\&")))) - (define (regexp-match/fail-without-reading pattern input-port [start-k 0] [end-k #f] [out #f]) + (define (regexp-try-match pattern input-port [start-k 0] [end-k #f] [out #f]) (unless (input-port? input-port) - (raise-type-error 'regexp-match/fail-without-reading + (raise-type-error 'regexp-try-match "input port" input-port)) (unless (or (not out) (output-port? out)) - (raise-type-error 'regexp-match/fail-without-reading + (raise-type-error 'regexp-try-match "output port or #f" out)) (let ([m (regexp-match-peek-positions pattern input-port start-k end-k)]) (and m diff --git a/collects/scribblings/reference/regexps.scrbl b/collects/scribblings/reference/regexps.scrbl index dd8074928d..6c63f7fd55 100644 --- a/collects/scribblings/reference/regexps.scrbl +++ b/collects/scribblings/reference/regexps.scrbl @@ -265,18 +265,17 @@ input port. When matching an input port, a match failure reads up to @scheme[end-pos] bytes (or end-of-file), even if @scheme[pattern] begins with a start-of-string @litchar{^}; see also -@scheme[regexp-match/fail-without-reading]. On success, all bytes up -to and including the match are eventually read from the port, but -matching proceeds by first peeking bytes from the port (using -@scheme[peek-bytes-avail!]), and then (re-)reading matching bytes to -discard them after the match result is determined. Non-matching bytes -may be read and discarded before the match is determined. The matcher -peeks in blocking mode only as far as necessary to determine a match, -but it may peek extra bytes to fill an internal buffer if immediately -available (i.e., without blocking). Greedy repeat operators in -@scheme[pattern], such as @litchar{*} or @litchar{+}, tend to force -reading the entire content of the port (up to @scheme[end-pos]) to -determine a match. +@scheme[regexp-try-match]. On success, all bytes up to and including +the match are eventually read from the port, but matching proceeds by +first peeking bytes from the port (using @scheme[peek-bytes-avail!]), +and then (re-)reading matching bytes to discard them after the match +result is determined. Non-matching bytes may be read and discarded +before the match is determined. The matcher peeks in blocking mode +only as far as necessary to determine a match, but it may peek extra +bytes to fill an internal buffer if immediately available (i.e., +without blocking). Greedy repeat operators in @scheme[pattern], such +as @litchar{*} or @litchar{+}, tend to force reading the entire +content of the port (up to @scheme[end-pos]) to determine a match. If the input port is read simultaneously by another thread, or if the port is a custom port with inconsistent reading and peeking procedures @@ -324,7 +323,7 @@ port). ]} -@defproc[(regexp-match/fail-without-reading +@defproc[(regexp-try-match [pattern (or/c string? bytes? regexp? byte-regexp?)] [input input-port?] [start-pos nonnegative-exact-integer? 0] diff --git a/collects/tests/mzscheme/basic.ss b/collects/tests/mzscheme/basic.ss index 19529741e4..21651c8882 100644 --- a/collects/tests/mzscheme/basic.ss +++ b/collects/tests/mzscheme/basic.ss @@ -6,7 +6,7 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (test '() 'null null) -(test '() 'null ()) +(test '() 'null '()) (let ([f (lambda () #&7)]) (test #t eq? (f) (f))) diff --git a/collects/tests/mzscheme/name.ss b/collects/tests/mzscheme/name.ss index 2e2f689ecd..343022ac83 100644 --- a/collects/tests/mzscheme/name.ss +++ b/collects/tests/mzscheme/name.ss @@ -69,11 +69,11 @@ (test 'f object-name f) ; Test class stuff ok when no name -(test #t src-name? (object-name (class object% () (super-make-object)))) +(test #t src-name? (object-name (class object% (super-make-object)))) (test #t src-name? (object-name (interface ()))) ; Test class stuff ok when name -(test 'class:c1 object-name (let ([c1 (class object% () (super-make-object))]) c1)) +(test 'class:c1 object-name (let ([c1 (class object% (super-make-object))]) c1)) (test 'interface:i1 object-name (let ([i1 (interface ())]) i1)) ; Test unit stuff ok when no name diff --git a/collects/tests/mzscheme/object.ss b/collects/tests/mzscheme/object.ss index cd770fcfa7..82c8a657ea 100644 --- a/collects/tests/mzscheme/object.ss +++ b/collects/tests/mzscheme/object.ss @@ -1058,7 +1058,7 @@ (syntax-test #'(new x ("a" x))) (test #t object? (new object%)) -(test #t object? (new (class object% () (init-field x) (super-instantiate ())) (x 1))) +(test #t object? (new (class object% (init-field x) (super-instantiate ())) (x 1))) ;; ------------------------------------------------------------ ;; `field' tests diff --git a/collects/tests/mzscheme/pconvert.ss b/collects/tests/mzscheme/pconvert.ss index bcea9b779d..2e970bb8e6 100644 --- a/collects/tests/mzscheme/pconvert.ss +++ b/collects/tests/mzscheme/pconvert.ss @@ -11,7 +11,7 @@ (quasi-read-style-printing #f) (define (xl) 1) -(define (xc) (class object% () (sequence (super-init)))) +(define (xc) (class object% (sequence (super-init)))) (let () (define-struct pctest (value constructor-sexp @@ -183,8 +183,8 @@ xl-ID-BETTER-NOT-BE-DEFINED) '(lambda () ...)) (make-same-test xc 'xc) - (make-same-test (letrec ([xc (class object% ())]) xc) '(class ...)) - (make-same-test (letrec ([xc-ID-BETTER-NOT-BE-DEFINED (class object% ())]) + (make-same-test (letrec ([xc (class object%)]) xc) '(class ...)) + (make-same-test (letrec ([xc-ID-BETTER-NOT-BE-DEFINED (class object%)]) xc-ID-BETTER-NOT-BE-DEFINED) '(class ...)) (make-same-test (lambda (x) x) '(lambda (a1) ...)) @@ -212,7 +212,7 @@ (hash-table-put! ht 'x 1) ht) '(hash-table ('x 1))) - (make-pctest (list 'a (box (list ())) (cons 1 '())) + (make-pctest (list 'a (box (list '())) (cons 1 '())) '(list (quote a) (box (list empty)) (list 1)) '(list (quote a) (box (list empty)) (list 1)) '(list (quote a) (box (list empty)) (list 1)) @@ -346,7 +346,7 @@ (test-not-shared 'x ''x) (test-shared (lambda (x) x) '(lambda (a1) ...)) (test-shared (delay 1) '(delay ...)) - (test-shared (class object% ()) '(class ...)) + (test-shared (class object%) '(class ...)) (test-shared (new (class object% (super-new))) '(instantiate (class ...) ...)) (test-shared "abc" "abc") diff --git a/collects/tests/mzscheme/quiet.ss b/collects/tests/mzscheme/quiet.ss index 1cff4e09a9..311a258b3e 100644 --- a/collects/tests/mzscheme/quiet.ss +++ b/collects/tests/mzscheme/quiet.ss @@ -25,7 +25,7 @@ ;; -- set up a timeout (thread (lambda () (sleep 600) - (fprintf err "\n\n~aTIMEOUT -- ABORTING!\n" (get-section-prefix)) + (fprintf err "\n\n~aTIMEOUT -- ABORTING!\n" Section-prefix) (exit 3) ;; in case the above didn't work for some reason (sleep 60) @@ -42,7 +42,7 @@ (lambda (thunk) (when last-error (fprintf real-error-port "~aERROR: ~a\n" - (get-section-prefix) + Section-prefix (if (exn? last-error) (exn-message last-error) last-error)) (exit 2)))) (report-errs #t)) diff --git a/collects/tests/mzscheme/syntax.ss b/collects/tests/mzscheme/syntax.ss index 09d2542172..b5455f3d3b 100644 --- a/collects/tests/mzscheme/syntax.ss +++ b/collects/tests/mzscheme/syntax.ss @@ -642,7 +642,7 @@ (let ((name1 'x) (name2 'y)) `(a `(b ,,name1 ,',name2 d) e))) (test '(list 3 4) 'quasiquote (quasiquote (list (unquote (+ 1 2)) 4))) (test '`(list ,(+ 1 2) 4) 'quasiquote '(quasiquote (list (unquote (+ 1 2)) 4))) -(test '(()) 'qq `((,@()))) +(test '(()) 'qq `((,@'()))) (define x 5) (test '(quasiquote (unquote x)) 'qq ``,x) (test '(quasiquote (unquote 5)) 'qq ``,,x) @@ -995,7 +995,8 @@ (+ 1 2))) (test 3 '#%app (#%app + 1 2)) -(test null '#%app (#%app)) +(syntax-test #'()) +(syntax-test #'(#%app)) (syntax-test #'#%top) (syntax-test #'(#%top 1)) diff --git a/collects/tests/mzscheme/unit.ss b/collects/tests/mzscheme/unit.ss index e997409878..7358951dec 100644 --- a/collects/tests/mzscheme/unit.ss +++ b/collects/tests/mzscheme/unit.ss @@ -417,7 +417,7 @@ (test #t unit? (unit (import x) (export) - (class object% () + (class object% (field [x 10]) (set! x 5)))) diff --git a/doc/release-notes/mzscheme/MzScheme_4.txt b/doc/release-notes/mzscheme/MzScheme_4.txt index 4e9e5117f3..c179a9c7ff 100644 --- a/doc/release-notes/mzscheme/MzScheme_4.txt +++ b/doc/release-notes/mzscheme/MzScheme_4.txt @@ -334,6 +334,8 @@ with some syntactic and name changes. * One-armed `if' is prohibited; use `when', instead. + * Empty applications, (), are disallowed, instead of producing '(). + * Some popular procedures formerly in libraries have been moved into `scheme/base', including `filter', `remq', and `regexp-split'.