- added tests for the case and exclusive-cond syntax-error calls

    4.ms, root-experr-compile-0-f-f-f
- added print-extended-identifier parameter.  when #t, symbols like
  1+ and +++ print without escapes.
    priminfo.ss, print.ss,
    6.ms

LOG

@@ -298,4 +298,10 @@
     7.ms
 - fixed a bug in case and exclusive-cond syntax-error calls causing an
   exception in syntax-error instead of the intended error message.
-    s/syntax.ss
+    syntax.ss
+- added tests for the case and exclusive-cond syntax-error calls
+    4.ms, root-experr-compile-0-f-f-f
+- added print-extended-identifier parameter.  when #t, symbols like
+  1+ and +++ print without escapes.
+    priminfo.ss, print.ss,
+    6.ms

mats/4.ms

@@ -393,6 +393,8 @@
  )
 
 (mat exclusive-cond
+   (error? ; invalid syntax
+     (exclusive-cond [a . b]))
    (let ((a 'a))
       (and (begin (set! a 3)
                   (exclusive-cond ((= a 4) #f) ((= a 3) #t) (else #f)))
@@ -464,6 +466,8 @@
  )
 
 (mat case
+   (error? ; invalid syntax
+     (case 3 [a . b]))
    (eq? (case 'a [a 'yes] [b 'no]) 'yes)
    (let ((a 'a))
       (and

mats/6.ms

@@ -1085,6 +1085,16 @@
                  (pretty-print '#(1 2 3 3 3))
                  (pretty-print '#vfx(5 7 9 8 8 9 -1 -1)))))
            "#5(1 2 3)\n#8vfx(5 7 9 8 8 9 -1)\n")
+   (equal? (parameterize ([print-extended-identifiers #f])
+             (with-output-to-string
+               (lambda ()
+                 (for-each pretty-print '(1+ +++ .. |12| xyz aBc |-155| |.5e7| |.5e|)))))
+           "\\x31;+\n\\x2B;++\n\\x2E;.\n\\x31;2\nxyz\naBc\n\\x2D;155\n\\x2E;5e7\n\\x2E;5e\n")
+   (equal? (parameterize ([print-extended-identifiers #t])
+             (with-output-to-string
+               (lambda ()
+                 (for-each pretty-print '(1+ +++ .. |12| xyz aBc |-155| |.5e7| |.5e|)))))
+           "1+\n+++\n..\n\\x31;2\nxyz\naBc\n\\x2D;155\n\\x2E;5e7\n.5e\n")
    (equal? (parameterize ([print-gensym #f])
               (format "~s" '(#3# #3=#{g0 fool})))
            "(g0 g0)")

mats/root-experr-compile-0-f-f-f

@@ -243,7 +243,9 @@ primvars.mo:Expected error in mat trace-output-port: "trace-output-port: #<input
 4.mo:Expected error in mat apply: "apply: (1 2 1 2 1 2 ...) is circular".
 4.mo:Expected error in mat begin: "invalid syntax (begin)".
 4.mo:Expected error in mat cond: "invalid syntax x".
+4.mo:Expected error in mat exclusive-cond: "invalid exclusive-cond clause (a . b)".
 4.mo:Expected error in mat exclusive-cond: "invalid syntax x".
+4.mo:Expected error in mat case: "invalid case clause (a . b)".
 4.mo:Expected error in mat r6rs:case: "invalid syntax (r6rs:case (quote a) (a (quote yes)) (b (quote no)))".
 4.mo:Expected error in mat r6rs:case: "invalid syntax (case (quote a) (a (quote yes)) (b (quote no)))".
 4.mo:Expected error in mat named-let: "incorrect argument count in call ((letrec ((...)) x) 3 4)".

s/primdata.ss

@@ -972,6 +972,7 @@
   (pretty-standard-indent [sig [() -> (ufixnum)] [(ufixnum) -> (void)]] [flags])
   (print-brackets [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
   (print-char-name [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
+  (print-extended-identifiers [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
   (print-gensym [sig [() -> (ptr)] [(ptr) -> (void)]] [flags unrestricted])
   (print-graph [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
   (print-length [sig [() -> (maybe-ufixnum)] [(maybe-ufixnum) -> (void)]] [flags])

s/print.ss

@@ -1143,6 +1143,77 @@ floating point returns with (1 0 -1 ...).
           [else (print-hex-char c p)]))
       (s1 s p n (fx+ i 1))))
 
+  (define extended-identifier?
+    (let ()
+      (define-syntax state-machine
+        (lambda (x)
+          (syntax-case x ()
+            ((_k start-state (name def (test e) ...) ...)
+             (with-implicit (_k s i n) ; support num4 kludge
+               #'(let ()
+                   (define name
+                     (lambda (s i n)
+                       (if (= i n)
+                           def
+                           (let ([g (string-ref s i)])
+                             (state-machine-help (s i n) g (test e) ... ))))) ...
+                   (lambda (string)
+                     (start-state string 0 (string-length string)))))))))
+      (define-syntax state-machine-help
+        (syntax-rules (else to skip)
+          [(_ (s i n) c [test (skip to x)] more ...)
+           (state-machine-help (s i n) c [test (x s i n)] more ...)]
+          [(_ (s i n) c [test (to x)] more ...)
+           (state-machine-help (s i n) c [test (x s (fx+ i 1) n)] more ...)]
+          [(_ (s i n) c [else e]) e]
+          [(_ (s i n) c [test e] more ...)
+           (if (state-machine-test c test)
+               e
+               (state-machine-help (s i n)c more ...))]))
+      (define-syntax state-machine-test
+        (syntax-rules (-)
+          [(_ c (char1 - char2))
+           (char<=? char1 c char2)]
+          [(_ c (e1 e2 ...))
+           (or (state-machine-test c e1) (state-machine-test c e2) ...)]
+          [(_ c char)
+           (char=? c char)]))
+      (state-machine start
+        (start #f          ; start state
+          [((#\a - #\z) (#\A - #\Z)) (to sym)]
+          [(#\- #\+) (to num1)]
+          [(#\* #\= #\> #\<) (to sym)]
+          [(#\0 - #\9) (to num4)]
+          [#\. (to num2)]
+          [(#\{ #\}) (to brace)]
+          [else (skip to sym)])
+        (num1 #t           ; seen + or -
+          [(#\0 - #\9) (to num4)]
+          [#\. (to num3)]
+          [(#\i #\I) (to num5)]
+          [else (skip to sym)])
+        (num2 #f           ; seen .
+          [(#\0 - #\9) (to num4)]
+          [else (skip to sym)])
+        (num3 #f           ; seen +. or -.
+          [(#\0 - #\9) (to num4)]
+          [else (skip to sym)])
+        (num4 #f           ; seen digit, +digit, -digit, or .digit
+          [else ; kludge
+            (if (number? ($str->num s n 10 #f #f)) ; grabbing private s and n
+                #f
+                (sym s i n))])             ; really (skip to sym)
+        (num5 #f           ; bars: seen +i, -i, +I, or -I
+          [else (skip to sym)])
+        (sym #t            ; safe symbol
+          [((#\a - #\z) (#\A - #\Z) #\- #\? (#\0 - #\9) #\* #\! #\= #\> #\< #\+ #\/)
+           (to sym)]
+          [((#\nul - #\space) #\( #\) #\[ #\] #\{ #\} #\" #\' #\` #\, #\; #\" #\\ #\|)
+           #f]
+          [else (to sym)])
+        (brace #t          ; { or }
+          [else #f]))))
+
   (define wrsymbol
     (case-lambda
       [(s p) (wrsymbol s p #f)]
@@ -1152,7 +1223,9 @@ floating point returns with (1 0 -1 ...).
              (s1 s p n 0)
              (if (fx= n 0)
                  (display-string "||" p)
-                 (s0 s p n))))])))
+                 (if (and (print-extended-identifiers) (extended-identifier? s))
+                     (display-string s p)
+                     (s0 s p n)))))])))
 
 (set! $write-pretty-quick
    (lambda (x lev len env p)
@@ -1237,6 +1310,8 @@ floating point returns with (1 0 -1 ...).
 
 (define print-vector-length ($make-thread-parameter #f (lambda (x) (and x #t))))
 
+(define print-extended-identifiers ($make-thread-parameter #f (lambda (x) (and x #t))))
+
 (define print-precision
   ($make-thread-parameter
     #f