disallow empty application; rename regexp-match/fail-without-reading to regexp-try-match

svn: r8152

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)

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)

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)))]))))))
   

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)
 
 

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)])

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)))])))
 

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

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]

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)))

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

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

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")

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))

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))

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))))

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'.