- the $case macro used by r6rs:case and case now unconditionally trims

redundant keys and expands into exclusive-cond rather than cond. it catches references to => before expanding into exclusive-cond to avoid supporting => as an undocumented and useless extension of the case syntax. the r6rs:case and case macros now require multiple clauses rather than leaving the enforcement to exclusive-cond, and the exclusive-cond macro now requires multiple clauses rather than leaving the enforcement to cond. syntax.ss, 4.ms, root-experr*, patch* original commit: 303921d8515b101c558a056dcf9c05f7cad97f4a
2017-10-13 14:33:32 -04:00 · 2017-10-13 14:33:32 -04:00 · 09366c6247
commit 09366c6247
parent f102c718c6
11 changed files with 764 additions and 585 deletions
--- a/10
+++ b/10
@ -623,3 +623,13 @@
  added a note to BUILDING that CHEZSCHEMELIBDIRS should be unset in
  Version 9.5 and before.
    s/Mf-base, mats/Mf-base, BUILDING
 - the $case macro used by r6rs:case and case now unconditionally trims
  redundant keys and expands into exclusive-cond rather than cond.
  it catches references to => before expanding into exclusive-cond
  to avoid supporting => as an undocumented and useless extension
  of the case syntax.  the r6rs:case and case macros now require
  multiple clauses rather than leaving the enforcement to exclusive-cond,
  and the exclusive-cond macro now requires multiple clauses rather
  than leaving the enforcement to cond.
    syntax.ss,
    4.ms, root-experr*, patch*
--- a/mats/4.ms
+++ b/mats/4.ms
@ -370,6 +370,8 @@
 )
 (mat cond
  (error? ; invalid syntax
    (cond))
   (let ((a 'a))
      (and (begin (set! a 3)
                  (cond ((= a 4) #f) ((= a 3) #t) (else #f)))
@ -395,6 +397,8 @@
 (mat exclusive-cond
   (error? ; invalid syntax
     (exclusive-cond [a . b]))
   (error? ; invalid syntax
     (exclusive-cond))
   (let ((a 'a))
      (and (begin (set! a 3)
                  (exclusive-cond ((= a 4) #f) ((= a 3) #t) (else #f)))
@ -466,165 +470,285 @@
 )
 (mat case
-   (error? ; invalid syntax
+  (error? ; invalid syntax
-     (case 3 [a . b]))
+    (case 3 [a . b]))
-   (eq? (case 'a [a 'yes] [b 'no]) 'yes)
+  (eq? (case 'a [a 'yes] [b 'no]) 'yes)
-   (let ((a 'a))
+  (let ((a 'a))
-      (and
+    (and
-        (begin (set! a 'a)
+      (begin (set! a 'a)
-               (case a (a #t) ((b c) #f))
+        (case a (a #t) ((b c) #f))
-               (case a (a #t) ((b c) #f) (else #f)))
+        (case a (a #t) ((b c) #f) (else #f)))
-        (begin (set! a 'b)
+      (begin (set! a 'b)
-               (case a (a #f) ((b c) #t))
+        (case a (a #f) ((b c) #t))
-               (case a (a #f) ((b c) #t) (else #f)))
+        (case a (a #f) ((b c) #t) (else #f)))
-        (begin (set! a 'c)
+      (begin (set! a 'c)
-               (case a (a #f) ((b c) #t))
+        (case a (a #f) ((b c) #t))
-               (case a (a #f) ((b c) #t) (else #f)))
+        (case a (a #f) ((b c) #t) (else #f)))
-        (begin (set! a 'd)
+      (begin (set! a 'd)
-               (case a (a #f) ((b c) #f) (else #t)))))
+        (case a (a #f) ((b c) #f) (else #t)))))
-    (let ([f (lambda (x)
+  (let ([f (lambda (x)
-                (case x
+             (case x
-                   (#\a 'case1)
+               (#\a 'case1)
-                   (1/2 'case2)
+               (1/2 'case2)
-                   (999999999999999 'case3)
+               (999999999999999 'case3)
-                   (3.4 'case4)
+               (3.4 'case4)
-                   (else 'oops)))])
+               (else 'oops)))])
-       (and (eq? (f (string-ref "abc" 0)) 'case1)
+    (and (eq? (f (string-ref "abc" 0)) 'case1)
-            (eq? (f (exact 0.5)) 'case2)
+         (eq? (f (exact 0.5)) 'case2)
-            (eq? (f (- 1000000000000000 1)) 'case3)
+         (eq? (f (- 1000000000000000 1)) 'case3)
-            (eq? (f (+ 3.0 4/10)) 'case4)
+         (eq? (f (+ 3.0 4/10)) 'case4)
-            (eq? (f 'b) 'oops)))
+         (eq? (f 'b) 'oops)))
-    (case '() [() #f] [else #t])
+  (case '() [() #f] [else #t])
-    (case '() [(()) #t] [else #f])
+  (case '() [(()) #t] [else #f])
-    (case "meow" ["meow" #t] [else #f])
+  (case "meow" ["meow" #t] [else #f])
-    (case '(1 2 3) [((1 2 3) (3 2 1)) #t] [else #f])
+  (case '(1 2 3) [((1 2 3) (3 2 1)) #t] [else #f])
-    (case 'a [1 6] ["meow" #f] [(a b c) #t])
+  (case 'a [1 6] ["meow" #f] [(a b c) #t])
-    (case #\: [1 6] ["meow" #f] [(a b c) #f] [(#\; #\9 #\: #\4) #t])
+  (case #\: [1 6] ["meow" #f] [(a b c) #f] [(#\; #\9 #\: #\4) #t])
-    (case (/ 12.0 3.0) [(4 5 6) #f] [("bla") #f] [(a b c) #f] [(1 5.8 4.9 4.0) #t] [else #f])
+  (case (/ 12.0 3.0) [(4 5 6) #f] [("bla") #f] [(a b c) #f] [(1 5.8 4.9 4.0) #t] [else #f])
-   (begin
+  (begin
-     (with-output-to-file "testfile.ss"
+    (with-output-to-file "testfile.ss"
-       (lambda ()
+      (lambda ()
-         (pretty-print
+        (pretty-print
-           '(define foo
+          '(define foo
-              (lambda (x)
+             (lambda (x)
-                (case x
+               (case x
-                  [("three" 4) 'B]
+                 [("three" 4) 'B]
-                  [("three" 5) 'A]
+                 [("three" 5) 'A]
-                  [else #f]))))
+                 [else #f]))))
-         (pretty-print
+        (pretty-print
-           '(begin
+          '(begin
-              (do ([i 10 (fx- i 1)]) ((fx= i 0)) (write (foo 5)))
+             (do ([i 10 (fx- i 1)]) ((fx= i 0)) (write (foo 5)))
-              (write (foo "three")))))
+             (write (foo "three")))))
-       'replace)
+      'replace)
-     (profile-clear-database)
+    (profile-clear-database)
-     #t)
+    #t)
-   ; verify no reordering w/no profile information
+  ; verify no reordering w/no profile information
-   (let ([x (let* ([ip (open-file-input-port "testfile.ss")]
+  (let ([x (let* ([ip (open-file-input-port "testfile.ss")]
-                   [sfd (make-source-file-descriptor "testfile.ss" ip #t)]
+                  [sfd (make-source-file-descriptor "testfile.ss" ip #t)]
-                   [ip (transcoded-port ip (native-transcoder))])
+                  [ip (transcoded-port ip (native-transcoder))])
-              (let-values ([(x efp) (get-datum/annotations ip sfd 0)])
+             (let-values ([(x efp) (get-datum/annotations ip sfd 0)])
-                (close-port ip)
+               (close-port ip)
-                (parameterize ([optimize-level 2] [enable-cp0 #f] [#%$suppress-primitive-inlining #f]) (expand/optimize x))))])
+               (parameterize ([optimize-level 2] [enable-cp0 #f] [#%$suppress-primitive-inlining #f]) (expand/optimize x))))])
-     ; redundant keys might or might not be pruned, so allow it both ways
+    ; redundant keys might or might not be pruned, so allow it both ways
-     (or (equivalent-expansion?
+    (or (equivalent-expansion?
-           x
+          x
-           '(begin
+          '(begin
-              (set! foo
+             (set! foo
-                (lambda (x)
+               (lambda (x)
-                  (let ([t x])
+                 (let ([t x])
-                    (if (#2%member t '("three" 4))
+                   (if (#2%member t '("three" 4))
-                        'B
+                       'B
-                        (if (#2%member t '("three" 5))
+                       (if (#2%member t '("three" 5))
-                            'A
+                           'A
-                            #f)))))
+                           #f)))))
-              (#2%void)))
+             (#2%void)))
-         (equivalent-expansion?
+        (equivalent-expansion?
-           x
+          x
-           '(begin
+          '(begin
-              (set! foo
+             (set! foo
-                (lambda (x)
+               (lambda (x)
-                  (let ([t x])
+                 (let ([t x])
-                    (if (#2%member t '("three" 4))
+                   (if (#2%member t '("three" 4))
-                        'B
+                       'B
-                        (if (#2%member t '(5))
+                       (if (#2%member t '(5))
-                            'A
+                           'A
-                            #f)))))
+                           #f)))))
-              (#2%void)))))
+             (#2%void)))))
-   (equal?
+  (equal?
-     (with-output-to-string
+    (with-output-to-string
-       (lambda ()
+      (lambda ()
-         (parameterize ([compile-profile #t]) (load "testfile.ss" compile))))
+        (parameterize ([compile-profile #t]) (load "testfile.ss" compile))))
-     "AAAAAAAAAAB")
+    "AAAAAAAAAAB")
-   (begin
+  (begin
-     (profile-dump-data "testfile.pd")
+    (profile-dump-data "testfile.pd")
-     (profile-load-data "testfile.pd")
+    (profile-load-data "testfile.pd")
-     #t)
+    #t)
-   (equal?
+  (equal?
-     (with-output-to-string
+    (with-output-to-string
-       (lambda ()
+      (lambda ()
-         (load "testfile.ss" compile)))
+        (load "testfile.ss" compile)))
-     "AAAAAAAAAAB")
+    "AAAAAAAAAAB")
-   ; verify reordering based on profile information
+  ; verify reordering based on profile information
-   (equivalent-expansion?
+  (equivalent-expansion?
-     (let* ([ip (open-file-input-port "testfile.ss")]
+    (let* ([ip (open-file-input-port "testfile.ss")]
-            [sfd (make-source-file-descriptor "testfile.ss" ip #t)]
+           [sfd (make-source-file-descriptor "testfile.ss" ip #t)]
-            [ip (transcoded-port ip (native-transcoder))])
+           [ip (transcoded-port ip (native-transcoder))])
-       (let-values ([(x efp) (get-datum/annotations ip sfd 0)])
+      (let-values ([(x efp) (get-datum/annotations ip sfd 0)])
-         (close-port ip)
+        (close-port ip)
-         (parameterize ([optimize-level 2] [enable-cp0 #f] [#%$suppress-primitive-inlining #f]) (expand/optimize x))))
+        (parameterize ([optimize-level 2] [enable-cp0 #f] [#%$suppress-primitive-inlining #f]) (expand/optimize x))))
-     '(begin
+    '(begin
-        (set! foo
+       (set! foo
-          (lambda (x)
+         (lambda (x)
-            (let ([t x])
+           (let ([t x])
-              (if (#2%member t '(5))
+             (if (#2%member t '(5))
-                  'A
+                 'A
-                  (if (#2%member t '("three" 4))
+                 (if (#2%member t '("three" 4))
-                      'B
+                     'B
-                      #f)))))
+                     #f)))))
-        (#2%void)))
+       (#2%void)))
-   (begin
+  (begin
-     (profile-clear-database)
+    (profile-clear-database)
-     #t)
+    #t)
  (equivalent-expansion?
    (parameterize ([optimize-level 2] [enable-cp0 #f] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(lambda (x) (case x [(a b a 7) 'one] [(c a 7 9) 'two] [else 'three]))))
    '(lambda (x)
       (let ([t x])
         (if (#2%member t '(a b 7))
             'one
             (if (#2%member t '(c 9))
                 'two
                 'three)))))
  ; ensure we don't miss syntax errors through case discarding unreachable clause bodies
  (error? ; invalid syntax (if)
    (lambda (x)
      (case x
        [(a) 'one]
        [(b c) 'two]
        [(a b c) (if)]
        [else #f])))
  ; ensure expansion into cond doesn't cause => to "work" for case
  (error? ; invalid syntax =>
    (lambda (x)
      (case x
        [(a b c) => values])))
  (error? ; invalid syntax =>
    (lambda (x)
      (case x
        [(a b c) #f]
        [(d e f) => values])))
  (error? ; invalid syntax =>
    (lambda (x)
      (case x
        [(a b c) #f]
        [(a b c) => values])))
  (error? ; invalid syntax =>
    (lambda (x)
      (case x
        [(a b c) => values]
        [else #f])))
  (error? ; invalid syntax =>
    (lambda (x)
      (case x
        [(a b c) #f]
        [(d e f) => values]
        [else #f])))
  (error? ; invalid syntax =>
    (lambda (x)
      (case x
        [(a b c) #f]
        [(a b c) => values]
        [else #f])))
  (error? ; invalid syntax (case)
    (case))
 )
 (mat r6rs:case
-   (error? ; invalid syntax
+  (error? ; invalid syntax
-     (r6rs:case 'a [a 'yes] [b 'no]))
+    (let ()
   (error? ; invalid syntax
     (let ()
       (import (only (rnrs) case))
       (case 'a [a 'yes] [b 'no])))
   (let ((a 'a))
      (import (only (rnrs) case))
-      (and
+      (case 'a [a 'yes] [b 'no])))
-        (begin (set! a 'a)
+  (error? ; invalid syntax
-               (case a ((a) #t) ((b c) #f))
+    (let ()
-               (case a ((a) #t) ((b c) #f) (else #f)))
+      (import (only (rnrs) case))
-        (begin (set! a 'b)
+      (case 'a [a 'yes] [b 'no])))
-               (case a ((a) #f) ((b c) #t))
+  (let ((a 'a))
-               (case a ((a) #f) ((b c) #t) (else #f)))
+    (import (only (rnrs) case))
-        (begin (set! a 'c)
+    (and
-               (case a ((a) #f) ((b c) #t))
+      (begin (set! a 'a)
-               (case a ((a) #f) ((b c) #t) (else #f)))
+        (case a ((a) #t) ((b c) #f))
-        (begin (set! a 'd)
+        (case a ((a) #t) ((b c) #f) (else #f)))
-               (case a ((a) #f) ((b c) #f) (else #t)))))
+      (begin (set! a 'b)
-    (let ([f (lambda (x)
+        (case a ((a) #f) ((b c) #t))
-                (import (only (rnrs) case))
+        (case a ((a) #f) ((b c) #t) (else #f)))
-                (case x
+      (begin (set! a 'c)
-                   ((#\a) 'case1)
+        (case a ((a) #f) ((b c) #t))
-                   ((1/2) 'case2)
+        (case a ((a) #f) ((b c) #t) (else #f)))
-                   ((999999999999999) 'case3)
+      (begin (set! a 'd)
-                   ((3.4) 'case4)
+        (case a ((a) #f) ((b c) #f) (else #t)))))
-                   (else 'oops)))])
+  (let ([f (lambda (x)
-       (and (eq? (f (string-ref "abc" 0)) 'case1)
+             (import (only (rnrs) case))
-            (eq? (f (exact 0.5)) 'case2)
+             (case x
-            (eq? (f (- 1000000000000000 1)) 'case3)
+               ((#\a) 'case1)
-            (eq? (f (+ 3.0 4/10)) 'case4)
+               ((1/2) 'case2)
-            (eq? (f 'b) 'oops)))
+               ((999999999999999) 'case3)
-    (case '() [() #f] [else #t])
+               ((3.4) 'case4)
-    (case '() [(()) #t] [else #f])
+               (else 'oops)))])
- )
+    (and (eq? (f (string-ref "abc" 0)) 'case1)
         (eq? (f (exact 0.5)) 'case2)
         (eq? (f (- 1000000000000000 1)) 'case3)
         (eq? (f (+ 3.0 4/10)) 'case4)
         (eq? (f 'b) 'oops)))
  (let ()
    (import (only (rnrs) case))
    (case '() [() #f] [else #t]))
  (let ()
    (import (only (rnrs) case))
    (case '() [(()) #t] [else #f]))
  (equivalent-expansion?
    (parameterize ([optimize-level 2] [enable-cp0 #f] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(lambda (x)
                          (import (only (rnrs) case))
                          (case x [(a b a 7) 'one] [(c a 7 9) 'two] [else 'three]))))
    '(lambda (x)
       (let ([t x])
         (if (#2%memv t '(a b 7))
             'one
             (if (#2%memv t '(c 9))
                 'two
                 'three)))))
  ; ensure we don't miss syntax errors through case discarding unreachable clause bodies
  (error? ; invalid syntax (if)
    (lambda (x)
      (import (only (rnrs) case))
      (case x
        [(a) 'one]
        [(b c) 'two]
        [(a b c) (if)]
        [else #f])))
  ; ensure expansion into cond doesn't cause => to "work" for case
  (error? ; invalid syntax =>
    (lambda (x)
      (import (only (rnrs) case))
      (case x
        [(a b c) => values])))
  (error? ; invalid syntax =>
    (lambda (x)
      (import (only (rnrs) case))
      (case x
        [(a b c) #f]
        [(d e f) => values])))
  (error? ; invalid syntax =>
    (lambda (x)
      (import (only (rnrs) case))
      (case x
        [(a b c) #f]
        [(a b c) => values])))
  (error? ; invalid syntax =>
    (lambda (x)
      (import (only (rnrs) case))
      (case x
        [(a b c) => values]
        [else #f])))
  (error? ; invalid syntax =>
    (lambda (x)
      (import (only (rnrs) case))
      (case x
        [(a b c) #f]
        [(d e f) => values]
        [else #f])))
  (error? ; invalid syntax =>
    (lambda (x)
      (import (only (rnrs) case))
      (case x
        [(a b c) #f]
        [(a b c) => values]
        [else #f])))
  (error? ; invalid syntax (case)
    (let ()
      (import (only (rnrs) case))
      (case)))
 )
 (mat record-case
   (record-case '(a b c)
--- a/mats/patch-compile-0-f-t-f
+++ b/mats/patch-compile-0-f-t-f
@ -1,5 +1,5 @@
-*** errors-compile-0-f-f-f	2017-07-06 20:31:25.000000000 -0600
+*** errors-compile-0-f-f-f	2017-10-13 12:34:00.000000000 -0400
--- errors-compile-0-f-t-f	2017-07-06 19:50:33.000000000 -0600
+--- errors-compile-0-f-t-f	2017-10-13 11:59:38.000000000 -0400
 ***************
 *** 125,131 ****
  3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
@ -58,24 +58,24 @@
  3.mo:Expected error in mat mrvs: "attempt to apply non-procedure 17".
  3.mo:Expected error in mat mrvs: "returned two values to single value return context".
 ***************
-*** 249,255 ****
+*** 267,273 ****
-  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: "misplaced aux keyword =>".
-  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 r6rs:case: "invalid syntax (case)".
  4.mo:Expected error in mat named-let: "incorrect argument count in call ((letrec ((...)) x) 3 4)".
 ! 4.mo:Expected error in mat map: "map: 3 is not a procedure".
  4.mo:Expected error in mat map: "map: a is not a proper list".
  4.mo:Expected error in mat map: "map: (a . b) is not a proper list".
  4.mo:Expected error in mat map: "map: (a a a a a a ...) is circular".
--- 249,255 ----
+--- 267,273 ----
-  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: "misplaced aux keyword =>".
-  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 r6rs:case: "invalid syntax (case)".
  4.mo:Expected error in mat named-let: "incorrect argument count in call ((letrec ((...)) x) 3 4)".
 ! 4.mo:Expected error in mat map: "attempt to apply non-procedure 3".
  4.mo:Expected error in mat map: "map: a is not a proper list".
  4.mo:Expected error in mat map: "map: (a . b) is not a proper list".
  4.mo:Expected error in mat map: "map: (a a a a a a ...) is circular".
 ***************
-*** 319,325 ****
+*** 337,343 ****
  4.mo:Expected error in mat fold-right: "fold-right: (a a a a a a ...) is circular".
  4.mo:Expected error in mat fold-right: "fold-right: (a a a a a a ...) is circular".
  4.mo:Expected error in mat fold-right: "fold-right: (a a a a a a ...) is circular".
@ -83,7 +83,7 @@
  4.mo:Expected error in mat for-each: "for-each: a is not a proper list".
  4.mo:Expected error in mat for-each: "for-each: (a . b) is not a proper list".
  4.mo:Expected error in mat for-each: "for-each: (a a a a a a ...) is circular".
--- 319,325 ----
+--- 337,343 ----
  4.mo:Expected error in mat fold-right: "fold-right: (a a a a a a ...) is circular".
  4.mo:Expected error in mat fold-right: "fold-right: (a a a a a a ...) is circular".
  4.mo:Expected error in mat fold-right: "fold-right: (a a a a a a ...) is circular".
@ -92,7 +92,7 @@
  4.mo:Expected error in mat for-each: "for-each: (a . b) is not a proper list".
  4.mo:Expected error in mat for-each: "for-each: (a a a a a a ...) is circular".
 ***************
-*** 3655,3661 ****
+*** 3673,3679 ****
  misc.mo:Expected error in mat cpletrec: "foreign-procedure: no entry for "foo"".
  misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable q".
  misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable bar".
@ -100,7 +100,7 @@
  misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable b".
  misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable b".
  misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable a".
--- 3655,3661 ----
+--- 3673,3679 ----
  misc.mo:Expected error in mat cpletrec: "foreign-procedure: no entry for "foo"".
  misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable q".
  misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable bar".
@ -109,7 +109,7 @@
  misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable b".
  misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable a".
 ***************
-*** 7105,7112 ****
+*** 7123,7130 ****
  7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
  7.mo:Expected error in mat error: "a: hit me!".
  7.mo:Expected error in mat error: "f: n is 0".
@ -118,7 +118,7 @@
  record.mo:Expected error in mat record2: "invalid value 3 for foreign type double-float".
  record.mo:Expected error in mat record2: "3 is not of type #<record type fudge>".
  record.mo:Expected error in mat record2: "make-record-type: invalid field list ((immutable double-float a) . b)".
--- 7105,7112 ----
+--- 7123,7130 ----
  7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
  7.mo:Expected error in mat error: "a: hit me!".
  7.mo:Expected error in mat error: "f: n is 0".
@ -128,7 +128,7 @@
  record.mo:Expected error in mat record2: "3 is not of type #<record type fudge>".
  record.mo:Expected error in mat record2: "make-record-type: invalid field list ((immutable double-float a) . b)".
 ***************
-*** 7114,7128 ****
+*** 7132,7146 ****
  record.mo:Expected error in mat type-descriptor: "invalid syntax (type-descriptor 3)".
  record.mo:Expected error in mat type-descriptor: "type-descriptor: unrecognized record car".
  record.mo:Expected error in mat record3: "variable set-fudge-a! is not bound".
@ -144,7 +144,7 @@
  record.mo:Expected error in mat record9: "record-reader: invalid input #f".
  record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
  record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
--- 7114,7128 ----
+--- 7132,7146 ----
  record.mo:Expected error in mat type-descriptor: "invalid syntax (type-descriptor 3)".
  record.mo:Expected error in mat type-descriptor: "type-descriptor: unrecognized record car".
  record.mo:Expected error in mat record3: "variable set-fudge-a! is not bound".
@ -161,7 +161,7 @@
  record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
  record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
 ***************
-*** 7135,7160 ****
+*** 7153,7178 ****
  record.mo:Expected error in mat record10: "read: unresolvable cycle constructing record of type #<record type bar> at char 3 of #<input port string>".
  record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
  record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
@ -188,7 +188,7 @@
  record.mo:Expected error in mat foreign-data: "foreign-alloc: 0 is not a positive fixnum".
  record.mo:Expected error in mat foreign-data: "foreign-alloc: <int> is not a positive fixnum".
  record.mo:Expected error in mat foreign-data: "foreign-alloc: -5 is not a positive fixnum".
--- 7135,7160 ----
+--- 7153,7178 ----
  record.mo:Expected error in mat record10: "read: unresolvable cycle constructing record of type #<record type bar> at char 3 of #<input port string>".
  record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
  record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
@ -216,7 +216,7 @@
  record.mo:Expected error in mat foreign-data: "foreign-alloc: <int> is not a positive fixnum".
  record.mo:Expected error in mat foreign-data: "foreign-alloc: -5 is not a positive fixnum".
 ***************
-*** 7285,7323 ****
+*** 7303,7341 ****
  record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
  record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
  record.mo:Expected error in mat record23: "make-record-type: cannot extend sealed record type #<record type foo>".
@ -256,7 +256,7 @@
  record.mo:Expected error in mat record?: "record?: 4 is not a record type descriptor".
  record.mo:Expected error in mat record?: "record?: a is not a record type descriptor".
  record.mo:Expected error in mat record?: "record?: #(1) is not a record type descriptor".
--- 7285,7323 ----
+--- 7303,7341 ----
  record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
  record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
  record.mo:Expected error in mat record23: "make-record-type: cannot extend sealed record type #<record type foo>".
@ -297,7 +297,7 @@
  record.mo:Expected error in mat record?: "record?: a is not a record type descriptor".
  record.mo:Expected error in mat record?: "record?: #(1) is not a record type descriptor".
 ***************
-*** 7332,7388 ****
+*** 7350,7406 ****
  record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: invalid protocol flimflam".
  record.mo:Expected error in mat r6rs-records-procedural: "attempt to apply non-procedure not-a-procedure".
  record.mo:Expected error in mat r6rs-records-procedural: "attempt to apply non-procedure spam".
@ -355,7 +355,7 @@
  record.mo:Expected error in mat r6rs-records-syntactic: "define-record-type: incompatible record type cpoint - different parent".
  record.mo:Expected error in mat r6rs-records-syntactic: "define-record-type: incompatible record type cpoint - different parent".
  record.mo:Expected error in mat r6rs-records-syntactic: "cannot extend define-record-type parent fratrat".
--- 7332,7388 ----
+--- 7350,7406 ----
  record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: invalid protocol flimflam".
  record.mo:Expected error in mat r6rs-records-procedural: "attempt to apply non-procedure not-a-procedure".
  record.mo:Expected error in mat r6rs-records-procedural: "attempt to apply non-procedure spam".
--- a/mats/patch-compile-0-t-f-f
+++ b/mats/patch-compile-0-t-f-f
--- a/mats/patch-interpret-0-f-f-f
+++ b/mats/patch-interpret-0-f-f-f
@ -1,5 +1,5 @@
-*** errors-compile-0-f-f-f	2017-07-06 20:31:25.000000000 -0600
+*** errors-compile-0-f-f-f	2017-10-13 12:34:00.000000000 -0400
--- errors-interpret-0-f-f-f	2017-07-06 20:08:28.000000000 -0600
+--- errors-interpret-0-f-f-f	2017-10-13 12:15:36.000000000 -0400
 ***************
 *** 1,7 ****
  primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".
@ -196,7 +196,7 @@
  3.mo:Expected error in mat mrvs: "returned two values to single value return context".
  3.mo:Expected error in mat mrvs: "cdr: a is not a pair".
 ***************
-*** 4014,4029 ****
+*** 4032,4047 ****
  6.mo:Expected error in mat pretty-print: "incorrect argument count in call (pretty-format (quote foo) (quote x) (quote x))".
  6.mo:Expected error in mat pretty-print: "pretty-format: 3 is not a symbol".
  6.mo:Expected error in mat pretty-print: "pretty-format: invalid format (bad 0 ... ... 0 format)".
@ -213,9 +213,9 @@
  6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "abc~s" in call to fprintf at line 1, char 29 of testfile.ss".
  6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~%~abc~adef~ag~s~~~%" in call to fprintf at line 1, char 29 of testfile.ss".
  6.mo:Expected error in mat print-parameters: "write: cycle detected; proceeding with (print-graph #t)".
--- 4020,4029 ----
+--- 4038,4047 ----
 ***************
-*** 6969,6975 ****
+*** 6987,6993 ****
  7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in include: failed for testfile-mc-1a.ss: no such file or directory
  7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: failed for "testfile-mc-1a.ss": no such file or directory
  7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: file "testfile-mc-1a.ss" not found in source directories
@ -223,7 +223,7 @@
  7.mo:Expected error in mat eval: "interpret: 7 is not an environment".
  7.mo:Expected error in mat eval: "compile: 7 is not an environment".
  7.mo:Expected error in mat expand: "sc-expand: 7 is not an environment".
--- 6969,6975 ----
+--- 6987,6993 ----
  7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in include: failed for testfile-mc-1a.ss: no such file or directory
  7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: failed for "testfile-mc-1a.ss": no such file or directory
  7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: file "testfile-mc-1a.ss" not found in source directories
@ -232,7 +232,7 @@
  7.mo:Expected error in mat eval: "compile: 7 is not an environment".
  7.mo:Expected error in mat expand: "sc-expand: 7 is not an environment".
 ***************
-*** 7296,7302 ****
+*** 7314,7320 ****
  record.mo:Expected error in mat record25: "invalid value #\9 for foreign type uptr".
  record.mo:Expected error in mat record25: "invalid value 10 for foreign type float".
  record.mo:Expected error in mat record25: "invalid value 11.0+0.0i for foreign type double".
@ -240,7 +240,7 @@
  record.mo:Expected error in mat record25: "invalid value 12.0 for foreign type long-long".
  record.mo:Expected error in mat record25: "invalid value 13.0 for foreign type unsigned-long-long".
  record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type int".
--- 7296,7302 ----
+--- 7314,7320 ----
  record.mo:Expected error in mat record25: "invalid value #\9 for foreign type uptr".
  record.mo:Expected error in mat record25: "invalid value 10 for foreign type float".
  record.mo:Expected error in mat record25: "invalid value 11.0+0.0i for foreign type double".
@ -249,7 +249,7 @@
  record.mo:Expected error in mat record25: "invalid value 13.0 for foreign type unsigned-long-long".
  record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type int".
 ***************
-*** 8485,8497 ****
+*** 8523,8535 ****
  fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
  fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
  fx.mo:Expected error in mat fx*: "fx*: (a . b) is not a fixnum".
@ -263,7 +263,7 @@
  fx.mo:Expected error in mat r6rs:fx*: "fx*: <int> is not a fixnum".
  fx.mo:Expected error in mat r6rs:fx*: "fx*: <-int> is not a fixnum".
  fx.mo:Expected error in mat r6rs:fx*: "fx*: #f is not a fixnum".
--- 8485,8497 ----
+--- 8523,8535 ----
  fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
  fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
  fx.mo:Expected error in mat fx*: "fx*: (a . b) is not a fixnum".
@ -278,7 +278,7 @@
  fx.mo:Expected error in mat r6rs:fx*: "fx*: <-int> is not a fixnum".
  fx.mo:Expected error in mat r6rs:fx*: "fx*: #f is not a fixnum".
 ***************
-*** 9248,9272 ****
+*** 9286,9310 ****
  foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: invalid foreign procedure handle foo".
  foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: invalid foreign procedure handle foo".
  foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: invalid foreign procedure handle foo".
@ -304,7 +304,7 @@
  foreign.mo:Expected error in mat foreign-procedure: "invalid foreign-procedure argument type specifier booleen".
  foreign.mo:Expected error in mat foreign-procedure: "invalid foreign-procedure argument type specifier integer-34".
  foreign.mo:Expected error in mat foreign-procedure: "invalid foreign-procedure result type specifier chare".
--- 9248,9272 ----
+--- 9286,9310 ----
  foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: invalid foreign procedure handle foo".
  foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: invalid foreign procedure handle foo".
  foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: invalid foreign procedure handle foo".
@ -331,7 +331,7 @@
  foreign.mo:Expected error in mat foreign-procedure: "invalid foreign-procedure argument type specifier integer-34".
  foreign.mo:Expected error in mat foreign-procedure: "invalid foreign-procedure result type specifier chare".
 ***************
-*** 9279,9310 ****
+*** 9317,9348 ****
  foreign.mo:Expected error in mat foreign-sizeof: "incorrect argument count in call (foreign-sizeof (quote int) (quote int))".
  foreign.mo:Expected error in mat foreign-sizeof: "foreign-sizeof: invalid foreign type specifier i-am-not-a-type".
  foreign.mo:Expected error in mat foreign-sizeof: "foreign-sizeof: invalid foreign type specifier 1".
@ -364,7 +364,7 @@
  foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
  foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
  foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
--- 9279,9310 ----
+--- 9317,9348 ----
  foreign.mo:Expected error in mat foreign-sizeof: "incorrect argument count in call (foreign-sizeof (quote int) (quote int))".
  foreign.mo:Expected error in mat foreign-sizeof: "foreign-sizeof: invalid foreign type specifier i-am-not-a-type".
  foreign.mo:Expected error in mat foreign-sizeof: "foreign-sizeof: invalid foreign type specifier 1".
@ -398,7 +398,7 @@
  foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
  foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
 ***************
-*** 9312,9337 ****
+*** 9350,9375 ****
  foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
  foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
  foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
@ -425,7 +425,7 @@
  foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
  foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
  foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
--- 9312,9337 ----
+--- 9350,9375 ----
  foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
  foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
  foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
@ -453,7 +453,7 @@
  foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
  foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
 ***************
-*** 9342,9376 ****
+*** 9380,9414 ****
  foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
  foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
  foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
@ -489,7 +489,7 @@
  foreign.mo:Expected error in mat foreign-C-types: "foreign-callable: invalid return value (73 74) from #<procedure>".
  foreign.mo:Expected error in mat foreign-C-types: "foreign-callable: invalid return value (73 74) from #<procedure>".
  foreign.mo:Expected error in mat foreign-C-types: "foreign-callable: invalid return value (73 74) from #<procedure>".
--- 9342,9376 ----
+--- 9380,9414 ----
  foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
  foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
  foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
@ -526,7 +526,7 @@
  foreign.mo:Expected error in mat foreign-C-types: "foreign-callable: invalid return value (73 74) from #<procedure>".
  foreign.mo:Expected error in mat foreign-C-types: "foreign-callable: invalid return value (73 74) from #<procedure>".
 ***************
-*** 9963,9972 ****
+*** 10001,10010 ****
  exceptions.mo:Expected error in mat assert: "failed assertion (memq (quote b) (quote (1 2 a 3 4)))".
  exceptions.mo:Expected error in mat assert: "failed assertion (q ...)".
  exceptions.mo:Expected error in mat assert: "failed assertion (andmap symbol? (syntax (x ...)))".
@ -537,7 +537,7 @@
  oop.mo:Expected error in mat oop: "m1: not applicable to 17".
  oop.mo:Expected error in mat oop: "variable <a>-x1 is not bound".
  oop.mo:Expected error in mat oop: "variable <a>-x1-set! is not bound".
--- 9963,9972 ----
+--- 10001,10010 ----
  exceptions.mo:Expected error in mat assert: "failed assertion (memq (quote b) (quote (1 2 a 3 4)))".
  exceptions.mo:Expected error in mat assert: "failed assertion (q ...)".
  exceptions.mo:Expected error in mat assert: "failed assertion (andmap symbol? (syntax (x ...)))".
--- a/mats/patch-interpret-0-f-t-f
+++ b/mats/patch-interpret-0-f-t-f
@ -1,5 +1,5 @@
-*** errors-compile-0-f-t-f	2017-07-06 19:50:33.000000000 -0600
+*** errors-compile-0-f-t-f	2017-10-13 11:59:38.000000000 -0400
--- errors-interpret-0-f-t-f	2017-07-06 20:18:46.000000000 -0600
+--- errors-interpret-0-f-t-f	2017-10-13 12:23:52.000000000 -0400
 ***************
 *** 1,7 ****
  primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".
@ -169,7 +169,7 @@
  3.mo:Expected error in mat letrec: "variable f is not bound".
  3.mo:Expected error in mat letrec: "attempt to reference undefined variable a".
 ***************
-*** 4014,4029 ****
+*** 4032,4047 ****
  6.mo:Expected error in mat pretty-print: "incorrect argument count in call (pretty-format (quote foo) (quote x) (quote x))".
  6.mo:Expected error in mat pretty-print: "pretty-format: 3 is not a symbol".
  6.mo:Expected error in mat pretty-print: "pretty-format: invalid format (bad 0 ... ... 0 format)".
@ -186,9 +186,9 @@
  6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "abc~s" in call to fprintf at line 1, char 29 of testfile.ss".
  6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~%~abc~adef~ag~s~~~%" in call to fprintf at line 1, char 29 of testfile.ss".
  6.mo:Expected error in mat print-parameters: "write: cycle detected; proceeding with (print-graph #t)".
--- 4020,4029 ----
+--- 4038,4047 ----
 ***************
-*** 6969,6975 ****
+*** 6987,6993 ****
  7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in include: failed for testfile-mc-1a.ss: no such file or directory
  7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: failed for "testfile-mc-1a.ss": no such file or directory
  7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: file "testfile-mc-1a.ss" not found in source directories
@ -196,7 +196,7 @@
  7.mo:Expected error in mat eval: "interpret: 7 is not an environment".
  7.mo:Expected error in mat eval: "compile: 7 is not an environment".
  7.mo:Expected error in mat expand: "sc-expand: 7 is not an environment".
--- 6969,6975 ----
+--- 6987,6993 ----
  7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in include: failed for testfile-mc-1a.ss: no such file or directory
  7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: failed for "testfile-mc-1a.ss": no such file or directory
  7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: file "testfile-mc-1a.ss" not found in source directories
@ -205,7 +205,7 @@
  7.mo:Expected error in mat eval: "compile: 7 is not an environment".
  7.mo:Expected error in mat expand: "sc-expand: 7 is not an environment".
 ***************
-*** 7105,7112 ****
+*** 7123,7130 ****
  7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
  7.mo:Expected error in mat error: "a: hit me!".
  7.mo:Expected error in mat error: "f: n is 0".
@ -214,7 +214,7 @@
  record.mo:Expected error in mat record2: "invalid value 3 for foreign type double-float".
  record.mo:Expected error in mat record2: "3 is not of type #<record type fudge>".
  record.mo:Expected error in mat record2: "make-record-type: invalid field list ((immutable double-float a) . b)".
--- 7105,7112 ----
+--- 7123,7130 ----
  7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
  7.mo:Expected error in mat error: "a: hit me!".
  7.mo:Expected error in mat error: "f: n is 0".
@ -224,7 +224,7 @@
  record.mo:Expected error in mat record2: "3 is not of type #<record type fudge>".
  record.mo:Expected error in mat record2: "make-record-type: invalid field list ((immutable double-float a) . b)".
 ***************
-*** 7114,7128 ****
+*** 7132,7146 ****
  record.mo:Expected error in mat type-descriptor: "invalid syntax (type-descriptor 3)".
  record.mo:Expected error in mat type-descriptor: "type-descriptor: unrecognized record car".
  record.mo:Expected error in mat record3: "variable set-fudge-a! is not bound".
@ -240,7 +240,7 @@
  record.mo:Expected error in mat record9: "record-reader: invalid input #f".
  record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
  record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
--- 7114,7128 ----
+--- 7132,7146 ----
  record.mo:Expected error in mat type-descriptor: "invalid syntax (type-descriptor 3)".
  record.mo:Expected error in mat type-descriptor: "type-descriptor: unrecognized record car".
  record.mo:Expected error in mat record3: "variable set-fudge-a! is not bound".
@ -257,7 +257,7 @@
  record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
  record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
 ***************
-*** 7135,7160 ****
+*** 7153,7178 ****
  record.mo:Expected error in mat record10: "read: unresolvable cycle constructing record of type #<record type bar> at char 3 of #<input port string>".
  record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
  record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
@ -284,7 +284,7 @@
  record.mo:Expected error in mat foreign-data: "foreign-alloc: 0 is not a positive fixnum".
  record.mo:Expected error in mat foreign-data: "foreign-alloc: <int> is not a positive fixnum".
  record.mo:Expected error in mat foreign-data: "foreign-alloc: -5 is not a positive fixnum".
--- 7135,7160 ----
+--- 7153,7178 ----
  record.mo:Expected error in mat record10: "read: unresolvable cycle constructing record of type #<record type bar> at char 3 of #<input port string>".
  record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
  record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
@ -312,7 +312,7 @@
  record.mo:Expected error in mat foreign-data: "foreign-alloc: <int> is not a positive fixnum".
  record.mo:Expected error in mat foreign-data: "foreign-alloc: -5 is not a positive fixnum".
 ***************
-*** 7285,7323 ****
+*** 7303,7341 ****
  record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
  record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
  record.mo:Expected error in mat record23: "make-record-type: cannot extend sealed record type #<record type foo>".
@ -352,7 +352,7 @@
  record.mo:Expected error in mat record?: "record?: 4 is not a record type descriptor".
  record.mo:Expected error in mat record?: "record?: a is not a record type descriptor".
  record.mo:Expected error in mat record?: "record?: #(1) is not a record type descriptor".
--- 7285,7323 ----
+--- 7303,7341 ----
  record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
  record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
  record.mo:Expected error in mat record23: "make-record-type: cannot extend sealed record type #<record type foo>".
@ -393,7 +393,7 @@
  record.mo:Expected error in mat record?: "record?: a is not a record type descriptor".
  record.mo:Expected error in mat record?: "record?: #(1) is not a record type descriptor".
 ***************
-*** 7332,7388 ****
+*** 7350,7406 ****
  record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: invalid protocol flimflam".
  record.mo:Expected error in mat r6rs-records-procedural: "attempt to apply non-procedure not-a-procedure".
  record.mo:Expected error in mat r6rs-records-procedural: "attempt to apply non-procedure spam".
@ -451,7 +451,7 @@
  record.mo:Expected error in mat r6rs-records-syntactic: "define-record-type: incompatible record type cpoint - different parent".
  record.mo:Expected error in mat r6rs-records-syntactic: "define-record-type: incompatible record type cpoint - different parent".
  record.mo:Expected error in mat r6rs-records-syntactic: "cannot extend define-record-type parent fratrat".
--- 7332,7388 ----
+--- 7350,7406 ----
  record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: invalid protocol flimflam".
  record.mo:Expected error in mat r6rs-records-procedural: "attempt to apply non-procedure not-a-procedure".
  record.mo:Expected error in mat r6rs-records-procedural: "attempt to apply non-procedure spam".
@ -510,7 +510,7 @@
  record.mo:Expected error in mat r6rs-records-syntactic: "define-record-type: incompatible record type cpoint - different parent".
  record.mo:Expected error in mat r6rs-records-syntactic: "cannot extend define-record-type parent fratrat".
 ***************
-*** 8485,8497 ****
+*** 8523,8535 ****
  fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
  fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
  fx.mo:Expected error in mat fx*: "fx*: (a . b) is not a fixnum".
@ -524,7 +524,7 @@
  fx.mo:Expected error in mat r6rs:fx*: "fx*: <int> is not a fixnum".
  fx.mo:Expected error in mat r6rs:fx*: "fx*: <-int> is not a fixnum".
  fx.mo:Expected error in mat r6rs:fx*: "fx*: #f is not a fixnum".
--- 8485,8497 ----
+--- 8523,8535 ----
  fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
  fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
  fx.mo:Expected error in mat fx*: "fx*: (a . b) is not a fixnum".
@ -539,7 +539,7 @@
  fx.mo:Expected error in mat r6rs:fx*: "fx*: <-int> is not a fixnum".
  fx.mo:Expected error in mat r6rs:fx*: "fx*: #f is not a fixnum".
 ***************
-*** 9963,9972 ****
+*** 10001,10010 ****
  exceptions.mo:Expected error in mat assert: "failed assertion (memq (quote b) (quote (1 2 a 3 4)))".
  exceptions.mo:Expected error in mat assert: "failed assertion (q ...)".
  exceptions.mo:Expected error in mat assert: "failed assertion (andmap symbol? (syntax (x ...)))".
@ -550,7 +550,7 @@
  oop.mo:Expected error in mat oop: "m1: not applicable to 17".
  oop.mo:Expected error in mat oop: "variable <a>-x1 is not bound".
  oop.mo:Expected error in mat oop: "variable <a>-x1-set! is not bound".
--- 9963,9972 ----
+--- 10001,10010 ----
  exceptions.mo:Expected error in mat assert: "failed assertion (memq (quote b) (quote (1 2 a 3 4)))".
  exceptions.mo:Expected error in mat assert: "failed assertion (q ...)".
  exceptions.mo:Expected error in mat assert: "failed assertion (andmap symbol? (syntax (x ...)))".
--- a/mats/patch-interpret-3-f-f-f
+++ b/mats/patch-interpret-3-f-f-f
@ -1,5 +1,5 @@
-*** errors-compile-3-f-f-f	2017-07-06 19:46:12.000000000 -0600
+*** errors-compile-3-f-f-f	2017-10-13 11:55:48.000000000 -0400
--- errors-interpret-3-f-f-f	2017-07-06 20:38:59.000000000 -0600
+--- errors-interpret-3-f-f-f	2017-10-13 12:40:16.000000000 -0400
 ***************
 *** 1,3 ****
 --- 1,9 ----
--- a/mats/patch-interpret-3-f-t-f
+++ b/mats/patch-interpret-3-f-t-f
@ -1,5 +1,5 @@
-*** errors-compile-3-f-t-f	2017-07-06 19:54:42.000000000 -0600
+*** errors-compile-3-f-t-f	2017-10-13 12:03:19.000000000 -0400
--- errors-interpret-3-f-t-f	2017-07-06 20:23:52.000000000 -0600
+--- errors-interpret-3-f-t-f	2017-10-13 12:27:55.000000000 -0400
 ***************
 *** 1,3 ****
 --- 1,9 ----
--- a/mats/root-experr-compile-0-f-f-f
+++ b/mats/root-experr-compile-0-f-f-f
@ -242,12 +242,30 @@ primvars.mo:Expected error in mat trace-output-port: "trace-output-port: #<input
 4.mo:Expected error in mat apply: "apply: (3 4 5 6 7 8 ...) is not a proper list".
 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 (cond)".
 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 (exclusive-cond)".
 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 case: "invalid syntax (if)".
-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 case: "misplaced aux keyword =>".
 4.mo:Expected error in mat case: "misplaced aux keyword =>".
 4.mo:Expected error in mat case: "misplaced aux keyword =>".
 4.mo:Expected error in mat case: "misplaced aux keyword =>".
 4.mo:Expected error in mat case: "misplaced aux keyword =>".
 4.mo:Expected error in mat case: "misplaced aux keyword =>".
 4.mo:Expected error in mat case: "invalid syntax (case)".
 4.mo:Expected error in mat r6rs:case: "invalid case clause (a (quote yes))".
 4.mo:Expected error in mat r6rs:case: "invalid case clause (a (quote yes))".
 4.mo:Expected error in mat r6rs:case: "invalid syntax (if)".
 4.mo:Expected error in mat r6rs:case: "misplaced aux keyword =>".
 4.mo:Expected error in mat r6rs:case: "misplaced aux keyword =>".
 4.mo:Expected error in mat r6rs:case: "misplaced aux keyword =>".
 4.mo:Expected error in mat r6rs:case: "misplaced aux keyword =>".
 4.mo:Expected error in mat r6rs:case: "misplaced aux keyword =>".
 4.mo:Expected error in mat r6rs:case: "misplaced aux keyword =>".
 4.mo:Expected error in mat r6rs:case: "invalid syntax (case)".
 4.mo:Expected error in mat named-let: "incorrect argument count in call ((letrec ((...)) x) 3 4)".
 4.mo:Expected error in mat map: "map: 3 is not a procedure".
 4.mo:Expected error in mat map: "map: a is not a proper list".
--- a/mats/root-experr-compile-2-f-f-f
+++ b/mats/root-experr-compile-2-f-f-f
@ -242,12 +242,30 @@ primvars.mo:Expected error in mat trace-output-port: "trace-output-port: #<input
 4.mo:Expected error in mat apply: "apply: (3 4 5 6 7 8 ...) is not a proper list".
 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 (cond)".
 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 (exclusive-cond)".
 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 case: "invalid syntax (if)".
-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 case: "misplaced aux keyword =>".
 4.mo:Expected error in mat case: "misplaced aux keyword =>".
 4.mo:Expected error in mat case: "misplaced aux keyword =>".
 4.mo:Expected error in mat case: "misplaced aux keyword =>".
 4.mo:Expected error in mat case: "misplaced aux keyword =>".
 4.mo:Expected error in mat case: "misplaced aux keyword =>".
 4.mo:Expected error in mat case: "invalid syntax (case)".
 4.mo:Expected error in mat r6rs:case: "invalid case clause (a (quote yes))".
 4.mo:Expected error in mat r6rs:case: "invalid case clause (a (quote yes))".
 4.mo:Expected error in mat r6rs:case: "invalid syntax (if)".
 4.mo:Expected error in mat r6rs:case: "misplaced aux keyword =>".
 4.mo:Expected error in mat r6rs:case: "misplaced aux keyword =>".
 4.mo:Expected error in mat r6rs:case: "misplaced aux keyword =>".
 4.mo:Expected error in mat r6rs:case: "misplaced aux keyword =>".
 4.mo:Expected error in mat r6rs:case: "misplaced aux keyword =>".
 4.mo:Expected error in mat r6rs:case: "misplaced aux keyword =>".
 4.mo:Expected error in mat r6rs:case: "invalid syntax (case)".
 4.mo:Expected error in mat named-let: "incorrect argument count in call ((letrec ((...)) x) 3 4)".
 4.mo:Expected error in mat map: "map: 3 is not a procedure".
 4.mo:Expected error in mat map: "map: a is not a proper list".
--- a/s/syntax.ss
+++ b/s/syntax.ss
@ -7252,7 +7252,7 @@
        #`(cond #,@(map clause-clause (sort-em (map parse-clause clause*))) . #,els?)))
    (syntax-case x (else)
      [(_ m1 ... [else e1 e2 ...]) (helper #'(m1 ...) #'([else e1 e2 ...]))]
-      [(_ m1 ...) (helper #'(m1 ...) #'())])))
+      [(_ m1 m2 ...) (helper #'(m1 m2 ...) #'())])))
 (define-syntax do
   (lambda (orig-x)
@ -7520,62 +7520,71 @@
 (define-syntax $case
  (lambda (x)
    (define-record-type clause
      (nongenerative)
      (fields (mutable keys) (immutable body)))
    (define parse-clause
      (lambda (atomic-keys?)
        (lambda (clause)
          (syntax-case clause ()
            ; a case clause eventually expands into an exclusive-cond clause.  the e1 e2 ... body
            ; structure must remain intact so exclusive-cond can use e1's profile count, if any,
            ; to determine the clause's position in the output.  but naively leaving e1 e2 ...
            ; in place results in case inappropriately supporting cond's => syntax, so we explicitly
            ; weed out uses of => here.
            [(k arrow e1 e2 ...)
             (and (identifier? #'arrow) (free-identifier=? #'arrow #'=>))
             (syntax-error #'arrow "misplaced aux keyword")]
            [((k ...) e1 e2 ...) (make-clause #'(k ...) #'(e1 e2 ...))]
            [(k e1 e2 ...) atomic-keys? (make-clause #'(k) #'(e1 e2 ...))]
            [_ (syntax-error clause "invalid case clause")]))))
    (define trim-keys!
      (let ([ht (make-hashtable equal-hash equal?)])
        (lambda (clause)
          ; remove keys already seen in the same or a previous clause.  we must remove
          ; keys seen in a previous clause before expanding to exclusive-cond, which
          ; might reorder clauses, and removing those in the same clause doesn't do any
          ; harm and might be beneficial if the compiler doesn't do it for us.
          (clause-keys-set! clause
            (let f ([keys (clause-keys clause)])
              (if (null? keys)
                  '()
                  (let ([key (car keys)])
                    (let ([datum-key (syntax->datum key)])
                      (if (hashtable-ref ht datum-key #f)
                          (f (cdr keys))
                          (begin
                            (hashtable-set! ht datum-key #t)
                            (cons key (f (cdr keys)))))))))))))
    (define helper
-      (lambda (mem key-expr clause* els?)
+      (lambda (mem atomic-keys? key-expr clause* else*)
-        (define-record-type clause
+        (let ([clause* (map (parse-clause atomic-keys?) clause*)])
-          (nongenerative)
+          (for-each trim-keys! clause*)
-          (fields (mutable keys) (immutable body)))
+          #`(let ([t #,key-expr])
-        (define parse-clause
+             (exclusive-cond
-          (lambda (clause)
+               #,@(map (lambda (clause)
-            (syntax-case clause ()
+                         ; the compiler reduces memv or member calls like those we produce here
-              [((k ...) e1 e2 ...) (make-clause #'(k ...) #'(e1 e2 ...))]
+                         ; to less expensive code (using memq or eqv? or eq?) when the elements
-              [(k e1 e2 ...) (make-clause #'(k) #'(e1 e2 ...))]
+                         ; of the constant second argument (keys in this case) allow.
-              [_ (syntax-error clause "invalid case clause")])))
+                         #`[(#,mem t '#,(clause-keys clause)) #,@(clause-body clause)])
-        (define emit
+                    ; we could remove keyless clauses here but don't because that would suppress
-          (lambda (kcond clause*)
+                    ; various compile-time errors in the clause body.  cp0 will optimize away the
-            #`(let ([t #,key-expr])
+                    ; code we produce for keyless clauses anyway.
-                (#,kcond
+                    clause*)
-                  #,@(map (lambda (clause)
+               #,@else*)))))
                            #`[(#,mem t '#,(clause-keys clause)) #,@(clause-body clause)])
                       clause*)
                  . #,els?))))
        (let ([clause* (map parse-clause clause*)])
          (if ($profile-source-data?)
              (let ()
                (define ht (make-hashtable equal-hash equal?))
                (define trim-keys!
                  (lambda (clause)
                    (clause-keys-set! clause
                      (let f ([keys (clause-keys clause)])
                        (if (null? keys)
                            '()
                            (let ([key (car keys)])
                              (let ([datum-key (syntax->datum key)])
                                (if (hashtable-ref ht datum-key #f)
                                    (f (cdr keys))
                                    (begin
                                      (hashtable-set! ht datum-key #t)
                                      (cons key (f (cdr keys))))))))))))
                (for-each trim-keys! clause*)
                (emit #'exclusive-cond clause*))
              (emit #'cond clause*)))))
    (syntax-case x (else)
-      [(_ mem e clause ... [else e1 e2 ...])
+      [(_ mem atomic-keys? e clause ... [else e1 e2 ...])
-       (helper #'mem #'e #'(clause ...) #'([else e1 e2 ...]))]
+       (helper #'mem (datum atomic-keys?) #'e #'(clause ...) #'([else e1 e2 ...]))]
-      [(_ mem e clause ...)
+      [(_ mem atomic-keys? e clause1 clause2 ...)
-       (helper #'mem #'e #'(clause ...) #'())])))
+       (helper #'mem (datum atomic-keys?) #'e #'(clause1 clause2 ...) #'())])))
 (define-syntax r6rs:case
- ; case in Chez Scheme allows atomic keys.  rule them out here.
+  (syntax-rules ()
-  (syntax-rules (else)
+    [(_ e clause1 clause2 ...) ($case memv #f e clause1 clause2 ...)]))
    [(_ e [(k** ...) e1* e2* ...] ... [else e1 e2 ...])
     ($case memv e [(k** ...) e1* e2* ...] ... [else e1 e2 ...])]
    [(_ e [(k** ...) e1* e2* ...] ...)
     ($case memv e [(k** ...) e1* e2* ...] ...)]))
 (define-syntax case
  (syntax-rules ()
-    [(_ e clause ...) ($case member e clause ...)]))
+    [(_ e clause1 clause2 ...) ($case member #t e clause1 clause2 ...)]))
 ;;; case aux keywords
 #;(define-syntax else ; defined above for cond