- 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
This commit is contained in:
dyb
parent
f102c718c6
commit
09366c6247
10
LOG
10
LOG
|
|
@ -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*
|
||||
|
|
|
|||
434
mats/4.ms
434
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
|
||||
(case 3 [a . b]))
|
||||
(eq? (case 'a [a 'yes] [b 'no]) 'yes)
|
||||
(let ((a 'a))
|
||||
(and
|
||||
(begin (set! a 'a)
|
||||
(case a (a #t) ((b c) #f))
|
||||
(case a (a #t) ((b c) #f) (else #f)))
|
||||
(begin (set! a 'b)
|
||||
(case a (a #f) ((b c) #t))
|
||||
(case a (a #f) ((b c) #t) (else #f)))
|
||||
(begin (set! a 'c)
|
||||
(case a (a #f) ((b c) #t))
|
||||
(case a (a #f) ((b c) #t) (else #f)))
|
||||
(begin (set! a 'd)
|
||||
(case a (a #f) ((b c) #f) (else #t)))))
|
||||
(let ([f (lambda (x)
|
||||
(case x
|
||||
(#\a 'case1)
|
||||
(1/2 'case2)
|
||||
(999999999999999 'case3)
|
||||
(3.4 'case4)
|
||||
(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)))
|
||||
(case '() [() #f] [else #t])
|
||||
(case '() [(()) #t] [else #f])
|
||||
(case "meow" ["meow" #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 #\: [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])
|
||||
(begin
|
||||
(with-output-to-file "testfile.ss"
|
||||
(lambda ()
|
||||
(pretty-print
|
||||
'(define foo
|
||||
(lambda (x)
|
||||
(case x
|
||||
[("three" 4) 'B]
|
||||
[("three" 5) 'A]
|
||||
[else #f]))))
|
||||
(pretty-print
|
||||
'(begin
|
||||
(do ([i 10 (fx- i 1)]) ((fx= i 0)) (write (foo 5)))
|
||||
(write (foo "three")))))
|
||||
'replace)
|
||||
(profile-clear-database)
|
||||
#t)
|
||||
; verify no reordering w/no profile information
|
||||
(let ([x (let* ([ip (open-file-input-port "testfile.ss")]
|
||||
[sfd (make-source-file-descriptor "testfile.ss" ip #t)]
|
||||
[ip (transcoded-port ip (native-transcoder))])
|
||||
(let-values ([(x efp) (get-datum/annotations ip sfd 0)])
|
||||
(close-port ip)
|
||||
(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
|
||||
(or (equivalent-expansion?
|
||||
x
|
||||
'(begin
|
||||
(set! foo
|
||||
(lambda (x)
|
||||
(let ([t x])
|
||||
(if (#2%member t '("three" 4))
|
||||
'B
|
||||
(if (#2%member t '("three" 5))
|
||||
'A
|
||||
#f)))))
|
||||
(#2%void)))
|
||||
(equivalent-expansion?
|
||||
x
|
||||
'(begin
|
||||
(set! foo
|
||||
(lambda (x)
|
||||
(let ([t x])
|
||||
(if (#2%member t '("three" 4))
|
||||
'B
|
||||
(if (#2%member t '(5))
|
||||
'A
|
||||
#f)))))
|
||||
(#2%void)))))
|
||||
(equal?
|
||||
(with-output-to-string
|
||||
(lambda ()
|
||||
(parameterize ([compile-profile #t]) (load "testfile.ss" compile))))
|
||||
"AAAAAAAAAAB")
|
||||
(begin
|
||||
(profile-dump-data "testfile.pd")
|
||||
(profile-load-data "testfile.pd")
|
||||
#t)
|
||||
(equal?
|
||||
(with-output-to-string
|
||||
(lambda ()
|
||||
(load "testfile.ss" compile)))
|
||||
"AAAAAAAAAAB")
|
||||
; verify reordering based on profile information
|
||||
(equivalent-expansion?
|
||||
(let* ([ip (open-file-input-port "testfile.ss")]
|
||||
[sfd (make-source-file-descriptor "testfile.ss" ip #t)]
|
||||
[ip (transcoded-port ip (native-transcoder))])
|
||||
(let-values ([(x efp) (get-datum/annotations ip sfd 0)])
|
||||
(close-port ip)
|
||||
(parameterize ([optimize-level 2] [enable-cp0 #f] [#%$suppress-primitive-inlining #f]) (expand/optimize x))))
|
||||
'(begin
|
||||
(set! foo
|
||||
(lambda (x)
|
||||
(let ([t x])
|
||||
(if (#2%member t '(5))
|
||||
'A
|
||||
(if (#2%member t '("three" 4))
|
||||
'B
|
||||
#f)))))
|
||||
(#2%void)))
|
||||
(begin
|
||||
(profile-clear-database)
|
||||
#t)
|
||||
(error? ; invalid syntax
|
||||
(case 3 [a . b]))
|
||||
(eq? (case 'a [a 'yes] [b 'no]) 'yes)
|
||||
(let ((a 'a))
|
||||
(and
|
||||
(begin (set! a 'a)
|
||||
(case a (a #t) ((b c) #f))
|
||||
(case a (a #t) ((b c) #f) (else #f)))
|
||||
(begin (set! a 'b)
|
||||
(case a (a #f) ((b c) #t))
|
||||
(case a (a #f) ((b c) #t) (else #f)))
|
||||
(begin (set! a 'c)
|
||||
(case a (a #f) ((b c) #t))
|
||||
(case a (a #f) ((b c) #t) (else #f)))
|
||||
(begin (set! a 'd)
|
||||
(case a (a #f) ((b c) #f) (else #t)))))
|
||||
(let ([f (lambda (x)
|
||||
(case x
|
||||
(#\a 'case1)
|
||||
(1/2 'case2)
|
||||
(999999999999999 'case3)
|
||||
(3.4 'case4)
|
||||
(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)))
|
||||
(case '() [() #f] [else #t])
|
||||
(case '() [(()) #t] [else #f])
|
||||
(case "meow" ["meow" #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 #\: [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])
|
||||
(begin
|
||||
(with-output-to-file "testfile.ss"
|
||||
(lambda ()
|
||||
(pretty-print
|
||||
'(define foo
|
||||
(lambda (x)
|
||||
(case x
|
||||
[("three" 4) 'B]
|
||||
[("three" 5) 'A]
|
||||
[else #f]))))
|
||||
(pretty-print
|
||||
'(begin
|
||||
(do ([i 10 (fx- i 1)]) ((fx= i 0)) (write (foo 5)))
|
||||
(write (foo "three")))))
|
||||
'replace)
|
||||
(profile-clear-database)
|
||||
#t)
|
||||
; verify no reordering w/no profile information
|
||||
(let ([x (let* ([ip (open-file-input-port "testfile.ss")]
|
||||
[sfd (make-source-file-descriptor "testfile.ss" ip #t)]
|
||||
[ip (transcoded-port ip (native-transcoder))])
|
||||
(let-values ([(x efp) (get-datum/annotations ip sfd 0)])
|
||||
(close-port ip)
|
||||
(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
|
||||
(or (equivalent-expansion?
|
||||
x
|
||||
'(begin
|
||||
(set! foo
|
||||
(lambda (x)
|
||||
(let ([t x])
|
||||
(if (#2%member t '("three" 4))
|
||||
'B
|
||||
(if (#2%member t '("three" 5))
|
||||
'A
|
||||
#f)))))
|
||||
(#2%void)))
|
||||
(equivalent-expansion?
|
||||
x
|
||||
'(begin
|
||||
(set! foo
|
||||
(lambda (x)
|
||||
(let ([t x])
|
||||
(if (#2%member t '("three" 4))
|
||||
'B
|
||||
(if (#2%member t '(5))
|
||||
'A
|
||||
#f)))))
|
||||
(#2%void)))))
|
||||
(equal?
|
||||
(with-output-to-string
|
||||
(lambda ()
|
||||
(parameterize ([compile-profile #t]) (load "testfile.ss" compile))))
|
||||
"AAAAAAAAAAB")
|
||||
(begin
|
||||
(profile-dump-data "testfile.pd")
|
||||
(profile-load-data "testfile.pd")
|
||||
#t)
|
||||
(equal?
|
||||
(with-output-to-string
|
||||
(lambda ()
|
||||
(load "testfile.ss" compile)))
|
||||
"AAAAAAAAAAB")
|
||||
; verify reordering based on profile information
|
||||
(equivalent-expansion?
|
||||
(let* ([ip (open-file-input-port "testfile.ss")]
|
||||
[sfd (make-source-file-descriptor "testfile.ss" ip #t)]
|
||||
[ip (transcoded-port ip (native-transcoder))])
|
||||
(let-values ([(x efp) (get-datum/annotations ip sfd 0)])
|
||||
(close-port ip)
|
||||
(parameterize ([optimize-level 2] [enable-cp0 #f] [#%$suppress-primitive-inlining #f]) (expand/optimize x))))
|
||||
'(begin
|
||||
(set! foo
|
||||
(lambda (x)
|
||||
(let ([t x])
|
||||
(if (#2%member t '(5))
|
||||
'A
|
||||
(if (#2%member t '("three" 4))
|
||||
'B
|
||||
#f)))))
|
||||
(#2%void)))
|
||||
(begin
|
||||
(profile-clear-database)
|
||||
#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
|
||||
(r6rs:case 'a [a 'yes] [b 'no]))
|
||||
(error? ; invalid syntax
|
||||
(let ()
|
||||
(import (only (rnrs) case))
|
||||
(case 'a [a 'yes] [b 'no])))
|
||||
(let ((a 'a))
|
||||
(error? ; invalid syntax
|
||||
(let ()
|
||||
(import (only (rnrs) case))
|
||||
(and
|
||||
(begin (set! a 'a)
|
||||
(case a ((a) #t) ((b c) #f))
|
||||
(case a ((a) #t) ((b c) #f) (else #f)))
|
||||
(begin (set! a 'b)
|
||||
(case a ((a) #f) ((b c) #t))
|
||||
(case a ((a) #f) ((b c) #t) (else #f)))
|
||||
(begin (set! a 'c)
|
||||
(case a ((a) #f) ((b c) #t))
|
||||
(case a ((a) #f) ((b c) #t) (else #f)))
|
||||
(begin (set! a 'd)
|
||||
(case a ((a) #f) ((b c) #f) (else #t)))))
|
||||
(let ([f (lambda (x)
|
||||
(import (only (rnrs) case))
|
||||
(case x
|
||||
((#\a) 'case1)
|
||||
((1/2) 'case2)
|
||||
((999999999999999) 'case3)
|
||||
((3.4) 'case4)
|
||||
(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)))
|
||||
(case '() [() #f] [else #t])
|
||||
(case '() [(()) #t] [else #f])
|
||||
)
|
||||
(case 'a [a 'yes] [b 'no])))
|
||||
(error? ; invalid syntax
|
||||
(let ()
|
||||
(import (only (rnrs) case))
|
||||
(case 'a [a 'yes] [b 'no])))
|
||||
(let ((a 'a))
|
||||
(import (only (rnrs) case))
|
||||
(and
|
||||
(begin (set! a 'a)
|
||||
(case a ((a) #t) ((b c) #f))
|
||||
(case a ((a) #t) ((b c) #f) (else #f)))
|
||||
(begin (set! a 'b)
|
||||
(case a ((a) #f) ((b c) #t))
|
||||
(case a ((a) #f) ((b c) #t) (else #f)))
|
||||
(begin (set! a 'c)
|
||||
(case a ((a) #f) ((b c) #t))
|
||||
(case a ((a) #f) ((b c) #t) (else #f)))
|
||||
(begin (set! a 'd)
|
||||
(case a ((a) #f) ((b c) #f) (else #t)))))
|
||||
(let ([f (lambda (x)
|
||||
(import (only (rnrs) case))
|
||||
(case x
|
||||
((#\a) 'case1)
|
||||
((1/2) 'case2)
|
||||
((999999999999999) 'case3)
|
||||
((3.4) 'case4)
|
||||
(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)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-0-f-f-f 2017-07-06 20:31:25.000000000 -0600
|
||||
--- errors-compile-0-f-t-f 2017-07-06 19:50:33.000000000 -0600
|
||||
*** errors-compile-0-f-f-f 2017-10-13 12:34:00.000000000 -0400
|
||||
--- 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 ****
|
||||
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)))".
|
||||
*** 267,273 ****
|
||||
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".
|
||||
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 ----
|
||||
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)))".
|
||||
--- 267,273 ----
|
||||
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: "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".
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-0-f-f-f 2017-07-06 20:31:25.000000000 -0600
|
||||
--- errors-interpret-0-f-f-f 2017-07-06 20:08:28.000000000 -0600
|
||||
*** errors-compile-0-f-f-f 2017-10-13 12:34:00.000000000 -0400
|
||||
--- 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 ...)))".
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-0-f-t-f 2017-07-06 19:50:33.000000000 -0600
|
||||
--- errors-interpret-0-f-t-f 2017-07-06 20:18:46.000000000 -0600
|
||||
*** errors-compile-0-f-t-f 2017-10-13 11:59:38.000000000 -0400
|
||||
--- 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 ...)))".
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-3-f-f-f 2017-07-06 19:46:12.000000000 -0600
|
||||
--- errors-interpret-3-f-f-f 2017-07-06 20:38:59.000000000 -0600
|
||||
*** errors-compile-3-f-f-f 2017-10-13 11:55:48.000000000 -0400
|
||||
--- errors-interpret-3-f-f-f 2017-10-13 12:40:16.000000000 -0400
|
||||
***************
|
||||
*** 1,3 ****
|
||||
--- 1,9 ----
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-3-f-t-f 2017-07-06 19:54:42.000000000 -0600
|
||||
--- errors-interpret-3-f-t-f 2017-07-06 20:23:52.000000000 -0600
|
||||
*** errors-compile-3-f-t-f 2017-10-13 12:03:19.000000000 -0400
|
||||
--- errors-interpret-3-f-t-f 2017-10-13 12:27:55.000000000 -0400
|
||||
***************
|
||||
*** 1,3 ****
|
||||
--- 1,9 ----
|
||||
|
|
|
|||
|
|
@ -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 r6rs:case: "invalid syntax (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 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".
|
||||
|
|
|
|||
|
|
@ -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 r6rs:case: "invalid syntax (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 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".
|
||||
|
|
|
|||
109
s/syntax.ss
109
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?)
|
||||
(define-record-type clause
|
||||
(nongenerative)
|
||||
(fields (mutable keys) (immutable body)))
|
||||
(define parse-clause
|
||||
(lambda (clause)
|
||||
(syntax-case clause ()
|
||||
[((k ...) e1 e2 ...) (make-clause #'(k ...) #'(e1 e2 ...))]
|
||||
[(k e1 e2 ...) (make-clause #'(k) #'(e1 e2 ...))]
|
||||
[_ (syntax-error clause "invalid case clause")])))
|
||||
(define emit
|
||||
(lambda (kcond clause*)
|
||||
#`(let ([t #,key-expr])
|
||||
(#,kcond
|
||||
#,@(map (lambda (clause)
|
||||
#`[(#,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*)))))
|
||||
(lambda (mem atomic-keys? key-expr clause* else*)
|
||||
(let ([clause* (map (parse-clause atomic-keys?) clause*)])
|
||||
(for-each trim-keys! clause*)
|
||||
#`(let ([t #,key-expr])
|
||||
(exclusive-cond
|
||||
#,@(map (lambda (clause)
|
||||
; the compiler reduces memv or member calls like those we produce here
|
||||
; to less expensive code (using memq or eqv? or eq?) when the elements
|
||||
; of the constant second argument (keys in this case) allow.
|
||||
#`[(#,mem t '#,(clause-keys clause)) #,@(clause-body clause)])
|
||||
; we could remove keyless clauses here but don't because that would suppress
|
||||
; various compile-time errors in the clause body. cp0 will optimize away the
|
||||
; code we produce for keyless clauses anyway.
|
||||
clause*)
|
||||
#,@else*)))))
|
||||
(syntax-case x (else)
|
||||
[(_ mem e clause ... [else e1 e2 ...])
|
||||
(helper #'mem #'e #'(clause ...) #'([else e1 e2 ...]))]
|
||||
[(_ mem e clause ...)
|
||||
(helper #'mem #'e #'(clause ...) #'())])))
|
||||
[(_ mem atomic-keys? e clause ... [else e1 e2 ...])
|
||||
(helper #'mem (datum atomic-keys?) #'e #'(clause ...) #'([else e1 e2 ...]))]
|
||||
[(_ mem atomic-keys? e clause1 clause2 ...)
|
||||
(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 (else)
|
||||
[(_ 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* ...] ...)]))
|
||||
(syntax-rules ()
|
||||
[(_ e clause1 clause2 ...) ($case memv #f e clause1 clause2 ...)]))
|
||||
|
||||
(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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user