warning to stderr, not stdout

See PR 11691
  Merge to release branch

original commit: fd3595e7d30b7fcabba84185f8d5c4e6d63aa239

collects/parser-tools/examples/calc.rkt

@@ -82,7 +82,7 @@
 	    (lambda ()
 	      (let ((result (calcp (lambda () (calcl ip)))))
 		(when result
-                  (printf "~a~n" result)
+                  (printf "~a\n" result)
                   (one-line))))))
     (one-line)))
 

collects/parser-tools/lex.rkt

@@ -113,7 +113,7 @@
                                       (let ((next-check (vector-ref next 1)))
                                         (or (>= next-check max-char-num)
                                             (loop (add1 next-check) (cdr nexts))))))))))
-                   (printf "Warning: lexer at ~a can accept the empty string.~n" stx)))
+                   (eprintf "Warning: lexer at ~a can accept the empty string.\n" stx)))
                (with-syntax ((start-state-stx start)
                              (trans-table-stx trans)
                              (no-lookahead-stx no-look)
@@ -230,7 +230,7 @@
               (lambda (ip)
                 (let ((first-pos (get-position ip))
                       (first-char (peek-char-or-special ip 0)))
-                  ;(printf "(peek-char-or-special port 0) = ~e~n" first-char)
+                  ;(printf "(peek-char-or-special port 0) = ~e\n" first-char)
                   (cond
                     ((eof-object? first-char)
                      (do-match ip first-pos eof-action (read-char-or-special ip)))
@@ -279,7 +279,7 @@
                             (let* ((act (vector-ref actions next-state))
                                    (next-length-bytes (+ (char-utf-8-length char) length-bytes))
                                    (next-char (peek-char-or-special ip next-length-bytes)))
-                              #;(printf "(peek-char-or-special port ~e) = ~e~n"
+                              #;(printf "(peek-char-or-special port ~e) = ~e\n"
                                       next-length-bytes next-char)
                               (lexer-loop next-state 
                                           next-char
@@ -312,13 +312,13 @@
 	 (position-offset first-pos)
 	 (- (position-offset end-pos) (position-offset first-pos)))))
     (let ((match (read-string longest-match-length lb)))
-      ;(printf "(read-string ~e port) = ~e~n" longest-match-length match)
+      ;(printf "(read-string ~e port) = ~e\n" longest-match-length match)
       (do-match lb first-pos longest-match-action match)))
       
   (define file-path (make-parameter #f))
                    
   (define (do-match ip first-pos action value)
-    #;(printf "(action ~a ~a ~a ~a)~n" 
+    #;(printf "(action ~a ~a ~a ~a)\n" 
             (position-offset first-pos) (position-offset (get-position ip)) value ip)
     (action first-pos (get-position ip) value ip))
   

collects/parser-tools/parser-tools.scrbl

@@ -140,7 +140,7 @@ are a few examples, using @scheme[:] prefixed SRE syntax:
 
 @item{@schemeblock0[(:: "/*" (:* (complement "*/")) "*/")]
 
- Matches any string that starts with @scheme["/*"] and and ends with
+ Matches any string that starts with @scheme["/*"] and ends with
  @scheme["*/"], including @scheme["/* */ */ */"].
  @scheme[(complement "*/")] matches any string except @scheme["*/"].
  This includes @scheme["*"] and @scheme["/"] separately.  Thus

collects/parser-tools/private-lex/deriv.rkt

@@ -281,13 +281,13 @@
                (else (loop old-states new-states all-states (cdr cs))))))))))
   
   (define (print-dfa x)
-    (printf "number of states: ~a~n" (dfa-num-states x))
+    (printf "number of states: ~a\n" (dfa-num-states x))
-    (printf "start state: ~a~n" (dfa-start-state x))
+    (printf "start state: ~a\n" (dfa-start-state x))
-    (printf "final states: ~a~n" (map car (dfa-final-states/actions x)))
+    (printf "final states: ~a\n" (map car (dfa-final-states/actions x)))
     (for-each (lambda (trans)
-                (printf "state: ~a~n" (car trans))
+                (printf "state: ~a\n" (car trans))
                 (for-each (lambda (rule)
-                            (printf "  -~a-> ~a~n"
+                            (printf "  -~a-> ~a\n"
                                     (is:integer-set-contents (car rule))
                                     (cdr rule)))
                           (cdr trans)))

collects/parser-tools/private-lex/front.rkt

@@ -170,7 +170,7 @@
                      (vector->list x))))
                 (vector->list table))
                (length (hash-table-map ht cons)))))
-        (printf "~a states, ~aKB~n"
+        (printf "~a states, ~aKB\n"
                 num-states
                 (/ (* 4.0 (+ 2 num-states (* 2 num-vectors) num-entries
                              (* 5 num-different-entries))) 1024)))

collects/parser-tools/private-lex/util.rkt

@@ -14,7 +14,7 @@
        (let* defs
          (let ((real-ans code))
            (unless (equal? real-ans right-ans)
-             (printf "Test failed: ~e gave ~e.  Expected ~e~n"
+             (printf "Test failed: ~e gave ~e.  Expected ~e\n"
                      'code real-ans 'right-ans))) ...))))
 
   (define-syntax test-block

collects/parser-tools/private-yacc/lalr.rkt

@@ -149,14 +149,14 @@
     (print-input-st-prod l "LA" a g print-output-terms))
 
   (define (print-input-st-sym f name a g print-output)
-    (printf "~a:~n" name)
+    (printf "~a:\n" name)
     (send a for-each-state
      (lambda (state)
        (for-each
         (lambda (non-term)
           (let ((res (f (make-trans-key state non-term))))
             (if (not (null? res))
-                (printf "~a(~a, ~a) = ~a~n"
+                (printf "~a(~a, ~a) = ~a\n"
                         name
                         state
                         (gram-sym-symbol non-term)
@@ -165,7 +165,7 @@
     (newline))
 
   (define (print-input-st-prod f name a g print-output)
-    (printf "~a:~n" name)
+    (printf "~a:\n" name)
     (send a for-each-state
      (lambda (state)
        (for-each
@@ -174,7 +174,7 @@
            (lambda (prod)
              (let ((res (f state prod)))
                (if (not (null? res))
-                   (printf "~a(~a, ~a) = ~a~n"
+                   (printf "~a(~a, ~a) = ~a\n"
                            name
                            (kernel-index state)
                            (prod-index prod)

collects/parser-tools/private-yacc/lr0.rkt

@@ -167,7 +167,7 @@
   ;; build-LR0-automaton: grammar -> LR0-automaton
   ;; Constructs the kernels of the sets of LR(0) items of g
   (define (build-lr0-automaton grammar)
-;    (printf "LR(0) automaton:~n")
+;    (printf "LR(0) automaton:\n")
     (letrec (
 	     (epsilons (make-hash-table 'equal))
 	     (grammar-symbols (append (send grammar get-non-terms)
@@ -304,7 +304,7 @@
                            (set! automaton-non-term (cons (cons (make-trans-key kernel gs)
                                                                 unique-kernel)
                                                           automaton-non-term))))
-                        #;(printf "~a -> ~a on ~a~n" 
+                        #;(printf "~a -> ~a on ~a\n" 
  				(kernel->string kernel)
  				(kernel->string unique-kernel)
 				(gram-sym-symbol gs))

collects/parser-tools/private-yacc/parser-builder.rkt

@@ -91,9 +91,9 @@
                     (hash-table-put! ht x #t)))
                 (map cdr (apply append (vector->list table))))
                (length (hash-table-map ht void)))))
-        (printf "~a states, ~a grammar symbols, ~a hash-table entries, ~a reduces~n"
+        (printf "~a states, ~a grammar symbols, ~a hash-table entries, ~a reduces\n"
                 num-states num-gram-syms num-ht-entries num-reduces)
-        (printf "~a -- ~aKB, previously ~aKB~n"
+        (printf "~a -- ~aKB, previously ~aKB\n"
                 (/ (+ 2 num-states
                       (* 4 num-states) (* 2 1.5 num-ht-entries)
                       (* 5 num-reduces)) 256.0)

collects/parser-tools/private-yacc/table.rkt

@@ -97,16 +97,16 @@
       (for-each
        (lambda (prod)
          (fprintf port 
-                  "~a\t~a\t=\t~a~n" 
+                  "~a\t~a\t=\t~a\n" 
                   (prod-index prod)
                   (gram-sym-symbol (prod-lhs prod))
                   (map gram-sym-symbol (vector->list (prod-rhs prod)))))
        prods)
       (send a for-each-state
         (lambda (state)
-          (fprintf port "State ~a~n" (kernel-index state))
+          (fprintf port "State ~a\n" (kernel-index state))
           (for-each (lambda (item)
-                      (fprintf port "\t~a~n" (item->string item)))
+                      (fprintf port "\t~a\n" (item->string item)))
                     (kernel-items state))
           (newline port)
           (for-each
@@ -118,22 +118,22 @@
                 ((null? (cdr act))
                  (print-entry sym (car act) port))
                 (else
-                 (fprintf port "begin conflict:~n")
+                 (fprintf port "begin conflict:\n")
                  (when (> (count reduce? act) 1)
                    (set! RR-conflicts (add1 RR-conflicts)))
                  (when (> (count shift? act) 0)
                    (set! SR-conflicts (add1 SR-conflicts)))
                  (map (lambda (x) (print-entry sym x port)) act)
-                 (fprintf port "end conflict~n")))))
+                 (fprintf port "end conflict\n")))))
            (vector-ref grouped-table (kernel-index state)))
           (newline port)))
       
       (when (> SR-conflicts 0)
-        (fprintf port "~a shift/reduce conflict~a~n" 
+        (fprintf port "~a shift/reduce conflict~a\n" 
                  SR-conflicts
                  (if (= SR-conflicts 1) "" "s")))
       (when (> RR-conflicts 0)
-        (fprintf port "~a reduce/reduce conflict~a~n"
+        (fprintf port "~a reduce/reduce conflict~a\n"
                  RR-conflicts
                  (if (= RR-conflicts 1) "" "s")))))
   
@@ -159,7 +159,7 @@
               (loop (car rest) (cdr rest)))
              ((accept? (car rest))
               (fprintf (current-error-port) 
-                       "accept/reduce or accept/shift conflicts.  Check the grammar for useless cycles of productions~n")
+                       "accept/reduce or accept/shift conflicts.  Check the grammar for useless cycles of productions\n")
               (loop current-guess (cdr rest)))
              (else (loop current-guess (cdr rest)))))))))
   
@@ -180,12 +180,12 @@
       (unless suppress
         (when (> SR-conflicts 0)
           (fprintf (current-error-port) 
-                   "~a shift/reduce conflict~a~n" 
+                   "~a shift/reduce conflict~a\n" 
                    SR-conflicts
                    (if (= SR-conflicts 1) "" "s")))
         (when (> RR-conflicts 0)
           (fprintf (current-error-port)
-                   "~a reduce/reduce conflict~a~n"
+                   "~a reduce/reduce conflict~a\n"
                    RR-conflicts
                    (if (= RR-conflicts 1) "" "s"))))
       table))

collects/parser-tools/private-yacc/yacc-helper.rkt

@@ -74,7 +74,7 @@
                           (car rhs))
                 (if (= 3 (length rhs))
                     (p "%prec ~a" (cadadr rhs)))
-                (p "~n"))))
+                (p "\n"))))
         (for-each
          (lambda (t)
            (for-each
@@ -86,7 +86,7 @@
          (lambda (t)
            (for-each
             (lambda (t)
-              (p "%token ~a~n" t)
+              (p "%token ~a\n" t)
               (hash-table-put! term-table t (format "~a" t)))
             (syntax-object->datum (terminals-def-t t))))
          terms)
@@ -96,10 +96,10 @@
                         (for-each (lambda (tok)
                                     (p " ~a" (hash-table-get term-table tok)))
                                   (cdr prec))
-                        (p "~n"))
+                        (p "\n"))
                       precs))
-        (p "%start ~a~n" start)
+        (p "%start ~a\n" start)
-        (p "%%~n")
+        (p "%%\n")
 
         (for-each (lambda (prod)
                     (let ((nt (car prod)))
@@ -109,9 +109,9 @@
                                   (p "| ")
                                   (display-rhs rhs))
                                 (cddr prod))
-                      (p ";~n")))
+                      (p ";\n")))
           grammar)
-        (p "%%~n"))))
+        (p "%%\n"))))
   
 
 )  

collects/parser-tools/yacc-to-scheme.rkt

@@ -8,14 +8,14 @@
   
   (define match-double-string
     (lexer
-     ((:* (:~ #\" #\\)) (append (string->list lexeme)
+     ((:+ (:~ #\" #\\)) (append (string->list lexeme)
                                 (match-double-string input-port)))
      ((:: #\\ any-char) (cons (string-ref lexeme 1) (match-double-string input-port)))
      (#\" null)))
 
    (define match-single-string
     (lexer
-     ((:* (:~ #\' #\\)) (append (string->list lexeme)
+     ((:+ (:~ #\' #\\)) (append (string->list lexeme)
                                 (match-single-string input-port)))
      ((:: #\\ any-char) (cons (string-ref lexeme 1) (match-single-string input-port)))
      (#\' null)))

collects/parser-tools/yacc.rkt

@@ -174,7 +174,7 @@
                               (lambda (e)
                                 (fprintf 
                                  (current-error-port)
-                                 "Cannot write yacc-output to file \"~a\"~n"
+                                 "Cannot write yacc-output to file \"~a\"\n"
                                  yacc-output)))]
                (call-with-output-file yacc-output
                  (lambda (port)
@@ -271,14 +271,14 @@
                             (let ((a (find-action stack tok val start-pos end-pos)))
                               (cond
                                 ((runtime-shift? a)
-                                 ;; (printf "shift:~a~n" (runtime-shift-state a))
+                                 ;; (printf "shift:~a\n" (runtime-shift-state a))
                                  (cons (make-stack-frame (runtime-shift-state a)
                                                          val
                                                          start-pos
                                                          end-pos)
                                        stack))
                                 (else
-                                 ;; (printf "discard input:~a~n" tok)
+                                 ;; (printf "discard input:~a\n" tok)
                                  (let-values (((tok val start-pos end-pos)
                                                (extract (get-token))))
                                    (remove-input tok val start-pos end-pos))))))))
@@ -286,7 +286,7 @@
                   (let ((a (find-action stack 'error #f start-pos end-pos)))
                     (cond
                       ((runtime-shift? a)
-                       ;; (printf "shift:~a~n" (runtime-shift-state a))
+                       ;; (printf "shift:~a\n" (runtime-shift-state a))
                        (set! stack 
                              (cons
                               (make-stack-frame (runtime-shift-state a) 
@@ -296,7 +296,7 @@
                               stack))
                        (remove-input tok val start-pos end-pos))
                       (else
-                       ;; (printf "discard state:~a~n" (car stack))
+                       ;; (printf "discard state:~a\n" (car stack))
                        (cond
                          ((< (length stack) 2)
                           (raise-read-error "parser: Cannot continue after error"
@@ -330,7 +330,7 @@
                     (let ((action (find-action stack tok val start-pos end-pos)))
                       (cond
                         ((runtime-shift? action)
-                         ;; (printf "shift:~a~n" (runtime-shift-state action))
+                         ;; (printf "shift:~a\n" (runtime-shift-state action))
                          (parsing-loop (cons (make-stack-frame (runtime-shift-state action)
                                                                val
                                                                start-pos
@@ -338,7 +338,7 @@
                                              stack)
                                        (get-token)))
                         ((runtime-reduce? action)
-                         ;; (printf "reduce:~a~n" (runtime-reduce-prod-num action))
+                         ;; (printf "reduce:~a\n" (runtime-reduce-prod-num action))
                          (let-values (((new-stack args)
                                        (reduce-stack stack 
                                                      (runtime-reduce-rhs-length action)
@@ -367,7 +367,7 @@
                                new-stack)
                               ip))))
                         ((runtime-accept? action)
-                         ;; (printf "accept~n")
+                         ;; (printf "accept\n")
                          (stack-frame-value (car stack)))
                         (else 
                          (if src-pos