feat: 9.5.9

This commit is contained in:
tmtt 2022-07-29 15:12:07 +02:00
parent cb1753732b
commit 35f43a7909
1084 changed files with 558985 additions and 0 deletions

2310
mats/3.ms Normal file

File diff suppressed because it is too large Load diff

3982
mats/4.ms Normal file

File diff suppressed because it is too large Load diff

918
mats/5_1.ms Normal file
View file

@ -0,0 +1,918 @@
;;; 5-1.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(mat eq?
(eq? 'a 'a)
(let ((x 203840238409238402384)) (eq? x x))
(let ((x (cons 3 4))) (eq? x x))
(not (eq? "hi there" (string-append "hi " "there")))
(not (eq? (cons '() '()) (cons '() '())))
)
(mat eqv?
(eqv? 'a 'a)
(not (eqv? '(a b (c)) "hi"))
(not (eqv? '(a b (c)) (list 'a 'b '(c))))
(not (eqv? 3.4 3.5))
(eqv? 3.4 3.4)
(eqv? 3/4 3/4)
(not (eqv? 3/4 4/5))
(not (eqv? 2.0 2))
(not (eqv? 4.5 9/2))
(eqv? 123124211123 123124211123)
(not (eqv? 123124211123 123124211124))
(not (eqv? "hi there" (string-append "hi " "there")))
(not (eqv? (vector 1 2 (vector 3 4) 5) '#(1 2 #(3 4) 5)))
(eqv? +nan.0 +nan.0)
(eqv? +inf.0 +inf.0)
(eqv? -inf.0 -inf.0)
(not (eqv? -inf.0 +inf.0))
(eqv? +0.0 +0.0)
(eqv? -0.0 -0.0)
(not (eqv? +0.0 -0.0))
(eqv? 3.0+0.0i 3.0+0.0i)
(eqv? 3.0-0.0i 3.0-0.0i)
(not (eqv? 3.0+0.0i 3.0-0.0i))
(not (eqv? 3.0+0.0i 3.0))
(not (eqv? 3.0 3))
(not (eqv? 3.0+4.0i 3+4i))
(not (eqv? 3 3.0))
(not (eqv? 3+4i 3.0+4.0i))
)
(mat equal?
(equal? 'a 'a)
(not (equal? '(a b (c)) "hi"))
(equal? '(a b (c)) (list 'a 'b '(c)))
(not (equal? '(a b (c)) '(a b (d))))
(equal? 123124211123 123124211123)
(not (equal? 123124211123 123124211124))
(equal? "hi there" (string-append "hi " "there"))
(not (equal? "hi there " "hi there"))
(equal? (vector 1 2 (vector 3 4) 5) '#(1 2 #(3 4) 5))
(not (equal? (vector 1 2 (vector 3 4) 5) '#(1 2 3 4 5)))
(equal? +nan.0 +nan.0)
(equal? +inf.0 +inf.0)
(equal? -inf.0 -inf.0)
(not (equal? -inf.0 +inf.0))
(equal? +0.0 +0.0)
(equal? -0.0 -0.0)
(not (equal? +0.0 -0.0))
(equal? 3.0+0.0i 3.0+0.0i)
(equal? 3.0-0.0i 3.0-0.0i)
(not (equal? 3.0+0.0i 3.0-0.0i))
(not (equal? 3.0+0.0i 3.0))
(not (equal? 3.0 3))
(not (equal? 3.0+4.0i 3+4i))
(not (equal? 3 3.0))
(not (equal? 3+4i 3.0+4.0i))
)
(mat new-equal? ; includes dag and cycle checks
(time (equal? '(a b c) '(a b c)))
(equal? '#1=(a b c . #1#) '#2=(a b c . #2#))
(not (equal? '#3=(a b c . #3#) '#4=(a b . #4#)))
(equal? '#5=(a b c . #5#) '#6=(a b c a b c . #6#))
(equal? '#7=(a b c . #7#) '(a b c a b c . #7#))
(not (equal? '#8=(a b c . #8#) '#9=(a b c a c . #9#)))
(andmap eq?
(let ([ls1 '#10=(a #10# c #10# d #11# f)]
[ls2 '#11=(a (a #11# c #10# d #11# f) c #10# d #11# f)])
(list (equal? ls1 ls1)
(equal? ls2 ls2)
(equal? ls1 ls2)
(equal? ls2 ls1)
(equal? (cadr ls1) ls2)
(equal? (cons 'g ls1) ls1)
(equal? (append ls1 '(g)) ls1)
(equal? (cdr ls1) (cdddr ls1))
(equal? (cdr ls1) (cdr (cadr ls2)))))
'(#t #t #t #t #t #f #f #f #t))
(andmap eq?
(let ([leaf1 (list "As a tree, I am huge.")]
[leaf2 (list "As a dag, I am small.")])
(let ([tr1 (let f ([n 100])
(if (= n 0)
leaf1
(let ([tr (f (- n 1))])
(cons tr tr))))]
[tr2 (let f ([n 100])
(if (= n 0)
leaf2
(let ([tr (f (- n 1))])
(cons tr tr))))])
(let ([ls (list (equal? tr1 tr1)
(equal? tr2 tr2)
(equal? tr1 tr2)
(equal? tr1 (car tr1)))])
(set-car! leaf1 (car leaf2))
(cons* (equal? tr1 tr1)
(equal? tr2 tr2)
(equal? tr1 tr2)
(equal? tr1 (cdr tr1))
ls))))
'(#t #t #t #f #t #t #f #f))
(time (equal? '#(a b c) '#(a b c)))
(equal? '#101=#(a b c #1#) '#102=#(a b c #2#))
(not (equal? '#103=#(a b c #103#) '#104=#(a b #104#)))
(equal? '#105=#(a b c #105#) '#106=#(a b c #(a b c #106#)))
(equal? '#107=#(a b c #107#) '#(a b c #(a b c #107#)))
(not (equal? '#108=#(a b c #108#) '#109=#(a b c #(a c #109#))))
(andmap eq?
(let ([v1 '#110=#(a #110# c #110# d #111# f)]
[v2 '#111=#(a #(a #111# c #110# d #111# f) c #110# d #111# f)]
[v3 '#112=#(a #(a #112# c #110# d #112# f) c #110# d #112# g)])
(list (equal? v1 v1)
(equal? v2 v2)
(equal? v3 v3)
(equal? v1 v2)
(equal? v2 v1)
(equal? v1 v3)
(equal? v2 v3)
(equal? v3 v1)
(equal? v3 v2)
(equal? (vector-ref v1 1) v2)))
'(#t #t #t #t #t #f #f #f #f #t))
(andmap eq?
(let ([leaf1 (vector "As a tree, I am huge.")]
[leaf2 (vector "As a dag, I am small.")])
(let ([tr1 (let f ([n 100])
(if (= n 0)
leaf1
(let ([tr (f (- n 1))])
(vector tr tr))))]
[tr2 (let f ([n 100])
(if (= n 0)
leaf2
(let ([tr (f (- n 1))])
(vector tr tr))))])
(let ([ls (list (equal? tr1 tr1)
(equal? tr2 tr2)
(equal? tr1 tr2)
(equal? tr1 (vector-ref tr1 0)))])
(vector-set! leaf1 0 (vector-ref leaf2 0))
(cons* (equal? tr1 tr1)
(equal? tr2 tr2)
(equal? tr1 tr2)
(equal? tr1 (vector-ref tr1 1))
ls))))
'(#t #t #t #f #t #t #f #f))
(let ([ls1 (make-list 100000 'a)]
[ls2 (make-list 100000 'a)])
(time
(let f ([n 1000])
(or (fx= n 0) (and (equal? ls1 ls2) (f (fx- n 1)))))))
(let ([v1 (make-vector 10000 (make-vector 100 'a))]
[v2 (make-vector 10000 (make-vector 100 'a))])
(time
(let f ([n 100])
(or (fx= n 0) (and (equal? v1 v2) (f (fx- n 1)))))))
(time
(let () ; w/sharing
(define (consup1 n)
(case n
[(0) '()]
[(1) 'a]
[(2) 3/4]
[(3) 3.416]
[else
(case (logand n 7)
[(0) (let ([x (consup1 (ash n -3))]) (cons x x))]
[(1) (make-vector 10 (consup1 (ash n -3)))]
[(2) (let ([x (cons #f (consup1 (ash n -3)))]) (set-car! x x) x)]
[(3) (let ([x (consup1 (ash n -3))]) (vector x 'a x))]
[(4) (cons (consup1 (ash n -3)) (consup1 (ash n -3)))]
[(5) (cons (string-copy "hello") (consup1 (ash n -3)))]
[(6) (list (consup1 (ash n -3)))]
[(7) (box (consup2 (ash n -3)))])]))
(define (consup2 n)
(case n
[(0) '()]
[(1) 'a]
[(2) 3/4]
[(3) 3.416]
[else
(case (logand n 7)
[(0) (cons (consup2 (ash n -3)) (consup2 (ash n -3)))]
[(1) (let ([x (make-vector 10 (consup1 (ash n -3)))])
(vector-set! x 5 (consup1 (ash n -3)))
x)]
[(2) (let ([x (cons #f (consup2 (ash n -3)))]) (set-car! x x) x)]
[(3) (let ([x (consup2 (ash n -3))]) (vector x 'a x))]
[(4) (let ([x (consup2 (ash n -3))]) (cons x x))]
[(5) (cons (string-copy "hello") (consup2 (ash n -3)))]
[(6) (list (consup2 (ash n -3)))]
[(7) (box (consup1 (ash n -3)))])]))
(define (consup3 n)
(case n
[(0) 'a]
[(1) '()]
[(2) 3.416]
[(3) 3/4]
[else
(case (logand n 7)
[(0) (cons (consup3 (ash n -3)) (consup3 (ash n -3)))]
[(1) (let ([x (make-vector 10 (consup3 (ash n -3)))])
(vector-set! x 5 (consup3 (ash n -3)))
x)]
[(2) (let ([x (cons #f (consup3 (ash n -3)))]) (set-car! x x) x)]
[(3) (let ([x (consup3 (ash n -3))]) (vector x 'a x))]
[(4) (let ([x (consup3 (ash n -3))]) (cons x x))]
[(5) (cons (string-copy "hello") (consup3 (ash n -3)))]
[(6) (list (consup3 (ash n -3)))]
[(7) (box (consup3 (ash n -3)))])]))
(let loop ([n 10000])
(unless (fx= n 0)
(let ([rn (random (ash 1 50))])
(let ([x1 (consup1 rn)] [x2 (consup2 rn)] [x3 (consup3 rn)])
(define-syntax test
(syntax-rules ()
[(_ e) (unless e (errorf #f "~s failed for rn = ~s" 'e rn))]))
(test (equal? x1 x1))
(test (equal? x2 x2))
(test (equal? x3 x3))
(test (equal? x1 x2))
(test (equal? x2 x1))
(test (not (equal? x1 x3)))
(test (not (equal? x3 x1)))
(test (not (equal? x2 x3)))
(test (not (equal? x3 x2)))))
(loop (fx- n 1))))
#t))
(time
(let () ; w/o sharing
(define (consup1 n)
(case n
[(0) '(#() 1389222281905413113340958870929048921229855260389703462234642106526635063669)]
[(1) '#(a #vfx(3 4 5))]
[(2) '(3/4 . #e3e100+4i)]
[(3) '(3.416 . -7.5+.05i)]
[else
(case (logand n 3)
[(0) (cons (consup1 (ash n -2)) (consup1 (ash n -3)))]
[(1) (vector (consup1 (ash n -2)) (consup1 (ash n -3)))]
[(2) (cons "hello" (consup1 (ash n -2)))]
[(3) (box (consup2 (ash n -2)))])]))
(define (consup2 n)
(case n
[(0) '(#() 1389222281905413113340958870929048921229855260389703462234642106526635063669)]
[(1) '#(a #vfx(3 4 5))]
[(2) '(3/4 . #e3e100+4i)]
[(3) '(3.416 . -7.5+.05i)]
[else
(case (logand n 3)
[(0) (cons (consup2 (ash n -2)) (consup2 (ash n -3)))]
[(1) (vector (consup2 (ash n -2)) (consup2 (ash n -3)))]
[(2) (cons "hello" (consup2 (ash n -2)))]
[(3) (box (consup1 (ash n -2)))])]))
(define (consup3 n)
(case n
[(0) '(#() 1389222281905413113340958870929048921229855260289703462234642106526635063669)]
[(1) '#(a #vfx(3 4 6))]
[(2) '(3/4 . #e3e100+5i)]
[(3) '(3.417 . -7.5+.05i)]
[else
(case (logand n 3)
[(0) (cons (consup3 (ash n -2)) (consup3 (ash n -3)))]
[(1) (vector (consup3 (ash n -2)) (consup3 (ash n -3)))]
[(2) (cons "hello" (consup3 (ash n -2)))]
[(3) (box (consup3 (ash n -2)))])]))
(let loop ([n 10000])
(unless (fx= n 0)
(let ([rn (random (ash 1 25))])
(let ([x1 (consup1 rn)] [x2 (consup2 rn)] [x3 (consup3 rn)])
(define-syntax test
(syntax-rules ()
[(_ e) (unless e (errorf #f "~s failed for rn = ~s" 'e rn))]))
(test (equal? x1 x1))
(test (equal? x2 x2))
(test (equal? x3 x3))
(test (equal? x1 x2))
(test (equal? x2 x1))
(test (not (equal? x1 x3)))
(test (not (equal? x3 x1)))
(test (not (equal? x2 x3)))
(test (not (equal? x3 x2)))))
(loop (fx- n 1))))
#t))
(time
(let () ; w/sharing
(define (consup n)
(define cache
(let ([ls '()] [n 0] [vk 1000])
(case-lambda
[()
(and (> n 0)
(let f ([i (random n)] [ls ls])
(if (fx< i vk)
(vector-ref (car ls) i)
(f (fx- i vk) (cdr ls)))))]
[(x)
(let ([i (fxmodulo n vk)])
(if (fx= i 0)
(set! ls (append ls (list (make-vector vk x))))
(vector-set! (list-ref ls (fxquotient n vk)) i x)))
(set! n (fx+ n 1))])))
(let f ([n n])
(if (= n 0)
(or (cache) (cons '() '()))
(case (logand n 3)
[(0) (let ([p1 (cons #f #f)] [p2 (cons #f #f)])
(let ([p (cons p1 p2)])
(cache p)
(let ([p (f (ash n -2))])
(set-car! p1 (car p))
(set-car! p2 (cdr p)))
(let ([p (f (ash n -2))])
(set-cdr! p1 (car p))
(set-cdr! p2 (cdr p)))
p))]
[(1) (let ([m (random 10)])
(let ([v1 (make-vector m #f)] [v2 (make-vector m #f)])
(let ([p (cons v1 v2)])
(cache p)
(do ([i 0 (fx+ i 1)])
((fx= i m))
(let ([p (f (ash n -2))])
(vector-set! v1 i (car p))
(vector-set! v2 i (cdr p))))
p)))]
[(2) (let ([p1 (f (ash n -2))]
[p2 (f (ash n -2))])
(cons (cons (cdr p1) (cdr p2))
(cons (car p1) (car p2))))]
[(3) (or (cache) (f (ash n -2)))]))))
(let loop ([n 5000])
(unless (fx= n 0)
(let ([rn (* (random 1000) (expt 2 (random 10)))])
(let ([p (consup rn)])
(let ([x1 (car p)] [x2 (cdr p)])
(define-syntax test
(syntax-rules ()
[(_ e) (unless e (errorf #f "~s failed for rn = ~s" 'e rn))]))
(test (equal? x1 x1))
(test (equal? x2 x2))
(test (equal? x1 x2))
(test (equal? x2 x1)))))
(loop (fx- n 1))))
#t))
; srfi 85 examples
(equal? '() '())
(equal? (vector 34.5 34.5) '#(34.5 34.5))
(andmap eq?
(let* ([x (list 'a)] [y (list 'a)] [z (list x y)])
(list (equal? z (list y x)) (equal? z (list x x))))
'(#t #t))
(andmap eq?
(let ([x (list 'a 'b 'c 'a)]
[y (list 'a 'b 'c 'a 'b 'c 'a)])
(set-cdr! (list-tail x 2) x)
(set-cdr! (list-tail y 5) y)
(list
(equal? x x)
(equal? x y)
(equal? (list x y 'a) (list y x 'b))))
'(#t #t #f))
; tests that break original SRFI 85 implementation
(let ()
(define x
(let ([x1 (vector 'h)]
[x2 (let ([x (list #f)]) (set-car! x x) x)])
(vector x1 (vector 'h) x1 (vector 'h) x1 x2)))
(define y
(let ([y1 (vector 'h)]
[y2 (vector 'h)]
[y3 (let ([x (list #f)]) (set-car! x x) x)])
(vector (vector 'h) y1 y1 y2 y2 y3)))
(equal? x y))
(let ()
(define x
(let ([x0 (vector #f #f #f)]
[x1 (vector #f #f #f)]
[x2 (vector #f #f #f)])
(vector-fill! x0 x0)
(vector-fill! x1 x1)
(vector-fill! x2 x2)
(vector x0 x1 x0 x2 x0)))
(define y
(let ([y0 (vector #f #f #f)]
[y1 (vector #f #f #f)]
[y2 (vector #f #f #f)])
(vector-fill! y0 y0)
(vector-fill! y1 y1)
(vector-fill! y2 y2)
(vector y0 y1 y1 y2 y2)))
(equal? x y))
(let ()
(define x
(let ([x (cons (cons #f 'a) 'a)])
(set-car! (car x) x)
x))
(define y
(let ([y (cons (cons #f 'a) 'a)])
(set-car! (car y) (car y))
y))
(equal? x y))
(let ()
(define x
(let* ([x3 (cons 'x3 'x3)]
[x2 (cons 'x2 x3)]
[x1 (cons x2 'x1)])
(set-car! x3 x3)
(set-cdr! x3 x3)
(set-car! x2 x2)
(set-cdr! x1 x1)
x1))
(define y
(let* ([y2 (cons 'y1 'y1)]
[y1 (cons y2 y2)])
(set-car! y2 y1)
(set-cdr! y2 y1)
y1))
(equal? x y))
(let ()
(define x
(let* ([x3 (cons 'x3 'x3)]
[x2 (cons 'x2 x3)]
[x1 (cons x2 'x1)])
(set-car! x3 x3)
(set-cdr! x3 x3)
(set-car! x2 x2)
(set-cdr! x1 x1)
x1))
(define y
(let* ([y2 (cons 'y1 'y1)]
[y1 (cons y2 y2)])
(set-car! y2 y1)
(set-cdr! y2 y1)
y1))
(equal? x y))
(let ()
(define (make-x k)
(let ([x1 (cons
(let f ([n k])
(if (= n 0)
(let ([x0 (cons #f #f)])
(set-car! x0 x0)
(set-cdr! x0 x0)
x0)
(let ([xi (cons #f (f (- n 1)))])
(set-car! xi xi)
xi)))
#f)])
(set-cdr! x1 x1)
x1))
(define y
(let* ([y2 (cons #f #f)] [y1 (cons y2 y2)])
(set-car! y2 y1)
(set-cdr! y2 y1)
y1))
(time (equal? (make-x 100) y)))
; tests that stress corrected SRFI 85 implementation
(or (equal?
(let ([v1 '#200=(#200#)] [v2 '#201=(#201#)])
(let ([t0 (current-time 'time-process)])
(let ([ans (let f ([i 1000] [x #t])
(if (fx= i 0)
x
(f (fx- i 1) (and x (equal? v1 v2)))))])
(list
ans
(let ([t (current-time 'time-process)])
(< (+ (* (- (time-second t) (time-second t0)) 1000000000)
(- (time-nanosecond t) (time-nanosecond t0)))
30000000))))))
'(#t #t))
(#%$enable-check-heap))
(or (equal?
(let ([v1 (make-vector 95000 (make-vector 95000 0))]
[v2 (make-vector 95000 (make-vector 95000 0))])
(let ([t0 (current-time 'time-process)])
(let ([ans (equal? v1 v2)])
(list
ans
(let ([t (current-time 'time-process)])
(> (+ (* (- (time-second t) (time-second t0)) 1000000000)
(- (time-nanosecond t) (time-nanosecond t0)))
100000000))))))
'(#t #f))
(#%$enable-check-heap))
(or (equal?
(let ([n 100000])
(let ([f (lambda (n)
(let ([ls (make-list n 0)])
(set-cdr! (last-pair ls) ls)
ls))])
(let ([v1 (f n)] [v2 (f (- n 1))])
(let ([t0 (current-time 'time-process)])
(let ([ans (equal? v1 v2)])
(let ([t (current-time 'time-process)])
(list
ans
(< (+ (* (- (time-second t) (time-second t0)) 1000000000)
(- (time-nanosecond t) (time-nanosecond t0)))
200000000))))))))
'(#t #t))
(#%$enable-check-heap))
)
(mat boolean?
(boolean? #t)
(boolean? #f)
(not (boolean? 't))
(not (boolean? 'f))
(not (boolean? 'nil))
(not (boolean? '(a b c)))
(not (boolean? #\a))
)
(mat null?
(null? '())
(not (null? #f))
(not (null? #t))
(not (null? 3))
(not (null? 'a))
)
(mat pair?
(pair? '(a b c))
(pair? '(a . b))
(pair? (cons 3 4))
(not (pair? '()))
(not (pair? 3))
(not (pair? 'a))
(not (pair? "hi"))
)
(mat list?
(list? '(a b c))
(not (list? '(a . b)))
(not (list? (cons 3 4)))
(list? '())
(not (list? 3))
(not (list? 'a))
(not (list? "hi"))
(let ([a (make-list 100)])
(set-cdr! (last-pair a) a)
(not (list? a)))
)
(mat atom?
(not (atom? '(a b c)))
(not (atom? '(a . b)))
(not (atom? (cons 3 4)))
(atom? '())
(atom? 3)
(atom? 'a)
(atom? "hi")
)
(mat number?
(number? 3)
(number? 23048230482304)
(number? 203480234802384/23049821)
(number? -3/4)
(number? -1)
(number? 0)
(number? -12083)
(number? 3.5)
(number? 1.8e-10)
(number? -3e5)
(number? -1231.2344)
(not (number? 'a))
(not (number? "hi"))
(not (number? (cons 3 4)))
(number? 5.0-0.0i)
(number? 5.0+0.0i)
(number? 5.0+4.0i)
(number? +inf.0)
(number? -inf.0)
(number? +nan.0)
)
(mat complex?
(complex? 3)
(complex? 23048230482304)
(complex? 203480234802384/23049821)
(complex? -3/4)
(complex? -1)
(complex? 0)
(complex? -12083)
(complex? 3.5)
(complex? 1.8e-10)
(complex? -3e5)
(complex? -1231.2344)
(not (complex? 'a))
(not (complex? "hi"))
(not (complex? (cons 3 4)))
(complex? 5.0-0.0i)
(complex? 5.0+0.0i)
(complex? 5.0+4.0i)
(complex? +inf.0)
(complex? -inf.0)
(complex? +nan.0)
)
(mat real?
(real? 3)
(real? 23048230482304)
(real? 203480234802384/23049821)
(real? -3/4)
(real? -1)
(real? 0)
(real? -12083)
(real? 3.5)
(real? 1.8e-10)
(real? -3e5)
(real? -1231.2344)
(not (real? 'a))
(not (real? "hi"))
(not (real? (cons 3 4)))
(not (real? 5.0-0.0i))
(not (real? 5.0+0.0i))
(not (real? 5.0+4.0i))
(real? +inf.0)
(real? -inf.0)
(real? +nan.0)
)
(mat real-valued?
(real-valued? 3)
(real-valued? 23048230482304)
(real-valued? 203480234802384/23049821)
(real-valued? -3/4)
(real-valued? -1)
(real-valued? 0)
(real-valued? -12083)
(real-valued? 3.5)
(real-valued? 1.8e-10)
(real-valued? -3e5)
(real-valued? -1231.2344)
(not (real-valued? 'a))
(not (real-valued? "hi"))
(not (real-valued? (cons 3 4)))
(real-valued? 5.0-0.0i)
(real-valued? 5.0+0.0i)
(not (real-valued? 8.0+3.0i))
(real-valued? +inf.0)
(real-valued? -inf.0)
(real-valued? +nan.0)
)
(mat rational?
(rational? 3)
(rational? 23048230482304)
(rational? 203480234802384/23049821)
(rational? -3/4)
(rational? -1)
(rational? 0)
(rational? -12083)
(rational? 3.5)
(rational? 1.8e-10)
(rational? -3e5)
(rational? -1231.2344)
(not (rational? 'a))
(not (rational? "hi"))
(not (rational? (cons 3 4)))
(not (rational? 5.0-0.0i))
(not (rational? 5.0+0.0i))
(not (rational? 8.0+3.0i))
(not (rational? +inf.0))
(not (rational? -inf.0))
(not (rational? +nan.0))
)
(mat rational-valued?
(rational-valued? 3)
(rational-valued? 23048230482304)
(rational-valued? 203480234802384/23049821)
(rational-valued? -3/4)
(rational-valued? -1)
(rational-valued? 0)
(rational-valued? -12083)
(rational-valued? 3.5)
(rational-valued? 1.8e-10)
(rational-valued? -3e5)
(rational-valued? -1231.2344)
(not (rational-valued? 'a))
(not (rational-valued? "hi"))
(not (rational-valued? (cons 3 4)))
(rational-valued? 5.0-0.0i)
(rational-valued? 5.0+0.0i)
(not (rational-valued? 8.0+3.0i))
(not (rational-valued? +inf.0))
(not (rational-valued? -inf.0))
(not (rational-valued? +nan.0))
(not (rational-valued? +inf.0+0.0i))
(not (rational-valued? +inf.0-0.0i))
(not (rational-valued? -inf.0+0.0i))
(not (rational-valued? -inf.0-0.0i))
(not (rational-valued? +nan.0+0.0i))
(not (rational-valued? +nan.0-0.0i))
)
(mat integer?
(integer? 3)
(integer? 23048230482304)
(not (integer? 203480234802384/23049821))
(not (integer? -3/4))
(integer? -1)
(integer? 0)
(integer? -12083)
(integer? 4.0)
(not (integer? 3.5))
(not (integer? 1.8e-10))
(integer? 1.8e10)
(integer? -3e5)
(not (integer? -1231.2344))
(not (integer? 'a))
(not (integer? "hi"))
(not (integer? (cons 3 4)))
(not (integer? 3.0-0.0i))
(not (integer? 3.0+0.0i))
(not (integer? 3.0+1.0i))
(integer? #i1)
(not (integer? +inf.0))
(not (integer? -inf.0))
(not (integer? +nan.0))
)
(mat integer-valued?
(integer-valued? 3)
(integer-valued? 23048230482304)
(not (integer-valued? 203480234802384/23049821))
(not (integer-valued? -3/4))
(integer-valued? -1)
(integer-valued? 0)
(integer-valued? -12083)
(integer-valued? 4.0)
(not (integer-valued? 3.5))
(not (integer-valued? 1.8e-10))
(integer-valued? 1.8e10)
(integer-valued? -3e5)
(not (integer-valued? -1231.2344))
(not (integer-valued? 'a))
(not (integer-valued? "hi"))
(not (integer-valued? (cons 3 4)))
(integer-valued? 3.0-0.0i)
(integer-valued? 3.0+0.0i)
(not (integer-valued? 3.0+1.0i))
(integer-valued? #i1)
(not (integer-valued? +inf.0))
(not (integer-valued? -inf.0))
(not (integer-valued? +nan.0))
)
(mat char?
(char? #\a)
(char? #\3)
(char? (string-ref "hi" 0))
(not (char? "a"))
(not (char? 'a))
(not (char? '(a b c)))
)
(mat string?
(string? "hi")
(string? (string-append "hi " "there"))
(string? (string #\a #\b #\c #\c))
(not (string? #\a))
(not (string? 'a))
(not (string? '(a b c)))
(not (string? 3))
)
(mat vector?
(vector? '#(a b c))
(vector? (vector 1 2 3 4))
(not (vector? '(a b c)))
(not (vector? "hi there"))
(not (vector? 234234))
)
(mat fxvector?
(fxvector? #vfx(1 2 3))
(fxvector? (fxvector 1 2 3 4))
(not (fxvector? '(1 2 3)))
(not (fxvector? '#(1 2 3)))
(not (fxvector? '#vu8(1 2 3)))
(not (fxvector? "hi there"))
(not (fxvector? 234234))
)
(mat bytevector?
(bytevector? '#vu8(1 2 3))
(bytevector? (bytevector 1 2 3 4))
(not (bytevector? '(1 2 3)))
(not (bytevector? '#(1 2 3)))
(not (bytevector? '#vfx(1 2 3)))
(not (bytevector? "hi there"))
(not (bytevector? 234234))
)
(mat symbol?
(symbol? 'a)
(symbol? '|(a b c)|)
(symbol? (string->symbol "hi there"))
(symbol? (gensym "hi there"))
(not (symbol? "hi there"))
(not (symbol? 3))
)
(mat box?
(box? '#&(a b c))
(box? (box 3))
(not (box? '()))
(not (box? 3))
(not (box? '(a b c)))
(not (box? 'a))
(not (box? "hi"))
)
(mat input-port?
(input-port? (current-input-port))
(not (input-port? (open-output-string)))
)
(mat output-port?
(output-port? (current-output-port))
(not (output-port? (open-input-string "hello")))
(output-port? (trace-output-port))
)
(mat procedure?
(procedure? car)
(procedure? (lambda (x) x))
(not (procedure? 3))
(not (procedure? '#(1 b c)))
(not (procedure? '(a b c)))
)
(mat boolean=?
(error? (boolean=?))
(error? (boolean=? #f))
(error? (boolean=? 3 #t))
(error? (boolean=? #t 3))
(error? (boolean=? 3 #f #t))
(error? (boolean=? #t 3 #t))
(error? (boolean=? #t #f 3))
(error? (boolean=? 3 #t #f #t))
(error? (boolean=? #f 3 #f #t))
(error? (boolean=? #t #t 3 #t))
(error? (boolean=? #f #t #f 3))
(eqv? (boolean=? #t #t) #t)
(eqv? (boolean=? #f #t) #f)
(eqv? (boolean=? #t #f) #f)
(eqv? (boolean=? #f #f) #t)
(eqv? (boolean=? #f #f #t) #f)
(eqv? (boolean=? #f #f #f #f #f #t) #f)
(eqv? (boolean=? #t #t #t #t #t #f) #f)
(eqv? (boolean=? #t #t #t #t #t #t) #t)
(eqv? (boolean=? #f #f #f #f #f #f) #t)
)
(mat symbol=?
(error? (symbol=?))
(error? (symbol=? 'f))
(error? (symbol=? 3 't))
(error? (symbol=? 't 3))
(error? (symbol=? 3 'f 't))
(error? (symbol=? 't 3 't))
(error? (symbol=? 't 'f 3))
(error? (symbol=? 3 't 'f 't))
(error? (symbol=? 'f 3 'f 't))
(error? (symbol=? 't 't 3 't))
(error? (symbol=? 'f 't 'f 3))
(eqv? (symbol=? 't 't) #t)
(eqv? (symbol=? 'f 't) #f)
(eqv? (symbol=? 't 'f) #f)
(eqv? (symbol=? 'f 'f) #t)
(eqv? (symbol=? 'f 'f 't) #f)
(eqv? (symbol=? 'f 'f 'f 'f 'f 't) #f)
(eqv? (symbol=? 't 't 't 't 't 'f) #f)
(eqv? (symbol=? 't 't 't 't 't 't) #t)
(eqv? (symbol=? 'f 'f 'f 'f 'f 'f) #t)
)

1340
mats/5_2.ms Normal file

File diff suppressed because it is too large Load diff

7074
mats/5_3.ms Normal file

File diff suppressed because it is too large Load diff

1576
mats/5_4.ms Normal file

File diff suppressed because it is too large Load diff

781
mats/5_5.ms Normal file
View file

@ -0,0 +1,781 @@
;;; 5-5.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(mat string=?/string-ci=?
(error? (string=?))
(error? (string=? 'a))
(error? (string=? "hi" 'a))
(error? (string=? "hi" 'a "ho"))
(error? (string=? 'a "hi" "ho"))
(error? (string=? "hi" "ho" 'a "he"))
(error? (string-ci=?))
(error? (string-ci=? 'a))
(error? (string-ci=? "hi" 'a))
(error? (string-ci=? "hi" 'a "ho"))
(error? (string-ci=? 'a "hi" "ho"))
(error? (string-ci=? "hi" "ho" 'a "he"))
(string=? "abc" "abc")
(string-ci=? "abc" "abc")
(not (string=? "Abc" "abc"))
(string-ci=? "Abc" "abc")
(not (string=? "abc" "abc "))
(not (string-ci=? "abc" "abc "))
(not (string=? "abc " "abc"))
(not (string-ci=? "abc " "abc"))
(string=? "a")
(string=? "a" "a" "a")
(not (string=? "a" "b" "c"))
(not (string=? "c" "b" "a"))
(not (string=? "b" "c" "a"))
(not (string=? "A" "a" "A"))
(not (string=? "a" "B" "c"))
(not (string=? "C" "b" "A"))
(string-ci=? "a")
(string-ci=? "a" "a" "a")
(not (string-ci=? "a" "b" "c"))
(not (string-ci=? "c" "b" "a"))
(not (string-ci=? "b" "c" "a"))
(string-ci=? "A" "a" "A")
(not (string-ci=? "a" "B" "c"))
(not (string-ci=? "C" "b" "A"))
)
(mat string<?/string-ci<?
(error? (string<?))
(error? (string<? 'a))
(error? (string<? "hi" 'a))
(error? (string<? "hi" 'a "ho"))
(error? (string<? 'a "hi" "ho"))
(error? (string<? "hi" "ho" 'a "he"))
(error? (string-ci<?))
(error? (string-ci<? 'a))
(error? (string-ci<? "hi" 'a))
(error? (string-ci<? "hi" 'a "ho"))
(error? (string-ci<? 'a "hi" "ho"))
(error? (string-ci<? "hi" "ho" 'a "he"))
(not (string<? "abc" "abc"))
(not (string-ci<? "abc" "abc"))
(string<? "Abc" "abc")
(not (string-ci<? "aBc" "AbC"))
(string<? "abc" "abc ")
(string-ci<? "aBc" "AbC ")
(not (string<? "abc " "abc"))
(not (string-ci<? "aBc " "AbC"))
(string<? "a")
(not (string<? "a" "a" "a"))
(string<? "a" "b" "c")
(not (string<? "c" "b" "a"))
(not (string<? "b" "c" "a"))
(not (string<? "A" "a" "A"))
(not (string<? "a" "B" "c"))
(not (string<? "C" "b" "A"))
(string-ci<? "a")
(not (string-ci<? "a" "a" "a"))
(string-ci<? "a" "b" "c")
(not (string-ci<? "c" "b" "a"))
(not (string-ci<? "b" "c" "a"))
(not (string-ci<? "A" "a" "A"))
(string-ci<? "a" "B" "c")
(not (string-ci<? "C" "b" "A"))
)
(mat string>?/string-ci>?
(error? (string>?))
(error? (string>? 'a))
(error? (string>? "hi" 'a))
(error? (string>? "hi" 'a "ho"))
(error? (string>? 'a "hi" "ho"))
(error? (string>? "hi" "ho" 'a "he"))
(error? (string-ci>?))
(error? (string-ci>? 'a))
(error? (string-ci>? "hi" 'a))
(error? (string-ci>? "hi" 'a "ho"))
(error? (string-ci>? 'a "hi" "ho"))
(error? (string-ci>? "hi" "ho" 'a "he"))
(not (string>? "abc" "abc"))
(not (string-ci>? "abc" "abc"))
(string>? "abc" "Abc")
(not (string-ci>? "aBc" "AbC"))
(not (string>? "abc" "abc "))
(not (string-ci>? "aBc" "AbC "))
(string>? "abc " "abc")
(string-ci>? "aBc " "AbC")
(string>? "a")
(not (string>? "a" "a" "a"))
(not (string>? "a" "b" "c"))
(string>? "c" "b" "a")
(not (string>? "b" "c" "a"))
(not (string>? "A" "a" "A"))
(not (string>? "a" "B" "c"))
(not (string>? "C" "b" "A"))
(string-ci>? "a")
(not (string-ci>? "a" "a" "a"))
(not (string-ci>? "a" "b" "c"))
(string-ci>? "c" "b" "a")
(not (string-ci>? "b" "c" "a"))
(not (string-ci>? "A" "a" "A"))
(not (string-ci>? "a" "B" "c"))
(string-ci>? "C" "b" "A")
)
(mat string<=?/string-ci<=?
(error? (string<=?))
(error? (string<=? 'a))
(error? (string<=? "hi" 'a))
(error? (string<=? "hi" 'a "ho"))
(error? (string<=? 'a "hi" "ho"))
(error? (string<=? "hi" "ho" 'a "he"))
(error? (string-ci<=?))
(error? (string-ci<=? 'a))
(error? (string-ci<=? "hi" 'a))
(error? (string-ci<=? "hi" 'a "ho"))
(error? (string-ci<=? 'a "hi" "ho"))
(error? (string-ci<=? "hi" "ho" 'a "he"))
(string<=? "abc" "abc")
(string-ci<=? "abc" "abc")
(not (string<=? "abc" "Abc"))
(string-ci<=? "aBc" "AbC")
(string<=? "abc" "abc ")
(string-ci<=? "aBc" "AbC ")
(not (string<=? "abc " "abc"))
(not (string-ci<=? "aBc " "AbC"))
(string<=? "a")
(string<=? "a" "a" "a")
(string<=? "a" "b" "c")
(not (string<=? "c" "b" "a"))
(not (string<=? "b" "c" "a"))
(not (string<=? "A" "a" "A"))
(not (string<=? "a" "B" "c"))
(not (string<=? "C" "b" "A"))
(string-ci<=? "a")
(string-ci<=? "a" "a" "a")
(string-ci<=? "a" "b" "c")
(not (string-ci<=? "c" "b" "a"))
(not (string-ci<=? "b" "c" "a"))
(string-ci<=? "A" "a" "A")
(string-ci<=? "a" "B" "c")
(not (string-ci<=? "C" "b" "A"))
)
(mat string>=?/string-ci>=?
(error? (string>=?))
(error? (string>=? 'a))
(error? (string>=? "hi" 'a))
(error? (string>=? "hi" 'a "ho"))
(error? (string>=? 'a "hi" "ho"))
(error? (string>=? "hi" "ho" 'a "he"))
(error? (string-ci>=?))
(error? (string-ci>=? 'a))
(error? (string-ci>=? "hi" 'a))
(error? (string-ci>=? "hi" 'a "ho"))
(error? (string-ci>=? 'a "hi" "ho"))
(error? (string-ci>=? "hi" "ho" 'a "he"))
(string>=? "abc" "abc")
(string-ci>=? "abc" "abc")
(not (string>=? "Abc" "abc"))
(string-ci>=? "aBc" "AbC")
(not (string>=? "abc" "abc "))
(not (string-ci>=? "aBc" "AbC "))
(string>=? "abc " "abc")
(string-ci>=? "aBc " "AbC")
(string>=? "a")
(string>=? "a" "a" "a")
(not (string>=? "a" "b" "c"))
(string>=? "c" "b" "a")
(not (string>=? "b" "c" "a"))
(not (string>=? "A" "a" "A"))
(not (string>=? "a" "B" "c"))
(not (string>=? "C" "b" "A"))
(string-ci>=? "a")
(string-ci>=? "a" "a" "a")
(not (string-ci>=? "a" "b" "c"))
(string-ci>=? "c" "b" "a")
(not (string-ci>=? "b" "c" "a"))
(string-ci>=? "A" "a" "A")
(not (string-ci>=? "a" "B" "c"))
(string-ci>=? "C" "b" "A")
)
(mat r6rs:string=?/r6rs:string-ci=?
(error? (r6rs:string=?))
(error? (r6rs:string=? 'a))
(error? (r6rs:string=? "hi" 'a))
(error? (r6rs:string=? "hi" 'a "ho"))
(error? (r6rs:string=? 'a "hi" "ho"))
(error? (r6rs:string=? "hi" "ho" 'a "he"))
(error? (r6rs:string-ci=?))
(error? (r6rs:string-ci=? 'a))
(error? (r6rs:string-ci=? "hi" 'a))
(error? (r6rs:string-ci=? "hi" 'a "ho"))
(error? (r6rs:string-ci=? 'a "hi" "ho"))
(error? (r6rs:string-ci=? "hi" "ho" 'a "he"))
(r6rs:string=? "abc" "abc")
(r6rs:string-ci=? "abc" "abc")
(not (r6rs:string=? "Abc" "abc"))
(r6rs:string-ci=? "Abc" "abc")
(not (r6rs:string=? "abc" "abc "))
(not (r6rs:string-ci=? "abc" "abc "))
(not (r6rs:string=? "abc " "abc"))
(not (r6rs:string-ci=? "abc " "abc"))
(r6rs:string=? "a" "a" "a")
(not (r6rs:string=? "a" "b" "c"))
(not (r6rs:string=? "c" "b" "a"))
(not (r6rs:string=? "b" "c" "a"))
(not (r6rs:string=? "A" "a" "A"))
(not (r6rs:string=? "a" "B" "c"))
(not (r6rs:string=? "C" "b" "A"))
(r6rs:string-ci=? "a" "a" "a")
(not (r6rs:string-ci=? "a" "b" "c"))
(not (r6rs:string-ci=? "c" "b" "a"))
(not (r6rs:string-ci=? "b" "c" "a"))
(r6rs:string-ci=? "A" "a" "A")
(not (r6rs:string-ci=? "a" "B" "c"))
(not (r6rs:string-ci=? "C" "b" "A"))
)
(mat r6rs:string<?/r6rs:string-ci<?
(error? (r6rs:string<?))
(error? (r6rs:string<? 'a))
(error? (r6rs:string<? "hi" 'a))
(error? (r6rs:string<? "hi" 'a "ho"))
(error? (r6rs:string<? 'a "hi" "ho"))
(error? (r6rs:string<? "hi" "ho" 'a "he"))
(error? (r6rs:string-ci<?))
(error? (r6rs:string-ci<? 'a))
(error? (r6rs:string-ci<? "hi" 'a))
(error? (r6rs:string-ci<? "hi" 'a "ho"))
(error? (r6rs:string-ci<? 'a "hi" "ho"))
(error? (r6rs:string-ci<? "hi" "ho" 'a "he"))
(not (r6rs:string<? "abc" "abc"))
(not (r6rs:string-ci<? "abc" "abc"))
(r6rs:string<? "Abc" "abc")
(not (r6rs:string-ci<? "aBc" "AbC"))
(r6rs:string<? "abc" "abc ")
(r6rs:string-ci<? "aBc" "AbC ")
(not (r6rs:string<? "abc " "abc"))
(not (r6rs:string-ci<? "aBc " "AbC"))
(not (r6rs:string<? "a" "a" "a"))
(r6rs:string<? "a" "b" "c")
(not (r6rs:string<? "c" "b" "a"))
(not (r6rs:string<? "b" "c" "a"))
(not (r6rs:string<? "A" "a" "A"))
(not (r6rs:string<? "a" "B" "c"))
(not (r6rs:string<? "C" "b" "A"))
(not (r6rs:string-ci<? "a" "a" "a"))
(r6rs:string-ci<? "a" "b" "c")
(not (r6rs:string-ci<? "c" "b" "a"))
(not (r6rs:string-ci<? "b" "c" "a"))
(not (r6rs:string-ci<? "A" "a" "A"))
(r6rs:string-ci<? "a" "B" "c")
(not (r6rs:string-ci<? "C" "b" "A"))
)
(mat r6rs:string>?/r6rs:string-ci>?
(error? (r6rs:string>?))
(error? (r6rs:string>? 'a))
(error? (r6rs:string>? "hi" 'a))
(error? (r6rs:string>? "hi" 'a "ho"))
(error? (r6rs:string>? 'a "hi" "ho"))
(error? (r6rs:string>? "hi" "ho" 'a "he"))
(error? (r6rs:string-ci>?))
(error? (r6rs:string-ci>? 'a))
(error? (r6rs:string-ci>? "hi" 'a))
(error? (r6rs:string-ci>? "hi" 'a "ho"))
(error? (r6rs:string-ci>? 'a "hi" "ho"))
(error? (r6rs:string-ci>? "hi" "ho" 'a "he"))
(not (r6rs:string>? "abc" "abc"))
(not (r6rs:string-ci>? "abc" "abc"))
(r6rs:string>? "abc" "Abc")
(not (r6rs:string-ci>? "aBc" "AbC"))
(not (r6rs:string>? "abc" "abc "))
(not (r6rs:string-ci>? "aBc" "AbC "))
(r6rs:string>? "abc " "abc")
(r6rs:string-ci>? "aBc " "AbC")
(not (r6rs:string>? "a" "a" "a"))
(not (r6rs:string>? "a" "b" "c"))
(r6rs:string>? "c" "b" "a")
(not (r6rs:string>? "b" "c" "a"))
(not (r6rs:string>? "A" "a" "A"))
(not (r6rs:string>? "a" "B" "c"))
(not (r6rs:string>? "C" "b" "A"))
(not (r6rs:string-ci>? "a" "a" "a"))
(not (r6rs:string-ci>? "a" "b" "c"))
(r6rs:string-ci>? "c" "b" "a")
(not (r6rs:string-ci>? "b" "c" "a"))
(not (r6rs:string-ci>? "A" "a" "A"))
(not (r6rs:string-ci>? "a" "B" "c"))
(r6rs:string-ci>? "C" "b" "A")
)
(mat r6rs:string<=?/r6rs:string-ci<=?
(error? (r6rs:string<=?))
(error? (r6rs:string<=? 'a))
(error? (r6rs:string<=? "hi" 'a))
(error? (r6rs:string<=? "hi" 'a "ho"))
(error? (r6rs:string<=? 'a "hi" "ho"))
(error? (r6rs:string<=? "hi" "ho" 'a "he"))
(error? (r6rs:string-ci<=?))
(error? (r6rs:string-ci<=? 'a))
(error? (r6rs:string-ci<=? "hi" 'a))
(error? (r6rs:string-ci<=? "hi" 'a "ho"))
(error? (r6rs:string-ci<=? 'a "hi" "ho"))
(error? (r6rs:string-ci<=? "hi" "ho" 'a "he"))
(r6rs:string<=? "abc" "abc")
(r6rs:string-ci<=? "abc" "abc")
(not (r6rs:string<=? "abc" "Abc"))
(r6rs:string-ci<=? "aBc" "AbC")
(r6rs:string<=? "abc" "abc ")
(r6rs:string-ci<=? "aBc" "AbC ")
(not (r6rs:string<=? "abc " "abc"))
(not (r6rs:string-ci<=? "aBc " "AbC"))
(r6rs:string<=? "a" "a" "a")
(r6rs:string<=? "a" "b" "c")
(not (r6rs:string<=? "c" "b" "a"))
(not (r6rs:string<=? "b" "c" "a"))
(not (r6rs:string<=? "A" "a" "A"))
(not (r6rs:string<=? "a" "B" "c"))
(not (r6rs:string<=? "C" "b" "A"))
(r6rs:string-ci<=? "a" "a" "a")
(r6rs:string-ci<=? "a" "b" "c")
(not (r6rs:string-ci<=? "c" "b" "a"))
(not (r6rs:string-ci<=? "b" "c" "a"))
(r6rs:string-ci<=? "A" "a" "A")
(r6rs:string-ci<=? "a" "B" "c")
(not (r6rs:string-ci<=? "C" "b" "A"))
)
(mat r6rs:string>=?/r6rs:string-ci>=?
(error? (r6rs:string>=?))
(error? (r6rs:string>=? 'a))
(error? (r6rs:string>=? "hi" 'a))
(error? (r6rs:string>=? "hi" 'a "ho"))
(error? (r6rs:string>=? 'a "hi" "ho"))
(error? (r6rs:string>=? "hi" "ho" 'a "he"))
(error? (r6rs:string-ci>=?))
(error? (r6rs:string-ci>=? 'a))
(error? (r6rs:string-ci>=? "hi" 'a))
(error? (r6rs:string-ci>=? "hi" 'a "ho"))
(error? (r6rs:string-ci>=? 'a "hi" "ho"))
(error? (r6rs:string-ci>=? "hi" "ho" 'a "he"))
(r6rs:string>=? "abc" "abc")
(r6rs:string-ci>=? "abc" "abc")
(not (r6rs:string>=? "Abc" "abc"))
(r6rs:string-ci>=? "aBc" "AbC")
(not (r6rs:string>=? "abc" "abc "))
(not (r6rs:string-ci>=? "aBc" "AbC "))
(r6rs:string>=? "abc " "abc")
(r6rs:string-ci>=? "aBc " "AbC")
(r6rs:string>=? "a" "a" "a")
(not (r6rs:string>=? "a" "b" "c"))
(r6rs:string>=? "c" "b" "a")
(not (r6rs:string>=? "b" "c" "a"))
(not (r6rs:string>=? "A" "a" "A"))
(not (r6rs:string>=? "a" "B" "c"))
(not (r6rs:string>=? "C" "b" "A"))
(r6rs:string-ci>=? "a" "a" "a")
(not (r6rs:string-ci>=? "a" "b" "c"))
(r6rs:string-ci>=? "c" "b" "a")
(not (r6rs:string-ci>=? "b" "c" "a"))
(r6rs:string-ci>=? "A" "a" "A")
(not (r6rs:string-ci>=? "a" "B" "c"))
(r6rs:string-ci>=? "C" "b" "A")
)
(mat string
(error? (string 'a))
(error? (string #\a 'a))
(error? (string #\a #\b 'a))
(equal? (string #\a #\b #\c) "abc")
(equal? (string #\a (string-ref "b" 0) #\c) "abc")
(equal? (let ([x #\a]) (string x (string-ref "b" 0) #\c)) "abc")
(eq? (string) "")
)
(mat make-string
(error? (make-string))
(error? (make-string 2 #\a #\b))
(error? (make-string 3 'a))
(error? (make-string 'a 3))
(eqv? (make-string 0) "")
(eqv? (make-string (- 4 4)) (string))
(eqv? (string-length (make-string 3)) 3)
(eqv? (string-length (make-string (+ 3 4))) 7)
(eqv? (string-length (make-string 1000)) 1000)
(string=? (make-string 10 #\a) "aaaaaaaaaa")
(string=? (make-string (- 4 1) #\a) "aaa")
(string=? (make-string (- 4 1) (string-ref "b" 0)) "bbb")
(andmap char? (string->list (make-string 20)))
)
(mat string-length
(error? (string-length))
(error? (string-length "hi" "there"))
(error? (string-length 'a))
(eqv? (string-length "abc") 3)
(eqv? (string-length "") 0)
)
(mat $string-ref-check?
(let ([s (make-string 3)] [imm-s (string->immutable-string (make-string 3))] [not-s (make-vector 3)])
(let ([i-1 -1] [i0 0] [i1 1] [i2 2] [i3 3] [ifalse #f] [ibig (+ (most-positive-fixnum) 1)])
(and
(not (#%$string-ref-check? not-s i0))
(not (#%$string-ref-check? s ifalse))
(not (#%$string-ref-check? s i-1))
(not (#%$string-ref-check? imm-s i-1))
(#%$string-ref-check? s 0)
(#%$string-ref-check? s 1)
(#%$string-ref-check? s 2)
(#%$string-ref-check? imm-s 0)
(#%$string-ref-check? imm-s 1)
(#%$string-ref-check? imm-s 2)
(#%$string-ref-check? s i0)
(#%$string-ref-check? s i1)
(#%$string-ref-check? s i2)
(#%$string-ref-check? imm-s i0)
(#%$string-ref-check? imm-s i1)
(#%$string-ref-check? imm-s i2)
(not (#%$string-ref-check? s 3))
(not (#%$string-ref-check? s i3))
(not (#%$string-ref-check? s ibig))
(not (#%$string-ref-check? imm-s 3))
(not (#%$string-ref-check? imm-s i3))
(not (#%$string-ref-check? imm-s ibig)))))
)
(mat string-ref
(error? (string-ref))
(error? (string-ref "hi"))
(error? (string-ref "hi" 3 4))
(error? (string-ref 'a 3))
(error? (string-ref "hi" 'a))
(error? (string-ref "hi" -1))
(error? (string-ref "hi" 2))
(eqv? (string-ref "abc" 0) #\a)
(eqv? (string-ref "abc" 1) #\b)
(eqv? (string-ref "abc" 2) #\c)
)
(mat string-set!
(error? (string-set!))
(error? (string-set! "hi"))
(error? (string-set! "hi" 1))
(error? (string-set! "hi" 3 #\a #\b))
(error? (string-set! 'a 3 #\a))
(error? (string-set! "hi" 'a #\a))
(error? (string-set! "hi" 3 'a))
(error? (string-set! "hi" -1 #\a))
(error? (string-set! "hi" 2 #\a))
(let ((s (string #\a #\b #\c)))
(and
(begin (string-set! s 0 #\x) (equal? s "xbc"))
(begin (string-set! s 1 #\y) (equal? s "xyc"))
(begin (string-set! s 2 #\z) (equal? s "xyz"))))
)
(mat string-copy
; incorrect argument count
(error? (string-copy))
(error? (string-copy "hi" "there"))
; not a string
(error? (string-copy 'a))
(error? (if (string-copy '(a b c)) #f #t))
(equal? (string-copy "") "")
(equal? (string-copy "abc") "abc")
(let* ((x1 (string #\1 #\2 #\3)) (x2 (string-copy x1)))
(and (equal? x2 x1) (not (eq? x2 x1))))
)
(mat string-copy!
(begin
(define $s1 (string #\1 #\2 #\3 #\4))
(define $s2 (string #\a #\b #\c #\d #\e #\f #\g #\h #\i))
(and (string? $s1)
(string? $s2)
(eqv? (string-length $s1) 4)
(eqv? (string-length $s2) 9)))
; wrong number of arguments
(error? (string-copy!))
(error? (string-copy! $s2))
(error? (string-copy! $s2 3))
(error? (string-copy! $s2 3 $s1))
(error? (string-copy! $s2 3 $s1 1))
(error? (if (string-copy! $s2 3 $s1 1 2 3) #f #t))
; not string
(error? (string-copy! 0 0 $s2 0 0))
(error? (if (string-copy! $s1 0 (bytevector 1 2 3) 0 0) #f #t))
; bad index
(error? (string-copy! $s1 -1 $s2 0 0))
(error? (string-copy! $s1 0 $s2 -1 0))
(error? (string-copy! $s1 'a $s2 0 0))
(error? (string-copy! $s1 0 $s2 0.0 0))
(error? (string-copy! $s1 (+ (most-positive-fixnum) 1) $s2 0 0))
(error? (if (string-copy! $s1 0 $s2 (+ (most-positive-fixnum) 1) 0) #f #t))
; bad count
(error? (string-copy! $s1 0 $s2 0 -1))
(error? (string-copy! $s1 0 $s2 0 (+ (most-positive-fixnum) 1)))
(error? (if (string-copy! $s1 0 $s2 0 'a) #f #t))
; beyond end
(error? (string-copy! $s1 0 $s2 0 5))
(error? (string-copy! $s2 0 $s1 0 5))
(error? (string-copy! $s1 1 $s2 0 4))
(error? (string-copy! $s2 0 $s1 1 4))
(error? (string-copy! $s1 2 $s2 0 3))
(error? (string-copy! $s2 0 $s1 2 3))
(error? (string-copy! $s1 3 $s2 0 2))
(error? (string-copy! $s2 0 $s1 3 2))
(error? (string-copy! $s1 4 $s2 0 1))
(error? (string-copy! $s2 0 $s1 4 1))
(error? (string-copy! $s2 0 $s1 0 500))
(error? (if (string-copy! $s2 500 $s1 0 0) #f #t))
; make sure no damage done
(and (string? $s1)
(string? $s2)
(equal? $s1 "1234")
(equal? $s2 "abcdefghi"))
(begin
(string-copy! $s2 3 $s1 1 2)
(and (equal? $s1 "1de4")
(equal? $s2 "abcdefghi")))
(begin
(string-copy! $s2 6 $s1 2 2)
(and (equal? $s1 "1dgh")
(equal? $s2 "abcdefghi")))
(begin
(string-copy! $s2 0 $s1 4 0)
(and (equal? $s1 "1dgh")
(equal? $s2 "abcdefghi")))
(begin
(string-copy! $s2 3 $s1 4 0)
(and (equal? $s1 "1dgh")
(equal? $s2 "abcdefghi")))
(begin
(string-copy! $s2 3 $s2 4 0)
(and (equal? $s1 "1dgh")
(equal? $s2 "abcdefghi")))
(begin
(string-copy! $s2 2 $s1 1 3)
(and (equal? $s1 "1cde")
(equal? $s2 "abcdefghi")))
(begin
(string-copy! $s1 0 $s2 3 4)
(and (equal? $s1 "1cde")
(equal? $s2 "abc1cdehi")))
(begin
(string-copy! $s2 0 $s2 3 5)
(and (equal? $s1 "1cde")
(equal? $s2 "abcabc1ci")))
(begin
(string-copy! $s2 4 $s2 2 5)
(and (equal? $s1 "1cde")
(equal? $s2 "abbc1cici")))
(begin
(string-copy! $s2 1 $s2 1 7)
(and (equal? $s1 "1cde")
(equal? $s2 "abbc1cici")))
)
(mat string-truncate!
(begin
(define $s (string #\a #\b #\c #\d #\e #\f #\g #\h #\i))
(and (string? $s)
(fx= (string-length $s) 9)
(string=? $s "abcdefghi")))
; wrong number of arguments
(error? (string-truncate!))
(error? (string-truncate! $s))
(error? (string-truncate! $s 3 15))
; not string
(error? (string-truncate! 0 0))
(error? (if (string-truncate! (bytevector 1 2 3) 2) #f #t))
; bad length
(error? (string-truncate! $s -1))
(error? (string-truncate! $s 10))
(error? (string-truncate! $s 1000))
(error? (string-truncate! $s (+ (most-positive-fixnum) 1)))
(error? (string-truncate! $s 'a))
(begin
(string-truncate! $s 9)
(and (string? $s)
(fx= (string-length $s) 9)
(string=? $s "abcdefghi")))
(begin
(string-truncate! $s 8)
(and (string? $s)
(fx= (string-length $s) 8)
(string=? $s "abcdefgh")))
(begin
(string-truncate! $s 6)
(and (string? $s)
(fx= (string-length $s) 6)
(string=? $s "abcdef")))
(begin
(string-truncate! $s 3)
(and (string? $s)
(fx= (string-length $s) 3)
(string=? $s "abc")))
(begin
(define $s2 (string-truncate! $s 0))
(and (eqv? $s2 "")
(string? $s)
(fx= (string-length $s) 3)
(string=? $s "abc")))
)
(mat string-append
(error? (string-append 'a))
(error? (string-append "hi" 'b))
(error? (string-append "hi" 'b "there"))
(error? (string-copy 'a))
(eqv? (string-append) "")
(let ([x (make-string 10 #\space)])
(and (equal? x " ")
(not (eq? x (string-append x)))))
(equal? (string-append "abc") "abc")
(equal? (string-append "abc" "xyz") "abcxyz")
(equal? (string-append "hi " "there " "mom") "hi there mom")
(equal? (string-append "" "there") "there")
(equal? (string-append "hi " "") "hi ")
(eqv? (string-append "" "") "")
)
(mat substring
(error? (substring))
(error? (substring "hi"))
(error? (substring "hi" 0))
(error? (substring "hi" 0 2 3))
(error? (substring "hi" 0 3))
(error? (substring "hi" -1 2))
(error? (substring "hi" 'a 2))
(error? (substring 'a 0 1))
(error? (substring "hi" 0 'a))
(error? (substring "hi" 1 0))
(equal? (substring "hi there" 0 1) "h")
(equal? (substring "hi there" 3 6) "the")
(equal? (substring "hi there" 5 5) "")
(equal? (substring "hi there" 0 8) "hi there")
(eqv? (substring "" 0 0) "")
)
(mat string-fill!
(error? (string-fill!))
(error? (string-fill! "hi"))
(error? (string-fill! "hi" #\a #\b))
(error? (string-fill! "hi" 'a))
(error? (string-fill! 'a #\a))
(let ([s (string #\a #\b #\c)])
(and (equal? s "abc")
(begin (string-fill! s #\*) (equal? s "***"))))
; test for bug filling beyond the end of the string
(eqv? (let* ((s1 (make-string 3 #\a))
(s2 (make-string 3 #\b)))
(string-fill! s1 #\*)
(string-ref s2 0))
#\b)
)
(mat substring-fill!
(error? (substring-fill!))
(error? (substring-fill! "hi"))
(error? (substring-fill! "hi" 0))
(error? (substring-fill! "hi" 0 2))
(error? (substring-fill! "hi" 0 3 #\a))
(error? (substring-fill! "hi" -1 3 #\a))
(error? (substring-fill! 'a 0 1 #\a))
(error? (substring-fill! "hi" 0 'a #\a))
(error? (substring-fill! "hi" 1 0 #\a))
(let ([s (string-copy "hitme!")])
(substring-fill! s 0 5 #\a)
(equal? s "aaaaa!"))
(let ([s ""])
(substring-fill! s 0 0 #\a)
(eqv? s ""))
(let ([s (string-copy "ABCDE")])
(and (begin
(substring-fill! s 0 0 #\$)
(equal? s "ABCDE"))
(begin
(substring-fill! s 2 5 #\$)
(equal? s "AB$$$"))
(begin
(substring-fill! s 0 3 #\&)
(equal? s "&&&$$"))))
)
(mat list->string
(error? (list->string))
(error? (list->string '(#\a #\b) '(#\c #\d)))
(error? (list->string 'a))
(error? (list->string '(a b)))
(error? (list->string '(#\a #\b . #\c)))
(error? (list->string (let ([ls (list #\a #\b #\c)]) (set-cdr! (cddr ls) (cdr ls)) ls)))
(equal? (list->string '(#\a #\b #\c)) "abc")
(equal? (list->string '()) "")
)
(mat string->list
(error? (string->list))
(error? (string->list "ab" "cd"))
(error? (string->list 'a))
(equal? (string->list "abc") '(#\a #\b #\c))
(equal? (string->list "") '())
)
(mat string->immutable-string
(begin
(define immutable-abc-string
(string->immutable-string (string #\a #\b #\c)))
#t)
(immutable-string? immutable-abc-string)
(not (mutable-string? immutable-abc-string))
(equal? "abc" immutable-abc-string)
(eq? immutable-abc-string
(string->immutable-string immutable-abc-string))
(not (immutable-string? (make-string 5)))
(mutable-string? (make-string 5))
(immutable-string? (string->immutable-string (string)))
(not (mutable-string? (string->immutable-string (string))))
(not (immutable-string? (string)))
(mutable-string? (string))
(not (immutable-string? (string-copy immutable-abc-string)))
(error? (string-set! immutable-abc-string 0 #\a))
(error? (string-fill! immutable-abc-string #\a))
(error? (substring-fill! immutable-abc-string 0 1 #\a))
(error? (string-copy! "xyz" 0 immutable-abc-string 0 3))
(error? (string-truncate! immutable-abc-string 1))
)

1302
mats/5_6.ms Normal file

File diff suppressed because it is too large Load diff

107
mats/5_7.ms Normal file
View file

@ -0,0 +1,107 @@
;;; 5-7.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(mat string->symbol
(eq? (string->symbol "foo") 'foo)
(eq? (string->symbol "a") (string->symbol "a"))
(error? (string->symbol 3))
(error? (string->symbol 'a))
)
(mat gensym
(not (eq? (gensym "hi") 'hi))
(not (eq? (gensym "hi")
(gensym "hi")))
(equal? (symbol->string (gensym "hi")) "hi")
(error? (gensym '#(a b c)))
)
(mat gensym
(error? (gensym 'hitme!))
(error? (gensym 17))
(error? (gensym #f))
(error? (gensym 'hitme "a"))
(error? (gensym 17 "a"))
(error? (gensym #f "a"))
(error? (gensym "a" 'hitme))
(error? (gensym "a" 17))
(error? (gensym "a" #f))
(symbol? (gensym))
(gensym? (gensym))
(not (eq? (gensym) (gensym)))
(not (equal? (symbol->string (gensym)) (symbol->string (gensym))))
(parameterize ([gensym-count 1000] [gensym-prefix "xxx"])
(equal? (symbol->string (gensym)) "xxx1000"))
(error? (gensym-count -1))
(error? (gensym-count 'a))
(error? (gensym-count "3.4"))
(equal? (parameterize ([gensym-count 73]) (format "~a" (gensym)))
"g73")
(equal?
(let* ([g1 (with-input-from-string "#{pn1 un1}" read)] [g2 (gensym "pn1" "un1")])
(list (gensym? g1) (gensym? g2) (eq? g1 g2)))
'(#t #t #t))
(equal?
(let* ([g1 (gensym "pn2" "un2")] [g2 (with-input-from-string "#{pn2 un2}" read)])
(list (gensym? g1) (gensym? g2) (eq? g1 g2)))
'(#t #t #t))
)
(mat gensym?
(gensym? (gensym "foo"))
(not (gensym? 'foo))
(not (gensym? (string->symbol "foo")))
(not (gensym? '(a b)))
)
(mat symbol->string
(equal? (symbol->string 'foo) "foo")
(equal? (symbol->string (string->symbol "hi")) "hi")
(equal? (symbol->string (gensym "hi there")) "hi there")
(error? (symbol->string 3))
)
(mat gensym->unique-string
(error? ; not a gensym
(gensym->unique-string "spam"))
(error? ; not a gensym
(gensym->unique-string 3))
(error? ; not a gensym
(gensym->unique-string 'spam))
(string? (gensym->unique-string (gensym)))
(equal?
(gensym->unique-string '#{g0 e6sfz8u1obe67hsew4stu0-0})
"e6sfz8u1obe67hsew4stu0-0")
)
(mat putprop-getprop
(begin (putprop 'xyz 'key 'value) (eq? (getprop 'xyz 'key) 'value))
(begin (putprop 'xyz 'key 'new-value) (eq? (getprop 'xyz 'key) 'new-value))
(begin (putprop 'xyz 'key #f) (not (getprop 'xyz 'key)))
(begin (putprop 'xyz 'key #t)
(remprop 'xyz 'key)
(not (getprop 'xyz 'key)))
(let ([g (gensym)] [flag (box 0)])
(and (eq? (getprop g 'a flag) flag)
(begin (putprop g 'a 'b)
(and (eq? (getprop g 'a) 'b)
(equal? (property-list g) '(a b))))))
(begin (putprop 'x 'a 'b)
(putprop 'x 'b 'c)
(eq? (getprop 'x (getprop 'x (getprop 'x '? 'a) 0) 1) 'c))
(error? (getprop 3 'key))
(error? (putprop "hi" 'key 'value))
(error? (property-list '(a b c)))
)

66
mats/5_8.ms Normal file
View file

@ -0,0 +1,66 @@
;;; 5-7.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(mat box
(box? (box 3))
(equal? (box 'a) '#&a)
(equal? (box '(a b c)) '#&(a b c))
(not (eq? (box '()) (box '())))
)
(mat unbox
(equal? (unbox '#&3) 3)
(equal? (unbox (box 3)) 3)
)
(mat set-box!
(let ((x (box 3)))
(set-box! x 4)
(and (equal? x '#&4) (equal? (unbox x) 4)))
)
(mat box-cas!
(begin
(define bx1 (box 1))
(define bx2 (box 'apple))
(eq? 1 (unbox bx1)))
(not (box-cas! bx1 0 1))
(eq? 1 (unbox bx1))
(box-cas! bx1 1 2)
(eq? 2 (unbox bx1))
(not (box-cas! bx2 #f 'banana))
(box-cas! bx2 'apple 'banana)
(not (box-cas! bx2 'apple 'banana))
(eq? 'banana (unbox bx2))
(not (box-cas! (box (bitwise-arithmetic-shift-left 1 40))
(bitwise-arithmetic-shift-left 2 40)
'wrong))
(error? (box-cas! bx1)) ; arity
(error? (box-cas! bx1 1)) ; arity
(error? (box-cas! 1 bx1 2)) ; not a box
(error? (box-cas! (box-immutable 1) 1 2)) ; not a mutable box
;; make sure `box-cas!` works with GC generations:
(begin
(collect 0)
(let ([g1 (gensym)])
(and (box-cas! bx2 'banana g1)
(begin
(collect 0)
(eq? g1 (unbox bx2))))))
)

3559
mats/6.ms Normal file

File diff suppressed because it is too large Load diff

6244
mats/7.ms Normal file

File diff suppressed because it is too large Load diff

11903
mats/8.ms Normal file

File diff suppressed because it is too large Load diff

27
mats/Mf-a6fb Normal file
View file

@ -0,0 +1,27 @@
# Mf-a6fb
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = a6fb
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-a6le Normal file
View file

@ -0,0 +1,27 @@
# Mf-a6le
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = a6le
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -m64 -fPIC -shared -O2 -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-a6nb Normal file
View file

@ -0,0 +1,27 @@
# Mf-a6nb
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = a6nb
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

31
mats/Mf-a6nt Normal file
View file

@ -0,0 +1,31 @@
# Mf-a6nt
# Copyright 1984-2021 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = a6nt
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
mdclean = cat_flush.exe cat_flush.obj foreign1.exp foreign1.lib foreign1.obj foreign2.obj foreign3.obj foreign4.obj
include Mf-base
export MSYS_NO_PATHCONV=1
export MSYS2_ARG_CONV_EXCL=*
foreign1.so: $(fsrc)
cmd.exe /c "vs.bat amd64 && cl /DWIN32 /DX86_64 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv959.lib $(fsrc)"
cat_flush.exe: cat_flush.c
cmd.exe /c "vs.bat amd64 && cl /DWIN32 /DX86_64 /MD /nologo $<"

27
mats/Mf-a6ob Normal file
View file

@ -0,0 +1,27 @@
# Mf-a6ob
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = a6ob
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-a6osx Normal file
View file

@ -0,0 +1,27 @@
# Mf-a6osx
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = a6osx
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -m64 -dynamiclib -undefined dynamic_lookup -O2 -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-a6s2 Normal file
View file

@ -0,0 +1,27 @@
# Mf-a6s2
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = a6s2
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
gcc -m64 -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
gcc -o cat_flush cat_flush.c

27
mats/Mf-arm32le Normal file
View file

@ -0,0 +1,27 @@
# Mf-arm32le
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = arm32le
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) ${CFLAGS} -fPIC -fomit-frame-pointer -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) ${CFLAGS} -o cat_flush cat_flush.c

545
mats/Mf-base Normal file
View file

@ -0,0 +1,545 @@
# Mf-base
# Copyright 1984-2021 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# Assumes recursive makes inherit command-line settings as in GNU make
# Running "make" or "make all" in this directory runs the mats (test
# programs) and produces a report of bugs and errors. Unless you make
# changes to the mats or to the system, the report file report-$(conf)
# (where $(conf) is set below) will be output in the $(outdir) directory.
# If an error or bug report occurs, refer to the offending ".mo" file
# produced by the mats and mentioned in the bug or error report to
# determine what failed.
# Running "make allx" runs a set of mats with various settings. "make
# bullyx" runs a different, more stressful set. These targets allow make
# to run the various configurations in parallel (if so configured, e.g.
# with the -j flag). Most output from each parallel execution is directed
# to (separate) files, with status printed to stdout when testing of each
# different configuration begins and ends. In addition, each target
# concatenates the summary file from all configurations run into "summary"
# in the current directory.
# Running make with the argument "clean" removes the .so files, .mo
# files, report files, and temporary files generated by the mats.
# The variables below may be changed to affect how the mats are run.
# For example, "make o=2 cp0=t ctb=8192" causes the mats to be run at
# optimize level 2 with cp0 enabled and collect-trip-bytes set to 8192.
MatsDir = $(abspath .)
ifeq (${OS},Windows_NT)
dirsep = ;
else
dirsep = :
endif
# Explicit ".exe" needed for WSL
ifeq ($(OS),Windows_NT)
ExeSuffix = .exe
else
ExeSuffix =
endif
include ../c/Mf-config
# Scheme is the scheme executable to test, SCHEMEHEAPDIRS tells
# it where to find its boot files, and CHEZSCHEMELIBDIRS tells
# it where to find libraries.
Scheme = $(abspath ../bin/$m/scheme${ExeSuffix})
export SCHEMEHEAPDIRS=.${dirsep}$(abspath ../boot)/%m
export CHEZSCHEMELIBDIRS=.
# Include is the directory holding scheme.h.
Include = ../boot/$m
# patchfile is the name of a patch to be loaded while running the mats.
patchfile =
# o is the optimize level at which the mats should be run.
o = 0
# p determines whether profiling is enabled: f for false, t for true.
defaultp = f
p = $(defaultp)
# pdhtml determines whether profile-dump-html is called at end of a run: f for false, t for true.
# NB: beware of lost profile information due to mats that call profile-clear
defaultpdhtml = f
pdhtml = $(defaultpdhtml)
# cp0 determines whether cp0 is run: f for no, t for yes
defaultcp0 = f
cp0 = $(defaultcp0)
# eval is the evaluator to use.
defaulteval = compile
eval = $(defaulteval)
# ctb is the value to which collect-trip-bytes is set.
defaultctb = (collect-trip-bytes)
ctb = $(defaultctb)
# cn defines the value to which collect-notify is set: f for #f, t for #t
defaultcn = f
cn = $(defaultcn)
# cgr is the value to which collect-generation-radix is set.
defaultcgr = (collect-generation-radix)
cgr = $(defaultcgr)
# cmg is the value to which collect-maximum-generation is set.
defaultcmg = (collect-maximum-generation)
cmg = $(defaultcmg)
# rmg is the value to which release-minimum-generation is set.
defaultrmg = (release-minimum-generation)
rmg = $(defaultrmg)
# cis defines the value to which compile-interpret-simple is set: f for
# #f, t for #t
defaultcis = f
cis = $(defaultcis)
# spi defines the value to which suppress-primitive-inlining is set:
# f for #f, t for #t
defaultspi = f
spi = $(defaultspi)
# hci defines the value to which heap-check-interval (mat.ss) is set:
# 0 to disable, > 0 to enable
defaulthci = 0
hci = $(defaulthci)
# eoc determines whether object counts are enabled
defaulteoc = t
eoc = $(defaulteoc)
# cl determines the commonization level
defaultcl = (commonization-level)
cl = $(defaultcl)
# ecpf determines whether the compiler checks prelex flags
defaultecpf = t
ecpf = $(defaultecpf)
# c determines whether mat coverage (.covout) files are created
defaultc = f
c = $(defaultc)
# set of coverage files to load
coverage-files = $(abspath ../boot/$m/petite.covin ../boot/$m/scheme.covin)
# set of mats to run
mats = primvars 3 4 5_1 5_2 5_3 5_4 5_5 bytevector thread profile\
misc cp0 5_6 5_7 5_8 6 io format 7 record hash enum 8 fx fl cfl foreign\
ftype unix windows examples ieee date exceptions oop
Examples = $(abspath ../examples)
MAKEFLAGS += --no-print-directory
# directory where (most) output for this run will be written
outdir=output
conf = $(eval)-$o-$(spi)-$(cp0)-$(cis)
objdir=output-$(conf)
objname = $(mats:%=%.mo)
obj = $(objname:%=$(objdir)/%)
src = $(mats:%=%.ms)
# prettysrc is src to use for pretty-print test; we leave out mat files
# with cycles, e.g., primvars.ms, misc.ms, 4.ms, 5_1.ms, hash.ms
prettysrc = 3.ms 5_3.ms 5_4.ms 5_5.ms bytevector.ms thread.ms profile.ms\
5_6.ms 5_7.ms 5_8.ms 6.ms io.ms format.ms 7.ms record.ms enum.ms 8.ms\
fx.ms fl.ms cfl.ms foreign.ms unix.ms windows.ms examples.ms ieee.ms date.ms\
exceptions.ms
define conf-scheme-code
'(optimize-level $o)'\
'(#%$$suppress-primitive-inlining #${spi})'\
'(heap-check-interval ${hci})'\
'(#%$$enable-check-prelex-flags #${ecpf})'\
'(compile-profile #$p)'\
'(collect-notify #${cn})'\
'(collect-trip-bytes ${ctb})'\
'(collect-generation-radix ${cgr})'\
'(collect-maximum-generation ${cmg})'\
'(enable-object-counts #${eoc})'\
'(commonization-level ${cl})'\
'(release-minimum-generation ${rmg})'\
'(compile-interpret-simple #${cis})'\
'(set! *examples-directory* "${Examples}")'\
'(enable-cp0 #${cp0})'\
'(set! *scheme* "${Scheme}")'\
'(set! *mats-dir* "${MatsDir}")'\
'(set! $$cat_flush "${MatsDir}/cat_flush${ExeSuffix}")'\
'(current-eval ${eval})'\
'(when #$c (coverage-table (load-coverage-files ${coverage-files:%="%"})))'
endef
$(objdir)/%.mo : %.ms mat.so
echo $(conf-scheme-code)\
'(time ((mat-file "$(objdir)") "$*"))'\
'(unless (= (#%$$check-heap-errors) 0)'\
' (fprintf (console-error-port) "check heap detected errors---grep standard output for !!!\n")'\
' (abort))'\
| ${Scheme} -q mat.so ${patchfile}
# same as above except puts the .mo file in .
%.mo : %.ms mat.so
echo $(conf-scheme-code)\
'(time ((mat-file ".") "$*"))'\
'(parameterize ([source-directories (quote ("." "../s"))]) (when #${pdhtml} (profile-dump-html)))'\
'(unless (= (#%$$check-heap-errors) 0)'\
' (fprintf (console-error-port) "check heap detected errors---grep standard output for !!!\n")'\
' (abort))'\
| ${Scheme} -q mat.so ${patchfile}
%.so : %.ss
echo '(reset-handler abort) (time (compile-file "$*"))' | ${Scheme} -q ${patchfile}
report: $(outdir)/report-$(conf)
experr: experr-$(conf)
$(outdir)/report-$(conf): $(outdir)/errors-$(conf)
$(MAKE) doreport
doreport: experr-$(conf)
rm -f $(outdir)/report-$(conf)
-diff experr-$(conf) $(outdir)/errors-$(conf) > $(outdir)/report-$(conf) 2>&1
maybe-doreport:
-if [ -f $(outdir)/errors-$(conf) ] ; then\
$(MAKE) doreport ;\
fi
$(outdir)/errors-$(conf): ${obj}
$(MAKE) doerrors
doerrors: $(outdir)
rm -f $(outdir)/errors-$(conf)
-(cd $(objdir); grep '^Error' $(objname)) > $(outdir)/errors-$(conf)
-(cd $(objdir); grep '^Bug' $(objname)) >> $(outdir)/errors-$(conf)
-(cd $(objdir); grep '^Warning' $(objname)) >> $(outdir)/errors-$(conf)
-(cd $(objdir); grep '^Expected' $(objname))\
>> $(outdir)/errors-$(conf)
fastreport:
$(MAKE) doerrors
$(MAKE) doreport
docoverage: mat.so
if [ "$c" = "t" ] ; then\
echo '(reset-handler abort) (combine-coverage-files "$(objdir)/all.covout" (quote ($(mats:%="$(objdir)/%.covout"))))' | ${Scheme} -q ${patchfile} mat.so ;\
echo '(reset-handler abort) (coverage-percent "$(objdir)/all.covout" ${coverage-files:%="%"})' | ${Scheme} -q ${patchfile} mat.so ;\
echo '(reset-handler abort) (coverage-percent "$(objdir)/run.covout" ${coverage-files:%="%"})' | ${Scheme} -q ${patchfile} mat.so ;\
fi
doallcoverage: mat.so
if [ "$c" = "t" ] ; then\
echo '(reset-handler abort) (combine-coverage-files "all.covout" (map symbol->string (quote ($(shell echo */all.covout)))))' | ${Scheme} -q ${patchfile} mat.so ;\
echo '(reset-handler abort) (coverage-percent "all.covout" ${coverage-files:%="%"})' | ${Scheme} -q ${patchfile} mat.so ;\
echo '(reset-handler abort) (combine-coverage-files "run.covout" (map symbol->string (quote ($(shell echo */run.covout)))))' | ${Scheme} -q ${patchfile} mat.so ;\
echo '(reset-handler abort) (coverage-percent "run.covout" ${coverage-files:%="%"})' | ${Scheme} -q ${patchfile} mat.so ;\
fi
define parallel-config-template
parallel$(1)-0:
-@$$(MAKE) allxphelp outdir=output-$(1)-0 objdir=output-$(1)-0 o=0 $(2)
parallel$(1)-3:
-@$$(MAKE) allxphelp outdir=output-$(1)-3 objdir=output-$(1)-3 o=3 $(2)
endef
#configs from partialx and allx
$(eval $(call parallel-config-template,1,))
$(eval $(call parallel-config-template,2,cp0=t))
$(eval $(call parallel-config-template,3,cp0=t cl=3))
$(eval $(call parallel-config-template,4,spi=t rmg=2 p=t))
$(eval $(call parallel-config-template,5,eval=interpret cl=6))
$(eval $(call parallel-config-template,6,eval=interpret cp0=t rmg=2))
$(eval $(call parallel-config-template,7,eoc=f hci=101 cl=9))
$(eval $(call parallel-config-template,8,eval=interpret hci=101 rmg=2))
#configs from bullyx
$(eval $(call parallel-config-template,b1,allxphelp-target=allxhelpnotall spi=t cp0=f))
$(eval $(call parallel-config-template,b2,spi=f cp0=f cl=9 ctb='(/ (collect-trip-bytes) 64)' hci=503))
$(eval $(call parallel-config-template,b3,spi=t cp0=f cis=t cmg=1))
$(eval $(call parallel-config-template,b4,spi=f cp0=f cis=t cmg=6 hci=101))
$(eval $(call parallel-config-template,b5,spi=t cp0=t ctb='(/ (collect-trip-bytes) 64)' cgr=6))
$(eval $(call parallel-config-template,b6,spi=t cp0=f p=t eoc=f hci=101))
$(eval $(call parallel-config-template,b7,spi=f cp0=t cl=9 p=t hci=101))
$(eval $(call parallel-config-template,b8,eval=interpret spi=f cp0=f))
$(eval $(call parallel-config-template,b9,eval=interpret spi=f cp0=t))
$(eval $(call parallel-config-template,b10,eval=interpret spi=t cp0=f ctb='(/ (collect-trip-bytes) 64)' hci=503))
$(eval $(call parallel-config-template,b11,eval=interpret spi=t cp0=t cgr=2 hci=101 p=t))
partialx-confs = 1-0 1-3 2-3 6-3
allx-confs = 1-0 1-3 3-0 3-3 4-0 4-3 5-0 5-3 6-0 6-3 7-0 8-3
bullyx-confs = $(foreach n,1 2 3 4 5 6 7 8 9 10 11,b$(n)-0 b$(n)-3)
define parallel-target-template
$(1)-targets: $($(1)-confs:%=parallel%)
$(1): prettyclean
@echo building prereqs with output to Make.out
@$$(MAKE) parallel-prereqs > Make.out 2>&1
@$$(MAKE) $(1)-targets
$(if $(2),@$$(MAKE) $(2))
cat $($(1)-confs:%=output-%/summary) > summary && cat summary
endef
$(eval $(call parallel-target-template,partialx))
$(eval $(call parallel-target-template,allx,doallcoverage))
$(eval $(call parallel-target-template,bullyx,doallcoverage))
just-reports:
for EVAL in compile interpret ; do\
for O in 0 2 3 ; do\
for SPI in f t ; do\
for CP0 in f t ; do\
for CIS in f t ; do\
$(MAKE) maybe-doreport eval=$$EVAL o=$$O spi=$$SPI cp0=$$CP0 cis=$$CIS ;\
done\
done\
done\
done\
done
allxhelp:
$(MAKE) doheader
-$(MAKE) all
$(MAKE) dosummary
config-vars = spi hci ecpf cp0 cis p eval ctb cgr cmg eoc cl rmg
full-config-str = $(strip o=$(o) $(foreach var, $(config-vars),$(if $(filter-out $($(var:%=default%)),$($(var))),$(var)=$($(var)))) $(hdrmsg))
allxphelp-target = allxhelp
allxphelp: $(outdir)
@echo "matting configuration ($(full-config-str)) with output to $(outdir)/Make.out"
@$(MAKE) $(allxphelp-target) > "$(outdir)/Make.out" 2>&1
@echo "finished matting configuration $(full-config-str)"
summary-file=$(outdir)/summary
$(outdir):
@mkdir -p "$(outdir)"
doheader: $(outdir)
printf "%s" "-------- o=$o" >> $(summary-file)
if [ "$(spi)" != "$(defaultspi)" ] ; then printf " spi=$(spi)" >> $(summary-file) ; fi
if [ "$(hci)" != "$(defaulthci)" ] ; then printf " hci=$(hci)" >> $(summary-file) ; fi
if [ "$(ecpf)" != "$(defaultecpf)" ] ; then printf " ecpf(ecpf)" >> $(summary-file) ; fi
if [ "$(cp0)" != "$(defaultcp0)" ] ; then printf " cp0=$(cp0)" >> $(summary-file) ; fi
if [ "$(cis)" != "$(defaultcis)" ] ; then printf " cis=$(cis)" >> $(summary-file) ; fi
if [ "$p" != "$(defaultp)" ] ; then printf " p=$p" >> $(summary-file) ; fi
if [ "$(eval)" != "$(defaulteval)" ] ; then printf " eval=$(eval)" >> $(summary-file) ; fi
if [ "$(ctb)" != "$(defaultctb)" ] ; then printf " ctb=$(ctb)" >> $(summary-file) ; fi
if [ "$(cgr)" != "$(defaultcgr)" ] ; then printf " cgr=$(cgr)" >> $(summary-file) ; fi
if [ "$(cmg)" != "$(defaultcmg)" ] ; then printf " cmg=$(cmg)" >> $(summary-file) ; fi
if [ "$(eoc)" != "$(defaulteoc)" ] ; then printf " eoc=$(eoc)" >> $(summary-file) ; fi
if [ "$(cl)" != "$(defaultcl)" ] ; then printf " cl=$(cl)" >> $(summary-file) ; fi
if [ "$(rmg)" != "$(defaultrmg)" ] ; then printf " rmg=$(rmg)" >> $(summary-file) ; fi
if [ "$(hdrmsg)" != "" ] ; then printf " $(hdrmsg)" >> $(summary-file) ; fi
dosummary:
printf " --------\n" >> $(summary-file)
if [ -f $(outdir)/report-$(conf) ] ; then\
cat $(outdir)/report-$(conf) >> $(summary-file) ;\
else \
printf 'NO REPORT\n' >> $(summary-file) ;\
fi
allxhelpnotall:
rm -f mat.so
$(MAKE) doheader hdrmsg="not all"
-$(MAKE)
$(MAKE) dosummary
$(MAKE) docoverage
all0: ; $(MAKE) all o=0
all1: ; $(MAKE) all o=1
all2: ; $(MAKE) all o=2
all3: ; $(MAKE) all o=3
parallel-prereqs: $(src) oop.ss ht.ss mat.so cat_flush${ExeSuffix} ${fobj} m4test.in m4test.out prettytest.ss ftype.h freq.in freq.out ${patchfile} build-examples
all: $(outdir) $(outdir)/script.all $(src) oop.ss ht.ss mat.so cat_flush${ExeSuffix} ${fobj} m4test.in m4test.out prettytest.ss ftype.h freq.in freq.out ${patchfile} build-examples
${Scheme} --verbose -q mat.so ${patchfile} < $(outdir)/script.all
$(MAKE) doerrors
$(MAKE) doreport
$(MAKE) docoverage
$(outdir)/script.all: Mf-base $(outdir)
$(outdir)/script.all makescript$o:
echo $(conf-scheme-code)\
'(record-run-coverage "$(objdir)/run.covout"'\
' (lambda ()'\
' (time (for-each (lambda (x) (time ((mat-file "$(objdir)") x)))'\
' (quote ($(mats:%="%")))))'\
' (parameterize ([source-directories (quote ("." "../s"))]) (when #${pdhtml} (profile-dump-html)))'\
' (unless (= (#%$$check-heap-errors) 0)'\
' (fprintf (console-error-port) "check heap detected errors---grep standard output for !!!\n")'\
' (abort))))'\
> $(outdir)/script.all
source:
$(MAKE) source0 o=0
$(MAKE) source2 o=2
$(MAKE) source3 o=3
source$o: ${src} mat.ss oop.ss ht.ss cat_flush.c ${fsrc} freq.in freq.out m4test.in m4test.out $(outdir)/script.all prettytest.ss ftype.h
rootsrc = $(shell cd ../../mats; echo *)
${rootsrc}:
ifeq ($(OS),Windows_NT)
cp -p ../../mats/$@ $@
else
ln -s ../../mats/$@ $@
endif
prettytest.ss:
rm -f prettytest.ss
$(MAKE) ${prettysrc}
cat ${prettysrc} > prettytest.ss
bullyprettytest.ss: ${src}
(cd ../s; make source)
cat ${src} ../s/*.ss > prettytest.ss
mat.so: ${patchfile}
foreign.mo ${objdir}/foreign.mo: ${fobj}
thread.mo ${objdir}/thread.mo: ${fobj}
examples.mo ${objdir}/examples.mo: m4test.in m4test.out freq.in freq.out build-examples
6.mo ${objdir}/6.mo: prettytest.ss
bytevector.mo ${objdir}/bytevector.mo: prettytest.ss
io.mo ${objdir}/io.mo: prettytest.ss
unix.mo ${objdir}/unix.mo io.mo ${objdir}/io.mo 6.mo ${objdir}/6.mo: cat_flush${ExeSuffix}
oop.mo ${objdir}/oop.mo: oop.ss
ftype.mo ${objdir}/ftype.mo: ftype.h
hash.mo ${objdir}/hash.mo: ht.ss
build-examples:
( cd ../examples && ${MAKE} Scheme=${Scheme} )
touch build-examples
prettyclean:
rm -f *.o ${mdclean} *.so *.mo *.covout experr* errors* report* summary testfile* testscript\
${fobj} prettytest.ss cat_flush${ExeSuffix} so_locations\
build-examples script.all? *.html experr*.rej experr*.orig
rm -rf testdir*
rm -rf output output-* patches-work-dir
( cd ../examples && ${MAKE} Scheme=${Scheme} clean )
clean: prettyclean
rm -f Make.out
### rules for generating various experr files
# everything starts with the root experr files with default
# settings for the various parameters
experr-compile-$o-f-f-f: root-experr-compile-$o-f-f-f
cp root-experr-compile-$o-f-f-f experr-compile-$o-f-f-f
root-experr: # don't list dependencies!
rm -f root-experr-compile-$o-f-f-f
# use the shell glob mechanism to find the file in any output* dir
err_file=(output*/errors-compile-$o-f-f-f); cp $${err_file[0]} root-experr-compile-$o-f-f-f
root-experrs: # don't list dependencies!
$(MAKE) root-experr o=0
$(MAKE) root-experr o=3
# derive spi=t experr files by patching spi=f experr files
# cp first in case patch is empty, since patch produces an empty output
# file rather than a copy of the input file if the patch file is empty
experr-compile-$o-t-f-f: experr-compile-$o-f-f-f patch-compile-$o-t-f-f
cp experr-compile-$o-f-f-f experr-compile-$o-t-f-f
-patch experr-compile-$o-t-f-f patch-compile-$o-t-f-f
# derive cp0=t experr files by patching cp0=f experr files
experr-compile-$o-$(spi)-t-f: experr-compile-$o-$(spi)-f-f patch-compile-$o-$(spi)-t-f
cp experr-compile-$o-$(spi)-f-f experr-compile-$o-$(spi)-t-f
-patch experr-compile-$o-$(spi)-t-f patch-compile-$o-$(spi)-t-f
# derive cis=t experr files by patching cis=f experr files
experr-compile-$o-$(spi)-$(cp0)-t: experr-compile-$o-$(spi)-$(cp0)-f patch-compile-$o-$(spi)-$(cp0)-t
cp experr-compile-$o-$(spi)-$(cp0)-f experr-compile-$o-$(spi)-$(cp0)-t
-patch experr-compile-$o-$(spi)-$(cp0)-t patch-compile-$o-$(spi)-$(cp0)-t
# derive eval=interpret experr files by patching eval=compile experr files
# (with cis=f, since compile-interpret-simple does not affect interpret)
experr-interpret-$o-$(spi)-$(cp0)-$(cis): experr-compile-$o-$(spi)-$(cp0)-f patch-interpret-$o-$(spi)-$(cp0)-f
cp experr-compile-$o-$(spi)-$(cp0)-f experr-interpret-$o-$(spi)-$(cp0)-$(cis)
-patch experr-interpret-$o-$(spi)-$(cp0)-$(cis) patch-interpret-$o-$(spi)-$(cp0)-f
### rebuilding patch files
patches:
rm -rf patches-work-dir
mkdir patches-work-dir
shopt -s nullglob; cp output*/errors-compile* output*/errors-interpret* patches-work-dir
for O in 0 2 3 ; do\
if [ -f patches-work-dir/errors-compile-$$O-f-f-f -a -e patches-work-dir/errors-compile-$$O-t-f-f ] ; then \
$(MAKE) xpatch-compile-$$O-t-f-f o=$$O spi=t ; \
fi ;\
for SPI in f t ; do\
if [ -f patches-work-dir/errors-compile-$$O-$$SPI-f-f -a -e patches-work-dir/errors-compile-$$O-$$SPI-t-f ] ; then \
$(MAKE) xpatch-compile-$$O-$$SPI-t-f o=$$O spi=$$SPI cp0=t ;\
fi ;\
for CP0 in f t ; do\
if [ -f patches-work-dir/errors-compile-$$O-$$SPI-$$CP0-f -a -e patches-work-dir/errors-compile-$$O-$$SPI-$$CP0-t ] ; then \
$(MAKE) xpatch-compile-$$O-$$SPI-$$CP0-t o=$$O spi=$$SPI cp0=$$CP0 cis=t ;\
fi ;\
if [ -f patches-work-dir/errors-compile-$$O-$$SPI-$$CP0-f -a -e patches-work-dir/errors-interpret-$$O-$$SPI-$$CP0-f ] ; then \
$(MAKE) xpatch-interpret-$$O-$$SPI-$$CP0-f o=$$O spi=$$SPI cp0=$$CP0 ;\
fi\
done\
done\
done
xpatch-compile-$o-t-f-f: # don't list dependencies!
rm -f patch-compile-$o-t-f-f
-diff --context patches-work-dir/errors-compile-$o-f-f-f\
patches-work-dir/errors-compile-$o-t-f-f\
> patch-compile-$o-t-f-f
xpatch-compile-$o-$(spi)-t-f: # don't list dependencies!
rm -f patch-compile-$o-$(spi)-t-f
-diff --context patches-work-dir/errors-compile-$o-$(spi)-f-f\
patches-work-dir/errors-compile-$o-$(spi)-t-f\
> patch-compile-$o-$(spi)-t-f
xpatch-compile-$o-$(spi)-$(cp0)-t: # don't list dependencies!
rm -f patch-compile-$o-$(spi)-$(cp0)-t
-diff --context patches-work-dir/errors-compile-$o-$(spi)-$(cp0)-f\
patches-work-dir/errors-compile-$o-$(spi)-$(cp0)-t\
> patch-compile-$o-$(spi)-$(cp0)-t
xpatch-interpret-$o-$(spi)-$(cp0)-f: # don't list dependencies!
rm -f patch-interpret-$o-$(spi)-$(cp0)-f
-diff --context patches-work-dir/errors-compile-$o-$(spi)-$(cp0)-f\
patches-work-dir/errors-interpret-$o-$(spi)-$(cp0)-f\
> patch-interpret-$o-$(spi)-$(cp0)-f

27
mats/Mf-i3fb Normal file
View file

@ -0,0 +1,27 @@
# Mf-i3fb
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = i3fb
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-i3le Normal file
View file

@ -0,0 +1,27 @@
# Mf-i3le
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = i3le
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -m32 -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-i3nb Normal file
View file

@ -0,0 +1,27 @@
# Mf-i3nb
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = i3nb
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

31
mats/Mf-i3nt Normal file
View file

@ -0,0 +1,31 @@
# Mf-i3nt
# Copyright 1984-2021 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = i3nt
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
mdclean = cat_flush.exe cat_flush.obj foreign1.exp foreign1.lib foreign1.obj foreign2.obj foreign3.obj
include Mf-base
export MSYS_NO_PATHCONV=1
export MSYS2_ARG_CONV_EXCL=*
foreign1.so: $(fsrc)
cmd.exe /c "vs.bat x86 && cl /DWIN32 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv959.lib $(fsrc)"
cat_flush.exe: cat_flush.c
cmd.exe /c "vs.bat x86 && cl /DWIN32 /MD /nologo $<"

27
mats/Mf-i3ob Normal file
View file

@ -0,0 +1,27 @@
# Mf-i3ob
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = i3ob
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-i3osx Normal file
View file

@ -0,0 +1,27 @@
# Mf-i3osx
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = i3osx
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -m32 -dynamiclib -undefined dynamic_lookup -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-i3qnx Normal file
View file

@ -0,0 +1,27 @@
# Mf-i3qnx
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = i3qnx
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -m32 -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-i3s2 Normal file
View file

@ -0,0 +1,27 @@
# Mf-i3s2
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = i3s2
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
gcc -m32 -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
gcc -o cat_flush cat_flush.c

27
mats/Mf-ppc32le Normal file
View file

@ -0,0 +1,27 @@
# Mf-ppc32le
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ppc32le
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -m32 -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-ta6fb Normal file
View file

@ -0,0 +1,27 @@
# Mf-ta6fb
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ta6fb
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -pthread -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-ta6le Normal file
View file

@ -0,0 +1,27 @@
# Mf-ta6le
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ta6le
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -m64 -pthread -fPIC -shared -O2 -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-ta6nb Normal file
View file

@ -0,0 +1,27 @@
# Mf-ta6nb
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ta6nb
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -pthread -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

31
mats/Mf-ta6nt Normal file
View file

@ -0,0 +1,31 @@
# Mf-ta6nt
# Copyright 1984-2021 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ta6nt
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
mdclean = cat_flush.exe cat_flush.obj foreign1.exp foreign1.lib foreign1.obj foreign2.obj foreign3.obj
include Mf-base
export MSYS_NO_PATHCONV=1
export MSYS2_ARG_CONV_EXCL=*
foreign1.so: $(fsrc)
cmd.exe /c "vs.bat amd64 && cl /DWIN32 /DX86_64 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv959.lib $(fsrc)"
cat_flush.exe: cat_flush.c
cmd.exe /c "vs.bat amd64 && cl /DWIN32 /DX86_64 /MD /nologo $<"

27
mats/Mf-ta6ob Normal file
View file

@ -0,0 +1,27 @@
# Mf-ta6ob
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ta6ob
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -pthread -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-ta6osx Normal file
View file

@ -0,0 +1,27 @@
# Mf-ta6osx
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ta6osx
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -m64 -pthread -dynamiclib -undefined dynamic_lookup -O2 -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-ta6s2 Normal file
View file

@ -0,0 +1,27 @@
# Mf-ta6s2
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ta6s2
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
gcc -m64 -D_REENTRANT -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
gcc -o cat_flush cat_flush.c

27
mats/Mf-ti3fb Normal file
View file

@ -0,0 +1,27 @@
# Mf-ti3fb
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ti3fb
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -pthread -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-ti3le Normal file
View file

@ -0,0 +1,27 @@
# Mf-ti3le
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ti3le
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -m32 -pthread -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-ti3nb Normal file
View file

@ -0,0 +1,27 @@
# Mf-ti3nb
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ti3nb
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -pthread -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

32
mats/Mf-ti3nt Normal file
View file

@ -0,0 +1,32 @@
# Mf-ti3nt
# Copyright 1984-2021 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ti3nt
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
mdclean = cat_flush.exe cat_flush.obj foreign1.exp foreign1.lib foreign1.obj foreign2.obj foreign3.obj
include Mf-base
export MSYS_NO_PATHCONV=1
export MSYS2_ARG_CONV_EXCL=*
foreign1.so: $(fsrc)
cmd.exe /c "vs.bat x86 && cl /DWIN32 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv959.lib $(fsrc)"
cat_flush.exe: cat_flush.c
cmd.exe /c "vs.bat x86 && cl /DWIN32 /MD /nologo $<"

27
mats/Mf-ti3ob Normal file
View file

@ -0,0 +1,27 @@
# Mf-ti3ob
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ti3ob
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -pthread -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-ti3osx Normal file
View file

@ -0,0 +1,27 @@
# Mf-ti3osx
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ti3osx
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -m32 -pthread -dynamiclib -undefined dynamic_lookup -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

27
mats/Mf-ti3s2 Normal file
View file

@ -0,0 +1,27 @@
# Mf-ti3s2
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = ti3s2
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
gcc -m32 -D_REENTRANT -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
gcc -o cat_flush cat_flush.c

27
mats/Mf-tppc32le Normal file
View file

@ -0,0 +1,27 @@
# Mf-tppc32le
# Copyright 1984-2017 Cisco Systems, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
m = tppc32le
fsrc = foreign1.c foreign2.c foreign3.c foreign4.c
fobj = foreign1.so
include Mf-base
foreign1.so: ${fsrc} ../boot/$m/scheme.h
$(CC) -m32 -pthread -fPIC -shared -I${Include} -o foreign1.so ${fsrc}
cat_flush: cat_flush.c
$(CC) -o cat_flush cat_flush.c

11308
mats/bytevector.ms Normal file

File diff suppressed because it is too large Load diff

38
mats/cat_flush.c Normal file
View file

@ -0,0 +1,38 @@
/* cat_flush.c
* Copyright 1984-2017 Cisco Systems, Inc.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing, software
* distributed under the License is distributed on an "AS IS" BASIS,
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
*/
#include <stdio.h>
#include <stdlib.h>
#ifdef WIN32
#include <io.h>
#include <fcntl.h>
#endif
int main() {
int c;
#ifdef WIN32
_setmode(_fileno(stdin), O_BINARY);
_setmode(_fileno(stdout), O_BINARY);
#endif
while ((c = getchar()) != EOF) {
putchar(c);
fflush(stdout);
}
exit(0);
}

377
mats/cfl.ms Normal file
View file

@ -0,0 +1,377 @@
;;; cfl.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(define *fuzz* 1e-14)
(define ~=
(lambda (x y)
(or (= x y)
(and (fl~= (inexact (real-part x))
(inexact (real-part y)))
(fl~= (inexact (imag-part x))
(inexact (imag-part y)))))))
(define fl~=
(lambda (x y)
(cond
[(and (fl>= (flabs x) 2.0) (fl>= (flabs y) 2.0))
(fl~= (fl/ x 2.0) (fl/ y 2.0))]
[(and (fl< 0.0 (flabs x) 1.0) (fl< 0.0 (flabs y) 1.0))
(fl~= (fl* x 2.0) (fl* y 2.0))]
[else (let ([d (flabs (fl- x y))])
(or (fl<= d *fuzz*)
(begin (printf "fl~~=: ~s~%" d) #f)))])))
(define cfl~=
(lambda (x y)
(and (fl~= (cfl-real-part x) (cfl-real-part y))
(fl~= (cfl-imag-part x) (cfl-imag-part y)))))
(define zero 0.0)
(define a 1.1)
(define b +1.1i)
(define c 1.1+1.1i)
(define aa 1.21)
(define ab +1.21i)
(define ac 1.21+1.21i)
(define bb -1.21)
(define bc -1.21+1.21i)
(define cc +2.42i)
(mat cflonum?
(not (cflonum? 3))
(not (cflonum? 18/2))
(not (cflonum? 1+0i))
(not (cflonum? 23084982309482034820348023423048230482304))
(not (cflonum? 203480234802384/23049821))
(not (cflonum? -3/4))
(not (cflonum? -1))
(not (cflonum? 0))
(not (cflonum? -12))
(cflonum? 3.5)
(cflonum? 1.8e-10)
(cflonum? -3e5)
(cflonum? -1231.2344)
(cflonum? 3+5.0i)
(cflonum? 1.8e10@10)
(cflonum? -3e5+1.0i)
(cflonum? -1.0i)
(cflonum? +1.0i)
(not (cflonum? 'a))
(not (cflonum? "hi"))
(not (cflonum? (cons 3 4)))
(cflonum? a)
(cflonum? b)
(cflonum? c)
)
(mat fl-make-rectangular
(error? (fl-make-rectangular 3 'a))
(error? (fl-make-rectangular 'b 4))
(error? (fl-make-rectangular 3 -4))
(eqv? (fl-make-rectangular 3.0 -4.0) 3.0-4.0i)
(eqv? (fl-make-rectangular a a) c)
)
(mat cfl-real-part
(error? (cfl-real-part 'a))
(error? (cfl-real-part 3/2))
(eqv? (cfl-real-part 3.2) 3.2)
(eqv? (cfl-real-part -1.0+2.0i) -1.0)
(eqv? (cfl-real-part a) a)
(eqv? (cfl-real-part c) a)
(eqv? (cfl-real-part b) zero)
)
(mat cfl-imag-part
(error? (cfl-imag-part 'a))
(error? (cfl-imag-part -3))
(eqv? (cfl-imag-part 3.2) zero)
(eqv? (cfl-imag-part -1.0+2.0i) 2.0)
(eqv? (cfl-imag-part a) zero)
(eqv? (cfl-imag-part c) a)
(eqv? (cfl-imag-part b) a)
)
(mat cfl-conjugate
(error? (cfl-conjugate 'a))
(eqv? (cfl-conjugate 3.2) 3.2)
(eqv? (cfl-conjugate 3.2+2.0i) 3.2-2.0i)
(eqv? (cfl-conjugate a) a)
(eqv? (cfl-conjugate c) (+ a (- b)))
(eqv? (cfl-conjugate b) -1.1i)
)
(mat conjugate
(error? (conjugate 'a))
(eqv? (conjugate 3.2) 3.2)
(eqv? (conjugate 3.2+2.0i) 3.2-2.0i)
)
(mat cfl-magnitude-squared
(error? (cfl-magnitude-squared 'a))
(eqv? (cfl-magnitude-squared 3.2) (fl* 3.2 3.2))
(eqv? (cfl-magnitude-squared 3.5-2.0i) 16.25)
(fl~= (cfl-magnitude-squared 3.5@2.0) 12.25)
)
(mat magnitude-squared
(error? (magnitude-squared 'a))
(eqv? (magnitude-squared 3.5) 12.25)
(eqv? (magnitude-squared 3.5-2.0i) 16.25)
(fl~= (magnitude-squared 3.5@2.0) 12.25)
)
(mat cfl+
(error? (cfl+ 'a))
(error? (cfl+ 'a 3))
(error? (cfl+ 'a 3 4))
(eqv? (cfl+) zero)
(eqv? (cfl+ a) a)
(eqv? (cfl+ b) b)
(eqv? (cfl+ c) c)
(eqv? (cfl+ a b) c)
(cfl~= (cfl+ a b c) (cfl+ a (cfl+ b c)))
(cfl~= (cfl+ a b c a b c) (cfl+ (cfl+ a b c) (cfl+ a b c)))
(cfl~= (cfl+ 1+2.0i 3.0) 4.0+2.0i)
(cfl~= (cfl+ 1.0+2.2i -3.7+5.3i) -2.7+7.5i)
(cfl~= (cfl+ 1.0+2.2i -3.7) -2.7+2.2i)
(cfl~= (cfl+ 1.0 -3.7+5.3i) -2.7+5.3i)
(cfl~= (cfl+ 1.0+2.2i +5.3i) 1.0+7.5i)
(cfl~= (cfl+ +2.2i -3.7+5.3i) -3.7+7.5i)
(cfl~= (cfl+ 26.0 2.0) 28.0)
(test-cp0-expansion eqv? '(cfl+) zero)
(test-cp0-expansion eqv? `(cfl+ ,a) a)
(test-cp0-expansion eqv? `(cfl+ ,b) b)
(test-cp0-expansion eqv? `(cfl+ ,c) c)
(test-cp0-expansion eqv? `(cfl+ ,a ,b) c)
(test-cp0-expansion cfl~= `(cfl+ ,a ,b ,c) (cfl+ a (cfl+ b c)))
(test-cp0-expansion cfl~= `(cfl+ ,a ,b ,c ,a ,b ,c) (cfl+ (cfl+ a b c) (cfl+ a b c)))
(test-cp0-expansion cfl~= '(cfl+ 1+2.0i 3.0) 4.0+2.0i)
(test-cp0-expansion cfl~= '(cfl+ 1.0+2.2i -3.7+5.3i) -2.7+7.5i)
(test-cp0-expansion cfl~= '(cfl+ 1.0+2.2i -3.7) -2.7+2.2i)
(test-cp0-expansion cfl~= '(cfl+ 1.0 -3.7+5.3i) -2.7+5.3i)
(test-cp0-expansion cfl~= '(cfl+ 1.0+2.2i +5.3i) 1.0+7.5i)
(test-cp0-expansion cfl~= '(cfl+ +2.2i -3.7+5.3i) -3.7+7.5i)
(test-cp0-expansion cfl~= '(cfl+ 26.0 2.0) 28.0)
)
(mat cfl-
(error? (cfl- 'a))
(error? (cfl- 'a 3))
(error? (cfl- 'a 3 4))
(error? (cfl-))
(eqv? (cfl- a) -1.1)
(eqv? (cfl- b) -0.0-1.1i)
(eqv? (cfl- c) -1.1-1.1i)
(eqv? (cfl- a a) zero)
(cfl~= (cfl- b b) zero)
(cfl~= (cfl- c c) zero)
(eqv? (cfl- c a) b)
(cfl~= (cfl- c b) a)
(cfl~= (cfl- a b c) (cfl- (cfl- a b) c))
(cfl~= (cfl- a b c a b c) (cfl- a (cfl+ b c a b c)))
(cfl~= (cfl- 1+2.0i 3.0) -2.0+2.0i)
(cfl~= (cfl- 1.0+2.2i -3.7+5.3i) 4.7-3.1i)
(cfl~= (cfl- 1.0+2.2i -3.7) 4.7+2.2i)
(cfl~= (cfl- 1.0 -3.7+5.3i) 4.7-5.3i)
(cfl~= (cfl- 1.0+2.2i +5.3i) 1.0-3.1i)
(cfl~= (cfl- +2.2i -3.7+5.3i) 3.7-3.1i)
(cfl~= (cfl- 26.0 2.0) 24.0)
(andmap
(lambda (a)
(andmap
(lambda (b)
(andmap
(lambda (c) (eqv? (cfl- a b c) (cfl- (cfl- a b) c)))
'(0.0 -0.0)))
'(0.0 -0.0)))
'(0.0 -0.0))
(let ()
(define-syntax ff
(syntax-rules ()
[(_ k1 k2) (lambda (x) (eqv? (cfl- k1 x k2) (cfl- (cfl- k1 x) k2)))]))
(andmap
(lambda (p) (and (p +0.0) (p -0.0)))
(list (ff +0.0 +0.0) (ff +0.0 -0.0) (ff -0.0 +0.0) (ff -0.0 -0.0))))
(error? (cfl- 3.0 5.4 'a))
(error? (cfl- 'a 3.0 5.4))
(error? (cfl- 3.0 'a 5.4))
(eqv? (cfl- 5.0 4.0 3.0 2.0) -4.0)
(eqv? (cfl- 5.0 4.0 3.0 2.0 1.0 0.0 -1.0 -2.0) -2.0)
(cfl~= (cfl- 1e30 1e30 7.0) -7.0)
(test-cp0-expansion eqv? `(cfl- ,a) -1.1)
(test-cp0-expansion eqv? `(cfl- ,b) -0.0-1.1i)
(test-cp0-expansion eqv? `(cfl- ,c) -1.1-1.1i)
(test-cp0-expansion eqv? `(cfl- ,a ,a) zero)
(test-cp0-expansion cfl~= `(cfl- ,b ,b) zero)
(test-cp0-expansion cfl~= `(cfl- ,c ,c) zero)
(test-cp0-expansion eqv? `(cfl- ,c ,a) b)
(test-cp0-expansion cfl~= `(cfl- ,c ,b) a)
(test-cp0-expansion cfl~= `(cfl- ,a ,b ,c) (cfl- (cfl- a b) c))
(test-cp0-expansion cfl~= `(cfl- ,a ,b ,c ,a ,b ,c) (cfl- a (cfl+ b c a b c)))
(test-cp0-expansion cfl~= '(cfl- 1+2.0i 3.0) -2.0+2.0i)
(test-cp0-expansion cfl~= '(cfl- 1.0+2.2i -3.7+5.3i) 4.7-3.1i)
(test-cp0-expansion cfl~= '(cfl- 1.0+2.2i -3.7) 4.7+2.2i)
(test-cp0-expansion cfl~= '(cfl- 1.0 -3.7+5.3i) 4.7-5.3i)
(test-cp0-expansion cfl~= '(cfl- 1.0+2.2i +5.3i) 1.0-3.1i)
(test-cp0-expansion cfl~= '(cfl- +2.2i -3.7+5.3i) 3.7-3.1i)
(test-cp0-expansion cfl~= '(cfl- 26.0 2.0) 24.0)
(test-cp0-expansion eqv? '(cfl- 5.0 4.0 3.0 2.0) -4.0)
(test-cp0-expansion eqv? '(cfl- 5.0 4.0 3.0 2.0 1.0 0.0 -1.0 -2.0) -2.0)
(test-cp0-expansion cfl~= '(cfl- 1e30 1e30 7.0) -7.0)
)
(mat cfl*
(error? (cfl* 'a))
(error? (cfl* 'a 3))
(error? (cfl* 'a 3 4))
(eqv? (cfl*) 1.0)
(eqv? (cfl* a) a)
(eqv? (cfl* b) b)
(eqv? (cfl* c) c)
(eqv? (cfl* zero a) zero)
(cfl~= (cfl* zero b) zero)
(cfl~= (cfl* zero c) zero)
(cfl~= (cfl* a a) aa)
(cfl~= (cfl* a b) ab)
(cfl~= (cfl* a c) ac)
(cfl~= (cfl* b b) bb)
(cfl~= (cfl* b c) bc)
(cfl~= (cfl* c c) cc)
(cfl~= (cfl* a b c) (cfl* a (cfl* b c)))
(cfl~= (cfl* a b c a b c) (cfl* (cfl* a b c) (cfl* a b c)))
(cfl~= (cfl* 1+2.0i 3.0) 3.0+6.0i)
(cfl~= (cfl* 1.0+2.0i 3.0+4.0i) -5.0+10.0i)
(cfl~= (cfl* 1.0+2.0i 3.0) 3.0+6.0i)
(cfl~= (cfl* -2.0 3.0+4.0i) -6.0-8.0i)
(cfl~= (cfl* 1.0+2.0i +4.0i) -8.0+4.0i)
(cfl~= (cfl* +2.0i 3.0+4.0i) -8.0+6.0i)
(cfl~= (cfl* 26.0 2.0) 52.0)
(test-cp0-expansion eqv? '(cfl*) 1.0)
(test-cp0-expansion eqv? `(cfl* ,a) a)
(test-cp0-expansion eqv? `(cfl* ,b) b)
(test-cp0-expansion eqv? `(cfl* ,c) c)
(test-cp0-expansion eqv? `(cfl* ,zero ,a) zero)
(test-cp0-expansion cfl~= `(cfl* ,zero ,b) zero)
(test-cp0-expansion cfl~= `(cfl* ,zero ,c) zero)
(test-cp0-expansion cfl~= `(cfl* ,a ,a) aa)
(test-cp0-expansion cfl~= `(cfl* ,a ,b) ab)
(test-cp0-expansion cfl~= `(cfl* ,a ,c) ac)
(test-cp0-expansion cfl~= `(cfl* ,b ,b) bb)
(test-cp0-expansion cfl~= `(cfl* ,b ,c) bc)
(test-cp0-expansion cfl~= `(cfl* ,c ,c) cc)
(test-cp0-expansion cfl~= `(cfl* ,a ,b ,c) (cfl* a (cfl* b c)))
(test-cp0-expansion cfl~= `(cfl* ,a ,b ,c ,a ,b ,c) (cfl* (cfl* a b c) (cfl* a b c)))
(test-cp0-expansion cfl~= '(cfl* 1+2.0i 3.0) 3.0+6.0i)
(test-cp0-expansion cfl~= '(cfl* 1.0+2.0i 3.0+4.0i) -5.0+10.0i)
(test-cp0-expansion cfl~= '(cfl* 1.0+2.0i 3.0) 3.0+6.0i)
(test-cp0-expansion cfl~= '(cfl* -2.0 3.0+4.0i) -6.0-8.0i)
(test-cp0-expansion cfl~= '(cfl* 1.0+2.0i +4.0i) -8.0+4.0i)
(test-cp0-expansion cfl~= '(cfl* +2.0i 3.0+4.0i) -8.0+6.0i)
(test-cp0-expansion cfl~= '(cfl* 26.0 2.0) 52.0)
)
(mat cfl/
(error? (cfl/ 'a))
(error? (cfl/ 'a 3))
(error? (cfl/ 'a 3 4))
(error? (cfl/))
(fl~= (cfl/ a) (fl/ a))
(eqv? (cfl/ zero a) zero)
(cfl~= (cfl/ zero b) zero)
(cfl~= (cfl/ zero c) zero)
(cfl~= (cfl/ a a) 1.0)
(cfl~= (cfl/ b b) 1.0)
(cfl~= (cfl/ c c) 1.0)
(cfl~= (cfl/ aa a) a)
(cfl~= (cfl/ ab b) a)
(cfl~= (cfl/ ab a) b)
(cfl~= (cfl/ ac c) a)
(cfl~= (cfl/ ac a) c)
(cfl~= (cfl/ bc c) b)
(cfl~= (cfl/ bc b) c)
(cfl~= (cfl/ cc c) c)
(cfl~= (cfl/ a b c) (cfl/ (cfl/ a b) c))
(cfl~= (cfl/ a b c a b c) (cfl/ a (cfl* b c a b c)))
(cfl~= (cfl/ 3+6.0i 3.0) 1.0+2.0i)
(cfl~= (cfl/ -5.0+10.0i 1.0+2.0i) 3.0+4.0i)
(cfl~= (cfl/ -6.0-8.0i -2.0) 3.0+4.0i)
(cfl~= (cfl/ 26.0 3.0-2.0i) 6.0+4.0i)
(cfl~= (cfl/ -8.0+6.0i +2.0i) 3.0+4.0i)
(cfl~= (cfl/ +26.0i 3.0+2.0i) 4.0+6.0i)
(cfl~= (cfl/ 26.0 2.0) 13.0)
(andmap
(lambda (a)
(andmap
(lambda (b)
(andmap
(lambda (c) (eqv? (cfl/ a b c) (cfl/ (cfl/ a b) c)))
'(1e300 1e250)))
'(1e300 1e250)))
'(1e300 1e250))
(error? (cfl/ 3.0 5.4 'a))
(error? (cfl/ 'a 3.0 5.4))
(error? (cfl/ 3.0 'a 5.4))
(eqv? (cfl/ 16.0 2.0 -2.0 2.0) -2.0)
(eqv? (cfl/ 16.0 2.0 -2.0 2.0 4.0 1.0 -1.0) 0.5)
(test-cp0-expansion eqv? `(cfl/ ,zero ,a) zero)
(test-cp0-expansion eqv? '(cfl/ 16.0 2.0 -2.0 2.0) -2.0)
(test-cp0-expansion eqv? '(cfl/ 16.0 2.0 -2.0 2.0 4.0 1.0 -1.0) 0.5)
(test-cp0-expansion cfl~= `(cfl/ ,zero ,b) zero)
(test-cp0-expansion cfl~= `(cfl/ ,zero ,c) zero)
(test-cp0-expansion cfl~= `(cfl/ ,a ,a) 1.0)
(test-cp0-expansion cfl~= `(cfl/ ,b ,b) 1.0)
(test-cp0-expansion cfl~= `(cfl/ ,c ,c) 1.0)
(test-cp0-expansion cfl~= `(cfl/ ,aa ,a) a)
(test-cp0-expansion cfl~= `(cfl/ ,ab ,b) a)
(test-cp0-expansion cfl~= `(cfl/ ,ab ,a) b)
(test-cp0-expansion cfl~= `(cfl/ ,ac ,c) a)
(test-cp0-expansion cfl~= `(cfl/ ,ac ,a) c)
(test-cp0-expansion cfl~= `(cfl/ ,bc ,c) b)
(test-cp0-expansion cfl~= `(cfl/ ,bc ,b) c)
(test-cp0-expansion cfl~= `(cfl/ ,cc ,c) c)
(test-cp0-expansion cfl~= `(cfl/ ,a ,b ,c) (cfl/ (cfl/ a b) c))
(test-cp0-expansion cfl~= `(cfl/ ,a ,b ,c ,a ,b ,c) (cfl/ a (cfl* b c a b c)))
(test-cp0-expansion cfl~= '(cfl/ 3+6.0i 3.0) 1.0+2.0i)
(test-cp0-expansion cfl~= '(cfl/ -5.0+10.0i 1.0+2.0i) 3.0+4.0i)
(test-cp0-expansion cfl~= '(cfl/ -6.0-8.0i -2.0) 3.0+4.0i)
(test-cp0-expansion cfl~= '(cfl/ 26.0 3.0-2.0i) 6.0+4.0i)
(test-cp0-expansion cfl~= '(cfl/ -8.0+6.0i +2.0i) 3.0+4.0i)
(test-cp0-expansion cfl~= '(cfl/ +26.0i 3.0+2.0i) 4.0+6.0i)
(test-cp0-expansion cfl~= '(cfl/ 26.0 2.0) 13.0)
)
(mat cfl=
(error? (cfl= 'a))
(error? (cfl= 'a 3))
(error? (cfl= 'a 3 4))
(error? (cfl=))
(cfl= a a)
(cfl= b b)
(cfl= c c)
(cfl= (- c c) zero)
(cfl= (+ a b) c)
(not (cfl= a b))
(cfl= 1.1+1.1i c)
(cfl= c 1.1+1.1i c)
(not (cfl= c 1.1+1.1i c a))
(not (cfl= 3+6.0i 3.0))
(not (cfl= 3+6.0i +6.0i))
(cfl= 1.0+2.0i 1.0+2.0i)
(cfl= 5.4 5.4)
)

2889
mats/cp0.ms Normal file

File diff suppressed because it is too large Load diff

639
mats/date.ms Normal file
View file

@ -0,0 +1,639 @@
;;; date.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(mat time
(error? ; wrong number of arguments
(make-time))
(error? ; wrong number of arguments
(make-time 'time-utc))
(error? ; wrong number of arguments
(make-time 'time-utc 17))
(error? ; wrong number of arguments
(make-time 'time-utc 17 0 50))
(error? ; invalid type
(make-time 'time-nonsense 17 0))
(error? ; invalid seconds
(make-time 'time-utc 0 #f))
(error? ; invalid nanoseconds
(make-time 'time-utc -1 17))
(error? ; invalid nanoseconds
(make-time 'time-utc #e1e9 17))
(error? ; invalid nanoseconds
(make-time 'time-utc #f 17))
(error? ; wrong number of arguments
(time?))
(error? ; wrong number of arguments
(time? #f 3))
(begin
(define $time-t1 (make-time 'time-utc (- #e1e9 1) #e1e9))
(and (time? $time-t1) (not (date? $time-t1))))
(error? ; wrong number of arguments
(time-type))
(error? ; wrong number of arguments
(time-type $time-t1 #t))
(error? ; not a time record
(time-type 17))
(error? ; wrong number of arguments
(time-second))
(error? ; wrong number of arguments
(time-second $time-t1 #t))
(error? ; not a time record
(time-second 17))
(error? ; wrong number of arguments
(time-nanosecond))
(error? ; wrong number of arguments
(time-nanosecond $time-t1 #t))
(error? ; not a time record
(time-nanosecond 17))
(error? ; wrong number of arguments
(set-time-type!))
(error? ; wrong number of arguments
(set-time-type! $time-t1))
(error? ; wrong number of arguments
(set-time-type! $time-t1 'time-utc 0))
(error? ; not a time record
(set-time-type! 'time-utc 'time-utc))
(error? ; invalid type
(set-time-type! $time-t1 'time-nonsense))
(error? ; wrong number of arguments
(set-time-second!))
(error? ; wrong number of arguments
(set-time-second! $time-t1))
(error? ; wrong number of arguments
(set-time-second! $time-t1 5000 0))
(error? ; not a time record
(set-time-second! 5000 5000))
(error? ; invalid second
(set-time-second! $time-t1 'time-utc))
(error? ; wrong number of arguments
(set-time-nanosecond!))
(error? ; wrong number of arguments
(set-time-nanosecond! $time-t1))
(error? ; wrong number of arguments
(set-time-nanosecond! $time-t1 5000 0))
(error? ; not a time record
(set-time-nanosecond! 5000 5000))
(error? ; invalid nanosecond
(set-time-nanosecond! $time-t1 -1))
(error? ; invalid nanosecond
(set-time-nanosecond! $time-t1 'time-utc))
(error? ; invalid nanosecond
(set-time-nanosecond! $time-t1 #e1e9))
(error? ; wrong number of arguments
(current-time 'time-utc #t))
(error? ; invalid type
(current-time 'time-nonsense))
(begin
(define $time-t2 (current-time 'time-utc))
(and (time? $time-t2) (not (date? $time-t2))))
(begin
(define $time-t3 (current-time 'time-monotonic))
(and (time? $time-t3) (not (date? $time-t3))))
(begin
(define $time-t4 (current-time 'time-duration))
(and (time? $time-t4) (not (date? $time-t4))))
(begin
(define $time-t5 (current-time 'time-process))
(and (time? $time-t5) (not (date? $time-t5))))
(begin
(define $time-t6 (current-time 'time-thread))
(and (time? $time-t6) (not (date? $time-t6))))
(begin
(define $time-t7 (current-time 'time-collector-cpu))
(and (time? $time-t7) (not (date? $time-t7))))
(begin
(define $time-t8 (current-time 'time-collector-real))
(and (time? $time-t8) (not (date? $time-t8))))
(eqv? (time-type $time-t1) 'time-utc)
(eqv? (time-type $time-t2) 'time-utc)
(eqv? (time-type $time-t3) 'time-monotonic)
(eqv? (time-type $time-t4) 'time-duration)
(eqv? (time-type $time-t5) 'time-process)
(eqv? (time-type $time-t6) 'time-thread)
(eqv? (time-type $time-t7) 'time-collector-cpu)
(eqv? (time-type $time-t8) 'time-collector-real)
(eqv? (time-second $time-t1) #e1e9)
(eqv? (time-nanosecond $time-t1) (- #e1e9 1))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (>= x 0))) (time-second $time-t2))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (>= x 0))) (time-second $time-t3))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (>= x 0))) (time-second $time-t4))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (>= x 0))) (time-second $time-t5))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (>= x 0))) (time-second $time-t6))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (>= x 0))) (time-second $time-t7))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (>= x 0))) (time-second $time-t8))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1)))) (time-nanosecond $time-t2))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1)))) (time-nanosecond $time-t3))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1)))) (time-nanosecond $time-t4))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1)))) (time-nanosecond $time-t5))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1)))) (time-nanosecond $time-t6))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1)))) (time-nanosecond $time-t7))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1)))) (time-nanosecond $time-t8))
(eqv?
(let ([sec (+ (time-second (current-time 'time-thread)) 3)]
[cnt 0]
[ans 0])
(define fib (lambda (x) (if (< x 2) x (+ (fib (- x 1)) (fib (- x 2))))))
(let f ()
(when (< (time-second (current-time 'time-thread)) sec)
(for-each
(lambda (t)
(let ([n (time-nanosecond (current-time t))])
(unless (<= 0 n #e1e9)
(errorf #f "(time-nanosecond (current-time '~s)) = ~s" t n))))
'(time-utc time-monotonic time-duration time-process time-thread))
(set! ans (+ ans (fib 20)))
(set! cnt (+ cnt 1))
(f)))
(/ ans cnt))
6765)
(begin
(set-time-type! $time-t1 'time-monotonic)
(eqv? (time-type $time-t1) 'time-monotonic))
(begin
(set-time-second! $time-t1 3)
(eqv? (time-second $time-t1) 3))
(begin
(set-time-nanosecond! $time-t1 3000)
(eqv? (time-nanosecond $time-t1) 3000))
(error? ; wrong number of arguments
(time=?))
(error? ; wrong number of arguments
(time=? $time-t1))
(error? ; wrong number of arguments
(time=? $time-t1 $time-t1 $time-t1))
(error? ; invalid argument
(time=? $time-t1 3))
(error? ; invalid argument
(time=? car $time-t1))
(error? ; different types
(time=? $time-t4 $time-t5))
(error? ; wrong number of arguments
(time<?))
(error? ; wrong number of arguments
(time<? $time-t1))
(error? ; wrong number of arguments
(time<? $time-t1 $time-t1 $time-t1))
(error? ; invalid argument
(time<? $time-t1 3))
(error? ; invalid argument
(time<? car $time-t1))
(error? ; different types
(time<? $time-t4 $time-t5))
(error? ; wrong number of arguments
(time<=?))
(error? ; wrong number of arguments
(time<=? $time-t1))
(error? ; wrong number of arguments
(time<=? $time-t1 $time-t1 $time-t1))
(error? ; invalid argument
(time<=? $time-t1 3))
(error? ; invalid argument
(time<=? car $time-t1))
(error? ; different types
(time<=? $time-t4 $time-t5))
(error? ; wrong number of arguments
(time>?))
(error? ; wrong number of arguments
(time>? $time-t1))
(error? ; wrong number of arguments
(time>? $time-t1 $time-t1 $time-t1))
(error? ; invalid argument
(time>? $time-t1 3))
(error? ; invalid argument
(time>? car $time-t1))
(error? ; different types
(time>? $time-t4 $time-t5))
(error? ; wrong number of arguments
(time>=?))
(error? ; wrong number of arguments
(time>=? $time-t1))
(error? ; wrong number of arguments
(time>=? $time-t1 $time-t1 $time-t1))
(error? ; invalid argument
(time>=? $time-t1 3))
(error? ; invalid argument
(time>=? car $time-t1))
(error? ; different types
(time>=? $time-t4 $time-t5))
(time=? $time-t1 $time-t1)
(time<=? $time-t1 $time-t1)
(time>=? $time-t1 $time-t1)
(not (time<? $time-t1 $time-t1))
(not (time>? $time-t1 $time-t1))
(equal?
(let ([ta (make-time 'time-duration 200 #e1e19)]
[tb (make-time 'time-duration 300 #e1e20)]
[tc (make-time 'time-duration 300 #e1e20)]
[td (make-time 'time-duration 301 #e1e20)]
[te (make-time 'time-duration 400 #e1e21)])
(define-syntax foo
(syntax-rules ()
[(_ x ...)
(list
(let ([t x])
(list (time<? t x) ...
(time<=? t x) ...
(time=? t x) ...
(time>=? t x) ...
(time>? t x) ...))
...)]))
(foo ta tb tc td te))
'((#f #t #t #t #t
#t #t #t #t #t
#t #f #f #f #f
#t #f #f #f #f
#f #f #f #f #f)
(#f #f #f #t #t
#f #t #t #t #t
#f #t #t #f #f
#t #t #t #f #f
#t #f #f #f #f)
(#f #f #f #t #t
#f #t #t #t #t
#f #t #t #f #f
#t #t #t #f #f
#t #f #f #f #f)
(#f #f #f #f #t
#f #f #f #t #t
#f #f #f #t #f
#t #t #t #t #f
#t #t #t #f #f)
(#f #f #f #f #f
#f #f #f #f #t
#f #f #f #f #t
#t #t #t #t #t
#t #t #t #t #f)))
(error? (time-difference $time-t2 $time-t3))
(error? (add-duration $time-t3 $time-t2))
(error? (subtract-duration $time-t3 $time-t2))
(let ([t (make-time 'time-duration 1000000 -20)])
(and (time? t)
(not (date? t))
(eqv? (time-second t) -20)
(eqv? (time-nanosecond t) 1000000)))
(equal?
(let ([t1 (make-time 'time-process 999999999 7)]
[t2 (make-time 'time-duration 10 2)])
(let ([t3 (add-duration t1 t2)]
[t4 (subtract-duration t1 t2)])
(let ([t5 (time-difference t3 t1)]
[t6 (time-difference t1 t3)]
[t7 (time-difference t1 t4)]
[t8 (time-difference t4 t1)])
(list
(list (time-second t3) (time-nanosecond t3))
(list (time-second t4) (time-nanosecond t4))
(time=? t5 t2)
(list (time-second t6) (time-nanosecond t6))
(time=? t7 t2)
(list (time-second t8) (time-nanosecond t8))))))
'((10 9) (5 999999989) #t (-3 999999990) #t (-3 999999990)))
(error? (copy-time (current-date)))
(begin
(define $new-time-t2 (copy-time $time-t2))
(time? $new-time-t2))
(not (eq? $new-time-t2 $time-t2))
(time=? $new-time-t2 $time-t2)
)
(mat date
(error? ; wrong number of arguments
(make-date))
(error? ; wrong number of arguments
(make-date 0))
(error? ; wrong number of arguments
(make-date 0 0))
(error? ; wrong number of arguments
(make-date 0 0 0))
(error? ; wrong number of arguments
(make-date 0 0 0 0))
(error? ; wrong number of arguments
(make-date 0 0 0 0 1))
(error? ; wrong number of arguments
(make-date 0 0 0 0 1 1))
(error? ; wrong number of arguments
(make-date 0 0 0 0 1 1 2007 0 0))
(error? ; invalid nanosecond
(make-date -1 0 0 0 1 1 2007 0))
(error? ; invalid nanosecond
(make-date #e1e9 0 0 0 1 1 2007 0))
(error? ; invalid nanosecond
(make-date 'zero 0 0 0 1 1 2007 0))
(error? ; invalid second
(make-date 0 -1 0 0 1 1 2007 0))
(error? ; invalid second
(make-date 0 62 0 0 1 1 2007 0))
(error? ; invalid second
(make-date 0 "hello" 0 0 1 1 2007 0))
(error? ; invalid minute
(make-date 0 0 -1 0 1 1 2007 0))
(error? ; invalid minute
(make-date 0 0 60 0 1 1 2007 0))
(error? ; invalid minute
(make-date 0 0 "hello" 0 1 1 2007 0))
(error? ; invalid hour
(make-date 0 0 0 -1 1 1 2007 0))
(error? ; invalid hour
(make-date 0 0 0 24 1 1 2007 0))
(error? ; invalid hour
(make-date 0 0 0 "hello" 1 1 2007 0))
(error? ; invalid day
(make-date 0 0 0 0 0 1 2007 0))
(error? ; invalid day
(make-date 0 0 0 0 32 1 2007 0))
(error? ; invalid day
(make-date 0 0 0 0 31 11 2007 0))
(error? ; invalid day
(make-date 0 0 0 0 29 2 2007 0))
(error? ; invalid day
(make-date 0 0 0 0 "hello" 1 2007 0))
(error? ; invalid month
(make-date 0 0 0 0 1 0 2007 0))
(error? ; invalid month
(make-date 0 0 0 0 1 13 2007 0))
(error? ; invalid month
(make-date 0 0 0 0 1 'eleven 2007 0))
(error? ; invalid year
(make-date 0 0 0 0 1 1 'mmvii 0))
(error? ; invalid tz
(make-date 0 0 0 0 1 1 2007 (* -25 60 60)))
(error? ; invalid tz
(make-date 0 0 0 0 1 1 2007 (* 25 60 60)))
(error? ; invalid tz
(make-date 0 0 0 0 1 1 2007 'est))
(error? ; invalid tz
(make-date 0 0 0 0 1 1 2007 "est"))
(error? ; wrong number of arguments
(date?))
(error? ; wrong number of arguments
(date? #f 3))
(begin
(define $date-d1 (make-date 1 2 3 4 5 6 1970 8))
(and (date? $date-d1) (not (time? $date-d1))))
(error? ; wrong number of arguments
(date-nanosecond))
(error? ; wrong number of arguments
(date-nanosecond $date-d1 #t))
(error? ; not a date record
(date-nanosecond 17))
(error? ; not a date record
(date-nanosecond $time-t1))
(error? ; wrong number of arguments
(date-nanosecond))
(error? ; wrong number of arguments
(date-nanosecond $date-d1 #t))
(error? ; not a date record
(date-nanosecond 17))
(error? ; not a date record
(date-nanosecond $time-t1))
(error? ; wrong number of arguments
(date-second))
(error? ; wrong number of arguments
(date-second $date-d1 #t))
(error? ; not a date record
(date-second 17))
(error? ; not a date record
(date-second $time-t1))
(error? ; wrong number of arguments
(date-minute))
(error? ; wrong number of arguments
(date-minute $date-d1 #t))
(error? ; not a date record
(date-minute 17))
(error? ; not a date record
(date-minute $time-t1))
(error? ; wrong number of arguments
(date-hour))
(error? ; wrong number of arguments
(date-hour $date-d1 #t))
(error? ; not a date record
(date-hour 17))
(error? ; not a date record
(date-hour $time-t1))
(error? ; wrong number of arguments
(date-day))
(error? ; wrong number of arguments
(date-day $date-d1 #t))
(error? ; not a date record
(date-day 17))
(error? ; not a date record
(date-day $time-t1))
(error? ; wrong number of arguments
(date-month))
(error? ; wrong number of arguments
(date-month $date-d1 #t))
(error? ; not a date record
(date-month 17))
(error? ; not a date record
(date-month $time-t1))
(error? ; wrong number of arguments
(date-year))
(error? ; wrong number of arguments
(date-year $date-d1 #t))
(error? ; not a date record
(date-year 17))
(error? ; not a date record
(date-year $time-t1))
(error? ; wrong number of arguments
(date-week-day))
(error? ; wrong number of arguments
(date-week-day $date-d1 #t))
(error? ; not a date record
(date-week-day 17))
(error? ; not a date record
(date-week-day $time-t1))
(error? ; wrong number of arguments
(date-year-day))
(error? ; wrong number of arguments
(date-year-day $date-d1 #t))
(error? ; not a date record
(date-year-day 17))
(error? ; not a date record
(date-year-day $time-t1))
(error? ; wrong number of arguments
(date-dst?))
(error? ; wrong number of arguments
(date-dst? $date-d1 #t))
(error? ; not a date record
(date-dst? 17))
(error? ; not a date record
(date-dst? $time-t1))
(error? ; wrong number of arguments
(date-zone-offset))
(error? ; wrong number of arguments
(date-zone-offset $date-d1 #t))
(error? ; not a date record
(date-zone-offset 17))
(error? ; not a date record
(date-zone-offset $time-t1))
(error? ; wrong number of arguments
(date-zone-name))
(error? ; wrong number of arguments
(date-zone-name $date-d1 #t))
(error? ; not a date record
(date-zone-name 17))
(error? ; not a date record
(date-zone-name $time-t1))
(error? ; wrong number of arguments
(current-date 0 #t))
(error? ; invalid offset
(current-date (* -25 60 60)))
(error? ; invalid offset
(current-date (* 25 60 60)))
(begin
(define $date-d2 (current-date))
(and (date? $date-d2) (not (time? $date-d2))))
(begin
(define $date-d3 (current-date (* -5 60 60)))
(and (date? $date-d3) (not (time? $date-d3))))
(begin
(define $date-d4 (current-date (* 10 60 60)))
(and (date? $date-d4) (not (time? $date-d4))))
(begin
(define $date-d5 (make-date 0 1 1 1 15 6 2016))
(and (date? $date-d5) (not (time? $date-d5))))
(date? (make-date 0 0 0 0 1 1 1970 -24))
(date? (make-date 999999999 59 59 23 31 12 2007 24))
(eqv? (date-nanosecond $date-d1) 1)
(eqv? (date-second $date-d1) 2)
(eqv? (date-minute $date-d1) 3)
(eqv? (date-hour $date-d1) 4)
(eqv? (date-day $date-d1) 5)
(eqv? (date-month $date-d1) 6)
(eqv? (date-year $date-d1) 1970)
(eqv? (date-zone-offset $date-d1) 8)
(boolean? (date-dst? $date-d5))
(fixnum? (date-zone-offset $date-d5))
(eqv? (date-zone-name $date-d1) #f)
(or (string? (date-zone-name $date-d2))
(not (date-zone-name $date-d2)))
(eqv? (date-zone-name $date-d3) #f)
(eqv? (date-zone-name $date-d4) #f)
(or (string? (date-zone-name $date-d5))
(not (date-zone-name $date-d5)))
(begin
(define (plausible-dst? d)
;; Recognize a few time zone names and correlate with the DST field.
;; Names like "EST" appear on Unix variants, while the long names
;; show up on Windows.
(cond
[(member (date-zone-name d) '("EST" "CST" "MST" "PST"
"Eastern Standard Time"
"Central Standard Time"
"Mountain Standard Time"
"Pacific Standard Time"))
(eqv? (date-dst? d) #f)]
[(member (date-zone-name d) '("EDT" "CDT" "MDT" "PDT"
"Eastern Daylight Time"
"Central Daylight Time"
"Mountain Daylight Time"
"Pacific Daylight Time"))
(eqv? (date-dst? d) #t)]
[else #t]))
(plausible-dst? $date-d5))
(begin
(define $date-d6 (make-date 0 1 1 1 15 1 2016))
(plausible-dst? $date-d6))
; check whether tz offsets are set according to DST, assuming that
; DST always means a 1-hour shift
(let ([delta (time-second (time-difference (date->time-utc $date-d5)
(date->time-utc $date-d6)))]
[no-dst-delta (* 152 24 60 60)]; 152 days
[hour-delta (* 60 60)])
(cond
[(and (date-dst? $date-d5) (not (date-dst? $date-d6)))
;; Northern-hemisphere DST reduces delta
(= delta (- no-dst-delta hour-delta))]
[(and (not (date-dst? $date-d5)) (date-dst? $date-d6))
;; Southern-hemisphere DST increases delta
(= delta (+ no-dst-delta hour-delta))]
[else
;; No DST or always DST
(= delta no-dst-delta)]))
; check to make sure dst isn't screwing with our explicitly created dates
; when we call mktime to fill in wday and yday
(let f ([mon 1])
(or (= mon 13)
(and (andmap
(lambda (day)
(let ([d (make-date 5 6 7 8 day mon 2007 -18000)])
(and (eqv? (date-nanosecond d) 5)
(eqv? (date-second d) 6)
(eqv? (date-minute d) 7)
(eqv? (date-hour d) 8)
(eqv? (date-day d) day)
(eqv? (date-month d) mon)
(eqv? (date-year d) 2007)
(eqv? (date-zone-offset d) -18000))))
'(5 10 15 20 25))
(f (+ mon 1)))))
(eqv? (date-zone-offset $date-d3) (* -5 60 60))
(eqv? (date-zone-offset $date-d4) (* 10 60 60))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x 999999999))) (date-nanosecond $date-d2))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x 999999999))) (date-nanosecond $date-d3))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x 999999999))) (date-nanosecond $date-d4))
((lambda (x) (and (fixnum? x) (<= 0 x 61))) (date-second $date-d2))
((lambda (x) (and (fixnum? x) (<= 0 x 61))) (date-second $date-d3))
((lambda (x) (and (fixnum? x) (<= 0 x 61))) (date-second $date-d4))
((lambda (x) (and (fixnum? x) (<= 0 x 59))) (date-minute $date-d2))
((lambda (x) (and (fixnum? x) (<= 0 x 59))) (date-minute $date-d3))
((lambda (x) (and (fixnum? x) (<= 0 x 59))) (date-minute $date-d4))
((lambda (x) (and (fixnum? x) (<= 0 x 23))) (date-hour $date-d2))
((lambda (x) (and (fixnum? x) (<= 0 x 23))) (date-hour $date-d3))
((lambda (x) (and (fixnum? x) (<= 0 x 23))) (date-hour $date-d4))
((lambda (x) (and (fixnum? x) (<= 1 x 31))) (date-day $date-d2))
((lambda (x) (and (fixnum? x) (<= 1 x 31))) (date-day $date-d3))
((lambda (x) (and (fixnum? x) (<= 1 x 31))) (date-day $date-d4))
((lambda (x) (and (fixnum? x) (<= 1 x 12))) (date-month $date-d2))
((lambda (x) (and (fixnum? x) (<= 1 x 12))) (date-month $date-d3))
((lambda (x) (and (fixnum? x) (<= 1 x 12))) (date-month $date-d4))
((lambda (x) (and (fixnum? x) (<= 1900 x 2038))) (date-year $date-d2))
((lambda (x) (and (fixnum? x) (<= 1900 x 2038))) (date-year $date-d3))
((lambda (x) (and (fixnum? x) (<= 1900 x 2038))) (date-year $date-d4))
(let ([s (date-and-time)])
(and (fixnum? (read (open-input-string (substring s 8 10))))
(fixnum? (read (open-input-string (substring s 20 24))))))
(let ([d (current-date)])
(let ([s (date-and-time d)])
(and (= (read (open-input-string (substring s 8 10))) (date-day d))
(= (read (open-input-string (substring s 11 13))) (date-hour d))
(= (read (open-input-string (substring s 20 24))) (date-year d)))))
)
(mat conversions/sleep
(error? (date->time-utc (current-time)))
(error? (time-utc->date (current-date)))
(error? (sleep 20))
(time? (date->time-utc (current-date)))
(date? (time-utc->date (current-time 'time-utc)))
(let ([t (current-time 'time-utc)])
(sleep (make-time 'time-duration 0 1))
(time<? t (date->time-utc (current-date))))
(let ([t (current-time)])
(and
(time=? (date->time-utc (time-utc->date t)) t)
(time=? (date->time-utc (time-utc->date t -86400)) t)
(time=? (date->time-utc (time-utc->date t 0)) t)
(time=? (date->time-utc (time-utc->date t 86400)) t)))
)
(mat time&date-printing
(equal?
(with-output-to-string (lambda () (pretty-print (make-time 'time-duration 1 -1))))
"#<time-duration -0.999999999>\n")
(equal?
(with-output-to-string (lambda () (write (time-utc->date (make-time 'time-utc 708626501 1427137297) -14400))))
"#<date Mon Mar 23 15:01:37 2015>")
)

152
mats/enum.ms Normal file
View file

@ -0,0 +1,152 @@
;;; enum.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(mat enumeration
(equal? '(a b c) (enum-set->list (make-enumeration '(a b c))))
(equal? '(a b c) (enum-set->list (make-enumeration '(a b a c))))
(equal? '(a b c)
(enum-set->list
((enum-set-constructor (make-enumeration '(a a b b c d)))
'(a b c))))
(equal?
'(a b c d e f g h i j k l m n o p q r s t u v w x y z
aa bb cc dd ee ff gg hh ii jj kk ll mm
nn oo pp qq rr ss tt uu vv ww xx yy zz)
(enum-set->list
(make-enumeration
'(a b c d e f g h i j k l m n o p q r s t u v w x y z
aa bb cc dd ee ff gg hh ii jj kk ll mm
nn oo pp qq rr ss tt uu vv ww xx yy zz))))
(equal? '(d)
(let ([c (enum-set-constructor (make-enumeration '(a b c d e f)))])
(enum-set->list (enum-set-intersection (c '(a c d e))
(c '(b d f))))))
(equal? '(a b c d e f)
(let ([c (enum-set-constructor (make-enumeration '(a b c d e f)))])
(enum-set->list (enum-set-union (c '(a c d e))
(c '(b d f))))))
(equal? '(a c e)
(let ([c (enum-set-constructor (make-enumeration '(a b c d e f)))])
(enum-set->list (enum-set-difference (c '(a c d e))
(c '(b d f))))))
(equal? '(b f)
(let ([c (enum-set-constructor (make-enumeration '(a b c d e f)))])
(enum-set->list (enum-set-complement (c '(a c d e))))))
(equal? '(a b c d e f)
(let ([c (enum-set-constructor (make-enumeration '(a b c d e f)))])
(enum-set->list (enum-set-universe (c '(a c d e))))))
(equal? '(a c d e)
(let ([c (enum-set-constructor (make-enumeration '(a b c d e f)))])
(enum-set->list (enum-set-projection (c '(a c d e))
(c '(b d f))))))
(equal? '(0 1 #f 5 #f)
(let ([e (make-enumeration '(a b c d e f))])
(map (enum-set-indexer e) '(a b g f h))))
(error? (enum-set-intersection (make-enumeration '(a b c d e f g))
(make-enumeration '(a b c d e f g))))
(error? (enum-set-intersection 1 1))
(equal? '(#f #t #f #t #t #t #f #f #f #f)
(let ([x ((enum-set-constructor (make-enumeration '(a b c d e f g)))
'(b d e f))])
(map (lambda (y) (enum-set-member? y x)) '(a b c d e f g h i j))))
(equal? '(#t #f #t #f)
(let ([e1 (make-enumeration '(a b c d))]
[e2 (make-enumeration '(c d e f))])
(list (enum-set-subset? e1 e1)
(enum-set-subset? e1 e2)
(enum-set-subset? e2 e2)
(enum-set-subset? e2 e1))))
(equal? '(#f #f #f #f #f)
(let ([c1 (enum-set-constructor (make-enumeration '(a b c d)))]
[c2 (enum-set-constructor (make-enumeration '(c d e f)))])
(list (enum-set-subset? (c1 '(c)) (c2 '(c d)))
(enum-set-subset? (c1 '(a c)) (c2 '(c d)))
(enum-set-subset? (c1 '(c d)) (c2 '(c d)))
(enum-set=? (c1 '(c d)) (c2 '(c d)))
(enum-set=? (c1 '(c)) (c2 '(c d))))))
(equal? '(#t #f #t #t #f)
(let ([c1 (enum-set-constructor (make-enumeration '(a b c d e f)))]
[c2 (enum-set-constructor (make-enumeration '(f e d c b a)))])
(list (enum-set-subset? (c1 '(c)) (c2 '(c d)))
(enum-set-subset? (c1 '(a c)) (c2 '(c d)))
(enum-set-subset? (c1 '(c d)) (c2 '(c d)))
(enum-set=? (c1 '(c d)) (c2 '(c d)))
(enum-set=? (c1 '(c)) (c2 '(c d))))))
(equal? 'a
(let ()
(define-enumeration foo (a b c) make-foo)
(foo a)))
(error? (let ()
(define-enumeration foo (a b c) make-foo)
(foo d)))
(equal? '(a b)
(let ()
(define-enumeration foo (a b c) make-foo)
(enum-set->list (make-foo a b))))
(error? (let ()
(define-enumeration foo (a b c) make-foo)
(make-foo a d)))
(error? (make-enumeration 3))
(error? (enum-set-universe 3))
(error? (enum-set-indexer 3))
(error? (let ([e (make-enumeration '(a b c))])
((enum-set-indexer e) 1)))
(error? (enum-set->list 3))
(equal? '(a b)
(let ()
(define-enumeration foo (a b c) f)
(enum-set->list (enum-set-union (f a) (f b)))))
(error? (let ()
(define-enumeration foo (a b c) f)
(enum-set->list (enum-set-union (f a) 3))))
(error? (enum-set-union 4 (make-enumeration '(a b c))))
(error? (let ()
(define-enumeration foo (a b c) f)
(define-enumeration bar (a b c) g)
(enum-set-union (f a) (g b))))
(error? (enum-set-complement 3))
(error? (enum-set-projection 3 (make-enumeration '(a b))))
(error? (enum-set-projection (make-enumeration '(a b)) 4))
(equal? '(a b)
(enum-set->list
(enum-set-projection (make-enumeration '(a b))
(make-enumeration '(a b)))))
(equal? '(a b)
(enum-set->list
(enum-set-projection (make-enumeration '(a b c))
(make-enumeration '(a b)))))
(equal? '(a b)
(enum-set->list
(enum-set-projection (make-enumeration '(a b))
(make-enumeration '(a b c)))))
(equal? #t (let () (define-enumeration foo () bar) #t))
(error? (let () (define-enumeration 3 () bar) #t))
(error? (let () (define-enumeration foo baz bar) #t))
(error? (let () (define-enumeration foo () 3) #t))
(error? (let () (define-enumeration foo (a 3) bar) #t))
(error? (let ()
(define-enumeration foo (a b) bar)
(foo 3)))
(error? (let ()
(define-enumeration foo (a b) bar)
(bar 3)))
(error? ; cannot extend sealed record
(make-record-type
(record-rtd (make-enumeration '(a b c)))
"foo" '()))
(equal? #t (enum-set? (make-enumeration '(a b c))))
(equal? #f (enum-set? 1))
)

594
mats/examples.ms Normal file
View file

@ -0,0 +1,594 @@
;;; examples.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; define *examples-directory* in Makefile
(define-syntax examples-mat
(syntax-rules ()
[(_ name (file ...) expr ...)
(begin
(mat name
(begin
(parameterize ((source-directories (cons *examples-directory* (source-directories))))
(load (format "~a/~a.ss" *examples-directory* file))
...)
#t)
expr ...)
(mat name
(begin
(parameterize ((source-directories (cons *examples-directory* (source-directories))))
(load (format "~a/~a.so" *examples-directory* file))
...
#t))
expr ...))]))
(define load-example
(case-lambda
[(str)
(load (format "~a/~a.ss" *examples-directory* str))
#t]
[(str eval)
(load (format "~a/~a.ss" *examples-directory* str) eval)
#t]))
(define (example-file file) (format "~a/~a" *mats-dir* file))
(define file=?
(lambda (fn1 fn2)
(let ([p1 (open-input-file fn1)] [p2 (open-input-file fn2)])
(let loop ()
(let ([c1 (read-char p1)] [c2 (read-char p2)])
(if (eof-object? c1)
(begin
(close-port p1)
(close-port p2)
(eof-object? c2))
(and (not (eof-object? c2))
(char=? c1 c2)
(loop))))))))
(examples-mat def-edit ("def" "edit")
(begin (def fact (lambda (x) (if (zero? x) 1 (* x (fact ( x 1))))))
(procedure? fact))
(equal? (ls-def) '(fact))
(let ([in (open-input-string "3 3 4 3 2 (ib 1 -) t")]
[out (open-output-string)])
(and (eqv? (parameterize ([current-input-port in]
[current-output-port out])
(ed-def fact))
'fact)
(equal? (get-output-string out)
"(def fact (lambda (...) (...)))
edit> (lambda (x) (if (...) 1 (...)))
edit> (if (zero? x) 1 (* x (...)))
edit> (* x (fact (...)))
edit> (fact (x 1))
edit> (x 1)
edit> (- x 1)
edit> (def fact (lambda (...) (...)))
edit>
")))
(eqv? (fact 30) 265252859812191058636308480000000)
)
(examples-mat fact ("fact")
(eqv? (fact 30) 265252859812191058636308480000000)
)
(examples-mat fatfib ("fatfib")
(eqv? (fatfib 10) 89)
)
(examples-mat fib ("fib")
(begin (printf "***** expect trace of (fib 4):~%")
(eqv? (fib 4) 5))
)
(examples-mat freq ("freq")
;; freq.in and freq.out come from example in TSPL
(begin (delete-file "testfile.freq" #f) #t)
(begin (frequency (example-file "freq.in") "testfile.freq")
(file=? "testfile.freq" (example-file "freq.out")))
)
;-------- freq.in: --------
;Peter Piper picked a peck of pickled peppers;
;A peck of pickled peppers Peter Piper picked.
;If Peter Piper picked a peck of pickled peppers,
;Where's the peck of pickled peppers Peter Piper picked?
;-------- freq.out: --------
;1 A
;1 If
;4 Peter
;4 Piper
;1 Where
;2 a
;4 of
;4 peck
;4 peppers
;4 picked
;4 pickled
;1 s
;1 the
; "interpret" can't handle all Chez core forms
;(mat interpret
; (and (eq? (getprop 'interpret '*type*) 'primitive)
; (begin (remprop 'interpret '*type*) #t))
; (load-example "interpret")
; (load-example "interpret" interpret)
; (load-example "fatfib" interpret)
; (eqv? (fatfib 4) 5)
; (begin (putprop 'interpret '*type* 'primitive) #t)
; )
(examples-mat m4 ("m4")
(begin (m4 "testfile.m4" (example-file "m4test.in"))
(file=? (example-file "m4test.out") "testfile.m4"))
)
(examples-mat macro ("macro")
(begin (macro xxxxxx (lambda (x) `',x)) #t)
(equal? (xxxxxx 3) '(xxxxxx 3))
)
(examples-mat matrix ("matrix")
;; examples from TSPL2:
(equal? (mul 3 4) 12)
(equal? (mul 1/2 '#(#(1 2 3))) '#(#(1/2 1 3/2)))
(equal? (mul -2
'#(#(3 -2 -1)
#(-3 0 -5)
#(7 -1 -1))) '#(#(-6 4 2)
#(6 0 10)
#(-14 2 2)))
(equal? (mul '#(#(1 2 3))
'#(#(2 3)
#(3 4)
#(4 5))) '#(#(20 26)))
(equal? (mul '#(#(2 3 4)
#(3 4 5))
'#(#(1) #(2) #(3))) '#(#(20) #(26)))
(equal? (mul '#(#(1 2 3)
#(4 5 6))
'#(#(1 2 3 4)
#(2 3 4 5)
#(3 4 5 6))) '#(#(14 20 26 32)
#(32 47 62 77)))
)
(examples-mat object ("object")
(begin (define-object (summit x)
([y 3])
([getx (lambda () x)]
[sumxy (lambda () (+ x y))]
[setx (lambda (v) (set! x v))]))
(procedure? summit))
(begin (define a (summit 1)) (procedure? a))
(eq? (send-message a getx) 1)
(eq? (send-message a sumxy) 4)
(begin (send-message a setx 13)
(eq? (send-message a sumxy) 16))
;; examples from TSPL:
(begin (define-object (kons kar kdr)
([get-car (lambda () kar)]
[get-cdr (lambda () kdr)]
[set-car! (lambda (x) (set! kar x))]
[set-cdr! (lambda (x) (set! kdr x))]))
(procedure? kons))
(begin (define p (kons 'a 'b)) (procedure? p))
(eq? (send-message p get-car) 'a)
(eq? (send-message p get-cdr) 'b)
(begin (send-message p set-cdr! 'c)
(eq? (send-message p get-cdr) 'c))
(begin (define-object (kons kar kdr pwd)
([get-car (lambda () kar)]
[get-cdr (lambda () kar)]
[set-car!
(lambda (x p)
(when (string=? p pwd)
(set! kar x)))]
[set-cdr!
(lambda (x p)
(when (string=? p pwd)
(set! kar x)))]))
(procedure? kons))
(begin (define p1 (kons 'a 'b "magnificent")) (procedure? p1))
(begin (send-message p1 set-car! 'c "magnificent")
(eq? (send-message p1 get-car) 'c))
(begin (send-message p1 set-car! 'd "please")
(eq? (send-message p1 get-car) 'c))
(begin (define p2 (kons 'x 'y "please")) (procedure? p2))
(begin (send-message p2 set-car! 'z "please")
(eq? (send-message p2 get-car) 'z))
(begin (define-object (kons kar kdr)
([count 0])
([get-car
(lambda ()
(set! count (+ count 1))
kar)]
[get-cdr
(lambda ()
(set! count (+ count 1))
kdr)]
[accesses
(lambda () count)]))
(procedure? kons))
(begin (define p (kons 'a 'b)) (procedure? p))
(eq? (send-message p get-car) 'a)
(eq? (send-message p get-cdr) 'b)
(eq? (send-message p accesses) '2)
(eq? (send-message p get-cdr) 'b)
(eq? (send-message p accesses) '3)
)
(examples-mat power ("power")
(eqv? (power 1/2 3) 1/8)
)
(examples-mat rabbit ("rabbit")
(begin (printf "***** expect rabbit output:~%")
(rabbit 3)
(dispatch)
#t)
)
(examples-mat rsa ("rsa")
(begin (printf "***** expect rsa output:~%")
(make-user bonzo)
(make-user bobo)
(make-user tiger)
(show-center)
#t)
(equal? (send "hi there" bonzo bobo) "hi there")
(equal? (send "hi there to you" bobo bonzo) "hi there to you")
(not (equal? (decrypt (encrypt "hi there" bonzo bobo) tiger)
"hi there"))
)
(define stream->list
(lambda (s)
(if (procedure? s)
'()
(cons (car s) (stream->list (cdr s))))))
(examples-mat scons ("scons")
(eqv? (stream-ref factlist 3) 6)
(equal? (stream->list factlist) '(1 1 2 6))
(eqv? (stream-ref factlist 10) 3628800)
(equal? (stream->list factlist)
'(1 1 2 6 24 120 720 5040 40320 362880 3628800))
(eqv? (stream-ref fiblist 3) 3)
(equal? (stream->list fiblist) '(1 1 2 3))
(eqv? (stream-ref fiblist 5) 8)
(equal? (stream->list fiblist) '(1 1 2 3 5 8))
)
(examples-mat setof ("setof")
(equal? (set-of x (x in '(a b c))) '(a b c))
(equal? (set-of x (x in '(1 2 3 4)) (even? x)) '(2 4))
(equal? (set-of (cons x y) (x in '(1 2 3)) (y is (* x x)))
'((1 . 1) (2 . 4) (3 . 9)))
(equal? (set-of (cons x y) (x in '(a b)) (y in '(1 2)))
'((a . 1) (a . 2) (b . 1) (b . 2)))
)
(examples-mat unify ("unify")
;; examples from TSPL:
(eq? (unify 'x 'y) 'y)
(equal? (unify '(f x y) '(g x y)) "clash")
(equal? (unify '(f x (h)) '(f (h) y)) '(f (h) (h)))
(equal? (unify '(f (g x) y) '(f y x)) "cycle")
(equal? (unify '(f (g x) y) '(f y (g x))) '(f (g x) (g x)))
)
(examples-mat fft ("fft")
(equal? (dft '(0 0 0 0)) '(0 0 0 0))
(equal? (dft '(2.0 2.0 2.0 2.0)) '(8.0 0.0-0.0i 0.0 0.0+0.0i))
(equal? (dft '(+2.i +2.i +2.i +2.i)) '(+0.0+8.0i 0.0+0.0i 0.0+0.0i 0.0+0.0i))
)
(examples-mat compat ("compat")
(eqv? (define! defined-with-define! (lambda () defined-with-define!))
'defined-with-define!)
(let ((p defined-with-define!))
(set! defined-with-define! 0)
(eqv? (p) 0))
(eqv? (defrec! defined-with-defrec! (lambda () defined-with-defrec!))
'defined-with-defrec!)
(let ((p defined-with-defrec!))
(set! defined-with-defrec! 0)
(eqv? (p) p))
(eqv? (begin0 1 2 3 4) 1)
(equal? (recur f ((ls '(a b c)) (new '()))
(if (null? ls) new (f (cdr ls) (cons (car ls) new))))
'(c b a))
(equal? (tree-copy '()) '())
(equal? (tree-copy 'a) 'a)
(equal? (tree-copy '(a)) '(a))
(equal? (tree-copy '(a (b c) . d)) '(a (b c) . d))
(let* ((p1 '((a . b) c)) (p2 (car p1)) (p3 (cdr p1)))
(let ((c1 (tree-copy p1)))
(not
(or (memq c1 (list p1 p2 p3))
(memq (car c1) (list p1 p2 p3))
(memq (cdr c1) (list p1 p2 p3))))))
(= *most-positive-short-integer*
*most-positive-fixnum*
(most-positive-fixnum))
(= *most-negative-short-integer*
*most-negative-fixnum*
(most-negative-fixnum))
(eof-object? *eof*)
(eq? short-integer? fixnum?)
(eq? big-integer? bignum?)
(eq? ratio? ratnum?)
(eq? float? flonum?)
(eq? bound? top-level-bound?)
(eq? global-value top-level-value)
(eq? set-global-value! set-top-level-value!)
(eq? define-global-value define-top-level-value)
(eq? symbol-value top-level-value)
(eq? set-symbol-value! set-top-level-value!)
(eq? put putprop)
(eq? get getprop)
(eq? copy-list list-copy)
(eq? copy-tree tree-copy)
(eq? copy-string string-copy)
(eq? copy-vector vector-copy)
(eq? intern string->symbol)
(eq? symbol-name symbol->string)
(eq? make-temp-symbol gensym)
(eq? temp-symbol? gensym?)
(eq? string->uninterned-symbol gensym)
(eq? uninterned-symbol? gensym?)
(eq? compile-eval compile)
(eq? closure? procedure?)
(eq? =? =)
(eq? <? <)
(eq? >? >)
(eq? <=? <=)
(eq? >=? >=)
(eq? float exact->inexact)
(eq? rational inexact->exact)
(eq? char-equal? char=?)
(eq? char-less? char<?)
(eq? string-equal? string=?)
(eq? string-less? string<?)
(eq? flush-output flush-output-port)
(eq? clear-output clear-output-port)
(eq? clear-input clear-input-port)
(eq? mapcar map)
(eq? mapc for-each)
(eq? true #t)
(eq? false #f)
(eq? t #t)
(eq? nil '())
(eq? macro-expand expand)
(eq? (cull negative? '()) '())
(let ((x (list -1 2 -3 -3 1 -5 2 6)))
(and
(equal? (cull pair? x) '())
(equal? (cull negative? x) '(-1 -3 -3 -5))
(equal? x '(-1 2 -3 -3 1 -5 2 6))))
(eq? (cull! negative? '()) '())
(let ((x (list -1 2 -3 -3 1 -5 2 6)))
(and
(equal? (cull! pair? x) '())
(equal? (cull! negative? x) '(-1 -3 -3 -5))))
(eq? (mem (lambda (x) #t) '()) #f)
(let ((x '(a b c)))
(and
(equal? (mem (lambda (x) (eq? x 'a)) x) x)
(equal? (mem (lambda (x) (eq? x 'b)) x) (cdr x))
(equal? (mem (lambda (x) (eq? x 'c)) x) (cddr x))
(equal? (mem (lambda (x) (eq? x 'd)) x) #f)))
(let ((x '(1 -2 3)))
(and
(equal? (mem negative? x) (cdr x))
(equal? (mem positive? x) x)
(equal? (mem pair? x) #f)))
(eq? (rem (lambda (x) #t) '()) '())
(let ((x (list 1 -2 3)))
(and
(equal? (rem negative? x) '(1 3))
(equal? x '(1 -2 3))))
(let ((x (list 1 -2 3)))
(and
(equal? (rem positive? x) '(-2))
(equal? x '(1 -2 3))))
(eq? (rem! (lambda (x) #t) '()) '())
(let ((x (list 1 -2 3))) (equal? (rem! negative? x) '(1 3)))
(let ((x (list 1 -2 3))) (equal? (rem! positive? x) '(-2)))
(eq? (ass (lambda (x) #t) '()) #f)
(let ((a (list -1)) (b (list 2)) (c (list 3)))
(let ((l (list a b c)))
(and
(equal? (ass negative? l) a)
(equal? (ass positive? l) b)
(equal? (ass (lambda (x) (= x 3)) l) c)
(equal? (ass pair? l) #f))))
(equal? (decode-float 0.0) '#(0 0 1))
(let ((x (decode-float (inexact 2/3))))
(define ~=
(let ([*fuzz* .0001])
(lambda (x y)
(and (flonum? x)
(flonum? y)
(<= (abs (- x y)) *fuzz*)))))
(~= (inexact (* (vector-ref x 2)
(vector-ref x 0)
(expt 2 (vector-ref x 1))))
(inexact 2/3)))
(let ((x (box 3)))
(and (equal? (swap-box! x 4) 3) (equal? (unbox x) 4)))
(begin (define-macro! fudge (a (b . c) d) `(quote (,a ,b ,c ,d)))
(equal? (fudge + (- . *) /) '(+ - * /)))
; tests from MichaelL@frogware.com, testing the changes he suggested
(let ()
(define-macro test-1 (val)
`',val)
(equal? 'x (test-1 x)))
(let ()
(define-macro (test-1 val)
`',val)
(equal? 'x (test-1 x)))
(let ()
(define-macro test-2 (val)
`'(,val))
(equal? '(x) (test-2 x)))
(let ()
(define-macro (test-2 val)
`'(,val))
(equal? '(x) (test-2 x)))
(let ([xyz '(x y z)])
(define-macro test-3 (val)
`(,@val))
(equal? '(x y z) (test-3 xyz)))
(let ([xyz '(x y z)])
(define-macro (test-3 val)
`(,@val))
(equal? '(x y z) (test-3 xyz)))
(let ()
(define-macro test-4 (val)
(let ([test-function (lambda (x)
(string->symbol
(string-append
(symbol->string x)
"!!!")))])
`'(,(test-function val))))
(equal? '(xyz!!!) (test-4 xyz)))
(let ()
(define-macro (test-4 val)
(let ([test-function (lambda (x)
(string->symbol
(string-append
(symbol->string x)
"!!!")))])
`'(,(test-function val))))
(equal? '(xyz!!!) (test-4 xyz)))
(let ()
(define-macro test-5 (this . that)
`'(,this ,that))
(equal? '(x (y z)) (test-5 x y z)))
(let ()
(define-macro (test-5 this . that)
`'(,this ,that))
(equal? '(x (y z)) (test-5 x y z)))
(let ()
(define-macro test-6 (this . that)
`'(,this ,@that))
(equal? '(x y z) (test-6 x y z)))
(let ()
(define-macro (test-6 this . that)
`'(,this ,@that))
(equal? '(x y z) (test-6 x y z)))
(let ()
(defmacro test-1 (val)
`',val)
(equal? 'x (test-1 x)))
(let ()
(defmacro (test-1 val)
`',val)
(equal? 'x (test-1 x)))
(let ()
(defmacro test-2 (val)
`'(,val))
(equal? '(x) (test-2 x)))
(let ()
(defmacro (test-2 val)
`'(,val))
(equal? '(x) (test-2 x)))
(let ([xyz '(x y z)])
(defmacro test-3 (val)
`(,@val))
(equal? '(x y z) (test-3 xyz)))
(let ([xyz '(x y z)])
(defmacro (test-3 val)
`(,@val))
(equal? '(x y z) (test-3 xyz)))
(let ()
(defmacro test-4 (val)
(let ([test-function (lambda (x)
(string->symbol
(string-append
(symbol->string x)
"!!!")))])
`'(,(test-function val))))
(equal? '(xyz!!!) (test-4 xyz)))
(let ()
(defmacro (test-4 val)
(let ([test-function (lambda (x)
(string->symbol
(string-append
(symbol->string x)
"!!!")))])
`'(,(test-function val))))
(equal? '(xyz!!!) (test-4 xyz)))
(let ()
(defmacro test-5 (this . that)
`'(,this ,that))
(equal? '(x (y z)) (test-5 x y z)))
(let ()
(defmacro (test-5 this . that)
`'(,this ,that))
(equal? '(x (y z)) (test-5 x y z)))
(let ()
(defmacro test-6 (this . that)
`'(,this ,@that))
(equal? '(x y z) (test-6 x y z)))
(let ()
(defmacro (test-6 this . that)
`'(,this ,@that))
(equal? '(x y z) (test-6 x y z)))
(begin (define-struct! caramel x y z) (eqv? (caramel-x (caramel 1 2 3)) 1))
)
(examples-mat ez-grammar-test ("ez-grammar-test")
(equal?
(with-output-to-string ez-grammar-test)
"8 tests ran\n")
)

404
mats/exceptions.ms Normal file
View file

@ -0,0 +1,404 @@
;;; exceptions.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(mat exceptions
(begin
(define ($$capture thunk)
(with-output-to-string
(lambda ()
(call/cc
(lambda (k)
(with-exception-handler
(lambda (x) (printf "default handler: ~s\n" x) (k))
(lambda () (printf "~s\n" (thunk)))))))))
(define-syntax $capture
(syntax-rules ()
[(_ e1 e2 ...) ($$capture (lambda () e1 e2 ...))]))
#t)
(equal?
($capture 'hello)
"hello\n")
(begin
(define ($ex-test1) (raise 'oops) (printf "finished\n"))
(define ($ex-test2) (printf "handler returned: ~s\n" (raise-continuable 'oops)) 'done)
#t)
(equal?
($capture (list ($ex-test1)))
"default handler: oops\n")
(equal?
($capture
(list
(with-exception-handler
(lambda (arg) (printf "hello: ~s\n" arg))
$ex-test1)))
"hello: oops\ndefault handler: #<condition &non-continuable>\n")
(equal?
($capture
(list
(with-exception-handler
(lambda (arg) (raise (list arg)))
$ex-test1)))
"default handler: (oops)\n")
(equal?
($capture (list ($ex-test2)))
"default handler: oops\n")
(equal?
($capture
(list
(with-exception-handler
(lambda (arg) (printf "hello: ~s\n" arg) 17)
$ex-test2)))
"hello: oops\nhandler returned: 17\n(done)\n")
(equal?
($capture
(list
(with-exception-handler
(lambda (arg) (raise (list arg)))
$ex-test2)))
"default handler: (oops)\n")
(equal?
($capture
(list
(guard (foo [(null? foo) 'empty]
[(pair? foo) foo])
(raise '()))))
"(empty)\n")
(equal?
($capture
(list
(guard (foo [(null? foo) 'empty]
[(pair? foo) foo])
(raise '(a . b)))))
"((a . b))\n")
(equal?
($capture
(list
(guard (foo [(null? foo) 'empty]
[(pair? foo) foo])
(raise 'oops))))
"default handler: oops\n")
(equal?
($capture
(list
(guard (foo [(null? foo) 'empty]
[(pair? foo) foo])
(with-exception-handler
(lambda (x) (printf "just passing through...\n") (raise x))
(lambda () (raise '()))))))
"just passing through...\n(empty)\n")
(equal?
($capture
(list
(guard (foo [(null? foo) 'empty]
[(pair? foo) foo])
(with-exception-handler
(lambda (x) (printf "just passing through...\n") (raise x))
(lambda () (raise '(a . b)))))))
"just passing through...\n((a . b))\n")
(equal?
($capture
(list
(guard (foo [(null? foo) 'empty]
[(pair? foo) foo])
(with-exception-handler
(lambda (x) (printf "just passing through...\n") (raise x))
(lambda () (raise 'oops))))))
"just passing through...\ndefault handler: oops\n")
(equal?
($capture
(list
(guard (foo [(null? foo) 'empty]
[(pair? foo) foo]
[else (raise 'hair)])
(with-exception-handler
(lambda (x) (printf "just passing through...\n") (raise x))
(lambda () (raise '(a . b)))))))
"just passing through...\n((a . b))\n")
(equal?
($capture
(list
(guard (foo [(null? foo) 'empty]
[(pair? foo) foo]
[else (raise 'hair)])
(with-exception-handler
(lambda (x) (printf "just passing through...\n") (raise x))
(lambda () (raise 'oops))))))
"just passing through...\ndefault handler: hair\n")
(equal?
($capture
(list
(call/cc
(lambda (k)
(with-exception-handler
(lambda (arg) (printf "outer handler: ~s\n" arg) (k 'fini))
(lambda ()
(guard (foo [(begin (printf "checking null\n") (null? foo)) 'empty]
[(begin (printf "checking pair\n") (pair? foo)) foo])
(dynamic-wind
(lambda () (printf "in\n"))
(lambda () (raise 'oops))
(lambda () (printf "out\n"))))))))))
"in\nout\nchecking null\nchecking pair\nin\nouter handler: oops\nout\n(fini)\n")
(equal?
($capture
(list
(guard (foo [(null? foo) 'empty]
[(pair? foo) foo])
(with-exception-handler
(lambda (x) (printf "returning...\n"))
(lambda () (raise-continuable 'oops) 'continuing)))))
"returning...\n(continuing)\n")
(equal?
($capture
; test to make sure guard reraises with raise-continuable per r6rs errata
(list
(with-exception-handler
(lambda (x) (printf "returning...\n"))
(lambda ()
(guard (foo [(null? foo) 'empty]
[(pair? foo) foo])
(raise-continuable 'oops)
'continuing)))))
"returning...\n(continuing)\n")
)
(mat assert
(equal?
(begin (assert #t) "yes")
"yes")
(equal?
(assert (memq 'a '(1 2 a 3 4)))
'(a 3 4))
(error? ; assertion failed
(assert (memq 'b '(1 2 a 3 4))))
(equal?
(begin (assert (< 3 4)) "yes")
"yes")
(equal?
(guard (c [#t "yes"])
(begin (assert #f) "no"))
"yes")
(equal?
(guard (c [#t "yes"])
(begin (assert (< 4 3)) "no"))
"yes")
; make sure pattern variables and ellipses on RHS don't screw us up
(equal?
(guard (c [#t "oops"])
(let-syntax ([q (lambda (x) #t)])
(assert (q ...))
"okay"))
"okay")
(equal?
(guard (c [#t "oops"])
(let-syntax ([q (lambda (x) #f)])
(assert (q ...))
"okay"))
"oops")
(error? ; assertion failed
(let-syntax ([q (lambda (x) #f)])
(assert (q ...))
"okay"))
(equal?
(syntax-case '(a b c) ()
[(x ...)
(begin
(assert (andmap symbol? #'(x ...)))
#'((x . x) ...))])
'((a . a) (b . b) (c . c)))
(error? ; assertion failed
(syntax-case '(a b 3) ()
[(x ...)
(begin
(assert (andmap symbol? #'(x ...)))
#'((x . x) ...))]))
)
(mat exceptions-r6rs ; r6rs examples
(equal?
($capture
(guard (con
((error? con)
(if (message-condition? con)
(display (condition-message con))
(display "an error has occurred"))
'error)
((violation? con)
(if (message-condition? con)
(display (condition-message con))
(display "the program has a bug"))
'violation))
(raise
(condition
(make-error)
(make-message-condition "I am an error")))))
"I am an errorerror\n")
(equal?
($capture
(guard (con
((error? con)
(if (message-condition? con)
(display (condition-message con))
(display "an error has occurred"))
'error))
(raise
(condition
(make-violation)
(make-message-condition "I am an error")))))
"default handler: #<compound condition>\n")
(equal?
($capture
(with-exception-handler
(lambda (con)
(cond
((not (warning? con))
(raise con))
((message-condition? con)
(display (condition-message con)))
(else
(display "a warning has been issued")))
42)
(lambda ()
(+ (raise-continuable
(condition
(make-warning)
(make-message-condition
"should be a number")))
23))))
"should be a number65\n")
)
(mat conditions-r6rs ; r6rs examples
(begin
(define-record-type ($co-&cond1 $co-make-cond1 $co-real-cond1?)
(parent &condition)
(fields (immutable x $co-real-cond1-x)))
(define $co-cond1?
(condition-predicate
(record-type-descriptor $co-&cond1)))
(define $co-cond1-x
(condition-accessor
(record-type-descriptor $co-&cond1)
$co-real-cond1-x))
(define $co-foo ($co-make-cond1 'foo))
#t)
(condition? $co-foo)
($co-cond1? $co-foo)
(eq? ($co-cond1-x $co-foo) 'foo)
(begin
(define-record-type ($co-&cond2 $co-make-cond2 $co-real-cond2?)
(parent &condition)
(fields
(immutable y $co-real-cond2-y)))
(define $co-cond2?
(condition-predicate
(record-type-descriptor $co-&cond2)))
(define $co-cond2-y
(condition-accessor
(record-type-descriptor $co-&cond2)
$co-real-cond2-y))
(define $co-bar ($co-make-cond2 'bar))
#t)
(condition? (condition $co-foo $co-bar))
($co-cond1? (condition $co-foo $co-bar))
($co-cond2? (condition $co-foo $co-bar))
($co-cond1? (condition $co-foo))
(list?
(memq
($co-real-cond1? (condition $co-foo))
'(#t #f)))
(not ($co-real-cond1? (condition $co-foo $co-bar)))
(eq? ($co-cond1-x (condition $co-foo $co-bar)) 'foo)
(eq? ($co-cond2-y (condition $co-foo $co-bar)) 'bar)
(equal?
(simple-conditions (condition $co-foo $co-bar))
(list $co-foo $co-bar))
(equal?
(simple-conditions (condition $co-foo (condition $co-bar)))
(list $co-foo $co-bar))
(begin
(define-condition-type $co-&c &condition $co-make-c $co-c? (x $co-c-x))
(define-condition-type $co-&c1 $co-&c $co-make-c1 $co-c1? (a $co-c1-a))
(define-condition-type $co-&c2 $co-&c $co-make-c2 $co-c2? (b $co-c2-b))
(define $co-v1 ($co-make-c1 "V1" "a1"))
#t)
($co-c? $co-v1)
($co-c1? $co-v1)
(not ($co-c2? $co-v1))
(equal? ($co-c-x $co-v1) "V1")
(equal? ($co-c1-a $co-v1) "a1")
(begin
(define $co-v2 ($co-make-c2 "V2" "b2"))
(define $co-v3 (condition ($co-make-c1 "V3/1" "a3") ($co-make-c2 "V3/2" "b3")))
(define $co-v4 (condition $co-v1 $co-v2))
(define $co-v5 (condition $co-v2 $co-v3))
#t)
($co-c? $co-v2)
(not ($co-c1? $co-v2))
($co-c2? $co-v2)
(equal? ($co-c-x $co-v2) "V2")
(equal? ($co-c2-b $co-v2) "b2")
($co-c? $co-v3)
($co-c1? $co-v3)
($co-c2? $co-v3)
(equal? ($co-c-x $co-v3) "V3/1")
(equal? ($co-c1-a $co-v3) "a3")
(equal? ($co-c2-b $co-v3) "b3")
($co-c? $co-v4)
($co-c1? $co-v4)
($co-c2? $co-v4)
(equal? ($co-c-x $co-v4) "V1")
(equal? ($co-c1-a $co-v4) "a1")
(equal? ($co-c2-b $co-v4) "b2")
($co-c? $co-v5)
($co-c1? $co-v5)
($co-c2? $co-v5)
(equal? ($co-c-x $co-v5) "V2")
(equal? ($co-c1-a $co-v5) "a3")
(equal? ($co-c2-b $co-v5) "b2")
)
(mat system-exceptions
(equal?
($capture
; from r6rs
(guard (con
((error? con)
(display "error opening file")
#f))
(call-with-input-file "/probably/not/here" read)))
"error opening file#f\n")
(guard (c [else (and (assertion-violation? c)
(not (implementation-restriction-violation? c)))])
(let ()
(define-record-type foo (fields x))
(foo-x 17)))
)
(mat exception-state
(#%$record? (current-exception-state))
(not (record? (current-exception-state)))
(eq?
(call/cc
(lambda (k)
(parameterize ([current-exception-state
(create-exception-state
(lambda (x)
(if (eq? x 'oops)
(raise 'rats)
(k x))))])
(raise 'oops))))
'rats)
)

1035
mats/fl.ms Normal file

File diff suppressed because it is too large Load diff

3201
mats/foreign.ms Normal file

File diff suppressed because it is too large Load diff

72
mats/foreign1.c Normal file
View file

@ -0,0 +1,72 @@
/* foreign1.c
* Copyright 1984-2017 Cisco Systems, Inc.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing, software
* distributed under the License is distributed on an "AS IS" BASIS,
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
*/
#ifdef _WIN32
# define SCHEME_IMPORT
# include "scheme.h"
# undef EXPORT
# define EXPORT extern __declspec (dllexport)
#else
#include "scheme.h"
#endif
EXPORT int id(int x) {
return x;
}
EXPORT int idid(int x) {
return id(id(x));
}
EXPORT int ididid(int x) {
return idid(id(x));
}
EXPORT unsigned int iduns(unsigned int x) {
return x;
}
EXPORT iptr idiptr(iptr x) {
return x;
}
EXPORT iptr idiptr_addr(void) {
return (iptr)&idiptr;
}
EXPORT double float_id(double x) {
return x;
}
#ifdef _WIN32
#include <stdlib.h>
EXPORT int windows_strcpy(char *dst, char *src) {
return strcpy(dst, src);
}
EXPORT int windows_strcmp(char *dst, char *src) {
return strcmp(dst, src);
}
EXPORT void *windows_malloc(long n) {
return malloc(n);
}
EXPORT void windows_free(void *x) {
free(x);
}
#endif

464
mats/foreign2.c Normal file
View file

@ -0,0 +1,464 @@
/* foreign2.c
* Copyright 1984-2017 Cisco Systems, Inc.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing, software
* distributed under the License is distributed on an "AS IS" BASIS,
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
*/
#include <stdio.h>
#include <wchar.h>
#ifdef _WIN32
# define SCHEME_IMPORT
# include "scheme.h"
# undef EXPORT
# define EXPORT extern __declspec (dllexport)
#else
#include "scheme.h"
#endif
EXPORT int testten(int x0,int x1,int x2,int x3,int x4,int x5,int x6,int x7,int x8,int x9) {
return 1 * x0 +
2 * x1 +
3 * x2 +
5 * x3 +
7 * x4 +
11 * x5 +
13 * x6 +
17 * x7 +
19 * x8 +
23 * x9;
}
EXPORT double flsum8(double x1,double x2,double x3,double x4,double x5,double x6,double x7,double x8) {
return (x1+x2+x3+x4+x5+x6+x7+x8);
}
EXPORT double sparcfltest(int x1,int x2,int x3,int x4,int x5,double x6,int x7,double x8) {
return (x1+x2+x3+x4+x5+x6+x7+x8);
}
EXPORT double mipsfltest1(int x1,int x2,double x3) {
return (x1+x2+x3);
}
EXPORT double mipsfltest2(int x1,double x2,double x3) {
return (x1+x2+x3);
}
EXPORT double ppcfltest(int x1,double x2,int x3,double x4,int x5,double x6,int x7,double x8,double x9,double x10,double x11,double x12,double x13,double x14,double x15,double x16,double x17,double x18,double x19) {
return x1+x2+x3+x4+x5+x6+x7+x8+x9+x10+x11+x12+x13+x14+x15+x16+x17+x18+x19;
}
EXPORT double ppcfltest2(int x1, double x2, int x3, double x4, int x5, long long x5_5, double x6, int x7, double x8, long long x8_5, int x8_75, double x9, double x10, double x11, double x12, double x13, float x14, double x15, int x15_5, double x16, int x16_5, long long x17, double x18, int x18_5, double x19) {
return x1+x2+x3+x4+x5+x6+x7+x8+x9+x10+x11+x12+x13+x14+x15+x16+x17+x18+x19 + x5_5 + x8_5 + x8_75 + x15_5 + x16_5 + x18_5;
}
typedef char i8;
typedef unsigned char u8;
typedef short i16;
typedef unsigned short u16;
typedef int i32;
typedef unsigned int u32;
#ifdef _WIN32
typedef __int64 i64;
typedef unsigned __int64 u64;
typedef __int64 LONGLONG;
typedef unsigned __int64 UNSIGNED_LONGLONG;
#else
typedef long long i64;
typedef unsigned long long u64;
typedef long long LONGLONG;
typedef unsigned long long UNSIGNED_LONGLONG;
#endif
typedef float single_float;
typedef double double_float;
EXPORT int check_types(int Bchar, int Bwchar, int Bshort, int Bint, int Blong, int Blonglong, int Bfloat, int Bdouble, int Bvoid_star) {
int succ = 1;
if (sizeof(i8) != 1) {
fprintf(stderr,"sizeof(i8) [%ld] != 1\n", (long)sizeof(i8));
succ = 0;
}
if (sizeof(u8) != 1) {
fprintf(stderr,"sizeof(u8) [%ld] != 1\n", (long)sizeof(u8));
succ = 0;
}
if (sizeof(i16) != 2) {
fprintf(stderr,"sizeof(i16) [%ld] != 2\n", (long)sizeof(i16));
succ = 0;
}
if (sizeof(u16) != 2) {
fprintf(stderr,"sizeof(u16) [%ld] != 2\n", (long)sizeof(u16));
succ = 0;
}
if (sizeof(i32) != 4) {
fprintf(stderr,"sizeof(i32) [%ld] != 4\n", (long)sizeof(i32));
succ = 0;
}
if (sizeof(u32) != 4) {
fprintf(stderr,"sizeof(u32) [%ld] != 4\n", (long)sizeof(u32));
succ = 0;
}
if (sizeof(i64) != 8) {
fprintf(stderr,"sizeof(i64) [%ld] != 8\n", (long)sizeof(i64));
succ = 0;
}
if (sizeof(u64) != 8) {
fprintf(stderr,"sizeof(u64) [%ld] != 8\n", (long)sizeof(u64));
succ = 0;
}
if (sizeof(single_float) != 4) {
fprintf(stderr,"sizeof(single_float) [%ld] != 4\n", (long)sizeof(single_float));
succ = 0;
}
if (sizeof(double_float) != 8) {
fprintf(stderr,"sizeof(double_float) [%ld] != 8\n", (long)sizeof(double_float));
succ = 0;
}
if (sizeof(char) != Bchar) {
fprintf(stderr,"sizeof(char) [%ld] != %ld\n", (long)sizeof(char), (long)Bchar);
succ = 0;
}
if (sizeof(wchar_t) != Bwchar) {
fprintf(stderr,"sizeof(wchar_t) [%ld] != %ld\n", (long)sizeof(wchar_t), (long)Bwchar);
succ = 0;
}
if (sizeof(short) != Bshort) {
fprintf(stderr,"sizeof(short) [%ld] != %ld\n", (long)sizeof(short), (long)Bshort);
succ = 0;
}
if (sizeof(int) != Bint) {
fprintf(stderr,"sizeof(int) [%ld] != %ld\n", (long)sizeof(int), (long)Bint);
succ = 0;
}
if (sizeof(long) != Blong) {
fprintf(stderr,"sizeof(long) [%ld] != %ld\n", (long)sizeof(long), (long)Blong);
succ = 0;
}
if (sizeof(long long) != Blonglong) {
fprintf(stderr,"sizeof(long long) [%ld] != %ld\n", (long)sizeof(long long), (long)Blong);
succ = 0;
}
if (sizeof(float) != Bfloat) {
fprintf(stderr,"sizeof(float) [%ld] != %ld\n", (long)sizeof(float), (long)Bfloat);
succ = 0;
}
if (sizeof(double) != Bdouble) {
fprintf(stderr,"sizeof(double) [%ld] != %ld\n", (long)sizeof(double), (long)Bdouble);
succ = 0;
}
if (sizeof(void *) != Bvoid_star) {
fprintf(stderr,"sizeof(void *) [%ld] != %ld\n", (long)sizeof(void *), (long)Bvoid_star);
succ = 0;
}
return succ;
}
EXPORT i8 i8_to_i8(i8 x, int k) {
return x + k;
}
EXPORT u8 u8_to_u8(u8 x, int k) {
return x + k;
}
EXPORT i8 call_i8(ptr code, i8 x, int m, int k) {
return (*((i8 (*) (i8))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT u8 call_u8(ptr code, u8 x, int m, int k) {
return (*((u8 (*) (u8))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT i16 i16_to_i16(i16 x, int k) {
return x + k;
}
EXPORT u16 u16_to_u16(u16 x, int k) {
return x + k;
}
EXPORT i16 call_i16(ptr code, i16 x, int m, int k) {
return (*((i16 (*) (i16))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT u16 call_u16(ptr code, u16 x, int m, int k) {
return (*((u16 (*) (u16))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT i32 i32_to_i32(i32 x, int k) {
return x + k;
}
EXPORT u32 u32_to_u32(u32 x, int k) {
return x + k;
}
EXPORT i32 call_i32(ptr code, i32 x, int m, int k) {
return (*((i32 (*) (i32))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT u32 call_u32(ptr code, u32 x, int m, int k) {
return (*((u32 (*) (u32))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT i64 i64_to_i64(u64 x, int k) {
return x + k;
}
EXPORT u64 u64_to_u64(u64 x, int k) {
return x + k;
}
EXPORT i64 call_i64(ptr code, i64 x, int m, int k) {
return (*((i64 (*) (i64))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT u64 call_u64(ptr code, u64 x, int m, int k) {
return (*((u64 (*) (u64))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT single_float sf_to_sf(single_float x) {
return x + 1;
}
EXPORT single_float call_sf(ptr code, single_float x, int m, int k) {
return (*((single_float (*) (single_float))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT double_float df_to_df(double_float x) {
return x + 1;
}
EXPORT double_float call_df(ptr code, double_float x, int m, int k) {
return (*((double_float (*) (double_float))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT u8 *u8_star_to_u8_star(u8 *s) {
return s == (u8 *)0 ? (u8 *)0 : s + 1;
}
EXPORT u8 *call_u8_star(ptr code, u8 *s) {
return (*((u8 *(*) (u8 *))Sforeign_callable_entry_point(code)))(s + 1) + 1;
}
EXPORT u16 *u16_star_to_u16_star(u16 *s) {
return s == (u16 *)0 ? (u16 *)0 : s + 1;
}
EXPORT u16 *call_u16_star(ptr code, u16 *s) {
return (*((u16 *(*) (u16 *))Sforeign_callable_entry_point(code)))(s + 1) + 1;
}
EXPORT u32 *u32_star_to_u32_star(u32 *s) {
return s == (u32 *)0 ? (u32 *)0 : s + 1;
}
EXPORT u32 *call_u32_star(ptr code, u32 *s) {
return (*((u32 *(*) (u32 *))Sforeign_callable_entry_point(code)))(s + 1) + 1;
}
EXPORT char *char_star_to_char_star(char *s) {
return s == (char *)0 ? (char *)0 : s + 1;
}
EXPORT char *call_string(ptr code, char *s) {
return (*((char *(*) (char *))Sforeign_callable_entry_point(code)))(s + 1) + 1;
}
EXPORT wchar_t *wchar_star_to_wchar_star(wchar_t *s) {
return s == (wchar_t *)0 ? (wchar_t *)0 : s + 1;
}
EXPORT wchar_t *call_wstring(ptr code, wchar_t *s) {
return (*((wchar_t *(*) (wchar_t *))Sforeign_callable_entry_point(code)))(s + 1) + 1;
}
EXPORT char char_to_char(char x) {
return x - 0x20;
}
EXPORT char call_char(ptr code, char x, int m, int k) {
return (*((char (*) (char))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT wchar_t wchar_to_wchar(wchar_t x) {
return x - 0x20;
}
EXPORT wchar_t call_wchar(ptr code, wchar_t x, int m, int k) {
return (*((wchar_t (*) (wchar_t))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT short short_to_short(short x, int k) {
return x + k;
}
EXPORT unsigned short unsigned_short_to_unsigned_short(unsigned short x, int k) {
return x + k;
}
EXPORT short call_short(ptr code, short x, int m, int k) {
return (*((short (*) (short))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT unsigned short call_unsigned_short(ptr code, unsigned short x, int m, int k) {
return (*((unsigned short (*) (unsigned short))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT int int_to_int(int x, int k) {
return x + k;
}
EXPORT unsigned unsigned_to_unsigned(int x, int k) {
return x + k;
}
EXPORT int call_int(ptr code, int x, int m, int k) {
return (*((int (*) (int))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT unsigned call_unsigned(ptr code, unsigned x, int m, int k) {
return (*((unsigned (*) (unsigned))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT long long_to_long(long x, int k) {
return x + k;
}
EXPORT unsigned long unsigned_long_to_unsigned_long(unsigned long x, int k) {
return x + k;
}
EXPORT long call_long(ptr code, long x, int m, int k) {
return (*((long (*) (long))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT unsigned long call_unsigned_long(ptr code, unsigned long x, int m, int k) {
return (*((unsigned long (*) (unsigned long))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT LONGLONG long_long_to_long_long(LONGLONG x, int k) {
return x + k;
}
EXPORT UNSIGNED_LONGLONG unsigned_long_long_to_unsigned_long_long(UNSIGNED_LONGLONG x, int k) {
return x + k;
}
EXPORT LONGLONG call_long_long(ptr code, LONGLONG x, int m, int k) {
return (*((LONGLONG (*) (LONGLONG))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT UNSIGNED_LONGLONG call_unsigned_long_long(ptr code, UNSIGNED_LONGLONG x, int m, int k) {
return (*((UNSIGNED_LONGLONG (*) (UNSIGNED_LONGLONG))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT iptr iptr_to_iptr(iptr x, int k) {
return x + k;
}
EXPORT iptr uptr_to_uptr(uptr x, int k) {
return x + k;
}
EXPORT iptr call_iptr(ptr code, iptr x, int m, int k) {
return (*((iptr (*) (iptr))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT iptr call_uptr(ptr code, uptr x, int m, int k) {
return (*((uptr (*) (uptr))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT float float_to_float(float x) {
return x + 1;
}
EXPORT float call_float(ptr code, float x, int m, int k) {
return (*((float (*) (float))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT double double_to_double(double x) {
return x + 1;
}
EXPORT double call_double(ptr code, double x, int m, int k) {
return (*((double (*) (double))Sforeign_callable_entry_point(code)))(x + m) + k;
}
EXPORT u64 u32xu32_to_u64(u32 x, u32 y) {
return (u64)x << 32 | (u64)y;
}
EXPORT i64 i32xu32_to_i64(i32 x, u32 y) {
return (i64)((u64)x << 32 | (u64)y);
}
EXPORT i64 call_i32xu32_to_i64(ptr code, i32 x, u32 y, int k) {
i64 q = (*((i64 (*) (i32, u32))Sforeign_callable_entry_point(code)))(x, y);
return q + k;
}
EXPORT u64 ufoo64a(u64 a, u64 b, u64 c, u64 d, u64 e, u64 f, u64 g) {
return (a - b) + (c - d) + (e - f) + g;
}
EXPORT u64 ufoo64b(u32 x, u64 a, u64 b, u64 c, u64 d, u64 e, u64 f, u64 g) {
return (u64)x + (a - b) + (c - d) + (e - f) + g;
}
EXPORT i64 ifoo64a(i64 a, i64 b, i64 c, i64 d, i64 e, i64 f, i64 g) {
return (a - b) + (c - d) + (e - f) + g;
}
EXPORT i64 ifoo64b(i32 x, i64 a, i64 b, i64 c, i64 d, i64 e, i64 f, i64 g) {
return (i64)x + (a - b) + (c - d) + (e - f) + g;
}
EXPORT void call_many_times(void (*f)(iptr))
{
int x;
iptr a = 1, b = 3, c = 5, d = 7;
iptr e = 1, g = 3, h = 5, i = 7;
iptr j = 1, k = 3, l = 5, m = 7;
iptr big = (((iptr)1) << ((8 * sizeof(iptr)) - 2));
/* The intent of the loop is to convince the C compiler to store
something in the same register used for CP (so, compile with
optimization). */
for (x = 0; x < 1000000; x++) {
f(big|(a+e+j));
a = b; b = c; c = d; d = e;
e = g; g = h; h = i; i = j;
j = k+2; k = l+2; l = m+2; m = m+2;
}
}
EXPORT void call_many_times_bv(void (*f)(char *s))
{
/* make this sensible as u8*, u16*, and u32* */
char buf[8] = { 1, 2, 3, 4, 0, 0, 0, 0 };
int x;
for (x = 0; x < 1000000; x++) {
buf[0] = (x & 63) + 1;
f(buf);
}
}
typedef void (*many_arg_callback_t)(int i, const char* s1, const char* s2, const char* s3,
const char* s4, int i2, const char* s6, const char* s7, int i3);
EXPORT void call_with_many_args(many_arg_callback_t callback)
{
callback(0, "this", "is", "working", "just", 1, "fine", "or does it?", 2);
}

281
mats/foreign3.c Normal file
View file

@ -0,0 +1,281 @@
/* foreign3.c
* Copyright 1984-2017 Cisco Systems, Inc.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing, software
* distributed under the License is distributed on an "AS IS" BASIS,
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
*/
#include <stdio.h>
#include <stdlib.h>
#ifndef WIN32
#include <string.h>
#endif
#ifdef _WIN32
# define SCHEME_IMPORT
# include "scheme.h"
# undef EXPORT
# define EXPORT extern __declspec (dllexport)
#else
#include "scheme.h"
#endif
EXPORT int chk_data(void) {
static char c[10]="ABCDEFGH";
return('A' == c[0] && 'B' == c[1] && 'C' == c[2] && 'D' == c[3] &&
'E' == c[4] && 'F' == c[5] && 'G' == c[6] && 'H' == c[7]);
}
EXPORT int chk_bss(void) {
static int j[2000];
int i;
for (i=0; i<2000; i++) if (j[i] != 0) break;
return i == 2000;
}
EXPORT int chk_malloc(void) {
int *j, i;
j = (int *)malloc(2000 * sizeof(int));
for (i=0; i<2000; i++) j[i] = 0;
for (i=0; i<2000; i++) if (j[i] != 0) break;
free(j);
return i == 2000;
}
EXPORT float sxstos(float x, float y) {
return x * y;
}
EXPORT float singlesum12(float x1, float x2, float x3, float x4,
float x5, float x6, float x7, float x8,
float x9, float x10, float x11, float x12) {
return x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10 + x11 + x12;
}
/* these are taken from SYSTEM V Application Binary Interface
* MIPS Processor Supplement, 1991
* page 3-21
*/
EXPORT double d1d2(double d1, double d2) {
return d1 + d2;
}
EXPORT double s1s2(float s1, float s2) {
return s1 + s2;
}
EXPORT double s1d1(float s1, double d1) {
return s1 + d1;
}
EXPORT double d1s1(double d1, float s1) {
return d1 + s1;
}
EXPORT double n1n2n3n4(int n1, int n2, int n3, int n4) {
return (double)(n1 + n2 + n3 + n4);
}
EXPORT double d1n1d2(double d1, int n1, double d2) {
return d1 + n1 + d2;
}
EXPORT double d1n1n2(double d1, int n1, int n2) {
return d1 + n1 + n2;
}
EXPORT double s1n1n2(float s1, int n1, int n2) {
return s1 + n1 + n2;
}
EXPORT double n1n2n3d1(int n1, int n2, int n3, double d1) {
return n1 + n2 + n3 + d1;
}
EXPORT double n1n2n3s1(int n1, int n2, int n3, float s1) {
return n1 + n2 + n3 + s1;
}
EXPORT double n1n2d1(int n1, int n2, double d1) {
return n1 + n2 + d1;
}
EXPORT double n1d1(int n1, double d1) {
return n1 + d1;
}
EXPORT double s1s2s3s4(float s1, float s2, float s3, float s4) {
return s1 + s2 + s3 + s4;
}
EXPORT double s1n1s2n2(float s1, int n1, float s2, int n2) {
return s1 + n1 + s2 + n2;
}
EXPORT double d1s1s2(double d1, float s1, float s2) {
return d1 + s1 + s2;
}
EXPORT double s1s2d1(float s1, float s2, double d1) {
return s1 + s2 + d1;
}
EXPORT double n1s1n2s2(int n1, float s1, int n2, float s2) {
return n1 + s1 + n2 + s2;
}
EXPORT double n1s1n2n3(int n1, float s1, int n2, int n3) {
return n1 + s1 + n2 + n3;
}
EXPORT double n1n2s1n3(int n1, int n2, float s1, int n3) {
return n1 + n2 + s1 + n3;
}
/* a few more for good measure */
EXPORT double d1d2s1s2(double d1, double d2, float s1, float s2) {
return d1 + d2 + s1 + s2;
}
EXPORT double d1d2n1n2(double d1, double d2, int n1, int n2) {
return d1 + d2 + n1 + n2;
}
EXPORT double s1d1s2s3(float s1, double d1, float s2, float s3) {
return s1 + d1 + s2 + s3;
}
/* support for testing foreign-callable */
EXPORT ptr Sinvoke2(ptr code, ptr x1, iptr x2) {
return (*((ptr (*)(ptr, iptr))Sforeign_callable_entry_point(code)))(x1, x2);
}
EXPORT ptr Sargtest(iptr f, int x1, int x2, iptr x3, double x4, float x5, char *x6) {
return (*((ptr (*)(int, int, iptr, double, float, char *))f))(x1, x2, x3, x4, x5, x6);
}
EXPORT ptr Sargtest2(iptr f, short x1, int x2, char x3, double x4, short x5, char x6) {
return (*((ptr (*)(short, int, char, double, short, char))f))(x1, x2, x3, x4, x5, x6);
}
EXPORT int Srvtest_int32(ptr code, ptr x1) {
return (*((int (*)(ptr))Sforeign_callable_entry_point(code)))(x1);
}
EXPORT unsigned Srvtest_uns32(ptr code, ptr x1) {
return (*((unsigned (*)(ptr))Sforeign_callable_entry_point(code)))(x1);
}
EXPORT float Srvtest_single(ptr code, ptr x1) {
return (*((float (*)(ptr))Sforeign_callable_entry_point(code)))(x1);
}
EXPORT double Srvtest_double(ptr code, ptr x1) {
return (*((double (*)(ptr))Sforeign_callable_entry_point(code)))(x1);
}
EXPORT char Srvtest_char(ptr code, ptr x1) {
return (*((char (*)(ptr))Sforeign_callable_entry_point(code)))(x1);
}
#ifdef WIN32
EXPORT int __stdcall sum_stdcall(int a, int b) {
return a + b;
}
EXPORT ptr Sinvoke2_stdcall(ptr code, ptr x1, iptr x2) {
return (*((ptr (__stdcall *)(ptr, iptr))Sforeign_callable_entry_point(code)))(x1, x2);
}
typedef int (__stdcall *comfunc) (void *, int);
typedef struct { comfunc *vtable; int data; } com_instance_t;
static comfunc com_vtable[2];
static com_instance_t com_instance;
extern int __stdcall com_method0(void *inst, int val) {
return ((com_instance_t *)inst)->data = val;
}
extern int __stdcall com_method1(void *inst, int val) {
return val * 2 + ((com_instance_t *)inst)->data;
}
EXPORT com_instance_t *get_com_instance(void) {
com_instance.vtable = com_vtable;
com_vtable[0] = com_method0;
com_vtable[1] = com_method1;
com_instance.data = -31;
return &com_instance;
}
#endif /* WIN32 */
/* foreign_callable example adapted from foreign.stex */
typedef void (*CB)(char);
static CB callbacks[256];
EXPORT void cb_init(void) {
int i;
for (i = 0; i < 256; i += 1)
callbacks[i] = (CB)0;
}
EXPORT void register_callback(char c, iptr cb) {
callbacks[(int)c] = (CB)cb;
}
EXPORT void event_loop(char *s) {
char buf[10];
CB f; char c;
/* create a local copy, since s points into an unlocked Scheme string */
strncpy(buf, s, 9);
buf[9] = '0';
s = buf;
for (;;) {
c = *s++;
if (c == 0) break;
f = callbacks[(int)c];
if (f != (CB)0) f(c);
}
}
EXPORT void call_twice(void (*foo)(int), int x, int y) {
foo(x);
foo(y);
}
EXPORT void unlock_callback(int (* f)(int)) {
Sunlock_object(Sforeign_callable_code_object(f));
}
EXPORT int call_and_unlock(int (* f)(int), int arg) {
int ans = f(arg);
Sunlock_object(Sforeign_callable_code_object(f));
return ans;
}
EXPORT void init_lock (uptr *u) {
INITLOCK(u);
}
EXPORT void spinlock (uptr *u) {
SPINLOCK(u);
}
EXPORT void unlock (uptr *u) {
UNLOCK(u);
}
EXPORT int locked_incr (uptr *u) {
int ret;
LOCKED_INCR(u, ret);
return ret;
}
EXPORT int locked_decr (uptr *u) {
int ret;
LOCKED_DECR(u, ret);
return ret;
}

397
mats/foreign4.c Normal file
View file

@ -0,0 +1,397 @@
/* foreign4.c
* Copyright 1984-2017 Cisco Systems, Inc.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing, software
* distributed under the License is distributed on an "AS IS" BASIS,
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
*/
#include <stdio.h>
#include <stdlib.h>
#if defined(_REENTRANT) || defined(_WIN32)
# ifdef _WIN32
# include <Windows.h>
# define SCHEME_IMPORT
# include "scheme.h"
# else
# include <pthread.h>
# include "scheme.h"
# endif
# undef EXPORT
#endif
typedef signed char i8;
typedef unsigned char u8;
typedef unsigned short u16;
#ifdef _WIN32
typedef __int64 i64;
# define EXPORT extern __declspec (dllexport)
#else
typedef long long i64;
# define EXPORT
#endif
/* To help make sure that argument and result handling doesn't
read or write too far, try to provide functions that allocate
a structure at the end of a memory page (where the next page is
likely to be unmapped) */
#if defined(__linux__) || (defined(__APPLE__) && defined(__MACH__))
# include <stdlib.h>
# include <sys/mman.h>
# include <unistd.h>
# include <inttypes.h>
EXPORT void *malloc_at_boundary(int sz)
{
intptr_t alloc_size = getpagesize();
char *p;
p = mmap(NULL, 2 * alloc_size, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE, -1, 0);
mprotect(p + alloc_size, alloc_size, PROT_NONE);
return p + alloc_size - sz;
}
EXPORT void free_at_boundary(void *p)
{
intptr_t alloc_size = getpagesize();
munmap((void *)(((intptr_t)p) & ~(alloc_size-1)), 2 * alloc_size);
}
#elif defined(_WIN32)
EXPORT void *malloc_at_boundary(int sz)
{
SYSTEM_INFO si;
char *p;
DWORD dummy;
GetSystemInfo(&si);
p = VirtualAlloc(NULL, 2 * si.dwPageSize, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE);
VirtualProtect(p + si.dwPageSize, si.dwPageSize, PAGE_NOACCESS, &dummy);
return p + si.dwPageSize - sz;
}
EXPORT void free_at_boundary(void *p)
{
SYSTEM_INFO si;
GetSystemInfo(&si);
VirtualFree((void *)(((intptr_t)p) & ~(si.dwPageSize-1)), 0, MEM_RELEASE);
}
#else
EXPORT void *malloc_at_boundary(int sz)
{
return malloc(sz);
}
EXPORT void free_at_boundary(void *p)
{
free(p);
}
#endif
#if defined(_REENTRANT) || defined(_WIN32)
typedef struct in_thread_args_t {
double (*proc)(double arg);
double arg;
int n_times;
} in_thread_args_t;
void *in_thread(void *_proc_and_arg)
{
in_thread_args_t *proc_and_arg = _proc_and_arg;
int i;
for (i = 0; i < proc_and_arg->n_times; i++) {
proc_and_arg->arg = proc_and_arg->proc(proc_and_arg->arg);
}
return NULL;
}
#if defined(_WIN32)
# define os_thread_t unsigned
# define os_thread_create(addr, proc, arg) (((*(addr)) = _beginthread(proc, 0, arg)) == -1)
# define os_thread_join(t) WaitForSingleObject((HANDLE)(intptr_t)(t), INFINITE)
#else
# define os_thread_t pthread_t
# define os_thread_create(addr, proc, arg) pthread_create(addr, NULL, in_thread, proc_and_arg)
# define os_thread_join(t) pthread_join(t, NULL)
#endif
#ifdef FEATURE_PTHREADS
EXPORT double call_in_unknown_thread(double (*proc)(double arg), double arg, int n_times,
int do_fork, int do_deactivate) {
os_thread_t t;
in_thread_args_t *proc_and_arg = malloc(sizeof(in_thread_args_t));
proc_and_arg->proc = proc;
proc_and_arg->arg = arg;
proc_and_arg->n_times = n_times;
if (do_fork) {
if (do_deactivate) Sdeactivate_thread();
if (!os_thread_create(&t, in_thread, proc_and_arg)) {
os_thread_join(t);
}
if (do_deactivate) Sactivate_thread();
} else {
in_thread(proc_and_arg);
}
arg = proc_and_arg->arg;
free(proc_and_arg);
return arg;
}
#endif /* FEATURE_PTHREADS */
#endif
EXPORT unsigned spin_a_while(int amt, unsigned a, unsigned b)
{
int i;
/* A loop that the compiler is unlikely to optimize away */
for (i = 0; i < amt; i++) {
a = a + b;
b = b + a;
}
return a;
}
#define GEN(ts, init, sum) \
EXPORT ts f4_get_ ## ts () { \
ts r = init; \
return r; \
} \
EXPORT double f4_sum_ ## ts (ts v) { \
return sum(v); \
} \
EXPORT double f4_sum_two_ ## ts (ts v1, ts v2) { \
return sum(v1) + sum(v2); \
} \
EXPORT double f4_sum_pre_double_ ## ts (double v0, ts v) { \
return v0 + sum(v); \
} \
EXPORT double f4_sum_pre_double_double_ ## ts (double v0, double v1, ts v) { \
return v0 + v1 + sum(v); \
} \
EXPORT double f4_sum_pre_double_double_double_double_ ## ts (double v0, double v1, double v2, double v3, ts v) { \
return v0 + v1 + v2 + v3 + sum(v); \
} \
EXPORT double f4_sum_pre_double_double_double_double_double_double_double_double_ ## ts \
(double v0, double v1, double v2, double v3, double v4, double v5, double v6, double v7, ts v) { \
return v0 + v1 + v2 + v3 + v4 + v5 + v6 + v7 + sum(v); \
} \
EXPORT double f4_sum_ ## ts ## _post_double (ts v, double v0) { \
return v0 + sum(v); \
} \
EXPORT double f4_sum_pre_int_ ## ts (int v0, ts v) { \
return (double)v0 + sum(v); \
} \
EXPORT double f4_sum_pre_int_int_ ## ts (int v0, int v1, ts v) { \
return (double)v0 + (double)v1 + sum(v); \
} \
EXPORT double f4_sum_pre_int_int_int_int_ ## ts (int v0, int v1, int v2, int v3, ts v) { \
return (double)v0 + (double)v1 + (double)v2 + (double)v3 + sum(v); \
} \
EXPORT double f4_sum_pre_int_int_int_int_int_int_ ## ts (int v0, int v1, int v2, int v3, int v4, int v5, ts v) { \
return (double)v0 + (double)v1 + (double)v2 + (double)v3 + (double)v4 + (double)v5 + sum(v); \
} \
EXPORT double f4_sum_ ## ts ## _post_int (ts v, int v0) { \
return (double)v0 + sum(v); \
} \
EXPORT double f4_cb_send_ ## ts (double (*cb)(ts)) { \
ts r = init; \
return cb(r) + 1.0; \
} \
EXPORT double f4_cb_send_two_ ## ts (double (*cb)(ts, ts)) { \
ts r1 = init; \
ts r2 = init; \
return cb(r1, r2) + 1.0; \
} \
EXPORT double f4_cb_send_pre_int_ ## ts (double (*cb)(int, ts)) { \
ts r = init; \
return cb(8, r) + 1.0; \
} \
EXPORT double f4_cb_send_pre_int_int_ ## ts (double (*cb)(int, int, ts)) { \
ts r = init; \
return cb(8, 9, r) + 1.0; \
} \
EXPORT double f4_cb_send_pre_int_int_int_int_ ## ts (double (*cb)(int, int, int, int, ts)) { \
ts r = init; \
return cb(8, 9, 10, 11, r) + 1.0; \
} \
EXPORT double f4_cb_send_pre_int_int_int_int_int_int_ ## ts (double (*cb)(int, int, int, int, int, int, ts)) { \
ts r = init; \
return cb(8, 9, 10, 11, 12, 13, r) + 1.0; \
} \
EXPORT double f4_cb_send_pre_double_ ## ts (double (*cb)(double, ts)) { \
ts r = init; \
return cb(8.25, r) + 1.0; \
} \
EXPORT double f4_cb_send_pre_double_double_ ## ts (double (*cb)(double, double, ts)) { \
ts r = init; \
return cb(8.25, 9.25, r) + 1.0; \
} \
EXPORT double f4_cb_send_pre_double_double_double_double_ ## ts (double (*cb)(double, double, double, double, ts)) { \
ts r = init; \
return cb(8.25, 9.25, 10.25, 11.25, r) + 1.0; \
} \
EXPORT double f4_cb_send_pre_double_double_double_double_double_double_double_double_ ## ts \
(double (*cb)(double, double, double, double, double, double, double, double, ts)) { \
ts r = init; \
return cb(8.25, 9.25, 10.25, 11.25, 12.25, 13.25, 14.25, 15.25, r) + 1.0; \
} \
EXPORT double f4_sum_cb_ ## ts (ts (*cb)()) { \
ts v = cb(); \
return sum(v); \
}
#define TO_DOUBLE(x) ((double)(x))
GEN(i8, -11, TO_DOUBLE)
GEN(u8, 129, TO_DOUBLE)
GEN(short, -22, TO_DOUBLE)
GEN(u16, 33022, TO_DOUBLE)
GEN(long, 33, TO_DOUBLE)
GEN(int, 44, TO_DOUBLE)
GEN(i64, 49, TO_DOUBLE)
GEN(float, 55.0, TO_DOUBLE)
GEN(double, 66.0, TO_DOUBLE)
/* Some ABIs treat a struct containing a single field different that
just the field */
#define GEN_1(t1, v1) \
typedef struct struct_ ## t1 { t1 x; } struct_ ## t1; \
static double _f4_sum_struct_ ## t1 (struct_ ## t1 v) { \
return (double)v.x; \
} \
static struct_ ## t1 init_struct_ ## t1 = { v1 }; \
GEN(struct_ ## t1, init_struct_ ## t1, _f4_sum_struct_ ## t1)
GEN_1(i8, -12)
GEN_1(u8, 212)
GEN_1(short, -23)
GEN_1(u16, 33023)
GEN_1(long, 34)
GEN_1(int, 45)
GEN_1(i64, 48)
GEN_1(float, 56.0)
GEN_1(double, 67.0)
#define GEN_2(t1, t2, v1, v2) \
typedef struct struct_ ## t1 ## _ ## t2 { t1 x; t2 y; } struct_ ## t1 ## _ ## t2; \
static double _f4_sum_struct_ ## t1 ## _ ## t2 (struct_ ## t1 ## _ ## t2 v) { \
return (double)v.x + (double)v.y; \
} \
static struct_ ## t1 ## _ ## t2 init_struct_ ## t1 ## _ ## t2 = { v1, v2 }; \
GEN(struct_ ## t1 ## _ ## t2, init_struct_ ## t1 ## _ ## t2, _f4_sum_struct_ ## t1 ## _ ## t2)
#define GEN_2_SET(t, x) \
GEN_2(t, i8, 1+x, 10) \
GEN_2(t, short, 2+x, 20) \
GEN_2(t, long, 3+x, 30) \
GEN_2(t, i64, 5+x, 50) \
GEN_2(short, t, 6, 60+x) \
GEN_2(long, t, 7, 70+x) \
GEN_2(i64, t, 9, 90+x) \
GEN_2(i8, t, 10, 100+x)
GEN_2_SET(int, 0)
GEN_2_SET(float, 0.5)
GEN_2_SET(double, 0.25)
GEN_2(int, int, 4, 40)
GEN_2(float, float, 4.5, 40.5)
GEN_2(double, double, 4.25, 40.25)
#define GEN_3(t1, t2, t3, v1, v2, v3) \
typedef struct struct_ ## t1 ## _ ## t2 ## _ ## t3 { t1 x; t2 y; t3 z; } struct_ ## t1 ## _ ## t2 ## _ ## t3; \
static double _f4_sum_struct_ ## t1 ## _ ## t2 ## _ ## t3 (struct_ ## t1 ## _ ## t2 ## _ ## t3 v) { \
return (double)v.x + (double)v.y + (double)v.z; \
} \
static struct_ ## t1 ## _ ## t2 ## _ ## t3 init_struct_ ## t1 ## _ ## t2 ## _ ## t3 = { v1, v2, v3 }; \
GEN(struct_ ## t1 ## _ ## t2 ## _ ## t3, init_struct_ ## t1 ## _ ## t2 ## _ ## t3, _f4_sum_struct_ ## t1 ## _ ## t2 ## _ ## t3)
#define GEN_3_SET(t, x) \
GEN_3(t, i8, int, 1+x, 10, 100) \
GEN_3(t, short, int, 2+x, 20, 200) \
GEN_3(t, long, int, 3+x, 30, 300) \
GEN_3(t, i64, int, 5+x, 50, 500) \
GEN_3(short, t, int, 6, 60+x, 600) \
GEN_3(long, t, int, 7, 70+x, 700) \
GEN_3(i64, t, int, 9, 90+x, 900) \
GEN_3(i8, t, int, 10, 100+x, 1000)
GEN_3_SET(int, 0)
GEN_3_SET(float, 0.5)
GEN_3_SET(double, 0.25)
GEN_3(i8, i8, i8, 4, 38, 127)
GEN_3(short, short, short, 4, 39, 399)
GEN_3(int, int, int, 4, 40, 400)
GEN_3(float, float, float, 4.5, 40.5, 400.5)
GEN_3(double, double, double, 4.25, 40.25, 400.25)
typedef struct struct_i8_i8_i8_i8_i8 { i8 x, y, z, w, q; } struct_i8_i8_i8_i8_i8;
static double _f4_sum_struct_i8_i8_i8_i8_i8 (struct_i8_i8_i8_i8_i8 v) {
return (double)v.x + (double)v.y + (double)v.z + (double)v.w + (double)v.q;
}
static struct struct_i8_i8_i8_i8_i8 init_struct_i8_i8_i8_i8_i8 = { 1, 2, 3, 4, 5 };
GEN(struct_i8_i8_i8_i8_i8, init_struct_i8_i8_i8_i8_i8, _f4_sum_struct_i8_i8_i8_i8_i8)
typedef struct struct_i8_i8_i8_i8_i8_i8_i8 { i8 x, y, z, w, q, r, s; } struct_i8_i8_i8_i8_i8_i8_i8;
static double _f4_sum_struct_i8_i8_i8_i8_i8_i8_i8 (struct struct_i8_i8_i8_i8_i8_i8_i8 v) {
return (double)v.x + (double)v.y + (double)v.z + (double)v.w + (double)v.q + (double)v.r + (double)v.s;
}
static struct struct_i8_i8_i8_i8_i8_i8_i8 init_struct_i8_i8_i8_i8_i8_i8_i8 = { 1, 2, 3, 4, 5, 6, 7 };
GEN(struct_i8_i8_i8_i8_i8_i8_i8, init_struct_i8_i8_i8_i8_i8_i8_i8, _f4_sum_struct_i8_i8_i8_i8_i8_i8_i8)
/* Some ABIs treat a union containing a single field different that
just the field */
#define GEN_U1(t1, v1) \
typedef union union_ ## t1 { t1 x; } union_ ## t1; \
static double _f4_sum_union_ ## t1 (union_ ## t1 v) { \
return (double)v.x; \
} \
static union_ ## t1 init_union_ ## t1 = { v1 }; \
GEN(union_ ## t1, init_union_ ## t1, _f4_sum_union_ ## t1)
GEN_U1(i8, -17)
GEN_U1(u8, 217)
GEN_U1(short, -27)
GEN_U1(u16, 33027)
GEN_U1(long, 37)
GEN_U1(int, 47)
GEN_U1(i64, 49)
GEN_U1(float, 57.0)
GEN_U1(double, 77.0)
#define GEN_U2(t1, t2, v1) \
typedef union union_ ## t1 ## _ ## t2 { t1 x; t2 y; } union_ ## t1 ## _ ## t2; \
static double _f4_sum_union_ ## t1 ## _ ## t2 (union_ ## t1 ## _ ## t2 v) { \
return (double)v.x; \
} \
static union_ ## t1 ## _ ## t2 init_union_ ## t1 ## _ ## t2 = { v1 }; \
GEN(union_ ## t1 ## _ ## t2, init_union_ ## t1 ## _ ## t2, _f4_sum_union_ ## t1 ## _ ## t2)
GEN_U2(i8, int, 18)
GEN_U2(short, int, 28)
GEN_U2(long, int, 38)
GEN_U2(int, int, 48)
GEN_U2(i64, int, 43)
GEN_U2(float, int, 58.0)
GEN_U2(double, int, 68.0)

1726
mats/format.ms Normal file

File diff suppressed because it is too large Load diff

4
mats/freq.in Normal file
View file

@ -0,0 +1,4 @@
Peter Piper picked a peck of pickled peppers;
A peck of pickled peppers Peter Piper picked.
If Peter Piper picked a peck of pickled peppers,
Where's the peck of pickled peppers Peter Piper picked?

13
mats/freq.out Normal file
View file

@ -0,0 +1,13 @@
1 A
1 If
4 Peter
4 Piper
1 Where
2 a
4 of
4 peck
4 peppers
4 picked
4 pickled
1 s
1 the

38
mats/ftype.h Normal file
View file

@ -0,0 +1,38 @@
/* ftype.h
* Copyright 1984-2017 Cisco Systems, Inc.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing, software
* distributed under the License is distributed on an "AS IS" BASIS,
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
*/
#ifdef SPARC
typedef signed char int8_t;
typedef unsigned char uint8_t;
typedef signed short int16_t;
typedef unsigned short uint16_t;
typedef signed int int32_t;
typedef unsigned int uint32_t;
typedef signed long long int64_t;
typedef unsigned long long uint64_t;
#else
#include <stdint.h>
#endif
#ifdef WIN32
#define EXPORT extern __declspec (dllexport)
#else
#define EXPORT extern
#endif

5877
mats/ftype.ms Normal file

File diff suppressed because it is too large Load diff

2906
mats/fx.ms Normal file

File diff suppressed because it is too large Load diff

3892
mats/hash.ms Normal file

File diff suppressed because it is too large Load diff

149
mats/ht.ss Normal file
View file

@ -0,0 +1,149 @@
#! ../bin/scheme --script
;;; ht.ss
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
#;(optimize-level 3)
(collect-request-handler void)
(module M (eqht symht gen-set eq-set sym-set gen-ref eq-ref
sym-ref print-htstats)
(define (eqht) (make-eq-hashtable))
(define (symht) (make-hashtable symbol-hash eq?))
(define refsym* (oblist))
(define setsym*
(fold-left
(lambda (ls x i) (if (fx< (modulo i 10) 1) ls (cons x ls)))
'()
refsym*
(enumerate refsym*)))
(define gen-set
(lambda (ht n)
(do ([n n (fx- n 1)])
((fx= n 0) ht)
(for-each
(lambda (x) (hashtable-set! ht x (list n)))
setsym*))))
(define eq-set
(lambda (ht n)
(do ([n n (fx- n 1)])
((fx= n 0) ht)
(for-each
(lambda (x) (eq-hashtable-set! ht x (list n)))
setsym*))))
(define sym-set
(lambda (ht n)
(do ([n n (fx- n 1)])
((fx= n 0) ht)
(for-each
(lambda (x) (symbol-hashtable-set! ht x (list n)))
setsym*))))
(define maybe-car (lambda (x) (and x (car x))))
(define gen-ref
(lambda (ht n)
(let f ([n n] [x #f])
(if (fx= n 0)
x
(do ([sym* refsym* (cdr sym*)]
[x x (maybe-car (hashtable-ref ht (car sym*) #f))])
((null? sym*) (f (fx- n 1) x)))))))
(define eq-ref
(lambda (ht n)
(let f ([n n] [x #f])
(if (fx= n 0)
x
(do ([sym* refsym* (cdr sym*)]
[x x (maybe-car (eq-hashtable-ref ht (car sym*) #f))])
((null? sym*) (f (fx- n 1) x)))))))
(define sym-ref
(lambda (ht n)
(let f ([n n] [x #f])
(if (fx= n 0)
x
(do ([sym* refsym* (cdr sym*)]
[x x (maybe-car (symbol-hashtable-ref ht (car sym*) #f))])
((null? sym*) (f (fx- n 1) x)))))))
(define print-htstats
(let ()
(include "hashtable-types.ss")
(lambda (ht)
(let ([ls** (map (if (eq-ht? ht)
(lambda (b)
(do ([b b (#%$tlc-next b)]
[ls '() (cons
(car (#%$tlc-keyval b))
ls)])
((fixnum? b) ls)))
(lambda (ls) (map car ls)))
(vector->list (ht-vec ht)))])
(let* ([n* (map length ls**)] [len (length n*)])
(printf "min = ~d, max = ~d, avg = ~,2f, med = ~d, stddev = ~,2f\n"
(apply min n*) (apply max n*) (/ (apply + n*) len)
(list-ref (sort < n*) (quotient len 2))
(let* ([mu (/ (apply + n*) len)])
(sqrt
(/ (apply + (map (lambda (n) (expt (- n mu) 2)) n*))
len))))
(printf
"a max-size bucket: ~s\n"
(let ([n (apply max n*)])
(cdr (find
(lambda (n.ls) (= (car n.ls) n))
(map cons n* ls**)))))))))))
(collect 0 1)
(let ()
(import M)
(define millis
(lambda (t)
(+ (* (time-second t) 1000)
(round (/ (time-nanosecond t) 1000000)))))
(define runs 10)
(define iterations 1000)
(define-syntax run
(syntax-rules ()
[(_ ?set ?ref ?make-ht)
(let ([set ?set] [ref ?ref] [make-ht ?make-ht])
(let loop ([runs runs] [st 0] [rt 0])
(if (fx= runs 0)
(begin
(printf "(time (~s ~s ~d) ~d)\n" '?set '?make-ht
iterations st)
(printf "(time (~s ~s ~d) ~d)\n" '?ref '?make-ht
iterations rt))
(let ([ht (make-ht)])
(let* ([st (begin
(collect 0 1)
(let ([t (current-time 'time-process)])
(set ht iterations)
(let ([t (time-difference
(current-time 'time-process)
t)])
(+ st (millis t)))))]
[rt (begin
(collect 0 1)
(let ([t (current-time 'time-process)])
(ref ht iterations)
(let ([t (time-difference
(current-time 'time-process)
t)])
(+ rt (millis t)))))])
(when (= runs 1) (print-htstats ht))
(loop (fx- runs 1) st rt))))))]))
(run gen-set gen-ref eqht)
(run gen-set gen-ref symht)
(run eq-set eq-ref eqht)
(run sym-set sym-ref symht))

774
mats/ieee.ms Normal file
View file

@ -0,0 +1,774 @@
;;; 5_3.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(define <<
(case-lambda
[(x y)
(and (flonum? x)
(flonum? y)
(if (and (fl= x 0.0) (fl= y 0.0))
(fl< (fl/ 1.0 x) (fl/ 1.0 y))
(fl< x y)))]
[(x y z)
(and (<< x y) (<< y z))]))
(mat inexact
(== (inexact 0) +0.0)
(== (inexact #e+1e-400) +0.0)
(== (inexact #e-1e-400) -0.0)
(== (inexact #e+1e+400) +inf.0)
(== (inexact #e-1e+400) -inf.0)
(== (inexact #e+1e-5000) +0.0)
(== (inexact #e-1e-5000) -0.0)
(== (inexact #e+1e+5000) +inf.0)
(== (inexact #e-1e+5000) -inf.0)
; make sure inexact rounds to even whenever exactly half way to next
; (assuming 52-bit mantissa + hidden bit)
; ratios
(fl= (inexact (+ (ash 1 52) 0/2)) #x10000000000000.0)
(fl= (inexact (+ (ash 1 52) 1/2)) #x10000000000000.0)
(fl= (inexact (+ (ash 1 52) 2/2)) #x10000000000001.0)
(fl= (inexact (+ (ash 1 52) 3/2)) #x10000000000002.0)
(fl= (inexact (+ (ash 1 52) 4/2)) #x10000000000002.0)
(fl= (inexact (+ (ash 1 52) 5/2)) #x10000000000002.0)
; integers
(fl= (inexact (* (+ (ash 1 52) 0/2) 2)) #x20000000000000.0)
(fl= (inexact (* (+ (ash 1 52) 1/2) 2)) #x20000000000000.0)
(fl= (inexact (* (+ (ash 1 52) 2/2) 2)) #x20000000000002.0)
(fl= (inexact (* (+ (ash 1 52) 3/2) 2)) #x20000000000004.0)
(fl= (inexact (* (+ (ash 1 52) 4/2) 2)) #x20000000000004.0)
(fl= (inexact (* (+ (ash 1 52) 5/2) 2)) #x20000000000004.0)
(fl= (inexact (ash (* (+ (ash 1 52) 0/2) 2) 40)) #x200000000000000000000000.0)
(fl= (inexact (ash (* (+ (ash 1 52) 1/2) 2) 40)) #x200000000000000000000000.0)
(fl= (inexact (ash (* (+ (ash 1 52) 2/2) 2) 40)) #x200000000000020000000000.0)
(fl= (inexact (ash (* (+ (ash 1 52) 3/2) 2) 40)) #x200000000000040000000000.0)
(fl= (inexact (ash (* (+ (ash 1 52) 4/2) 2) 40)) #x200000000000040000000000.0)
(fl= (inexact (ash (* (+ (ash 1 52) 5/2) 2) 40)) #x200000000000040000000000.0)
; make sure inexact rounds up when more than half way to next
; (assuming 52-bit mantissa + hidden bit)
; ratios
(fl= (inexact (+ (ash 1 52) 0/2 1/4)) #x10000000000000.0)
(fl= (inexact (+ (ash 1 52) 1/2 1/4)) #x10000000000001.0)
(fl= (inexact (+ (ash 1 52) 2/2 1/4)) #x10000000000001.0)
(fl= (inexact (+ (ash 1 52) 3/2 1/4)) #x10000000000002.0)
(fl= (inexact (+ (ash 1 52) 4/2 1/4)) #x10000000000002.0)
(fl= (inexact (+ (ash 1 52) 5/2 1/4)) #x10000000000003.0)
(fl= (inexact (+ (ash 1 52) 1/2 1/8)) #x10000000000001.0)
(fl= (inexact (+ (ash 1 52) 3/2 1/8)) #x10000000000002.0)
(fl= (inexact (+ (ash 1 52) 1/2 (expt 2 -80))) #x10000000000001.0)
(fl= (inexact (+ (ash 1 52) 3/2 (expt 2 -80))) #x10000000000002.0)
; integers
(fl= (inexact (* (+ (ash 1 52) 0/2 1/4) 4)) #x40000000000000.0)
(fl= (inexact (* (+ (ash 1 52) 1/2 1/4) 4)) #x40000000000004.0)
(fl= (inexact (* (+ (ash 1 52) 2/2 1/4) 4)) #x40000000000004.0)
(fl= (inexact (* (+ (ash 1 52) 3/2 1/4) 4)) #x40000000000008.0)
(fl= (inexact (* (+ (ash 1 52) 4/2 1/4) 4)) #x40000000000008.0)
(fl= (inexact (* (+ (ash 1 52) 5/2 1/4) 4)) #x4000000000000C.0)
(fl= (inexact (* (+ (ash 1 52) 1/2 1/8) 8)) #x80000000000008.0)
(fl= (inexact (* (+ (ash 1 52) 3/2 1/8) 8)) #x80000000000010.0)
(fl= (inexact (* (+ (ash 1 52) 1/2 (expt 2 -80)) (expt 2 80)))
#x1000000000000100000000000000000000.0)
(fl= (inexact (* (+ (ash 1 52) 3/2 (expt 2 -80)) (expt 2 80)))
#x1000000000000200000000000000000000.0)
; verify fix for incorrect input of 2.2250738585072011e-308 reported by leppie
; 2.2250738585072011e-308 falls right on the edge between normalized and denormalized numbers,
; and should not be rounded up to a normalized number
(equal?
(number->string (string->number "2.2250738585072011e-308"))
"2.225073858507201e-308|52")
(equal?
(decode-float (string->number "2.2250738585072011e-308"))
'#(#b1111111111111111111111111111111111111111111111111111 -1074 1))
; similar case in binary...
(equal?
(decode-float (string->number "#b1.111111111111111111111111111111111111111111111111111011e-1111111111"))
'#(#b1111111111111111111111111111111111111111111111111111 -1074 1))
(equal?
(number->string (string->number "#b1.111111111111111111111111111111111111111111111111111011e-1111111111"))
"2.225073858507201e-308|52")
; slightly higher number should be rounded up
(equal?
(number->string (string->number "2.2250738585072012e-308"))
"2.2250738585072014e-308")
(equal?
(number->string (string->number "#b1.111111111111111111111111111111111111111111111111111100e-1111111111"))
"2.2250738585072014e-308")
)
(mat exact
(error? (exact (nan)))
(error? (exact +inf.0))
(error? (exact -inf.0))
(eq? (exact +0.0) 0)
(eq? (exact -0.0) 0)
)
(mat ==
(== 1.0 1.0)
(== -1.0 -1.0)
(not (== -1.0 +1.0))
(not (== +1.0 -1.0))
(== 0.0 0.0)
(== -0.0 -0.0)
(not (== -0.0 +0.0))
(not (== +0.0 -0.0))
(== +inf.0 +inf.0)
(== -inf.0 -inf.0)
(not (== -inf.0 +inf.0))
(not (== +inf.0 -inf.0))
(== (nan) (nan))
(not (== +inf.0 (nan)))
(not (== (nan) -inf.0))
(not (== 0.0 0.0-0.0i))
(== +e +e)
(== -e -e)
(not (== +e +0.0))
(not (== -e -0.0))
)
(mat <<
(<< -1.0 1.0)
(not (<< +1.0 -1.0))
(not (<< 0.0 0.0))
(<< -0.0 +0.0)
(not (<< +0.0 -0.0))
(<< -inf.0 +inf.0)
(not (<< +inf.0 -inf.0))
(not (<< (nan) (nan)))
(not (<< (nan) +0.0))
(not (<< +0.0 (nan)))
(<< -e +0.0 +e)
(<< -e -0.0 +e)
(not (<< +e +e))
(not (<< -e -e))
)
(mat fl=
(let ((n (read (open-input-string "+nan.0"))))
(not (fl= n n)))
(not (fl= (nan)))
(not (fl= (nan) +inf.0))
(not (fl= (nan) -inf.0))
(not (fl= (nan) (nan)))
(not (fl= (nan) 0.0))
(fl= +inf.0 +inf.0)
(fl= -inf.0 -inf.0)
(not (fl= -inf.0 +inf.0))
(fl= +0.0 -0.0)
)
(mat fl<
(not (fl< (nan)))
(not (fl< (nan) (nan)))
(not (fl< (nan) 0.0))
(not (fl< 0.0 (nan)))
(fl< -inf.0 0.0)
)
(mat fl>
(not (fl> (nan)))
(not (fl> (nan) (nan)))
(not (fl> (nan) 0.0))
(not (fl> 0.0 (nan)))
(fl> +inf.0 -inf.0)
(fl> +inf.0 0.0)
(not (fl> +0.0 -0.0))
)
(mat fl<=
(not (fl<= (nan)))
(not (fl<= (nan) (nan)))
(not (fl<= (nan) 0.0))
(not (fl<= 0.0 (nan)))
)
(mat fl>=
(not (fl>= (nan)))
(not (fl>= (nan) (nan)))
(not (fl>= (nan) 0.0))
(not (fl>= 0.0 (nan)))
)
(mat fl-
(== (fl- +0.0) -0.0)
(== (fl- -0.0) +0.0)
(== (fl- +inf.0) -inf.0)
(== (fl- -inf.0) +inf.0)
(== (fl- (nan)) (nan))
(== (fl- -0.0 -0.0) +0.0)
(== (fl- +0.0 -0.0) +0.0)
(== (fl- -0.0 +0.0) -0.0)
(== (fl- +0.0 +0.0) +0.0)
(andmap
(lambda (a)
(andmap
(lambda (b)
(andmap
(lambda (c) (== (fl- a b c) (fl- (fl- a b) c)))
'(0.0 -0.0)))
'(0.0 -0.0)))
'(0.0 -0.0))
(let ()
(define-syntax ff
(syntax-rules ()
[(_ k1 k2) (lambda (x) (eqv? (fl- k1 x k2) (fl- (fl- k1 x) k2)))]))
(andmap
(lambda (p) (and (p +0.0) (p -0.0)))
(list (ff +0.0 +0.0) (ff +0.0 -0.0) (ff -0.0 +0.0) (ff -0.0 -0.0))))
(error? (fl- 3.0 5.4 'a))
(error? (fl- 'a 3.0 5.4))
(error? (fl- 3.0 'a 5.4))
(== (fl- 5.0 4.0 3.0 2.0) -4.0)
(== (fl- 5.0 4.0 3.0 2.0 1.0 0.0 -1.0 -2.0) -2.0)
(begin
(define ($fl-f x y) (fl- -0.0 x y))
(procedure? $fl-f))
(== ($fl-f 3.0 4.0) -7.0)
(== (fl- 1e30 1e30 7.0) -7.0)
)
(mat +
; just in case we're ever tempted to combine nested generic arithmetic operators...
(begin
(define f1a (lambda (x) (= (+ x 2) (+ (+ x 1) 1))))
(define f1b (lambda (x) (= (+ (+ x 1) 1) x)))
(define f2 (lambda (x) (= (- (+ x 1e308) 1e308) +inf.0)))
#t)
(f1a 0)
(not (f1a (inexact (expt 2 53))))
(not (f1b 0))
(f1b (inexact (expt 2 53)))
(not (f2 (inexact 0)))
(f2 +inf.0)
(not (f2 +nan.0))
(f2 1e308)
)
(mat -
(== (- +0.0) -0.0)
(== (- -0.0) +0.0)
(== (- +inf.0) -inf.0)
(== (- -inf.0) +inf.0)
(== (- (nan)) (nan))
(== (- -0.0 -0.0) +0.0)
(== (- +0.0 -0.0) +0.0)
(== (- -0.0 +0.0) -0.0)
(== (- +0.0 +0.0) +0.0)
(andmap
(lambda (a)
(andmap
(lambda (b)
(andmap
(lambda (c) (== (- a b c) (- (- a b) c)))
'(0.0 -0.0)))
'(0.0 -0.0)))
'(0.0 -0.0))
(error? (- 3.0 5.4 'a))
(error? (- 'a 3.0 5.4))
(error? (- 3.0 'a 5.4))
(== (- 1e30 1e30 7.0) -7.0)
(begin
(define $ieee-foo
(lambda (x)
(- x 1e30 7.0)))
#t)
(== ($ieee-foo 1e30) -7.0)
)
(mat fl+
(== (fl+ -0.0 -0.0) -0.0)
(== (fl+ +0.0 -0.0) +0.0)
(== (fl+ -0.0 +0.0) +0.0)
(== (fl+ +0.0 +0.0) +0.0)
)
(mat fl*
(== (fl* -1.0 +0.0) -0.0)
(== (fl* -1.0 -0.0) +0.0)
(== (fl* +1.0 +0.0) +0.0)
(== (fl* +1.0 -0.0) -0.0)
)
(mat fl/
(== (fl/ +0.0) +inf.0)
(== (fl/ -0.0) -inf.0)
(== (fl/ +inf.0) +0.0)
(== (fl/ -inf.0) -0.0)
(== (fl/ (nan)) (nan))
(== (fl/ +1.0 +0.0) +inf.0)
(== (fl/ +1.0 -0.0) -inf.0)
(== (fl/ -1.0 +0.0) -inf.0)
(== (fl/ -1.0 -0.0) +inf.0)
(== (fl/ +0.0 +0.0) (nan))
(== (fl/ +0.0 -0.0) (nan))
(== (fl/ -0.0 +0.0) (nan))
(== (fl/ -0.0 -0.0) (nan))
(andmap
(lambda (a)
(andmap
(lambda (b)
(andmap
(lambda (c) (== (fl/ a b c) (fl/ (fl/ a b) c)))
'(1e300 1e250)))
'(1e300 1e250)))
'(1e300 1e250))
(error? (fl/ 3.0 5.4 'a))
(error? (fl/ 'a 3.0 5.4))
(error? (fl/ 3.0 'a 5.4))
(== (fl/ 16.0 2.0 -2.0 2.0) -2.0)
(== (fl/ 16.0 2.0 -2.0 2.0 4.0 1.0 -1.0) 0.5)
(== (fl/ 1e300 1e300 1e300) 1e-300)
)
(mat /
(== (/ +0.0) +inf.0)
(== (/ -0.0) -inf.0)
(== (/ +inf.0) +0.0)
(== (/ -inf.0) -0.0)
(== (/ (nan)) (nan))
(== (/ +1.0 +0.0) +inf.0)
(== (/ +1.0 -0.0) -inf.0)
(== (/ -1.0 +0.0) -inf.0)
(== (/ -1.0 -0.0) +inf.0)
(== (/ +0.0 +0.0) (nan))
(== (/ +0.0 -0.0) (nan))
(== (/ -0.0 +0.0) (nan))
(== (/ -0.0 -0.0) (nan))
(andmap
(lambda (a)
(andmap
(lambda (b)
(andmap
(lambda (c) (== (/ a b c) (/ (/ a b) c)))
'(1e300 1e250)))
'(1e300 1e250)))
'(1e300 1e250))
(error? (/ 3.0 5.4 'a))
(error? (/ 'a 3.0 5.4))
(error? (/ 3.0 'a 5.4))
(== (fl/ 1e300 1e300 1e300) 1e-300)
)
(mat expt
(== (expt +0.0 +0.0) +1.0)
(== (expt -0.0 +0.0) +1.0)
(== (expt +0.0 -0.0) +1.0)
(== (expt -0.0 -0.0) +1.0)
(== (expt +1.0 +0.0) +1.0)
(== (expt -1.0 +0.0) +1.0)
(== (expt +0.0 +1.0) +0.0)
(== (expt -0.0 +1.0) -0.0)
(== (expt -0.0 +2.0) +0.0)
(== (expt -0.0 +3.0) -0.0)
(== (expt +inf.0 +0.0) +1.0)
(== (expt +inf.0 +1.0) +inf.0)
(== (expt -inf.0 +0.0) +1.0)
(== (expt -inf.0 +1.0) -inf.0)
(== (expt +inf.0 +inf.0) +inf.0)
(== (expt +inf.0 -inf.0) +0.0)
(== (expt -inf.0 +inf.0) +inf.0)
(== (expt -inf.0 -inf.0) +0.0)
(== (expt +inf.0 +.5) +inf.0)
(== (expt (nan) +.5) (nan))
(== (expt +.5 (nan)) (nan))
(== (expt (nan) (nan)) (nan))
(== (expt (nan) +0.0) +1.0)
(== (expt +0.0 (nan)) (nan))
(== (expt +0.0 (nan)) (nan))
(== (expt +inf.0+2i 2) +inf.0+0.0i)
(== (let ([n (expt 2 32)]) (expt 2 (make-rectangular n n))) -inf.0+inf.0i)
)
(mat magnitude
(== (magnitude -0.0) 0.0)
(== (magnitude 0.0) 0.0)
(== (magnitude 0.0-0.0i) 0.0)
(== (magnitude -1.0) 1.0)
(== (magnitude 1.0) 1.0)
(== (magnitude 0.0+1.0i) 1.0)
(== (magnitude +inf.0) +inf.0)
(== (magnitude -inf.0) +inf.0)
(== (magnitude +inf.0+inf.0i) +inf.0)
(== (magnitude +inf.0+2.0i) +inf.0)
(== (magnitude +2.0+inf.0i) +inf.0)
(== (magnitude (nan)) (nan))
(== (magnitude (make-rectangular (nan) (nan))) (nan))
(== (magnitude (make-rectangular +0.0 (nan))) (nan))
(<< +0.0 (magnitude (make-rectangular +e +e)))
(<< +0.0 (magnitude (make-rectangular -e -e)))
)
(mat sqrt
; from Kahan
(== (sqrt -0.0) +0.0+0.0i)
(== (sqrt -4.0) +0.0+2.0i)
(== (sqrt -inf.0) +0.0+inf.0i)
(== (sqrt 0.0+inf.0i) +inf.0+inf.0i)
(== (sqrt 4.0+inf.0i) +inf.0+inf.0i)
(== (sqrt +inf.0+inf.0i) +inf.0+inf.0i)
(== (sqrt -0.0+inf.0i) +inf.0+inf.0i)
(== (sqrt -4.0+inf.0i) +inf.0+inf.0i)
(== (sqrt -inf.0+inf.0i) +inf.0+inf.0i)
(== (sqrt 0.0-inf.0i) +inf.0-inf.0i)
(== (sqrt 4.0-inf.0i) +inf.0-inf.0i)
(== (sqrt +inf.0-inf.0i) +inf.0-inf.0i)
(== (sqrt -0.0-inf.0i) +inf.0-inf.0i)
(== (sqrt -4.0-inf.0i) +inf.0-inf.0i)
(== (sqrt -inf.0-inf.0i) +inf.0-inf.0i)
(== (sqrt (make-rectangular (nan) +0.0)) (make-rectangular (nan)(nan)))
(== (sqrt (make-rectangular 0.0 (nan))) (make-rectangular (nan) (nan)))
(== (sqrt (make-rectangular (nan) (nan))) (make-rectangular (nan) (nan)))
(== (sqrt +inf.0+0.0i) +inf.0+0.0i)
(== (sqrt +inf.0+4.0i) +inf.0+0.0i)
(== (sqrt +inf.0-0.0i) +inf.0-0.0i)
(== (sqrt +inf.0-4.0i) +inf.0-0.0i)
(== (sqrt (make-rectangular +inf.0 (nan))) (make-rectangular +inf.0 (nan)))
(== (sqrt -inf.0+0.0i) +0.0+inf.0i)
(== (sqrt -inf.0+4.0i) +0.0+inf.0i)
(== (sqrt -inf.0-0.0i) +0.0-inf.0i)
(== (sqrt -inf.0-4.0i) +0.0-inf.0i)
(let ([z (sqrt (make-rectangular -inf.0 (nan)))])
(and (== (real-part z) (nan)) (== (abs (imag-part z)) +inf.0)))
; others
(== (sqrt +0.0) +0.0)
(== (sqrt +1.0) +1.0)
(== (sqrt +4.0) +2.0)
(== (sqrt +inf.0) +inf.0)
(== (sqrt +0.0+0.0i) +0.0+0.0i)
(== (sqrt +1.0+0.0i) +1.0+0.0i)
(== (sqrt +4.0+0.0i) +2.0+0.0i)
(== (sqrt +inf.0+0.0i) +inf.0+0.0i)
(== (sqrt -0.0+0.0i) +0.0+0.0i)
(== (sqrt -1.0+0.0i) +0.0+1.0i)
(== (sqrt -4.0+0.0i) +0.0+2.0i)
(== (sqrt -inf.0+0.0i) +0.0+inf.0i)
(== (sqrt -0.0-0.0i) +0.0-0.0i)
(== (sqrt -1.0-0.0i) +0.0-1.0i)
(== (sqrt -inf.0-0.0i) +0.0-inf.0i)
(== (sqrt +0.0-0.0i) +0.0-0.0i)
(== (sqrt +1.0-0.0i) +1.0-0.0i)
(== (sqrt +inf.0-0.0i) +inf.0-0.0i)
(== (sqrt (nan)) (nan))
)
(mat exp
(== (exp +0.0) +1.0)
(== (exp -0.0) +1.0)
(== (exp +inf.0) +inf.0)
(== (exp -inf.0) +0.0)
(== (exp (nan)) (nan))
(== (exp +0.0+0.0i) +1.0+0.0i)
(== (exp -0.0-0.0i) +1.0-0.0i)
; if exp treats x+0.0i the same as x:
(== (exp +inf.0+0.0i) +inf.0+0.0i)
; otherwise:
#;(== (exp +inf.0+0.0i) +inf.0+nan.0i)
(== (exp +inf.0-0.0i) +inf.0-0.0i)
(== (exp -inf.0+0.0i) 0.0+0.0i)
(== (exp -inf.0-0.0i) 0.0-0.0i)
; if exp treats x+0.0i the same as x:
(== (exp (make-rectangular (nan) +0.0)) (make-rectangular (nan) +0.0))
; otherwise:
#;(== (exp (make-rectangular (nan) +0.0)) (make-rectangular (nan) (nan)))
; if exp treats x+0.0i the same as x:
(== (exp (make-rectangular (nan) -0.0)) (make-rectangular (nan) -0.0))
; otherwise:
#;(== (exp (make-rectangular (nan) -0.0)) (make-rectangular (nan) (nan)))
(~= (exp 700.0+.75i) 7.421023049046266e303+6.913398801654868e303i)
(~= (exp 700.0-.75i) 7.421023049046266e303-6.913398801654868e303i)
(== (exp 800.0+.75i) +inf.0+inf.0i)
(== (exp 800.0-.75i) +inf.0-inf.0i)
(== (exp 800.0+1e-200i) +inf.0+2.7263745721125063e147i)
(== (exp 800.0-1e-200i) +inf.0-2.7263745721125063e147i)
(== (exp +inf.0+1.0i) +inf.0+inf.0i)
(== (exp +inf.0+2.0i) -inf.0+inf.0i)
(== (exp +inf.0+3.0i) -inf.0+inf.0i)
(== (exp +inf.0+4.0i) -inf.0-inf.0i)
(== (exp +inf.0+123.0i) -inf.0-inf.0i)
)
(mat log
(== (log 0.0) -inf.0)
(== (log 1.0) 0.0)
(== (log +inf.0) +inf.0)
(== (log -0.0) (make-rectangular -inf.0 +pi))
(== (log -1.0) (make-rectangular 0.0 +pi))
(== (log -inf.0) (make-rectangular +inf.0 +pi))
(== (log +1.0i) (make-rectangular 0.0 +pi/2))
(== (log -1.0i) (make-rectangular 0.0 -pi/2))
(== (log -0.0+0.0i) (make-rectangular -inf.0 +pi))
(== (log -0.0-0.0i) (make-rectangular -inf.0 -pi))
(== (log +0.0+0.0i) -inf.0+0.0i)
(== (log +0.0-0.0i) -inf.0-0.0i)
(== (log +1.0+0.0i) 0.0+0.0i)
(== (log -1.0+0.0i) (make-rectangular 0.0 +pi))
(== (log +1.0-0.0i) 0.0-0.0i)
(== (log -1.0-0.0i) (make-rectangular 0.0 -pi))
)
(mat fllog
(== (log 0.0) -inf.0)
(== (log 1.0) 0.0)
(== (log +inf.0) +inf.0)
(== (log -0.0) (make-rectangular -inf.0 +pi))
(== (log -1.0) (make-rectangular 0.0 +pi))
(== (log -inf.0) (make-rectangular +inf.0 +pi))
(== (log +1.0i) (make-rectangular 0.0 +pi/2))
(== (log -1.0i) (make-rectangular 0.0 -pi/2))
(== (log -0.0+0.0i) (make-rectangular -inf.0 +pi))
(== (log -0.0-0.0i) (make-rectangular -inf.0 -pi))
(== (log +0.0+0.0i) -inf.0+0.0i)
(== (log +0.0-0.0i) -inf.0-0.0i)
(== (log +1.0+0.0i) 0.0+0.0i)
(== (log -1.0+0.0i) (make-rectangular 0.0 +pi))
(== (log +1.0-0.0i) 0.0-0.0i)
(== (log -1.0-0.0i) (make-rectangular 0.0 -pi))
)
(mat sin
(== (sin +0.0) +0.0)
(== (sin -0.0) -0.0)
(== (sin +inf.0) (nan))
(== (sin -inf.0) (nan))
(== (sin (nan)) (nan))
)
(mat cos
(== (cos +0.0) +1.0)
(== (cos -0.0) +1.0)
(== (cos +inf.0) (nan))
(== (cos -inf.0) (nan))
(== (cos (nan)) (nan))
)
(mat tan
(== (tan +0.0) +0.0)
(== (tan -0.0) -0.0)
(== (tan +inf.0) (nan))
(== (tan -inf.0) (nan))
(== (tan (nan)) (nan))
(== (tan -0.0+0.0i) -0.0+0.0i)
)
(mat asin
(== (asin +0.0) +0.0)
(== (asin -0.0) -0.0)
(== (asin +1.0) +pi/2)
(== (asin -1.0) -pi/2)
(== (asin (nan)) (nan))
(== (asin -0.0+0.0i) -0.0+0.0i)
)
(mat acos
(== (acos +1.0) +0.0)
(== (acos -1.0) +pi)
(== (acos +0.0) +pi/2)
(== (acos -0.0) +pi/2)
(== (acos (nan)) (nan))
)
(mat atan
; cases from Steele (CLtL)
(== (atan +0.0 +e) +0.0)
(== (atan +0.0 +inf.0) +0.0)
(<< +0.0 (atan +e +e) +pi/2)
(<< +0.0 (atan +inf.0 +inf.0) +pi/2)
(== (atan +e +0.0) +pi/2)
(== (atan +inf.0 +0.0) +pi/2)
(== (atan +e -0.0) +pi/2)
(== (atan +inf.0 -0.0) +pi/2)
(<< +pi/2 (atan +e -e) +pi)
(<< +pi/2 (atan +inf.0 -inf.0) +pi)
(== (atan +0.0 -e) +pi)
(== (atan +0.0 -inf.0) +pi)
(== (atan -0.0 -e) -pi) ; Steele erroneously says +pi
(== (atan -0.0 -inf.0) -pi) ; Steele erroneously says +pi
(<< -pi (atan -e -e) -pi/2)
(<< -pi (atan -inf.0 -inf.0) -pi/2)
(== (atan -e +0.0) -pi/2)
(== (atan -e -0.0) -pi/2)
(== (atan -inf.0 +0.0) -pi/2)
(== (atan -inf.0 -0.0) -pi/2)
(<< -pi/2 (atan -e +e) -0.0)
(<< -pi/2 (atan -inf.0 +inf.0) -0.0)
(== (atan -0.0 +e) -0.0)
(== (atan -0.0 +inf.0) -0.0)
(== (atan +0.0 +0.0) +0.0)
(== (atan -0.0 +0.0) -0.0)
(== (atan +0.0 -0.0) +pi)
(== (atan -0.0 -0.0) -pi)
(== (atan -inf.0) -pi/2)
(== (atan +inf.0) +pi/2)
(== (atan +0.0) +0.0)
(== (atan -0.0) -0.0)
(if (memq (machine-type) '(i3qnx ti3qnx))
(~= (atan +1.0) +pi/4)
(== (atan +1.0) +pi/4))
(== (atan -1.0) -pi/4)
(== (atan (nan)) (nan))
(== (atan -0.0+0.0i) -0.0+0.0i)
)
(mat sinh
(== (sinh 0.0) 0.0)
(== (sinh -0.0) -0.0)
(== (sinh +inf.0) +inf.0)
(== (sinh -inf.0) -inf.0)
(== (sinh (nan)) (nan))
(== (sinh -0.0+0.0i) -0.0+0.0i)
)
(mat cosh
(== (cosh 0.0) 1.0)
(== (cosh -0.0) 1.0)
(== (cosh +inf.0) +inf.0)
(== (cosh -inf.0) +inf.0)
(== (cosh (nan)) (nan))
)
(mat tanh
(== (tanh 0.0) 0.0)
(== (tanh -0.0) -0.0)
(== (tanh +inf.0) +1.0)
(== (tanh -inf.0) -1.0)
(== (tanh (nan)) (nan))
(== (tanh -0.0+0.0i) -0.0+0.0i)
)
(mat asinh
(== (asinh 0.0) 0.0)
(== (asinh -0.0) -0.0)
(== (asinh +inf.0) +inf.0)
(== (asinh -inf.0) -inf.0)
(== (asinh (nan)) (nan))
(== (asinh -0.0+0.0i) -0.0+0.0i)
)
(mat acosh
(== (acosh 1.0) 0.0)
(== (acosh +inf.0) +inf.0)
(== (acosh (nan)) (nan))
)
(mat atanh
(== (atanh 0.0) 0.0)
(== (atanh -0.0) -0.0)
(== (atanh +1.0) +inf.0)
(== (atanh -1.0) -inf.0)
(== (atanh (nan)) (nan))
(== (atanh -0.0+0.0i) -0.0+0.0i)
(== (atanh -0.0+0.0i) -0.0+0.0i)
)
(mat flonum->fixnum
(error? (flonum->fixnum +inf.0))
(error? (flonum->fixnum -inf.0))
(error? (flonum->fixnum (nan)))
(eq? (flonum->fixnum -0.0) 0)
)
(mat fllp
(error? (fllp 3))
(eqv? (fllp 0.0) 0)
(eqv? (fllp 1.0) 2046)
(eqv? (fllp -1.0) 2046)
(eqv? (fllp 1.5) 2047)
(eqv? (fllp -1.5) 2047)
(and (memv (fllp +nan.0) '(4094 4095)) #t)
(eqv? (fllp +inf.0) 4094)
(eqv? (fllp -inf.0) 4094)
(eqv?
(fllp #b1.1111111111111111111111111111111111111111111111111111e1111111111)
4093)
(eqv? (fllp #b1.0e-1111111110) 2)
(or (eqv? #b.1e-1111111110 0.0)
(eqv? (fllp #b.1e-1111111110) 1))
(eqv? (fllp #b.01e-1111111110) 0)
)
(mat fp-output
(equal? (number->string 1e23) "1e23")
(equal? (number->string 4.450147717014403e-308) "4.450147717014403e-308")
(equal? (number->string 1.1665795231290236e-302) "1.1665795231290236e-302")
; fp printing algorithm always rounds up on ties
(equal? (number->string 3.6954879760742188e-6) "3.6954879760742188e-6")
(equal? (number->string 5.629499534213123e14) "5.629499534213123e14")
)
(mat string->number
(equal? (string->number "+1e-400") +0.0)
(equal? (string->number "-1e-400") -0.0)
(equal? (string->number "+1e+400") +inf.0)
(equal? (string->number "-1e+400") -inf.0)
(equal? (string->number "+1e-5000") +0.0)
(equal? (string->number "-1e-5000") -0.0)
(equal? (string->number "+1e+5000") +inf.0)
(equal? (string->number "-1e+5000") -inf.0)
(equal? (string->number "+1e-50000") +0.0)
(equal? (string->number "-1e-50000") -0.0)
(equal? (string->number "+1e+50000") +inf.0)
(equal? (string->number "-1e+50000") -inf.0)
(equal? (string->number "+1e-500000") +0.0)
(equal? (string->number "-1e-500000") -0.0)
(equal? (string->number "+1e+500000") +inf.0)
(equal? (string->number "-1e+500000") -inf.0)
(equal? (string->number "#b1e-10000110010") 5e-324)
(equal? (string->number "5e-324") 5e-324)
(equal? (string->number "#b-1e-10000110010") -5e-324)
(equal? (string->number "-5e-324") -5e-324)
(equal? (string->number "#b1e-10000110010") (inexact (* 5 (expt 10 -324))))
(equal? (string->number "5e-324") (inexact (* 5 (expt 10 -324))))
(equal? (string->number "#b-1e-10000110010") (inexact (* -5 (expt 10 -324))))
(equal? (string->number "-5e-324") (inexact (* -5 (expt 10 -324))))
(if (memq (machine-type) '(a6nt ta6nt)) ; tolerably inaccurate
(equal? (string->number "#b1e-10000110100") 0.0)
(equal? (string->number "#b1e-10000110011") 0.0))
(if (memq (machine-type) '(a6nt ta6nt)) ; tolerably inaccurate
(equal? (string->number "#b-1e-10000110100") -0.0)
(equal? (string->number "#b-1e-10000110011") -0.0))
(equal? (string->number "5e-325") 0.0)
(equal? (string->number "-5e-325") -0.0)
(equal? (string->number "1.7976931348623157e308") 1.7976931348623157e308)
(equal? (string->number "-1.7976931348623157e308") -1.7976931348623157e308)
(equal? (string->number "#b1.1111111111111111111111111111111111111111111111111111e1111111111") 1.7976931348623157e308)
(equal? (string->number "#b-1.1111111111111111111111111111111111111111111111111111e1111111111") -1.7976931348623157e308)
(equal? (string->number "1.7976931348623157e308") (inexact (* 9007199254740991 (expt 2 971))))
(equal? (string->number "-1.7976931348623157e308") (inexact (* -9007199254740991 (expt 2 971))))
(equal? (string->number "#b1.1111111111111111111111111111111111111111111111111111e1111111111") (inexact (* 9007199254740991 (expt 2 971))))
(equal? (string->number "#b-1.1111111111111111111111111111111111111111111111111111e1111111111") (inexact (* -9007199254740991 (expt 2 971))))
(equal? (string->number "#b1.11111111111111111111111111111111111111111111111111111e1111111111") +inf.0)
(equal? (string->number "#b-1.11111111111111111111111111111111111111111111111111111e1111111111") -inf.0)
(equal? (string->number "1.7976931348623159e308") +inf.0)
(equal? (string->number "-1.7976931348623159e308") -inf.0)
(equal? (string->number "1e100000000000000000000") +inf.0)
(equal? (string->number "-1e100000000000000000000") -inf.0)
(equal? (string->number "1e-100000000000000000000") 0.0)
(equal? (string->number "-1e-100000000000000000000") -0.0)
)

5008
mats/io.ms Normal file

File diff suppressed because it is too large Load diff

53
mats/m4test.in Normal file
View file

@ -0,0 +1,53 @@
dnl m4test.in
dnl Copyright 1984-2017 Cisco Systems, Inc.
dnl
dnl Licensed under the Apache License, Version 2.0 (the "License");
dnl you may not use this file except in compliance with the License.
dnl You may obtain a copy of the License at
dnl
dnl http://www.apache.org/licenses/LICENSE-2.0
dnl
dnl Unless required by applicable law or agreed to in writing, software
dnl distributed under the License is distributed on an "AS IS" BASIS,
dnl WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
dnl See the License for the specific language governing permissions and
dnl limitations under the License.
dnl
dnl a small excerpt from the delta 68k .m4 file that nonetheless strains
dnl m4 pretty well. use "make bullym4test.in" to test more fully, if you
dnl have the time.
changequote({,})
dnl delta assembler does not support register masks; must convert to constant
define(PUSHREGS,{moveml REGMASK({$1},{A7FIRST}),DEC(SP)})
define(POPREGS,{moveml INC(SP),REGMASK({$1},{D0FIRST})})
define(STOREREGS,{moveml REGMASK({$1},{D0FIRST}),{$2}})
define(LOADREGS,{moveml {$2},REGMASK({$1},{D0FIRST})})
define(REGMASK,{{&0x}HEXWORD(eval(REGMASK1({$1}/,0,{$2})))})
define(REGMASK1,{
ifelse(
$2,len({$1}),
{0},
substr({$1},eval($2+2),1),-,
{REGRANGE(substr({$1},$2,1),
substr({$1},eval($2+1),1),
substr({$1},eval($2+4),1),
{$3}) +
REGMASK1({$1},eval($2+6),{$3})},
{$3(substr({$1},$2,1),substr({$1},eval($2+1),1)) +
REGMASK1({$1},eval($2+3),{$3})})})
define(REGRANGE,{$4($1,$2)+ifelse($2,$3,{0},{REGRANGE($1,incr($2),$3,{$4})})})
define(A7FIRST,{(2**(ifelse($1,D,15,7)-$2))})
define(D0FIRST,{(2**(ifelse($1,A,8,0)+$2))})
dnl used to pretty up register mask
define(HEXLONG,{HEXIFY($1,0)})
define(HEXWORD,{HEXIFY($1,4)})
define(HEXBYTE,{HEXIFY($1,6)})
define(HEXIFY,{ifelse($1,0,{substr(00000000,$2)},{HEXIFY(eval($1/16),incr($2)){}HEXDIGIT(eval($1%16))})})
define(HEXDIGIT,{substr({0123456789abcdef},$1,1)})
PUSHREGS({D2-D7/A2-A6})
POPREGS({D2-D7/A2-A6})

22
mats/m4test.out Normal file
View file

@ -0,0 +1,22 @@
moveml &0x3f3e,DEC(SP)
moveml INC(SP),&0x7cfc

578
mats/mat.ss Normal file
View file

@ -0,0 +1,578 @@
;;; mat.ss
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;(eval-when (compile load eval) (current-expand sc-expand))
(eval-when (compile) (optimize-level 2))
(eval-when (load eval)
(define-syntax mat
(lambda (x)
(syntax-case x (parameters)
[(_ x (parameters [param val ...] ...) e ...)
#'(let f ([p* (list param ...)] [v** (list (list val ...) ...)])
(if (null? p*)
(mat x e ...)
(let ([p (car p*)])
(for-each
(lambda (v)
(parameterize ([p v])
(f (cdr p*) (cdr v**))))
(car v**)))))]
[(_ x e ...)
(with-syntax ([(source ...)
(map (lambda (clause)
(let ([a (syntax->annotation clause)])
(and (annotation? a) (annotation-source a))))
#'(e ...))])
#'(mat-run 'x '(e source) ...))]))))
(define enable-cp0 (make-parameter #f))
(define-syntax mat/cf
(syntax-rules (testfile)
[(_ (testfile ?path) expr ...)
(let* ([path ?path] [testfile.ss (format "~a.ss" path)] [testfile.so (format "~a.so" path)])
(with-output-to-file testfile.ss
(lambda () (begin (write 'expr) (newline)) ...)
'replace)
(parameterize ([generate-inspector-information #t])
(compile-file testfile.ss))
(load testfile.so)
#t)]
[(_ expr ...) (mat/cf (testfile "testfile") expr ...)]))
(define mat-output (make-parameter (current-output-port)))
(let ()
(define mat-load
(lambda (in)
(call/cc
(lambda (k)
(parameterize ([reset-handler (lambda () (k #f))]
[current-expand (current-expand)]
[run-cp0
(let ([default (run-cp0)])
(lambda (cp0 x)
(if (enable-cp0) (default cp0 x) x)))])
(with-exception-handler
(lambda (c)
(if (warning? c)
(raise-continuable c)
(begin
(fprintf (mat-output) "Error reading mat input: ")
(display-condition c (mat-output))
(reset))))
(lambda () (load in))))))))
(define mat-one-exp
(lambda (expect th sanitize-all?)
(define (sanitize-condition c)
(define sanitize
(lambda (arg)
(if sanitize-all?
(cond
[(port? arg) 'sanitized-port]
[else 'sanitized-unhandled-type])
; go one level only to avoid getting bit by cyclic structures
(if (list? arg)
(map sanitize1 arg)
(sanitize1 arg)))))
(define sanitize1
(lambda (arg)
; attempt to gloss over fixnum-size differences between
; 32- and 64-bit versions
(cond
[(ftype-pointer? arg) '<ftype-pointer>]
[(time? arg) '<time>]
[(date? arg) '<date>]
[(and (eq? expect 'error)
(real? arg)
(if (>= arg 0)
; look for numbers around the size in bits or quantity
; of our 30- and 61-bit fixnums, 32 and 64-bit words
(or (or (<= 28 arg 33) (<= (expt 2 28) arg (expt 2 33)))
(or (<= 59 arg 65) (<= (expt 2 59) arg (expt 2 65))))
(or (or (<= -33 arg -28) (<= (- (expt 2 33)) arg (- (expt 2 28))))
(or (<= -65 arg -59) (<= (- (expt 2 65)) arg (- (expt 2 59)))))))
(if (< arg 0) '<-int> '<int>)]
[else arg])))
(let ([sc* (simple-conditions c)])
(cond
[(find irritants-condition? sc*) =>
(lambda (ic)
(let ([ls (condition-irritants ic)])
(if (list? ls)
(apply condition (make-irritants-condition (map sanitize ls)) (remq ic sc*))
c)))]
[else c])))
(define (condition-message c)
(define prefix?
(lambda (x y)
(let ([n (string-length x)])
(and (fx<= n (string-length y))
(let prefix? ([i 0])
(or (fx= i n)
(and (char=? (string-ref x i) (string-ref y i))
(prefix? (fx+ i 1)))))))))
(define prune-prefix
(lambda (x y)
(and (prefix? x y)
(substring y (string-length x) (string-length y)))))
(let ([s (call-with-string-output-port
(lambda (p) (display-condition c p)))])
(or (prune-prefix "Exception: " s)
(prune-prefix "Exception in " s)
(prune-prefix "Warning: " s)
(prune-prefix "Warning in " s)
s)))
(define (condition-type c)
(case (fxior (if (warning? c) 1 0) (if (error? c) 2 0) (if (violation? c) 4 0))
[(1) 'warning]
[else 'error]))
(let ([blob '(reset . #f)])
(call/cc
(lambda (k)
(parameterize ([reset-handler (lambda () (k blob))])
(with-exception-handler
(lambda (c)
(let ([t (condition-type c)])
(when (or (eq? expect 'warning) (not (eq? t 'warning)))
(set! blob (cons t (condition-message (sanitize-condition c))))
(reset))))
(lambda ()
(case (th)
[(#t) 'true]
[(#f) 'false]
[else 'bogus])))))))))
(define mat-error
(lambda (src message . args)
(let ([msg (apply format message args)])
; strip out newlines so when we grep we get the whole message
(do ([i 0 (+ i 1)])
((= i (string-length msg)))
(when (char=? (string-ref msg i) #\newline)
(string-set! msg i #\space)))
(if src
(let ()
(let ([sfd (source-object-sfd src)] [fp (source-object-bfp src)])
(call-with-values
(lambda () (#%$locate-source sfd fp #t))
(case-lambda
[() (fprintf (mat-output) "~a at char ~a of ~a~%" msg fp (source-file-descriptor-path sfd))]
[(path line char) (fprintf (mat-output) "~a at line ~a, char ~a of ~a~%" msg line char path)]))))
(fprintf (mat-output) "~a~%" msg))
(flush-output-port (mat-output)))))
(define ununicode
; sanitizer for expected exception messages to make sure we don't end up
; with characters in mat error, experr, and report files so these files
; don't end up being O/S (locale) dependent
(lambda (s)
(let ([ip (open-input-string s)] [op (open-output-string)])
(let f ()
(let ([c (read-char ip)])
(cond
[(eof-object? c) (get-output-string op)]
[(fx> (char->integer c) 127) (fprintf op "U+~x" (char->integer c)) (f)]
[else (write-char c op) (f)]))))))
(define store-coverage
(lambda (universe-ct ct path)
(call-with-port
(open-file-output-port path
(file-options replace compressed)
(buffer-mode block)
(current-transcoder))
(lambda (op)
(put-source-table op
(if (eq? universe-ct ct)
ct
(let ([new-ct (make-source-table)])
(for-each
(lambda (p)
(let ([src (car p)] [count (cdr p)])
(when (source-table-contains? universe-ct src)
(source-table-set! new-ct src count))))
(source-table-dump ct))
new-ct)))))))
(define load-coverage
(lambda (ct)
(lambda (path)
(call-with-port
(open-file-input-port path
(file-options compressed)
(buffer-mode block)
(current-transcoder))
(lambda (ip) (get-source-table! ip ct +))))))
(set! coverage-table (make-parameter #f))
(set! mat-file
(lambda (dir)
(unless (string? dir)
(errorf 'mat-file "~s is not a string" dir))
(unless (file-exists? dir) (mkdir dir))
(lambda (mat)
(unless (string? mat)
(errorf 'mat-file "~s is not a string" mat))
(let ([ifn (format "~a.ms" mat)] [ofn (format "~a.mo" mat)])
(parameterize ([current-directory dir]
[source-directories (cons ".." (source-directories))]
[library-directories (cons ".." (library-directories))])
(printf "matting ~a with output to ~a/~a~%" ifn dir ofn)
(delete-file ofn #f)
(parameterize ([mat-output (open-output-file ofn)])
(dynamic-wind
(lambda () #f)
(lambda ()
(let ([go (lambda () (mat-load ifn))] [universe-ct (coverage-table)])
(if universe-ct
(let-values ([(ct . ignore) (with-profile-tracker go)])
(store-coverage universe-ct ct (format "~a.covout" mat)))
(go))))
(lambda () (close-output-port (mat-output))))))))))
(set! record-run-coverage
(lambda (covout th)
(let ([universe-ct (coverage-table)])
(if universe-ct
(let-values ([(ct . ignore) (with-profile-tracker #t th)])
(store-coverage universe-ct ct covout))
(th)))))
(set! load-coverage-files
(lambda path*
(let ([ct (make-source-table)])
(for-each (load-coverage ct) path*)
ct)))
(set! combine-coverage-files
(lambda (covout covout*)
(let ([ct (make-source-table)])
(for-each (load-coverage ct) covout*)
(store-coverage ct ct covout))))
(set! coverage-percent
(lambda (covout . covin*)
(let ([n (source-table-size (load-coverage-files covout))]
[d (source-table-size (apply load-coverage-files covin*))])
(printf "~a: covered ~s of ~s source expressions (~s%)\n"
covout n d (round (/ (* n 100) d))))))
(set! mat-run
(case-lambda
[(name)
(fprintf (mat-output) "Warning: empty mat for ~s.~%" name)]
[(name . clauses)
(fprintf (mat-output) "~%Starting mat ~s.~%" name)
; release counters for reclaimed code objects between mat groups to reduce gc time
(when (compile-profile) (profile-release-counters))
(do ([clauses clauses (cdr clauses)]
[count 1 (+ count 1)])
((null? clauses) 'done)
(let ([clause (caar clauses)] [source (cadar clauses)])
(with-exception-handler
(lambda (c)
(if (warning? c)
(raise-continuable c)
(begin
(fprintf (mat-output) "Error printing mat clause: ")
(display-condition c (mat-output))
(reset))))
(lambda ()
(pretty-print clause (mat-output))
(flush-output-port (mat-output))))
(if (and (list? clause)
(= (length clause) 2)
(memq (car clause) '(sanitized-error? error? warning?)))
(let ([expect (case (car clause) [(sanitized-error? error?) 'error] [(warning?) 'warning])])
(if (and (= (optimize-level) 3) (eq? expect 'error))
(fprintf (mat-output) "Ignoring error check at optimization level 3.~%")
(let ([ans (mat-one-exp expect (lambda () (eval (cadr clause))) (eq? (car clause) 'sanitized-error?))])
(cond
[(and (pair? ans) (eq? (car ans) expect))
(fprintf (mat-output)
"Expected ~s in mat ~s: \"~a\".~%"
expect name (ununicode (cdr ans)))]
[else
(mat-error source "Bug in mat ~s clause ~s" name count)]))))
(let ([ans (mat-one-exp #f (lambda () (eval clause)) #f)])
(cond
[(pair? ans)
(mat-error source
"Error in mat ~s clause ~s: \"~a\""
name
count
(cdr ans))]
[(eq? ans 'false)
(mat-error source
"Bug in mat ~s clause ~s"
name
count)]
[(eq? ans 'true) (void)]
[else
(mat-error source
"Bug (nonboolean, nonstring return value) in mat ~s clause ~s"
name
count)])))))]))
);let
(define equivalent-expansion?
; same modulo renaming of gensyms
; procedure in either input is used as predicate for other
(lambda (x y)
(let ([alist '()] [oops? #f])
(or (let e? ([x x] [y y])
(or (cond
[(procedure? x) (x y)]
[(procedure? y) (y x)]
[(eqv? x y) #t]
[(pair? x)
(and (pair? y) (e? (car x) (car y)) (e? (cdr x) (cdr y)))]
[(or (and (gensym? x) (symbol? y))
(and (gensym? y) (symbol? x)))
(cond
[(assq x alist) => (lambda (a) (eq? y (cdr a)))]
[else (set! alist (cons `(,x . ,y) alist)) #t])]
[(string? x) (and (string? y) (string=? x y))]
[(bytevector? x) (and (bytevector? y) (bytevector=? x y))]
[(vector? x)
(and (vector? y)
(fx= (vector-length x) (vector-length y))
(let f ([i (fx- (vector-length x) 1)])
(or (fx< i 0)
(and (e? (vector-ref x i) (vector-ref y i))
(f (fx1- i))))))]
[(fxvector? x)
(and (fxvector? y)
(fx= (fxvector-length x) (fxvector-length y))
(let f ([i (fx- (fxvector-length x) 1)])
(or (fx< i 0)
(and (fx= (fxvector-ref x i) (fxvector-ref y i))
(f (fx1- i))))))]
[(box? x) (and (box? y) (e? (unbox x) (unbox y)))]
[else #f])
(begin
(unless oops?
(set! oops? #t)
(printf "failure in equivalent-expansion?:\n")
(pretty-print x)
(printf "is not equivalent to\n")
(pretty-print y))
#f)))
(begin
(printf "original expressions:\n")
(pretty-print x)
(printf "is not equivalent to\n")
(pretty-print y)
#f)))))
(define *fuzz* 1e-14)
(define ~=
(lambda (x y)
(or (= x y)
(and (fl~= (inexact (real-part x))
(inexact (real-part y)))
(fl~= (inexact (imag-part x))
(inexact (imag-part y)))))))
(define fl~=
(lambda (x y)
(cond
[(and (fl>= (flabs x) 2.0) (fl>= (flabs y) 2.0))
(fl~= (fl/ x 2.0) (fl/ y 2.0))]
[(and (fl< 0.0 (flabs x) 1.0) (fl< 0.0 (flabs y) 1.0))
(fl~= (fl* x 2.0) (fl* y 2.0))]
[else (let ([d (flabs (fl- x y))])
(or (fl<= d *fuzz*)
(begin (printf "fl~~=: ~s~%" d) #f)))])))
(define cfl~=
(lambda (x y)
(and (fl~= (cfl-real-part x) (cfl-real-part y))
(fl~= (cfl-imag-part x) (cfl-imag-part y)))))
; from ieee.ms
(define ==
(lambda (x y)
(and (inexact? x)
(inexact? y)
(if (flonum? x)
(and (flonum? y)
(if (fl= x y)
(fl= (fl/ 1.0 x) (fl/ 1.0 y))
(and (not (fl= x x)) (not (fl= y y)))))
(and (not (flonum? y))
(== (real-part x) (real-part y))
(== (imag-part x) (imag-part y)))))))
(define (nan) (/ 0.0 0.0)) ; keeps "pretty-equal?" happy
(define pi (* (asin 1.0) 2))
(define +pi 3.14159265358979323846264)
(define +pi/2 1.57079632679489661923132)
(define +pi/4 .78539816339744830961566)
(define -pi (- +pi))
(define -pi/2 (- +pi/2))
(define -pi/4 (- +pi/4))
; smallest ieee flonum
(define +e 4.940656458412465e-324)
(define -e (- +e))
(define patch-exec-path
(lambda (p)
(if (windows?)
(list->string (subst #\\ #\/ (string->list p)))
p)))
(module separate-eval-tools (separate-eval run-script separate-compile)
(define (slurp ip)
(with-output-to-string
(lambda ()
(let f ()
(let ([c (read-char ip)])
(unless (eof-object? c)
(write-char c)
(f)))))))
(define ($separate-eval who expr*)
(let-values ([(to-stdin from-stdout from-stderr pid)
(open-process-ports (format "~a -q" (patch-exec-path *scheme*))
(buffer-mode block)
(native-transcoder))])
(pretty-print `(#%$enable-check-prelex-flags ,(#%$enable-check-prelex-flags)) to-stdin)
(for-each (lambda (expr) (pretty-print expr to-stdin)) expr*)
(close-port to-stdin)
(let* ([stdout-stuff (slurp from-stdout)]
[stderr-stuff (slurp from-stderr)])
(when (string=? stderr-stuff "")
(printf "$separate-eval command succeeded with\nSTDERR:\n~a\nSTDOUT:\n~a\nEND\n" stderr-stuff stdout-stuff))
(unless (string=? stderr-stuff "")
(printf "$separate-eval command failed with\nSTDERR:\n~a\nSTDOUT:\n~a\nEND\n" stderr-stuff stdout-stuff)
(errorf who "~a" stderr-stuff))
(close-port from-stdout)
(close-port from-stderr)
stdout-stuff)))
(define (separate-eval . expr*) ($separate-eval 'separate-eval expr*))
(define (run-script script)
(let-values ([(to-stdin from-stdout from-stderr pid)
(open-process-ports
(if (windows?)
(format "~a --script ~a" (patch-exec-path *scheme*) script)
script)
(buffer-mode block)
(native-transcoder))])
(close-port to-stdin)
(let* ([stdout-stuff (slurp from-stdout)]
[stderr-stuff (slurp from-stderr)])
(unless (string=? stderr-stuff "")
(errorf 'run-script "~a" stderr-stuff))
(close-port from-stdout)
(close-port from-stderr)
stdout-stuff)))
(define separate-compile
(case-lambda
[(x) (separate-compile 'compile-file x)]
[(cf x) ($separate-eval 'separate-compile `((,cf ,(if (symbol? x) (format "testfile-~a" x) x))))])))
(import separate-eval-tools)
#;(collect-request-handler
(begin
(warning #f "installing funky collect request-handler")
(lambda ()
(collect)
(when (= (random 100) 17)
(collect-maximum-generation (+ (random 254) 1))))))
(define windows?
(if (memq (machine-type) '(i3nt ti3nt a6nt ta6nt))
(lambda () #t)
(lambda () #f)))
(define embedded?
(lambda () #f))
(define ($record->vector x)
(let* ([rtd (#%$record-type-descriptor x)]
[n (length (csv7:record-type-field-names rtd))]
[v (make-vector (fx+ n 1) (record-type-name rtd))])
(do ([i 0 (fx+ i 1)])
((fx= i n))
(vector-set! v (fx+ i 1) ((csv7:record-field-accessor rtd i) x)))
v))
(define $cat_flush "./cat_flush")
(define test-cp0-expansion
(rec test-cp0-expansion
(case-lambda
[(expr expected) (test-cp0-expansion equivalent-expansion? expr expected)]
[(equiv? expr expected)
(let ([actual (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(let () (import scheme) ,expr)))])
(unless (equiv? actual expected)
(errorf 'test-cp0-expansion "expected ~s for ~s, got ~s\n" expected expr actual))
#t)])))
(define rm-rf
(lambda (path)
(when (file-exists? path)
(let f ([path path])
(if (file-directory? path)
(begin
(for-each (lambda (x) (f (format "~a/~a" path x))) (directory-list path))
(delete-directory path))
(delete-file path))))))
(define mkfile
(lambda (filename . expr*)
(with-output-to-file filename
(lambda () (for-each pretty-print expr*))
'replace)))
(define touch
(lambda (objfn srcfn)
(let loop ()
(let ([p (open-file-input/output-port srcfn (file-options no-fail no-truncate))])
(put-u8 p (lookahead-u8 p))
(close-port p))
(when (file-exists? objfn)
(unless (time>? (file-modification-time srcfn) (file-modification-time objfn))
(sleep (make-time 'time-duration 1000000 1))
(loop))))
#t))
(define preexisting-profile-dump-entry?
(let ([ht (make-eq-hashtable)])
(for-each (lambda (x) (eq-hashtable-set! ht (car x) #t)) (profile-dump))
(lambda (x) (eq-hashtable-contains? ht (car x)))))
(define heap-check-interval (make-parameter 0))
(collect-request-handler
(let ([counter 0])
(lambda ()
(parameterize ([#%$enable-check-heap
(let ([interval (heap-check-interval)])
(and (not (fx= interval 0))
(let ([n (fxmod (fx+ counter 1) interval)])
(set! counter n)
(fx= n 0))))])
(collect)))))

4707
mats/misc.ms Normal file

File diff suppressed because it is too large Load diff

2569
mats/oop.ms Normal file

File diff suppressed because it is too large Load diff

862
mats/oop.ss Normal file
View file

@ -0,0 +1,862 @@
;;; Copyright (c) 2002 Oscar Waddell and R. Kent Dybvig
;;; Permission is hereby granted, free of charge, to any person obtaining a
;;; copy of this software and associated documentation files (the "Software"),
;;; to deal in the Software without restriction, including without limitation
;;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
;;; and/or sell copies of the Software, and to permit persons to whom the
;;; Software is furnished to do so, subject to the following conditions:
;;; The above copyright notice and this permission notice shall be included in
;;; all copies or substantial portions of the Software.
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
;;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
;;; Last modified: October 2010
;;; Acknowledgements
;;; - Michael Lenaghan of frogware, Inc., contributed to the define-class
;;; interface handling code.
;;; Possible names:
;;; Chez Scheme OOP System (Chez SOOP)
#|
define-class:
definition -> (define-class (class-name class-formal*)
(base-name base-actual*)
clause*)
clause -> (implements interface*)
| (ivars ivar*)
| (init init-expr*)
| (methods method*)
| (constructor id)
| (predicate id)
| (prefix string)
ivar -> (modifier* ivar-name ivar-expression)
modifier -> mutability | visibility
mutability -> mutable | immutable
visibility -> public | private
method -> (method-name formals method-body+)
formals -> (var*) | var | (var+ . var)
notes:
- at most one of each kind of clause may be present
- at most one of each kind of modifier may be present
- multiple methods of the same name but different formals can be present
products:
- class-name is bound to class information in the expand-time environment
- make-class-name (or specified constructor name) is bound to creation procedure
- class-name? (or specified predicate name) is bound to predicate procedure
- new (not inherited) method names are bound to method-dispatch procedures
- for each public ivar, <prefix>-ivar is bound to an accessor procedure,
where <prefix> is the specified prefix or "class-name-"
- for each public, mutable ivar, <prefix>-ivar-set! is bound to a mutator
procedure, where <prefix> is the specified prefix or "class-name-"
define-interface:
definition -> (define-interface interface-name method*)
| (define-interface interface-name base-name method*)
method -> (method-name formals)
products:
- interface-name is bound to interface information in the expand-time environment
- new (not inherited) method names are bound to method-dispatch procedures
|#
#| Todo:
- try using record-constructor, record-accessor, and record-mutator!
instead of $record, $object-ref, and $object-set!
- add a nongenerative clause ala define-record-type
- squawk if any methods or interfaces
- default to generative
- need more tests:
- init-expr checks
- profile to see if all paths are covered by test suite
- consider: don't degenerate to record definition facility
- flush implicit nongenerative option
- flush visibility keywords
- flush getter/setter
=> less complex but less useful
- consider: alternative version
- <class-name> and method definitions are only products
- (make-class-name arg ...) replaced by (make <class-name> arg ...)
- (class-name? arg) replaced by (isa? <class-name> arg)
- accessors and mutators replaced by
(open-instance <class-name> (ivar ...) expr expr ...)
- upside: prettier, less namespace clutter
- downside: can't use module system directly to control visibility of
makers, predicates, accessors, and mutators separately
- downside: maker, predicate, accessors, mutators aren't
first-class procedures
- consider: inherited ivars
- (inherited-ivar ivar ...)
- inheritable / noninheritable ivar modifiers
- (frogware) Error messages for incorrect syntax should be better. (You often
get a generic "invalid syntax" message and have to hunt to figure
out what caused it.)
- consider exposing query-interface somehow
- (interface I x) => version of x to which I's methods are applicable
- (interface->instance (interface I x)) => x
- interfaces and inheritance
- either require parent for define-interface or hide <root-interface>
- consider allowing multiple inheritance (including zero parents) for interfaces
|#
#|
reaching into Chez Scheme's internals for:
#!base-rtd
$make-record-type
$record-type-field-offsets
$record-type-interfaces
$record
$object-ref
$object-set!
|#
#!chezscheme
(library (oop helpers)
(export
$make-class $class?
$class-formals $class-formal-bindings $class-ivar-bindings $class-minfos
$class-vtable-rtd $class-ctrtd
$class-vtable-expr $class-interfaces $class-init-proc
$make-interface $interface?
$interface-rtd $interface-minfos
$instance $make-instance $instance?
root-vtable-rtd
make-minfo minfo-mname minfo-hidden-mname minfo-arity minfo-formals minfo-flat-formals
construct-name parse-formals build-generic make-ivar-defn free-id-member
)
(import (chezscheme))
(define-record-type ($class $make-class $class?)
(nongenerative)
(fields
(immutable formals) ; (formal ...)
(immutable formal-bindings) ; (((base-formal base-arg) ...) ...)
(immutable ivar-bindings) ; (((ivar init) ...) ...)
(immutable minfos) ; ((mname hidden-mname arity) ...)
; same mname may appear more than once
(immutable vtable-rtd)
(immutable ctrtd)
(immutable vtable-expr)
(immutable interfaces)
(immutable init-proc)))
(define-record-type ($interface $make-interface $interface?)
(nongenerative)
(fields
(immutable rtd)
(immutable minfos)))
(define-record-type ($instance $make-instance $instance?)
(nongenerative))
;; minfos cannot be records since we insert minfos into the output of
;; define-class and define-interface and the identifiers contained within
;; these minfos must be marked/unmarked as appropriate by the expander,
;; which delves into vectors but not records
(define make-minfo
(lambda (mname hidden-name arity formals flat-formals)
(vector mname hidden-name arity formals flat-formals)))
(define minfo-mname (lambda (x) (vector-ref x 0)))
(define minfo-hidden-mname (lambda (x) (vector-ref x 1)))
(define minfo-arity (lambda (x) (vector-ref x 2)))
(define minfo-formals (lambda (x) (vector-ref x 3)))
(define minfo-flat-formals (lambda (x) (vector-ref x 4)))
(define root-vtable-rtd
(#%$make-record-type #!base-rtd #!base-rtd
"root-vtable-rtd"
'((immutable ptr interfaces))
#f
#f))
(define construct-name
(lambda (template-identifier . args)
(datum->syntax template-identifier
(string->symbol
(apply string-append
(map (lambda (x)
(if (string? x)
x
(symbol->string (syntax->datum x))))
args))))))
(define parse-formals
(lambda (fmls)
(let f ([ids fmls] [n 0])
(syntax-case ids ()
[(car . cdr)
(if (identifier? #'car)
(f #'cdr (fx+ n 1))
(syntax-error fmls "invalid method formals"))]
[() (values n fmls)]
[else
(if (identifier? #'ids)
(values
(fx- -1 n)
(let f ([ids fmls])
(syntax-case ids ()
[(x . d) (cons #'x (f #'d))]
[x #'(x)])))
(syntax-error #'fmls "invalid method formals"))]))))
(define build-generic
(lambda (minfos offsets)
(define cull-method
(lambda (mname minfos offsets)
(if (null? minfos)
(values '() '() '() '())
(let ([offset (car offsets)] [minfo (car minfos)])
(let-values ([(gminfos goffsets new-minfos new-offsets)
(cull-method mname (cdr minfos) (cdr offsets))])
(if (bound-identifier=? (minfo-mname minfo) mname)
(values
(cons minfo gminfos)
(cons offset goffsets)
new-minfos
new-offsets)
(values
gminfos
goffsets
(cons (car minfos) new-minfos)
(cons (car offsets) new-offsets))))))))
(if (null? minfos)
'()
(let ([generic-name (minfo-mname (car minfos))])
(let-values ([(gminfos goffsets minfos offsets)
(cull-method generic-name minfos offsets)])
(cons `(,generic-name
,@(map (lambda (minfo offset)
`(,(minfo-formals minfo) ,(minfo-flat-formals minfo) ,offset))
gminfos
goffsets))
(build-generic minfos offsets)))))))
(define (make-ivar-defn ivar mutable? ivar-offset)
(with-syntax ([ivar ivar] [ivar-offset ivar-offset])
(if mutable?
#'(define-syntax ivar
(identifier-syntax
[id (#3%$object-ref 'scheme-object ego ivar-offset)]
[(set! var val) (#3%$object-set! 'scheme-object ego ivar-offset val)]))
#'(define-syntax ivar
(make-variable-transformer
(lambda (x)
(syntax-case x (set!)
[id (identifier? #'id) #'(#3%$object-ref 'scheme-object ego ivar-offset)]
[(set! var val) (syntax-error x "invalid assignment of immutable ivar")])))))))
(define free-id-member
(lambda (id ls2)
(and (not (null? ls2))
(if (free-identifier=? (car ls2) id)
ls2
(free-id-member id (cdr ls2))))))
(record-writer (type-descriptor $instance)
(lambda (x p wr)
(fprintf p "#<instance of ~a>"
(let ([rtd (record-rtd x)])
(if (eq? rtd (type-descriptor $instance))
"<root>"
(record-type-name rtd))))))
; these aren't evaluated if placed in (oop), since (oop) has no
; run-time (variable) exports
(pretty-format 'define-class
'(_ (fill 0 x ...) 13 (fill 0 x ...) #f clause ...))
(pretty-format 'methods
'(_ #f (bracket x (fill 0 x ...) #f e ...) ...))
(pretty-format 'ivars
'(_ (bracket fill #f x ...) 6 (bracket fill #f x ...) ...))
(pretty-format 'define-interface
'(alt (_ var var #f (bracket x x) ...)
(_ var #f (bracket x x) ...)))
)
;;; supplies define-class, define-interface, <root>, and <root-interface>
;;; and aux keywords
(library (oop)
(export <root> <root-interface> define-interface
define-class ivars public private methods self implements init
constructor predicate prefix)
(import (chezscheme) (oop helpers))
(define-syntax <root>
(make-compile-time-value
($make-class '() '() '() '() ; formals formal-bindings ivar-bindings minfos
root-vtable-rtd
(type-descriptor $instance) ; ctrtd
#'(type-descriptor $instance) ; vtable-expr
'() ; interfaces
#'values))) ; init-expr ...
(define-syntax <root-interface>
(make-compile-time-value
($make-interface (make-record-type "base interface rtd" '()) '())))
(define-syntax define-interface
(lambda (x)
(define build-minfo
(lambda (mname formals)
(let-values ([(arity flat-formals) (parse-formals formals)])
; discard source information
(make-minfo mname "ignored" arity formals flat-formals))))
(syntax-case x ()
[(_ iname [method-name method-formals] ...)
(and (identifier? #'iname) (andmap identifier? #'(method-name ...)))
#'(define-interface iname <root-interface> [method-name method-formals] ...)]
[(_ iname base-iname [method-name method-formals] ...)
(and (identifier? #'iname) (identifier? #'base-iname) (andmap identifier? #'(method-name ...)))
(lambda (r)
(let ([bi (r #'base-iname)])
(unless ($interface? bi)
(syntax-error #'base-iname
"define-interface: unrecognized base interface"))
(let ([base-mnames (with-syntax ([(#(base-mname base-hidden-name base-arity base-formals base-flat-formals) ...) ($interface-minfos bi)])
#'(base-mname ...))])
(let f ([ls #'(method-name ...)])
(unless (null? ls)
(when (free-id-member (car ls) base-mnames)
(syntax-error (car ls) "conflict with inherited interface method"))
(f (cdr ls)))))
(with-syntax ([(base-minfo ...) ($interface-minfos bi)]
[(minfo ...) (map build-minfo #'(method-name ...) #'(method-formals ...))])
(with-syntax ([iface-rtd
(make-record-type ($interface-rtd bi)
(symbol->string (syntax->datum #'iname))
(syntax->datum (map minfo-mname #'(minfo ...))))])
(with-syntax ([((generic-name (generic-formals generic-flat-formals generic-offset) ...) ...)
(build-generic
#'(minfo ...)
(let ([ls (#%$record-type-field-offsets #'iface-rtd)])
(list-tail ls (- (length ls) (length #'(minfo ...))))))]
[opt3 (= (optimize-level) 3)])
#`(begin
(define-syntax iname (make-compile-time-value ($make-interface 'iface-rtd #'(base-minfo ... minfo ...))))
(define (qi who ego)
(define get-interfaces (#3%record-accessor '#,root-vtable-rtd 0))
(or (and (or opt3 (#3%record? ego))
(let ([rtd (#3%record-rtd ego)])
(and (or opt3 (#3%record? rtd '#,root-vtable-rtd))
(#3%ormap (lambda (i) (and (#3%record? i 'iface-rtd) i))
(get-interfaces rtd)))))
(errorf who "not applicable to ~s" ego)))
(define generic-name
(let ([who 'generic-name]) ; can't ref generic-name pattern vble inside ... below
(case-lambda
[(ego . generic-formals)
((#3%$object-ref 'scheme-object (qi who ego) generic-offset)
ego . generic-flat-formals)]
...)))
...))))))])))
(define-syntax define-class
(lambda (x)
(define build-minfo
(lambda (mname formals hidden)
(let-values ([(arity flat-formals) (parse-formals formals)])
(make-minfo mname hidden arity formals flat-formals))))
(define build-method
(lambda (minfo class-name body base-minfos)
(define cull-super
(lambda (mname minfos)
(if (null? minfos)
'()
(let ([minfo (car minfos)])
(if (free-identifier=? (minfo-mname minfo) mname)
(cons minfo (cull-super mname (cdr minfos)))
(cull-super mname (cdr minfos)))))))
(with-syntax ([(formal ...) (minfo-flat-formals minfo)]
[body body]
[super-definition
(with-syntax ([super (datum->syntax class-name 'super)])
(if (not (null? base-minfos))
(with-syntax ([(#(mname hidden-name arity formals flat-formals) ...)
(cull-super (minfo-mname minfo) base-minfos)])
#'(define super (case-lambda [formals (hidden-name ego . flat-formals)] ...)))
(with-syntax ([mname (minfo-mname minfo)] [class-name class-name])
#'(define-syntax super
(lambda (x)
(syntax-error x
(format "no inherited ~s method for ~s in" 'mname 'class-name)))))))])
#'(lambda (i formal ...)
(fluid-let-syntax ([ego (identifier-syntax i)])
super-definition
body)))))
(define unwrap-minfos
(lambda (minfos)
; need list/vector structure, with arity unwrapped
(with-syntax ([(#(mname hidden-name arity formals flat-formals) ...) minfos])
(with-syntax ([(arity ...) (syntax->datum #'(arity ...))])
#'(#(mname hidden-name arity formals flat-formals) ...)))))
(define build-interface-vtable
(lambda (minfos)
(lambda (iface)
(with-syntax
([irtd ($interface-rtd iface)]
[(hidden ...)
(map (lambda (iminfo)
(let ([mname (minfo-mname iminfo)] [arity (minfo-arity iminfo)])
(let f ([minfos minfos])
(cond
[(null? minfos) (syntax-error (minfo-mname iminfo) "no suitable implementation for interface method")]
[(minfo-match? (car minfos) mname arity) (minfo-hidden-mname (car minfos))]
[else (f (cdr minfos))]))))
(unwrap-minfos ($interface-minfos iface)))])
#'(#3%$record 'irtd hidden ...)))))
(define minfo-match?
(lambda (minfo mname arity)
(and (= arity (minfo-arity minfo))
(free-identifier=? mname (minfo-mname minfo)))))
(define process-methods
(lambda (class-name interfaces all-base-minfos minfos bodies)
(let f ([minfos minfos])
(unless (null? minfos)
(let ([mname (minfo-mname (car minfos))] [arity (minfo-arity (car minfos))])
(let f ([ls (cdr minfos)])
(unless (null? ls)
(if (minfo-match? (car ls) mname arity)
(syntax-error (minfo-mname (car ls)) "duplicate arity for method")
(f (cdr ls))))))
(f (cdr minfos))))
(let ([base-mnames (map minfo-mname all-base-minfos)])
(let f ([base-minfos all-base-minfos] [minfos minfos] [bodies bodies] [mlambdas '()] [all-minfos '()])
(if (null? base-minfos)
(let f ([minfos minfos] [bodies bodies] [mlambdas mlambdas] [all-minfos all-minfos] [generics '()])
(if (null? minfos)
(begin
; We should never create a new generic method that matches the name of
; an interface method. (If the generic method made it this far then we
; know it didn't match the arity of the interface method. If it did it
; would have been filtered out.)
(for-each
(lambda (generic)
(let ([mname (minfo-mname generic)])
(for-each
(lambda (i)
(for-each
(lambda (m)
(let ([interface-mname (minfo-mname m)])
(when (free-identifier=? mname interface-mname)
(syntax-error mname "arity not supported by interface method"))))
(unwrap-minfos ($interface-minfos i))))
interfaces)))
generics)
(list (reverse all-minfos)
(reverse mlambdas)
(reverse generics)
; We need to build a list of minfos that will actually be included in the class vtable--
; ie, minfos that appear in this class and/or any super-class (but not in any interface).
; That list will match up with the vtable offsets.
(let f ([possibly-included-minfos all-minfos] [included-minfos '()])
(if (null? possibly-included-minfos)
included-minfos
(let ([minfo (car possibly-included-minfos)])
(let ([mname (minfo-mname minfo)] [arity (minfo-arity minfo)])
(f (cdr possibly-included-minfos)
(if (ormap
(lambda (i)
(ormap (lambda (m) (minfo-match? m mname arity))
(unwrap-minfos ($interface-minfos i))))
interfaces)
included-minfos
(cons minfo included-minfos)))))))))
(let ([minfo (car minfos)])
(let ([mname (minfo-mname minfo)] [arity (minfo-arity minfo)])
(when (ormap (lambda (base-mname) (free-identifier=? mname base-mname)) base-mnames)
(syntax-error mname "arity not supported by base class method"))
(f (cdr minfos)
(cdr bodies)
(cons
(list (minfo-hidden-mname minfo)
(build-method minfo class-name (car bodies) '()))
mlambdas)
(cons minfo all-minfos)
(if (ormap
(lambda (i)
(ormap (lambda (m) (minfo-match? m mname arity))
(unwrap-minfos ($interface-minfos i))))
interfaces)
generics
(cons minfo generics)))))))
(let ([base-minfo (car base-minfos)])
(let ([base-mname (minfo-mname base-minfo)] [base-arity (syntax->datum (minfo-arity base-minfo))])
(let find-method ([xminfos minfos] [xbodies bodies])
(cond
[(null? xminfos)
(f (cdr base-minfos) minfos bodies mlambdas
(cons base-minfo all-minfos))]
[(and (= base-arity (minfo-arity (car xminfos)))
(free-identifier=? base-mname (minfo-mname (car xminfos))))
(f (cdr base-minfos)
(remq (car xminfos) minfos)
(remq (car xbodies) bodies)
(cons (list (minfo-hidden-mname (car xminfos))
(build-method (car xminfos) class-name (car xbodies) all-base-minfos))
mlambdas)
(cons (car xminfos) all-minfos))]
[else (find-method (cdr xminfos) (cdr xbodies))])))))))))
(define free-id-union
(lambda (ls1 ls2)
(if (null? ls1)
ls2
(if (free-id-member (car ls1) ls2)
(free-id-union (cdr ls1) ls2)
(cons (car ls1) (free-id-union (cdr ls1) ls2))))))
(module (parse-clauses)
(define-syntax define-option-parser
(lambda (x)
(syntax-case x (else)
[(_ name [desc (kwd ...) ([var default] ...) pattern guard expr] ...)
(with-syntax ([(seen? ...) (generate-temporaries #'(desc ...))])
#'(begin
(define (option-parser x*)
(let f ([x* x*] [seen? #f] ... [var default] ... ...)
(if (null? x*)
(values var ... ...)
(syntax-case (car x*) (kwd ... ...)
[pattern
guard
(begin
(when seen?
(syntax-error (car x*)
(format "extra ~a" desc)))
(let ([seen? #t])
(let-values ([(var ...) expr])
(f (cdr x*) seen? ... var ... ...))))]
...))))
(define-syntax name
(lambda (x)
(syntax-case x ()
[(k x* b1 b2 (... ...))
(with-implicit (k var ... ...)
#'(let-values ([(var ... ...) (option-parser x*)])
b1 b2 (... ...)))])))))])))
(define (valid-type? x) (eq? x 'scheme-object))
(define-option-parser parse-modifiers
["ivar mutability modifier" () ([mutable? #t])
x
(or (literal-identifier=? #'x #'mutable) (literal-identifier=? #'x #'immutable))
(literal-identifier=? #'x #'mutable)]
["ivar public/private modifier" () ([public? #f])
x
(or (literal-identifier=? #'x #'public) (literal-identifier=? #'x #'private))
(literal-identifier=? #'x #'public)]
["ivar type" () ([type 'scheme-object])
x
(valid-type? (datum x))
(datum x)]
["" () () x #t (syntax-error #'x "invalid ivar modifier")])
(define-option-parser parse-clauses
["implements clause" (implements) ([iface* '()])
(implements iface ...)
(andmap identifier? (syntax->list #'(iface ...)))
(syntax->list #'(iface ...))]
["ivars clause" (ivars) ([public?* '()] [mutable?* '()] [ivar* '()] [ivar-init* '()])
(ivars (modifier ... ivar ivar-init) ...)
(andmap identifier? (syntax->list #'(ivar ...)))
(let-values ([(public?* mutable?*)
(let f ([modifier** (syntax->list #'((modifier ...) ...))])
(if (null? modifier**)
(values '() '())
(let-values ([(public?* mutable?*) (f (cdr modifier**))])
(parse-modifiers (syntax->list (car modifier**))
(values (cons public? public?*)
(cons mutable? mutable?*))))))])
(values public?* mutable?* (syntax->list #'(ivar ...)) (syntax->list #'(ivar-init ...))))]
["init clause" (init) ([init-expr* '()])
(init init-expr ...)
#t
(syntax->list #'(init-expr ...))]
["methods clause" (methods) ([method-name* '()] [method-formals* '()] [method-body* '()])
(methods method ...)
#t
(let f ([method* (syntax->list #'(method ...))])
(if (null? method*)
(values '() '() '())
(let-values ([(method) (car method*)]
[(method-name* method-formals* method-body*) (f (cdr method*))])
(syntax-case method ()
[(method-name method-formals method-b1 method-b2 ...)
(values
(cons #'method-name method-name*)
(cons #'method-formals method-formals*)
(cons #'(let () method-b1 method-b2 ...) method-body*))]
[method (syntax-error #'method "invalid method syntax")]))))]
["constructor clause" (constructor) ([constructor-id #f])
(constructor id)
(identifier? #'id)
#'id]
["predicate clause" (predicate) ([predicate-id #f])
(predicate id)
(identifier? #'id)
#'id]
["prefix clause" (prefix) ([prefix-string #f])
(prefix str)
(string? (datum str))
(datum str)]
["" () () x #t (syntax-error #'x "invalid define-class clause")]))
(syntax-case x ()
[(_ (class-name class-formal ...) (base-name base-arg ...) clause ...)
(parse-clauses (syntax->list #'(clause ...))
(lambda (r)
(let ([bc (r #'base-name)])
(unless ($class? bc)
(syntax-error #'base-name
"define-class: unrecognized base class"))
(let f ([ls ivar*])
(define bound-id-member?
(lambda (x ls)
(and (not (null? ls))
(or (bound-identifier=? (car ls) x)
(bound-id-member? x (cdr ls))))))
(unless (null? ls)
(if (bound-id-member? (car ls) (cdr ls))
(syntax-error (car ls) "duplicate instance variable")
(f (cdr ls)))))
(with-syntax ([(iface-name ...) (free-id-union
iface*
(syntax->list ($class-interfaces bc)))])
(with-syntax ([(interface ...)
(map (lambda (x)
(let ([iface (r x)])
(unless ($interface? iface) (syntax-error x "unrecognized interface"))
iface))
#'(iface-name ...))])
(with-syntax ([(((base-ivar base-ivar-init) ...) ...) ($class-ivar-bindings bc)]
[base-init-proc ($class-init-proc bc)]
[(base-formal-binding ...)
(with-syntax ([(base-formal ...) ($class-formals bc)]
[(base-base-formal-binding ...) ($class-formal-bindings bc)])
(unless (= (length #'(base-arg ...)) (length #'(base-formal ...)))
(syntax-error #'base-name
"incorrect number of arguments to base class"))
#'(((base-formal base-arg) ...) base-base-formal-binding ...))]
[((all-minfo ...) ((new-hidden-mname mlambda) ...) (generic ...) (included-minfo ...))
(process-methods #'class-name #'(interface ...)
(unwrap-minfos ($class-minfos bc))
(map build-minfo
method-name*
method-formals*
(generate-temporaries method-name*))
method-body*)]
[self (datum->syntax #'class-name 'self)])
(let ([name (let ([name (datum class-name)])
(if (gensym? name)
name
(symbol->string name)))]
[nongenerative? (and (null? #'(all-minfo ...))
(null? #'(interface ...)))]
[flds (map list
(map (lambda (x) (if x 'mutable 'immutable)) mutable?*)
(map (lambda (x) 'ptr) ivar*)
(syntax->datum ivar*))])
(when (gensym? name)
(unless nongenerative?
(syntax-error #'class-name
"cannot specify gensym class-name with methods or interfaces")))
(with-syntax ([ctrtd (#%$make-record-type
#!base-rtd
($class-ctrtd bc)
name
flds
#f
#f)]
[vtable-rtd (#%$make-record-type
#!base-rtd
($class-vtable-rtd bc)
"compile-time-vtable-rtd"
(syntax->datum (map minfo-mname #'(generic ...)))
#f
#f)])
(with-syntax ([(ivar ...) ivar*]
[(ivar-init ...) ivar-init*]
[(ivar-defn ...)
(map make-ivar-defn
ivar*
mutable?*
(let ([offsets (#%$record-type-field-offsets #'ctrtd)])
(list-tail offsets (- (length offsets) (length ivar*)))))])
(with-syntax ([init-proc
(with-syntax ([(init-expr ...) init-expr*])
#'(lambda (ego)
(base-init-proc ego)
(let ()
ivar-defn
...
(define-syntax self (identifier-syntax ego))
init-expr ...
ego)))]
[vtable-expr
(if nongenerative?
#''ctrtd
(with-syntax ([(vtable-init ...) (map minfo-hidden-mname #'(included-minfo ...))]
[parent-rtd ($class-vtable-expr bc)]
[name (datum->syntax #'class-name name)]
[flds (datum->syntax #'class-name flds)]
[(iface-elt ...)
(map (build-interface-vtable #'(all-minfo ...)) #'(interface ...))])
#'(#%$make-record-type
'vtable-rtd
parent-rtd
name
'flds
#f
#f
(list iface-elt ...)
vtable-init ...)))]
[((generic-name (generic-formals generic-flat-formals generic-offset) ...) ...)
(build-generic
#'(generic ...)
(let ([offsets (#%$record-type-field-offsets #'vtable-rtd)] [minfos #'(included-minfo ...)])
(let f ([offsets (list-tail offsets (- (length offsets) (length minfos)))]
[minfos minfos]
[generics #'(generic ...)])
(if (null? generics)
'()
(if (eq? (car generics) (car minfos))
(cons (car offsets) (f (cdr offsets) (cdr minfos) (cdr generics)))
(f (cdr offsets) (cdr minfos) generics))))))]
[opt3 (= (optimize-level) 3)])
(with-syntax ([maker-name (or constructor-id (construct-name #'class-name "make-" #'class-name))]
[maker-body
(let f ([ls #'(base-formal-binding ...)])
(syntax-case ls ()
[(((lhs rhs) ...))
#'(let ((lhs rhs) ...)
(init-proc (let* ([base-ivar base-ivar-init] ... ... [ivar ivar-init] ...)
(#3%$record vtable base-ivar ... ... ivar ...))))]
[(((lhs rhs) ...) m ...)
(with-syntax ([body (f #'(m ...))])
#'(let ((lhs rhs) ...) body))]))]
[pred-name (or predicate-id (construct-name #'class-name #'class-name "?"))]
[((accessor-name . accessor) ...)
(let ([offset* (let ([offset* (#%$record-type-field-offsets #'ctrtd)])
(list-tail offset* (- (length offset*) (length ivar*))))]
[prefix-string (or prefix-string (format "~a-" (datum class-name)))])
(let f ([ivar* ivar*] [offset* offset*] [public?* public?*])
(if (null? ivar*)
'()
(with-syntax ([rest (f (cdr ivar*) (cdr offset*) (cdr public?*))])
(if (car public?*)
(with-syntax ([accessor-name (construct-name (car ivar*) prefix-string (car ivar*))]
[offset (car offset*)])
#'((accessor-name .
(lambda (x)
(unless (or opt3 (record? x vtable))
(errorf 'accessor-name "not applicable to ~s" x))
(#3%$object-ref 'scheme-object x offset)))
. rest))
#'rest)))))]
[((mutator-name . mutator) ...)
(let ([offset* (let ([offset* (#%$record-type-field-offsets #'ctrtd)])
(list-tail offset* (- (length offset*) (length ivar*))))]
[prefix-string (or prefix-string (format "~a-" (datum class-name)))])
(let f ([ivar* ivar*] [offset* offset*] [public?* public?*] [mutable?* mutable?*])
(if (null? ivar*)
'()
(with-syntax ([rest (f (cdr ivar*) (cdr offset*) (cdr public?*) (cdr mutable?*))])
(if (and (car public?*) (car mutable?*))
(with-syntax ([mutator-name (construct-name (car ivar*) prefix-string (car ivar*) "-set!")]
[offset (car offset*)])
#'((mutator-name .
(lambda (x v)
(unless (or opt3 (record? x vtable))
(errorf 'mutator-name "not applicable to ~s" x))
(#3%$object-set! 'scheme-object x offset v)))
. rest))
#'rest)))))])
#'(begin
; we use a module here (1) to attach necessary
; indirect exports to class-name in case class-name
; is exported from a top-level module and
; (2) so that we can define vtable after
; new-hidden-mname ... yet still have the introduced
; identifier vtable resolve to the correct binding
; in the method bodies. we don't wrap the entire
; define-class output in a module form since we want
; the pred-name, maker-name, and the generic names
; to be ordinary top-level variables at top level.
(module ((class-name vtable new-hidden-mname ...) vtable new-hidden-mname ...)
(module (new-hidden-mname ...)
; local ego for fluid-let-syntax to whack
(define-syntax ego values)
ivar-defn
...
(define-syntax self (identifier-syntax ego))
(define new-hidden-mname mlambda) ...)
; counting on letrec* semantics below so that
; new-hidden-mname ... are defined before referenced
; in vtable-expr
(define vtable vtable-expr)
(define-syntax class-name
(make-compile-time-value
($make-class
#'(class-formal ...)
#'(base-formal-binding ...)
#'(([base-ivar base-ivar-init] ...) ... ([ivar ivar-init] ...))
#'(all-minfo ...)
'vtable-rtd
'ctrtd
#'vtable
#'(iface-name ...)
#'init-proc))))
(define (pred-name x) (#3%record? x vtable))
(define (maker-name class-formal ...) maker-body)
(define accessor-name accessor) ...
(define mutator-name mutator) ...
(define generic-name
(let ([who 'generic-name]) ; can't ref generic-name pattern vble inside ... below
(case-lambda
[(ego . generic-formals)
(unless (or opt3 (#3%record? ego vtable))
(errorf who "not applicable to ~s" ego))
((#3%$object-ref 'scheme-object (#3%record-rtd ego) generic-offset)
ego . generic-flat-formals)]
...)))
...))))))))))))])))
(define-syntax aux
(syntax-rules ()
[(_ kwd)
(define-syntax kwd
(lambda (x)
(syntax-error x "misplaced aux keyword")))]))
(aux ivars)
(aux public)
(aux private)
(aux methods)
(aux self)
(aux implements)
(aux init)
; constructor, predicate, and prefix are defined by (chezscheme)
#;(aux constructor)
#;(aux predicate)
#;(aux prefix)
)

View file

@ -0,0 +1,73 @@
*** errors-compile-0-f-f-f 2020-02-28 00:39:54.092147000 -0500
--- errors-compile-0-f-f-t 2020-02-28 00:49:23.793545013 -0500
***************
*** 3887,3893 ****
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation -1".
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation "static"".
misc.mo:Expected error in mat make-object-finder: "make-object-finder: 17 is not a procedure".
! misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation 5".
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation oldgen".
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation -1".
misc.mo:Expected error in mat make-object-finder: "incorrect number of arguments to #<procedure find-next>".
--- 3887,3893 ----
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation -1".
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation "static"".
misc.mo:Expected error in mat make-object-finder: "make-object-finder: 17 is not a procedure".
! misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation 7".
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation oldgen".
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation -1".
misc.mo:Expected error in mat make-object-finder: "incorrect number of arguments to #<procedure find-next>".
***************
*** 7426,7436 ****
7.mo:Expected error in mat sstats: "set-sstats-gc-bytes!: twelve is not an exact integer".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation yuk".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation -1".
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 5".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation <int>".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation #f".
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 5".
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 5".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
--- 7426,7436 ----
7.mo:Expected error in mat sstats: "set-sstats-gc-bytes!: twelve is not an exact integer".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation yuk".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation -1".
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 7".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation <int>".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation #f".
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 7".
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 7".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
***************
*** 8890,8902 ****
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".
! fx.mo:Expected error in mat fx*: "fx*: fixnum overflow with arguments <int> and 2".
fx.mo:Expected error in mat fx*: "fx*: <int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: <-int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat r6rs:fx*: "fx*: (a . b) is not a fixnum".
! fx.mo:Expected error in mat r6rs:fx*: "fx*: fixnum overflow with arguments <int> and 2".
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".
--- 8890,8902 ----
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".
! fx.mo:Expected error in mat fx*: "fx*: fixnum overflow computing (fx* <int> 2)".
fx.mo:Expected error in mat fx*: "fx*: <int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: <-int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat r6rs:fx*: "fx*: (a . b) is not a fixnum".
! fx.mo:Expected error in mat r6rs:fx*: "fx*: fixnum overflow computing (fx* <int> 2)".
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".

381
mats/patch-compile-0-f-t-f Normal file
View file

@ -0,0 +1,381 @@
*** patches-work-dir/errors-compile-0-f-f-f 2022-05-08 20:43:10.000000000 -0700
--- patches-work-dir/errors-compile-0-f-t-f 2022-05-08 20:43:10.000000000 -0700
***************
*** 178,184 ****
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable c".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable m".
! 3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable y".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
--- 178,184 ----
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable c".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable m".
! 3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable b".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable y".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
***************
*** 197,203 ****
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable b".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable a".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
! 3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable c".
3.mo:Expected warning in mat cpvalid: "possible attempt to reference undefined variable x".
--- 197,203 ----
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable b".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable a".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
! 3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable c".
3.mo:Expected warning in mat cpvalid: "possible attempt to reference undefined variable x".
***************
*** 244,253 ****
3.mo:Expected error in mat mrvs: "returned three values to single value return context".
3.mo:Expected error in mat mrvs: "returned three values to single value return context".
3.mo:Expected error in mat mrvs: "returned zero values to single value return context".
! 3.mo:Expected error in mat mrvs: "incorrect number of values received in multiple value context".
! 3.mo:Expected error in mat mrvs: "returned zero values to single value return context".
! 3.mo:Expected error in mat mrvs: "incorrect number of values received in multiple value context".
! 3.mo:Expected error in mat mrvs: "incorrect number of values received in multiple value context".
3.mo:Expected error in mat mrvs: "variable $mrvs-foo is not bound".
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".
--- 244,253 ----
3.mo:Expected error in mat mrvs: "returned three values to single value return context".
3.mo:Expected error in mat mrvs: "returned three values to single value return context".
3.mo:Expected error in mat mrvs: "returned zero values to single value return context".
! 3.mo:Expected error in mat mrvs: "incorrect argument count in call (call-with-values (lambda () 5 (values 2)) (lambda (x y) (+ x y)))".
! 3.mo:Expected error in mat mrvs: "incorrect argument count in call (call-with-values values (lambda (x) x))".
! 3.mo:Expected error in mat mrvs: "incorrect argument count in call (call-with-values values (lambda (x y) x))".
! 3.mo:Expected error in mat mrvs: "incorrect argument count in call (call-with-values f (lambda (x y) x))".
3.mo:Expected error in mat mrvs: "variable $mrvs-foo is not bound".
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".
***************
*** 3932,3938 ****
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".
! misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable foo at line 1, char 108 of testfile.ss".
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".
--- 3932,3938 ----
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".
! misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable bar at line 1, char 76 of testfile.ss".
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".
***************
*** 7579,7586 ****
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".
! record.mo:Expected error in mat record1: "invalid value 3 for foreign type double-float".
! record.mo:Expected error in mat record1: "3 is not of type #<record type fudge>".
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)".
--- 7579,7586 ----
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".
! record.mo:Expected error in mat record1: "make-fudge: invalid value 3 for foreign type double-float".
! record.mo:Expected error in mat record1: "fudge-a: 3 is not of type #<record type fudge>".
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)".
***************
*** 7588,7602 ****
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".
! record.mo:Expected error in mat record4: "3 is not of type #<record type fudge>".
! record.mo:Expected error in mat record5: "invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record5: "invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record6: "invalid value <int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "invalid value <-int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "invalid value 23.0 for foreign type integer-32".
! record.mo:Expected error in mat record7: "invalid value <int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "invalid value <-int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "invalid value 23.0 for foreign type unsigned-32".
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".
--- 7588,7602 ----
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".
! record.mo:Expected error in mat record4: "set-fudge-a!: 3 is not of type #<record type fudge>".
! record.mo:Expected error in mat record5: "set-fudge-b!: invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record5: "set-fudge-b!: invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record6: "make-bar: invalid value <int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "make-bar: invalid value <-int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "make-bar: invalid value 23.0 for foreign type integer-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value <int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value <-int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value 23.0 for foreign type unsigned-32".
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".
***************
*** 7609,7634 ****
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>".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "invalid value 3 for foreign type single-float".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type single-float".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type integer-16".
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".
--- 7609,7634 ----
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>".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 3 for foreign type single-float".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "set-$froz-y!: invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "set-$froz-z!: invalid value 2 for foreign type single-float".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -32769 for foreign type integer-16".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value -32769 for foreign type integer-16".
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".
***************
*** 7763,7801 ****
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>".
! record.mo:Expected error in mat record25: "invalid value 1.0 for foreign type int".
! record.mo:Expected error in mat record25: "invalid value 2.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "invalid value three for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "invalid value 1/4 for foreign type short".
! record.mo:Expected error in mat record25: "invalid value "five" for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "invalid value (6) for foreign type long".
! record.mo:Expected error in mat record25: "invalid value #(a b c d e f ...) for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "invalid value ate for foreign type iptr".
! 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".
record.mo:Expected error in mat record25: "incorrect number of arguments to #<procedure make-r25-bar>".
! 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".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type short".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type iptr".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type uptr".
! record.mo:Expected error in mat record25: "invalid value 3 for foreign type float".
! record.mo:Expected error in mat record25: "invalid value 3 for foreign type double".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type char".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type wchar".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type fixnum".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type void*".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "invalid value <int> for foreign type int".
! record.mo:Expected error in mat record25: "invalid value <-int> for foreign type int".
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".
--- 7763,7801 ----
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>".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 1.0 for foreign type int".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 2.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value three for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 1/4 for foreign type short".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value "five" for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value (6) for foreign type long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value #(a b c d e f ...) for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value ate for foreign type iptr".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value #\9 for foreign type uptr".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 10 for foreign type float".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 11.0+0.0i for foreign type double".
record.mo:Expected error in mat record25: "incorrect number of arguments to #<procedure make-r25-bar>".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 12.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 13.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value 3.0 for foreign type int".
! record.mo:Expected error in mat record25: "set-r25-bar-b!: invalid value 3.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "set-r25-bar-c!: invalid value 3.0 for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "set-r25-bar-d!: invalid value 3.0 for foreign type short".
! record.mo:Expected error in mat record25: "set-r25-bar-e!: invalid value 3.0 for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "set-r25-bar-f!: invalid value 3.0 for foreign type long".
! record.mo:Expected error in mat record25: "set-r25-bar-g!: invalid value 3.0 for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "set-r25-bar-h!: invalid value 3.0 for foreign type iptr".
! record.mo:Expected error in mat record25: "set-r25-bar-i!: invalid value 3.0 for foreign type uptr".
! record.mo:Expected error in mat record25: "set-r25-bar-j!: invalid value 3 for foreign type float".
! record.mo:Expected error in mat record25: "set-r25-bar-k!: invalid value 3 for foreign type double".
! record.mo:Expected error in mat record25: "set-r25-bar-m!: invalid value 3.0 for foreign type char".
! record.mo:Expected error in mat record25: "set-r25-bar-n!: invalid value 3.0 for foreign type wchar".
! record.mo:Expected error in mat record25: "set-r25-bar-o!: invalid value 3.0 for foreign type fixnum".
! record.mo:Expected error in mat record25: "set-r25-bar-p!: invalid value 3.0 for foreign type void*".
! record.mo:Expected error in mat record25: "set-r25-bar-r!: invalid value 3.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-s!: invalid value 3.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value <int> for foreign type int".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value <-int> for foreign type int".
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".
***************
*** 7810,7866 ****
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".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure constructor>".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 0 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 1 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "parent record type is sealed ex3".
! record.mo:Expected error in mat r6rs-records-syntactic: "#<record of type point> is not of type #<record type point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "#<record of type cpoint> is not of type #<record type point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "#<record of type cpoint> is not of type #<record type cpoint>".
! record.mo:Expected error in mat r6rs-records-syntactic: "#<record of type cpoint> is not of type #<record type cpoint>".
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: "#<record of type cpoint> is not of type #<record type cpoint>".
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".
--- 7810,7866 ----
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".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure n>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure n>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure pcons>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure pcons>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect argument count in call (ccons 1)".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect argument count in call (ccons 1 2 3)".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect argument count in call (n (+ z 7) w "what?")".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect argument count in call ((p x 17) y (quote #(oops)))".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-x>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-y>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 0 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 1 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-x>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-y>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "parent record type is sealed ex3".
! record.mo:Expected error in mat r6rs-records-syntactic: "point-x: #<record of type point> is not of type #<record type point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "point-x: #<record of type cpoint> is not of type #<record type point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "cpoint-rgb: #<record of type cpoint> is not of type #<record type cpoint>".
! record.mo:Expected error in mat r6rs-records-syntactic: "cpoint-rgb: #<record of type cpoint> is not of type #<record type cpoint>".
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: "cpoint-rgb: #<record of type cpoint> is not of type #<record type cpoint>".
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".

View file

@ -0,0 +1,31 @@
*** errors-compile-0-f-t-f 2017-06-06 15:57:35.377030441 -0400
--- errors-compile-0-f-t-t 2017-06-06 15:59:53.402609438 -0400
***************
*** 8461,8473 ****
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".
! fx.mo:Expected error in mat fx*: "fx*: fixnum overflow with arguments <int> and 2".
fx.mo:Expected error in mat fx*: "fx*: <int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: <-int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat r6rs:fx*: "fx*: (a . b) is not a fixnum".
! fx.mo:Expected error in mat r6rs:fx*: "fx*: fixnum overflow with arguments <int> and 2".
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".
--- 8461,8473 ----
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".
! fx.mo:Expected error in mat fx*: "fx*: fixnum overflow computing (fx* <int> 2)".
fx.mo:Expected error in mat fx*: "fx*: <int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: <-int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat r6rs:fx*: "fx*: (a . b) is not a fixnum".
! fx.mo:Expected error in mat r6rs:fx*: "fx*: fixnum overflow computing (fx* <int> 2)".
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".

6215
mats/patch-compile-0-t-f-f Normal file

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,44 @@
*** errors-compile-0-t-f-f 2020-02-28 00:59:57.516641553 -0500
--- errors-compile-0-t-f-t 2020-02-28 00:44:53.297052688 -0500
***************
*** 3887,3893 ****
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation -1".
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation "static"".
misc.mo:Expected error in mat make-object-finder: "make-object-finder: 17 is not a procedure".
! misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation 5".
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation oldgen".
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation -1".
misc.mo:Expected error in mat make-object-finder: "incorrect number of arguments to #<procedure find-next>".
--- 3887,3893 ----
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation -1".
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation "static"".
misc.mo:Expected error in mat make-object-finder: "make-object-finder: 17 is not a procedure".
! misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation 2".
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation oldgen".
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation -1".
misc.mo:Expected error in mat make-object-finder: "incorrect number of arguments to #<procedure find-next>".
***************
*** 7426,7436 ****
7.mo:Expected error in mat sstats: "set-sstats-gc-bytes!: twelve is not an exact integer".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation yuk".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation -1".
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 5".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation <int>".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation #f".
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 5".
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 5".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
--- 7426,7436 ----
7.mo:Expected error in mat sstats: "set-sstats-gc-bytes!: twelve is not an exact integer".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation yuk".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation -1".
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 2".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation <int>".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation #f".
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 2".
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 2".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".

299
mats/patch-compile-0-t-t-f Normal file
View file

@ -0,0 +1,299 @@
*** errors-compile-0-t-f-f 2020-02-28 00:59:57.516641553 -0500
--- errors-compile-0-t-t-f 2020-02-28 00:55:03.513627852 -0500
***************
*** 197,203 ****
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable b".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable a".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
! 3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable c".
3.mo:Expected warning in mat cpvalid: "possible attempt to reference undefined variable x".
--- 197,203 ----
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable b".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable a".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
! 3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable c".
3.mo:Expected warning in mat cpvalid: "possible attempt to reference undefined variable x".
***************
*** 3929,3935 ****
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".
! misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable foo at line 1, char 108 of testfile.ss".
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".
--- 3929,3935 ----
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".
! misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable bar at line 1, char 76 of testfile.ss".
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".
***************
*** 7436,7443 ****
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".
! record.mo:Expected error in mat record1: "invalid value 3 for foreign type double-float".
! record.mo:Expected error in mat record1: "3 is not of type #<record type fudge>".
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)".
--- 7436,7443 ----
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".
! record.mo:Expected error in mat record1: "make-fudge: invalid value 3 for foreign type double-float".
! record.mo:Expected error in mat record1: "fudge-a: 3 is not of type #<record type fudge>".
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)".
***************
*** 7445,7459 ****
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".
! record.mo:Expected error in mat record4: "3 is not of type #<record type fudge>".
! record.mo:Expected error in mat record5: "invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record5: "invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record6: "invalid value <int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "invalid value <-int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "invalid value 23.0 for foreign type integer-32".
! record.mo:Expected error in mat record7: "invalid value <int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "invalid value <-int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "invalid value 23.0 for foreign type unsigned-32".
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".
--- 7445,7459 ----
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".
! record.mo:Expected error in mat record4: "set-fudge-a!: 3 is not of type #<record type fudge>".
! record.mo:Expected error in mat record5: "set-fudge-b!: invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record5: "set-fudge-b!: invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record6: "make-bar: invalid value <int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "make-bar: invalid value <-int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "make-bar: invalid value 23.0 for foreign type integer-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value <int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value <-int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value 23.0 for foreign type unsigned-32".
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".
***************
*** 7466,7491 ****
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>".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "invalid value 3 for foreign type single-float".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type single-float".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type integer-16".
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".
--- 7466,7491 ----
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>".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 3 for foreign type single-float".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "set-$froz-y!: invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "set-$froz-z!: invalid value 2 for foreign type single-float".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -32769 for foreign type integer-16".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value -32769 for foreign type integer-16".
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".
***************
*** 7616,7654 ****
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>".
! record.mo:Expected error in mat record25: "invalid value 1.0 for foreign type int".
! record.mo:Expected error in mat record25: "invalid value 2.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "invalid value three for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "invalid value 1/4 for foreign type short".
! record.mo:Expected error in mat record25: "invalid value "five" for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "invalid value (6) for foreign type long".
! record.mo:Expected error in mat record25: "invalid value #(a b c d e f ...) for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "invalid value ate for foreign type iptr".
! 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".
record.mo:Expected error in mat record25: "incorrect number of arguments to #<procedure make-r25-bar>".
! 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".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type short".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type iptr".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type uptr".
! record.mo:Expected error in mat record25: "invalid value 3 for foreign type float".
! record.mo:Expected error in mat record25: "invalid value 3 for foreign type double".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type char".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type wchar".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type fixnum".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type void*".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "invalid value <int> for foreign type int".
! record.mo:Expected error in mat record25: "invalid value <-int> for foreign type int".
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".
--- 7616,7654 ----
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>".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 1.0 for foreign type int".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 2.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value three for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 1/4 for foreign type short".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value "five" for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value (6) for foreign type long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value #(a b c d e f ...) for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value ate for foreign type iptr".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value #\9 for foreign type uptr".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 10 for foreign type float".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 11.0+0.0i for foreign type double".
record.mo:Expected error in mat record25: "incorrect number of arguments to #<procedure make-r25-bar>".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 12.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 13.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value 3.0 for foreign type int".
! record.mo:Expected error in mat record25: "set-r25-bar-b!: invalid value 3.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "set-r25-bar-c!: invalid value 3.0 for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "set-r25-bar-d!: invalid value 3.0 for foreign type short".
! record.mo:Expected error in mat record25: "set-r25-bar-e!: invalid value 3.0 for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "set-r25-bar-f!: invalid value 3.0 for foreign type long".
! record.mo:Expected error in mat record25: "set-r25-bar-g!: invalid value 3.0 for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "set-r25-bar-h!: invalid value 3.0 for foreign type iptr".
! record.mo:Expected error in mat record25: "set-r25-bar-i!: invalid value 3.0 for foreign type uptr".
! record.mo:Expected error in mat record25: "set-r25-bar-j!: invalid value 3 for foreign type float".
! record.mo:Expected error in mat record25: "set-r25-bar-k!: invalid value 3 for foreign type double".
! record.mo:Expected error in mat record25: "set-r25-bar-m!: invalid value 3.0 for foreign type char".
! record.mo:Expected error in mat record25: "set-r25-bar-n!: invalid value 3.0 for foreign type wchar".
! record.mo:Expected error in mat record25: "set-r25-bar-o!: invalid value 3.0 for foreign type fixnum".
! record.mo:Expected error in mat record25: "set-r25-bar-p!: invalid value 3.0 for foreign type void*".
! record.mo:Expected error in mat record25: "set-r25-bar-r!: invalid value 3.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-s!: invalid value 3.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value <int> for foreign type int".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value <-int> for foreign type int".
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".
***************
*** 7674,7709 ****
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 0 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 1 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "parent record type is sealed ex3".
--- 7674,7709 ----
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-x>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-y>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 0 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 1 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-x>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-y>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "parent record type is sealed ex3".

View file

View file

@ -0,0 +1,31 @@
*** errors-compile-2-f-f-f 2017-06-06 16:12:00.046943669 -0400
--- errors-compile-2-f-f-t 2017-06-06 16:14:20.812560365 -0400
***************
*** 8461,8473 ****
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".
! fx.mo:Expected error in mat fx*: "fx*: fixnum overflow with arguments <int> and 2".
fx.mo:Expected error in mat fx*: "fx*: <int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: <-int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat r6rs:fx*: "fx*: (a . b) is not a fixnum".
! fx.mo:Expected error in mat r6rs:fx*: "fx*: fixnum overflow with arguments <int> and 2".
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".
--- 8461,8473 ----
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".
! fx.mo:Expected error in mat fx*: "fx*: fixnum overflow computing (fx* <int> 2)".
fx.mo:Expected error in mat fx*: "fx*: <int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: <-int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat r6rs:fx*: "fx*: (a . b) is not a fixnum".
! fx.mo:Expected error in mat r6rs:fx*: "fx*: fixnum overflow computing (fx* <int> 2)".
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".

381
mats/patch-compile-2-f-t-f Normal file
View file

@ -0,0 +1,381 @@
*** errors-compile-2-f-f-f 2017-06-06 16:12:00.046943669 -0400
--- errors-compile-2-f-t-f 2017-06-06 16:16:41.718216927 -0400
***************
*** 125,131 ****
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable c".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable m".
! 3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable y".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
--- 125,131 ----
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable c".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable m".
! 3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable b".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable y".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
***************
*** 144,150 ****
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable b".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable a".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
! 3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable c".
3.mo:Expected warning in mat cpvalid: "possible attempt to reference undefined variable x".
--- 144,150 ----
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable b".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable a".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
! 3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable c".
3.mo:Expected warning in mat cpvalid: "possible attempt to reference undefined variable x".
***************
*** 191,200 ****
3.mo:Expected error in mat mrvs: "returned three values to single value return context".
3.mo:Expected error in mat mrvs: "returned three values to single value return context".
3.mo:Expected error in mat mrvs: "returned zero values to single value return context".
! 3.mo:Expected error in mat mrvs: "incorrect number of values received in multiple value context".
! 3.mo:Expected error in mat mrvs: "returned zero values to single value return context".
! 3.mo:Expected error in mat mrvs: "incorrect number of values received in multiple value context".
! 3.mo:Expected error in mat mrvs: "incorrect number of values received in multiple value context".
3.mo:Expected error in mat mrvs: "variable $mrvs-foo is not bound".
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".
--- 191,200 ----
3.mo:Expected error in mat mrvs: "returned three values to single value return context".
3.mo:Expected error in mat mrvs: "returned three values to single value return context".
3.mo:Expected error in mat mrvs: "returned zero values to single value return context".
! 3.mo:Expected error in mat mrvs: "incorrect argument count in call (call-with-values (lambda () 5 (values 2)) (lambda (x y) (+ x y)))".
! 3.mo:Expected error in mat mrvs: "incorrect argument count in call (call-with-values values (lambda (x) x))".
! 3.mo:Expected error in mat mrvs: "incorrect argument count in call (call-with-values values (lambda (x y) x))".
! 3.mo:Expected error in mat mrvs: "incorrect argument count in call (call-with-values f (lambda (x y) x))".
3.mo:Expected error in mat mrvs: "variable $mrvs-foo is not bound".
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".
***************
*** 3645,3651 ****
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".
! misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable foo at line 1, char 108 of testfile.ss".
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".
--- 3645,3651 ----
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".
! misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable bar at line 1, char 76 of testfile.ss".
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".
***************
*** 7095,7102 ****
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".
! record.mo:Expected error in mat record1: "invalid value 3 for foreign type double-float".
! record.mo:Expected error in mat record1: "3 is not of type #<record type fudge>".
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)".
--- 7095,7102 ----
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".
! record.mo:Expected error in mat record1: "make-fudge: invalid value 3 for foreign type double-float".
! record.mo:Expected error in mat record1: "fudge-a: 3 is not of type #<record type fudge>".
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)".
***************
*** 7104,7118 ****
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".
! record.mo:Expected error in mat record4: "3 is not of type #<record type fudge>".
! record.mo:Expected error in mat record5: "invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record5: "invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record6: "invalid value <int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "invalid value <-int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "invalid value 23.0 for foreign type integer-32".
! record.mo:Expected error in mat record7: "invalid value <int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "invalid value <-int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "invalid value 23.0 for foreign type unsigned-32".
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".
--- 7104,7118 ----
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".
! record.mo:Expected error in mat record4: "set-fudge-a!: 3 is not of type #<record type fudge>".
! record.mo:Expected error in mat record5: "set-fudge-b!: invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record5: "set-fudge-b!: invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record6: "make-bar: invalid value <int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "make-bar: invalid value <-int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "make-bar: invalid value 23.0 for foreign type integer-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value <int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value <-int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value 23.0 for foreign type unsigned-32".
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".
***************
*** 7125,7150 ****
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>".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "invalid value 3 for foreign type single-float".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type single-float".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type integer-16".
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".
--- 7125,7150 ----
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>".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 3 for foreign type single-float".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "set-$froz-y!: invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "set-$froz-z!: invalid value 2 for foreign type single-float".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -32769 for foreign type integer-16".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value -32769 for foreign type integer-16".
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".
***************
*** 7275,7313 ****
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>".
! record.mo:Expected error in mat record25: "invalid value 1.0 for foreign type int".
! record.mo:Expected error in mat record25: "invalid value 2.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "invalid value three for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "invalid value 1/4 for foreign type short".
! record.mo:Expected error in mat record25: "invalid value "five" for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "invalid value (6) for foreign type long".
! record.mo:Expected error in mat record25: "invalid value #(a b c d e f ...) for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "invalid value ate for foreign type iptr".
! 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".
record.mo:Expected error in mat record25: "incorrect number of arguments to #<procedure make-r25-bar>".
! 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".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type short".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type iptr".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type uptr".
! record.mo:Expected error in mat record25: "invalid value 3 for foreign type float".
! record.mo:Expected error in mat record25: "invalid value 3 for foreign type double".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type char".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type wchar".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type fixnum".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type void*".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "invalid value <int> for foreign type int".
! record.mo:Expected error in mat record25: "invalid value <-int> for foreign type int".
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".
--- 7275,7313 ----
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>".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 1.0 for foreign type int".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 2.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value three for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 1/4 for foreign type short".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value "five" for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value (6) for foreign type long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value #(a b c d e f ...) for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value ate for foreign type iptr".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value #\9 for foreign type uptr".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 10 for foreign type float".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 11.0+0.0i for foreign type double".
record.mo:Expected error in mat record25: "incorrect number of arguments to #<procedure make-r25-bar>".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 12.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 13.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value 3.0 for foreign type int".
! record.mo:Expected error in mat record25: "set-r25-bar-b!: invalid value 3.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "set-r25-bar-c!: invalid value 3.0 for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "set-r25-bar-d!: invalid value 3.0 for foreign type short".
! record.mo:Expected error in mat record25: "set-r25-bar-e!: invalid value 3.0 for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "set-r25-bar-f!: invalid value 3.0 for foreign type long".
! record.mo:Expected error in mat record25: "set-r25-bar-g!: invalid value 3.0 for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "set-r25-bar-h!: invalid value 3.0 for foreign type iptr".
! record.mo:Expected error in mat record25: "set-r25-bar-i!: invalid value 3.0 for foreign type uptr".
! record.mo:Expected error in mat record25: "set-r25-bar-j!: invalid value 3 for foreign type float".
! record.mo:Expected error in mat record25: "set-r25-bar-k!: invalid value 3 for foreign type double".
! record.mo:Expected error in mat record25: "set-r25-bar-m!: invalid value 3.0 for foreign type char".
! record.mo:Expected error in mat record25: "set-r25-bar-n!: invalid value 3.0 for foreign type wchar".
! record.mo:Expected error in mat record25: "set-r25-bar-o!: invalid value 3.0 for foreign type fixnum".
! record.mo:Expected error in mat record25: "set-r25-bar-p!: invalid value 3.0 for foreign type void*".
! record.mo:Expected error in mat record25: "set-r25-bar-r!: invalid value 3.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-s!: invalid value 3.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value <int> for foreign type int".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value <-int> for foreign type int".
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".
***************
*** 7322,7378 ****
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".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure>".
record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure>".
record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure constructor>".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 0 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 1 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "parent record type is sealed ex3".
! record.mo:Expected error in mat r6rs-records-syntactic: "#<record of type point> is not of type #<record type point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "#<record of type cpoint> is not of type #<record type point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "#<record of type cpoint> is not of type #<record type cpoint>".
! record.mo:Expected error in mat r6rs-records-syntactic: "#<record of type cpoint> is not of type #<record type cpoint>".
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: "#<record of type cpoint> is not of type #<record type cpoint>".
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".
--- 7322,7378 ----
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".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure n>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure n>".
record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure>".
record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect argument count in call (ccons 1)".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect argument count in call (ccons 1 2 3)".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect argument count in call (n (+ z 7) w "what?")".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect argument count in call ((p x 17) y (quote #(oops)))".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-x>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-y>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 0 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 1 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-x>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-y>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "parent record type is sealed ex3".
! record.mo:Expected error in mat r6rs-records-syntactic: "point-x: #<record of type point> is not of type #<record type point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "point-x: #<record of type cpoint> is not of type #<record type point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "cpoint-rgb: #<record of type cpoint> is not of type #<record type cpoint>".
! record.mo:Expected error in mat r6rs-records-syntactic: "cpoint-rgb: #<record of type cpoint> is not of type #<record type cpoint>".
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: "cpoint-rgb: #<record of type cpoint> is not of type #<record type cpoint>".
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".

View file

@ -0,0 +1,31 @@
*** errors-compile-2-f-t-f 2017-06-06 16:16:41.718216927 -0400
--- errors-compile-2-f-t-t 2017-06-06 16:19:00.107991971 -0400
***************
*** 8461,8473 ****
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".
! fx.mo:Expected error in mat fx*: "fx*: fixnum overflow with arguments <int> and 2".
fx.mo:Expected error in mat fx*: "fx*: <int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: <-int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat r6rs:fx*: "fx*: (a . b) is not a fixnum".
! fx.mo:Expected error in mat r6rs:fx*: "fx*: fixnum overflow with arguments <int> and 2".
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".
--- 8461,8473 ----
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".
! fx.mo:Expected error in mat fx*: "fx*: fixnum overflow computing (fx* <int> 2)".
fx.mo:Expected error in mat fx*: "fx*: <int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: <-int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat r6rs:fx*: "fx*: (a . b) is not a fixnum".
! fx.mo:Expected error in mat r6rs:fx*: "fx*: fixnum overflow computing (fx* <int> 2)".
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".

6089
mats/patch-compile-2-t-f-f Normal file

File diff suppressed because it is too large Load diff

View file

299
mats/patch-compile-2-t-t-f Normal file
View file

@ -0,0 +1,299 @@
*** errors-compile-2-t-f-f 2017-06-06 16:21:29.501865805 -0400
--- errors-compile-2-t-t-f 2017-06-06 16:26:19.869420768 -0400
***************
*** 144,150 ****
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable b".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable a".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
! 3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable c".
3.mo:Expected warning in mat cpvalid: "possible attempt to reference undefined variable x".
--- 144,150 ----
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable b".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable a".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
! 3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable g".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable f".
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable c".
3.mo:Expected warning in mat cpvalid: "possible attempt to reference undefined variable x".
***************
*** 3645,3651 ****
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".
! misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable foo at line 1, char 108 of testfile.ss".
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".
--- 3645,3651 ----
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".
! misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable bar at line 1, char 76 of testfile.ss".
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".
***************
*** 7095,7102 ****
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".
! record.mo:Expected error in mat record1: "invalid value 3 for foreign type double-float".
! record.mo:Expected error in mat record1: "3 is not of type #<record type fudge>".
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)".
--- 7095,7102 ----
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".
! record.mo:Expected error in mat record1: "make-fudge: invalid value 3 for foreign type double-float".
! record.mo:Expected error in mat record1: "fudge-a: 3 is not of type #<record type fudge>".
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)".
***************
*** 7104,7118 ****
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".
! record.mo:Expected error in mat record4: "3 is not of type #<record type fudge>".
! record.mo:Expected error in mat record5: "invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record5: "invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record6: "invalid value <int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "invalid value <-int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "invalid value 23.0 for foreign type integer-32".
! record.mo:Expected error in mat record7: "invalid value <int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "invalid value <-int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "invalid value 23.0 for foreign type unsigned-32".
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".
--- 7104,7118 ----
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".
! record.mo:Expected error in mat record4: "set-fudge-a!: 3 is not of type #<record type fudge>".
! record.mo:Expected error in mat record5: "set-fudge-b!: invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record5: "set-fudge-b!: invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record6: "make-bar: invalid value <int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "make-bar: invalid value <-int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "make-bar: invalid value 23.0 for foreign type integer-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value <int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value <-int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value 23.0 for foreign type unsigned-32".
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".
***************
*** 7125,7150 ****
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>".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "invalid value 3 for foreign type single-float".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type single-float".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type integer-16".
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".
--- 7125,7150 ----
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>".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 3 for foreign type single-float".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "set-$froz-y!: invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "set-$froz-z!: invalid value 2 for foreign type single-float".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -32769 for foreign type integer-16".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value -32769 for foreign type integer-16".
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".
***************
*** 7275,7313 ****
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>".
! record.mo:Expected error in mat record25: "invalid value 1.0 for foreign type int".
! record.mo:Expected error in mat record25: "invalid value 2.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "invalid value three for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "invalid value 1/4 for foreign type short".
! record.mo:Expected error in mat record25: "invalid value "five" for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "invalid value (6) for foreign type long".
! record.mo:Expected error in mat record25: "invalid value #(a b c d e f ...) for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "invalid value ate for foreign type iptr".
! 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".
record.mo:Expected error in mat record25: "incorrect number of arguments to #<procedure make-r25-bar>".
! 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".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type short".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type iptr".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type uptr".
! record.mo:Expected error in mat record25: "invalid value 3 for foreign type float".
! record.mo:Expected error in mat record25: "invalid value 3 for foreign type double".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type char".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type wchar".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type fixnum".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type void*".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "invalid value <int> for foreign type int".
! record.mo:Expected error in mat record25: "invalid value <-int> for foreign type int".
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".
--- 7275,7313 ----
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>".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 1.0 for foreign type int".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 2.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value three for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 1/4 for foreign type short".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value "five" for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value (6) for foreign type long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value #(a b c d e f ...) for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value ate for foreign type iptr".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value #\9 for foreign type uptr".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 10 for foreign type float".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 11.0+0.0i for foreign type double".
record.mo:Expected error in mat record25: "incorrect number of arguments to #<procedure make-r25-bar>".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 12.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 13.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value 3.0 for foreign type int".
! record.mo:Expected error in mat record25: "set-r25-bar-b!: invalid value 3.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "set-r25-bar-c!: invalid value 3.0 for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "set-r25-bar-d!: invalid value 3.0 for foreign type short".
! record.mo:Expected error in mat record25: "set-r25-bar-e!: invalid value 3.0 for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "set-r25-bar-f!: invalid value 3.0 for foreign type long".
! record.mo:Expected error in mat record25: "set-r25-bar-g!: invalid value 3.0 for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "set-r25-bar-h!: invalid value 3.0 for foreign type iptr".
! record.mo:Expected error in mat record25: "set-r25-bar-i!: invalid value 3.0 for foreign type uptr".
! record.mo:Expected error in mat record25: "set-r25-bar-j!: invalid value 3 for foreign type float".
! record.mo:Expected error in mat record25: "set-r25-bar-k!: invalid value 3 for foreign type double".
! record.mo:Expected error in mat record25: "set-r25-bar-m!: invalid value 3.0 for foreign type char".
! record.mo:Expected error in mat record25: "set-r25-bar-n!: invalid value 3.0 for foreign type wchar".
! record.mo:Expected error in mat record25: "set-r25-bar-o!: invalid value 3.0 for foreign type fixnum".
! record.mo:Expected error in mat record25: "set-r25-bar-p!: invalid value 3.0 for foreign type void*".
! record.mo:Expected error in mat record25: "set-r25-bar-r!: invalid value 3.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-s!: invalid value 3.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value <int> for foreign type int".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value <-int> for foreign type int".
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".
***************
*** 7333,7368 ****
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 0 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 1 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "parent record type is sealed ex3".
--- 7333,7368 ----
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-x>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-y>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 0 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 1 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-x>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-y>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "parent record type is sealed ex3".

View file

View file

View file

View file

View file

View file

View file

View file

View file

@ -0,0 +1,575 @@
*** patches-work-dir/errors-compile-0-f-f-f 2022-05-08 20:43:10.000000000 -0700
--- patches-work-dir/errors-interpret-0-f-f-f 2022-05-08 20:43:10.000000000 -0700
***************
*** 1,3 ****
--- 1,9 ----
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 1 at line 1032, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 2 at line 1034, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 5 at line 1041, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 6 at line 1043, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 9 at line 1050, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 10 at line 1052, char 4 of ../6.ms
primvars.mo:Expected error testing (environment (quote 0)): Exception in environment: invalid library reference 0
primvars.mo:Expected error testing (environment (quote (a . b))): Exception in environment: invalid library reference (a . b)
primvars.mo:Expected error testing (environment (quote #f)): Exception in environment: invalid library reference #f
***************
*** 18,25 ****
primvars.mo:Expected error testing (environment (quote (chezscheme)) (quote (chezscheme)) (quote #f)): Exception in environment: invalid library reference #f
primvars.mo:Expected error testing (base-exception-handler (quote 0)): Exception in default-exception-handler: 0 is not a procedure
primvars.mo:Expected error testing (base-exception-handler (quote #f)): Exception in default-exception-handler: #f is not a procedure
! primvars.mo:Expected error testing (eval 1.0+2.0i (quote ((a . b)))): Exception in compile: ((a . b)) is not an environment
! primvars.mo:Expected error testing (eval 1.0+2.0i (quote #f)): Exception in compile: #f is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote ((a . b)))): Exception in sc-expand: ((a . b)) is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote #f)): Exception in sc-expand: #f is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote ((a . b))) 1.0+2.0i): Exception in sc-expand: ((a . b)) is not an environment
--- 24,31 ----
primvars.mo:Expected error testing (environment (quote (chezscheme)) (quote (chezscheme)) (quote #f)): Exception in environment: invalid library reference #f
primvars.mo:Expected error testing (base-exception-handler (quote 0)): Exception in default-exception-handler: 0 is not a procedure
primvars.mo:Expected error testing (base-exception-handler (quote #f)): Exception in default-exception-handler: #f is not a procedure
! primvars.mo:Expected error testing (eval 1.0+2.0i (quote ((a . b)))): Exception in interpret: ((a . b)) is not an environment
! primvars.mo:Expected error testing (eval 1.0+2.0i (quote #f)): Exception in interpret: #f is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote ((a . b)))): Exception in sc-expand: ((a . b)) is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote #f)): Exception in sc-expand: #f is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote ((a . b))) 1.0+2.0i): Exception in sc-expand: ((a . b)) is not an environment
***************
*** 54,60 ****
primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".
primvars.mo:Expected error in mat make-parameter: "+: a is not a number".
primvars.mo:Expected error in mat make-parameter: "incorrect number of arguments to #<procedure>".
! primvars.mo:Expected error in mat parameterize: "incorrect number of arguments to #<procedure x>".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: a is not a positive fixnum".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: -1 is not a positive fixnum".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: 0 is not a positive fixnum".
--- 60,66 ----
primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".
primvars.mo:Expected error in mat make-parameter: "+: a is not a number".
primvars.mo:Expected error in mat make-parameter: "incorrect number of arguments to #<procedure>".
! primvars.mo:Expected error in mat parameterize: "incorrect number of arguments to #<procedure>".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: a is not a positive fixnum".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: -1 is not a positive fixnum".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: 0 is not a positive fixnum".
***************
*** 81,151 ****
primvars.mo:Expected error in mat print-radix: "print-radix: 1 is not between 2 and 36".
primvars.mo:Expected error in mat timer-interrupt-handler: "timer-interrupt-handler: midnight is not a procedure".
primvars.mo:Expected error in mat trace-output-port: "trace-output-port: #<input port string> is not a textual output port".
! 3.mo:Expected error in mat matrest1: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest2: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest2: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
3.mo:Expected error in mat application: "attempt to apply non-procedure ((a b c))".
3.mo:Expected error in mat case-lambda: "incorrect argument count in call ((case-lambda))".
3.mo:Expected error in mat case-lambda: "incorrect argument count in call (f 3 4 5)".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
3.mo:Expected error in mat let: "incorrect argument count in call ((lambda (x . r) (eq? x (...))))".
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".
--- 87,157 ----
primvars.mo:Expected error in mat print-radix: "print-radix: 1 is not between 2 and 36".
primvars.mo:Expected error in mat timer-interrupt-handler: "timer-interrupt-handler: midnight is not a procedure".
primvars.mo:Expected error in mat trace-output-port: "trace-output-port: #<input port string> is not a textual output port".
! 3.mo:Expected error in mat matrest1: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest2: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest2: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
3.mo:Expected error in mat application: "attempt to apply non-procedure ((a b c))".
3.mo:Expected error in mat case-lambda: "incorrect argument count in call ((case-lambda))".
3.mo:Expected error in mat case-lambda: "incorrect argument count in call (f 3 4 5)".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
3.mo:Expected error in mat let: "incorrect argument count in call ((lambda (x . r) (eq? x (...))))".
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".
***************
*** 244,255 ****
3.mo:Expected error in mat mrvs: "returned three values to single value return context".
3.mo:Expected error in mat mrvs: "returned three values to single value return context".
3.mo:Expected error in mat mrvs: "returned zero values to single value return context".
! 3.mo:Expected error in mat mrvs: "incorrect number of values received in multiple value context".
! 3.mo:Expected error in mat mrvs: "returned zero values to single value return context".
! 3.mo:Expected error in mat mrvs: "incorrect number of values received in multiple value context".
! 3.mo:Expected error in mat mrvs: "incorrect number of values received in multiple value context".
3.mo:Expected error in mat mrvs: "variable $mrvs-foo is not bound".
! 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".
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".
--- 250,261 ----
3.mo:Expected error in mat mrvs: "returned three values to single value return context".
3.mo:Expected error in mat mrvs: "returned three values to single value return context".
3.mo:Expected error in mat mrvs: "returned zero values to single value return context".
! 3.mo:Expected error in mat mrvs: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat mrvs: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat mrvs: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat mrvs: "incorrect number of arguments to #<procedure>".
3.mo:Expected error in mat mrvs: "variable $mrvs-foo is not bound".
! 3.mo:Expected error in mat mrvs: "call-with-values: 17 is not a procedure".
3.mo:Expected error in mat mrvs: "returned two values to single value return context".
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".
***************
*** 4278,4293 ****
6.mo:Expected error in mat pretty-print: "pretty-format: invalid format (bad 0 ... ... 0 format)".
6.mo:Expected error in mat fasl: "separate-eval: Warning in fasl-write: fasl file content is compressed internally; compressing the file (#<binary output port testfile.ss>) is redundant and can slow fasl writing and reading significantly
6.mo:Expected error in mat fasl: "separate-eval: Warning in fasl-read: fasl file content is compressed internally; compressing the file (#<binary input port testfile.ss>) is redundant and can slow fasl writing and reading significantly
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "~a~~~s" in call to format".
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~a~a~a~s" in call to format".
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "~a~~~s" in call to format at line 1, char 28 of testfile.ss".
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~a~a~a~s" in call to format at line 1, char 28 of testfile.ss".
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "abc~s" in call to printf".
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~%~abc~adef~ag~s~~~%" in call to printf".
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "abc~s" in call to printf at line 1, char 28 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 printf at line 1, char 28 of testfile.ss".
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "abc~s" in call to fprintf".
- 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".
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)".
--- 4284,4293 ----
***************
*** 7379,7385 ****
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 include: file "testfile-mc-1a.ss" not found in source directories
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in include: failed for ./testfile-mc-3a.ss: no such file or directory
! 7.mo:Expected error in mat eval: "compile: 7 is not an environment".
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".
--- 7379,7385 ----
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 include: file "testfile-mc-1a.ss" not found in source directories
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in include: failed for ./testfile-mc-3a.ss: no such file or directory
! 7.mo:Expected error in mat eval: "interpret: 7 is not an environment".
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".
***************
*** 7774,7780 ****
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".
! record.mo:Expected error in mat record25: "incorrect number of arguments to #<procedure make-r25-bar>".
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".
--- 7774,7780 ----
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".
! record.mo:Expected error in mat record25: "incorrect number of arguments to #<procedure>".
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".
***************
*** 9039,9051 ****
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".
! fx.mo:Expected error in mat fx*: "fx*: fixnum overflow with arguments <int> and 2".
fx.mo:Expected error in mat fx*: "fx*: <int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: <-int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat r6rs:fx*: "fx*: (a . b) is not a fixnum".
! fx.mo:Expected error in mat r6rs:fx*: "fx*: fixnum overflow with arguments <int> and 2".
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".
--- 9039,9051 ----
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".
! fx.mo:Expected error in mat fx*: "fx*: fixnum overflow computing (fx* <int> 2)".
fx.mo:Expected error in mat fx*: "fx*: <int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: <-int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat r6rs:fx*: "fx*: (a . b) is not a fixnum".
! fx.mo:Expected error in mat r6rs:fx*: "fx*: fixnum overflow computing (fx* <int> 2)".
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".
***************
*** 9806,9830 ****
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".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument 83076749736557242056487941267521535".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument #f".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument "hi"".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument -5444517870735015415413993718908291383295".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument #f".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument "hi"".
! foreign.mo:Expected error in mat foreign-procedure: "idfix: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "idfix: invalid foreign-procedure argument <-int>".
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".
--- 9806,9830 ----
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".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument 83076749736557242056487941267521535".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument #f".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument "hi"".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument -5444517870735015415413993718908291383295".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument #f".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument "hi"".
! foreign.mo:Expected error in mat foreign-procedure: "idiptr: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "idiptr: invalid foreign-procedure argument <-int>".
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".
***************
*** 9837,9868 ****
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".
! foreign.mo:Expected error in mat foreign-bytevectors: "u8*->u8*: invalid foreign-procedure argument "hello"".
! foreign.mo:Expected error in mat foreign-bytevectors: "u16*->u16*: invalid foreign-procedure argument "hello"".
! foreign.mo:Expected error in mat foreign-bytevectors: "u32*->u32*: invalid foreign-procedure argument "hello"".
! foreign.mo:Expected error in mat foreign-bytevectors: "u8*->u8*: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-bytevectors: "u16*->u16*: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-bytevectors: "u32*->u32*: invalid foreign-procedure argument 0".
foreign.mo:Expected error in mat foreign-bytevectors: "foreign-callable: invalid return value (#vu8(2 3 4 5) 4) from #<procedure>".
foreign.mo:Expected error in mat foreign-bytevectors: "foreign-callable: invalid return value (#vu8(3 4 5 6) 4) from #<procedure>".
foreign.mo:Expected error in mat foreign-bytevectors: "foreign-callable: invalid return value (#vu8(5 6 7 8) 4) from #<procedure>".
! foreign.mo:Expected error in mat foreign-bytevectors: "call-u8*: invalid foreign-procedure argument #(1 2 3 4 5 0)".
! foreign.mo:Expected error in mat foreign-bytevectors: "call-u16*: invalid foreign-procedure argument #(1 2 3 4 5 6 ...)".
! foreign.mo:Expected error in mat foreign-bytevectors: "call-u32*: invalid foreign-procedure argument #(1 2 3 4 5 6 ...)".
! foreign.mo:Expected error in mat foreign-strings: "utf-8->utf-8: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "utf-16le->utf-16le: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "utf-16be->utf-16be: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "utf-32le->utf-32le: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "utf-32be->utf-32be: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "string->string: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "wstring->wstring: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "utf-8->utf-8: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "utf-16le->utf-16le: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "utf-16be->utf-16be: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "utf-32le->utf-32le: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "utf-32be->utf-32be: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "string->string: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "wstring->wstring: invalid foreign-procedure argument 0".
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>".
--- 9837,9868 ----
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".
! foreign.mo:Expected error in mat foreign-bytevectors: "u8_star_to_u8_star: invalid foreign-procedure argument "hello"".
! foreign.mo:Expected error in mat foreign-bytevectors: "u16_star_to_u16_star: invalid foreign-procedure argument "hello"".
! foreign.mo:Expected error in mat foreign-bytevectors: "u32_star_to_u32_star: invalid foreign-procedure argument "hello"".
! foreign.mo:Expected error in mat foreign-bytevectors: "u8_star_to_u8_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-bytevectors: "u16_star_to_u16_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-bytevectors: "u32_star_to_u32_star: invalid foreign-procedure argument 0".
foreign.mo:Expected error in mat foreign-bytevectors: "foreign-callable: invalid return value (#vu8(2 3 4 5) 4) from #<procedure>".
foreign.mo:Expected error in mat foreign-bytevectors: "foreign-callable: invalid return value (#vu8(3 4 5 6) 4) from #<procedure>".
foreign.mo:Expected error in mat foreign-bytevectors: "foreign-callable: invalid return value (#vu8(5 6 7 8) 4) from #<procedure>".
! foreign.mo:Expected error in mat foreign-bytevectors: "call_u8_star: invalid foreign-procedure argument #(1 2 3 4 5 0)".
! foreign.mo:Expected error in mat foreign-bytevectors: "call_u16_star: invalid foreign-procedure argument #(1 2 3 4 5 6 ...)".
! foreign.mo:Expected error in mat foreign-bytevectors: "call_u32_star: invalid foreign-procedure argument #(1 2 3 4 5 6 ...)".
! foreign.mo:Expected error in mat foreign-strings: "u8_star_to_u8_star: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "u16_star_to_u16_star: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "u16_star_to_u16_star: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "u32_star_to_u32_star: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "u32_star_to_u32_star: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "char_star_to_char_star: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "wchar_star_to_wchar_star: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "u8_star_to_u8_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "u16_star_to_u16_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "u16_star_to_u16_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "u32_star_to_u32_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "u32_star_to_u32_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "char_star_to_char_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "wchar_star_to_wchar_star: invalid foreign-procedure argument 0".
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>".
***************
*** 9870,9895 ****
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>".
! foreign.mo:Expected error in mat foreign-fixed-types: "i8-to-i8: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u8-to-u8: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i16-to-i16: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u16-to-u16: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i24-to-i24: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u24-to-u24: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i32-to-i32: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u32-to-u32: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i64-to-i64: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u64-to-u64: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i8-to-i8: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u8-to-u8: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "i16-to-i16: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u16-to-u16: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "i32-to-i32: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u32-to-u32: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "i64-to-i64: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u64-to-u64: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "sf-to-sf: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "df-to-df: invalid foreign-procedure argument qqq".
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>".
--- 9870,9895 ----
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>".
! foreign.mo:Expected error in mat foreign-fixed-types: "i8_to_i8: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u8_to_u8: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i16_to_i16: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u16_to_u16: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i32_to_i32: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u32_to_u32: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i32_to_i32: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u32_to_u32: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i64_to_i64: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u64_to_u64: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i8_to_i8: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u8_to_u8: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "i16_to_i16: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u16_to_u16: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "i32_to_i32: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u32_to_u32: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "i64_to_i64: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u64_to_u64: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "sf_to_sf: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "df_to_df: invalid foreign-procedure argument qqq".
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>".
***************
*** 9900,9934 ****
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>".
! foreign.mo:Expected error in mat foreign-C-types: "int-to-int: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-to-unsigned: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-int-to-unsigned-int: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-short-to-unsigned-short: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "short-to-short: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "long-to-long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-long-to-unsigned-long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "long-long-to-long-long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-long-long-to-unsigned-long-long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "iptr-to-iptr: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "uptr-to-uptr: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "void*-to-void*: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "int-to-int: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-to-unsigned: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-int-to-unsigned-int: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-short-to-unsigned-short: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "short-to-short: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "long-to-long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-long-to-unsigned-long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "long-long-to-long-long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-long-long-to-unsigned-long-long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "iptr-to-iptr: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "uptr-to-uptr: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "void*-to-void*: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "char-to-char: invalid foreign-procedure argument 73".
! foreign.mo:Expected error in mat foreign-C-types: "char-to-char: invalid foreign-procedure argument #\U+100".
! foreign.mo:Expected error in mat foreign-C-types: "wchar-to-wchar: invalid foreign-procedure argument 73".
! foreign.mo:Expected error in mat foreign-C-types: "float-to-float: invalid foreign-procedure argument qqq.5".
! foreign.mo:Expected error in mat foreign-C-types: "double-to-double: invalid foreign-procedure argument qqq.5".
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>".
--- 9900,9934 ----
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>".
! foreign.mo:Expected error in mat foreign-C-types: "int_to_int: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_to_unsigned: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_to_unsigned: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_short_to_unsigned_short: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "short_to_short: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "long_to_long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_long_to_unsigned_long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "long_long_to_long_long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_long_long_to_unsigned_long_long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "iptr_to_iptr: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "uptr_to_uptr: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "uptr_to_uptr: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "int_to_int: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_to_unsigned: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_to_unsigned: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_short_to_unsigned_short: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "short_to_short: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "long_to_long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_long_to_unsigned_long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "long_long_to_long_long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_long_long_to_unsigned_long_long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "iptr_to_iptr: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "uptr_to_uptr: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "uptr_to_uptr: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "char_to_char: invalid foreign-procedure argument 73".
! foreign.mo:Expected error in mat foreign-C-types: "char_to_char: invalid foreign-procedure argument #\U+100".
! foreign.mo:Expected error in mat foreign-C-types: "wchar_to_wchar: invalid foreign-procedure argument 73".
! foreign.mo:Expected error in mat foreign-C-types: "float_to_float: invalid foreign-procedure argument qqq.5".
! foreign.mo:Expected error in mat foreign-C-types: "double_to_double: invalid foreign-procedure argument qqq.5".
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>".
***************
*** 10535,10544 ****
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 ...)))".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure make-<a>>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure make-<a>>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure m1>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure m1>".
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".
--- 10535,10544 ----
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 ...)))".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure>".
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".

View file

@ -0,0 +1,588 @@
*** patches-work-dir/errors-compile-0-f-t-f 2022-05-08 20:43:10.000000000 -0700
--- patches-work-dir/errors-interpret-0-f-t-f 2022-05-08 20:43:10.000000000 -0700
***************
*** 1,3 ****
--- 1,9 ----
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 1 at line 1032, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 2 at line 1034, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 5 at line 1041, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 6 at line 1043, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 9 at line 1050, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 10 at line 1052, char 4 of ../6.ms
primvars.mo:Expected error testing (environment (quote 0)): Exception in environment: invalid library reference 0
primvars.mo:Expected error testing (environment (quote (a . b))): Exception in environment: invalid library reference (a . b)
primvars.mo:Expected error testing (environment (quote #f)): Exception in environment: invalid library reference #f
***************
*** 18,25 ****
primvars.mo:Expected error testing (environment (quote (chezscheme)) (quote (chezscheme)) (quote #f)): Exception in environment: invalid library reference #f
primvars.mo:Expected error testing (base-exception-handler (quote 0)): Exception in default-exception-handler: 0 is not a procedure
primvars.mo:Expected error testing (base-exception-handler (quote #f)): Exception in default-exception-handler: #f is not a procedure
! primvars.mo:Expected error testing (eval 1.0+2.0i (quote ((a . b)))): Exception in compile: ((a . b)) is not an environment
! primvars.mo:Expected error testing (eval 1.0+2.0i (quote #f)): Exception in compile: #f is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote ((a . b)))): Exception in sc-expand: ((a . b)) is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote #f)): Exception in sc-expand: #f is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote ((a . b))) 1.0+2.0i): Exception in sc-expand: ((a . b)) is not an environment
--- 24,31 ----
primvars.mo:Expected error testing (environment (quote (chezscheme)) (quote (chezscheme)) (quote #f)): Exception in environment: invalid library reference #f
primvars.mo:Expected error testing (base-exception-handler (quote 0)): Exception in default-exception-handler: 0 is not a procedure
primvars.mo:Expected error testing (base-exception-handler (quote #f)): Exception in default-exception-handler: #f is not a procedure
! primvars.mo:Expected error testing (eval 1.0+2.0i (quote ((a . b)))): Exception in interpret: ((a . b)) is not an environment
! primvars.mo:Expected error testing (eval 1.0+2.0i (quote #f)): Exception in interpret: #f is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote ((a . b)))): Exception in sc-expand: ((a . b)) is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote #f)): Exception in sc-expand: #f is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote ((a . b))) 1.0+2.0i): Exception in sc-expand: ((a . b)) is not an environment
***************
*** 54,60 ****
primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".
primvars.mo:Expected error in mat make-parameter: "+: a is not a number".
primvars.mo:Expected error in mat make-parameter: "incorrect number of arguments to #<procedure>".
! primvars.mo:Expected error in mat parameterize: "incorrect number of arguments to #<procedure x>".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: a is not a positive fixnum".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: -1 is not a positive fixnum".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: 0 is not a positive fixnum".
--- 60,66 ----
primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".
primvars.mo:Expected error in mat make-parameter: "+: a is not a number".
primvars.mo:Expected error in mat make-parameter: "incorrect number of arguments to #<procedure>".
! primvars.mo:Expected error in mat parameterize: "incorrect number of arguments to #<procedure>".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: a is not a positive fixnum".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: -1 is not a positive fixnum".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: 0 is not a positive fixnum".
***************
*** 81,151 ****
primvars.mo:Expected error in mat print-radix: "print-radix: 1 is not between 2 and 36".
primvars.mo:Expected error in mat timer-interrupt-handler: "timer-interrupt-handler: midnight is not a procedure".
primvars.mo:Expected error in mat trace-output-port: "trace-output-port: #<input port string> is not a textual output port".
! 3.mo:Expected error in mat matrest1: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest2: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest2: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
3.mo:Expected error in mat application: "attempt to apply non-procedure ((a b c))".
3.mo:Expected error in mat case-lambda: "incorrect argument count in call ((case-lambda))".
3.mo:Expected error in mat case-lambda: "incorrect argument count in call (f 3 4 5)".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
3.mo:Expected error in mat let: "incorrect argument count in call ((lambda (x . r) (eq? x (...))))".
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".
--- 87,157 ----
primvars.mo:Expected error in mat print-radix: "print-radix: 1 is not between 2 and 36".
primvars.mo:Expected error in mat timer-interrupt-handler: "timer-interrupt-handler: midnight is not a procedure".
primvars.mo:Expected error in mat trace-output-port: "trace-output-port: #<input port string> is not a textual output port".
! 3.mo:Expected error in mat matrest1: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest2: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest2: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
3.mo:Expected error in mat application: "attempt to apply non-procedure ((a b c))".
3.mo:Expected error in mat case-lambda: "incorrect argument count in call ((case-lambda))".
3.mo:Expected error in mat case-lambda: "incorrect argument count in call (f 3 4 5)".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
3.mo:Expected error in mat let: "incorrect argument count in call ((lambda (x . r) (eq? x (...))))".
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".
***************
*** 4278,4293 ****
6.mo:Expected error in mat pretty-print: "pretty-format: invalid format (bad 0 ... ... 0 format)".
6.mo:Expected error in mat fasl: "separate-eval: Warning in fasl-write: fasl file content is compressed internally; compressing the file (#<binary output port testfile.ss>) is redundant and can slow fasl writing and reading significantly
6.mo:Expected error in mat fasl: "separate-eval: Warning in fasl-read: fasl file content is compressed internally; compressing the file (#<binary input port testfile.ss>) is redundant and can slow fasl writing and reading significantly
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "~a~~~s" in call to format".
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~a~a~a~s" in call to format".
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "~a~~~s" in call to format at line 1, char 28 of testfile.ss".
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~a~a~a~s" in call to format at line 1, char 28 of testfile.ss".
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "abc~s" in call to printf".
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~%~abc~adef~ag~s~~~%" in call to printf".
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "abc~s" in call to printf at line 1, char 28 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 printf at line 1, char 28 of testfile.ss".
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "abc~s" in call to fprintf".
- 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".
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)".
--- 4284,4293 ----
***************
*** 7379,7385 ****
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 include: file "testfile-mc-1a.ss" not found in source directories
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in include: failed for ./testfile-mc-3a.ss: no such file or directory
! 7.mo:Expected error in mat eval: "compile: 7 is not an environment".
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".
--- 7379,7385 ----
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 include: file "testfile-mc-1a.ss" not found in source directories
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in include: failed for ./testfile-mc-3a.ss: no such file or directory
! 7.mo:Expected error in mat eval: "interpret: 7 is not an environment".
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".
***************
*** 7579,7586 ****
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".
! record.mo:Expected error in mat record1: "make-fudge: invalid value 3 for foreign type double-float".
! record.mo:Expected error in mat record1: "fudge-a: 3 is not of type #<record type fudge>".
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)".
--- 7579,7586 ----
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".
! record.mo:Expected error in mat record1: "invalid value 3 for foreign type double-float".
! record.mo:Expected error in mat record1: "3 is not of type #<record type fudge>".
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)".
***************
*** 7588,7602 ****
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".
! record.mo:Expected error in mat record4: "set-fudge-a!: 3 is not of type #<record type fudge>".
! record.mo:Expected error in mat record5: "set-fudge-b!: invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record5: "set-fudge-b!: invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record6: "make-bar: invalid value <int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "make-bar: invalid value <-int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "make-bar: invalid value 23.0 for foreign type integer-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value <int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value <-int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "make-bar: invalid value 23.0 for foreign type unsigned-32".
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".
--- 7588,7602 ----
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".
! record.mo:Expected error in mat record4: "3 is not of type #<record type fudge>".
! record.mo:Expected error in mat record5: "invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record5: "invalid value 4 for foreign type double-float".
! record.mo:Expected error in mat record6: "invalid value <int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "invalid value <-int> for foreign type integer-32".
! record.mo:Expected error in mat record6: "invalid value 23.0 for foreign type integer-32".
! record.mo:Expected error in mat record7: "invalid value <int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "invalid value <-int> for foreign type unsigned-32".
! record.mo:Expected error in mat record7: "invalid value 23.0 for foreign type unsigned-32".
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".
***************
*** 7609,7634 ****
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>".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 3 for foreign type single-float".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "set-$froz-y!: invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "set-$froz-z!: invalid value 2 for foreign type single-float".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "make-$froz: invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "make-$froz: invalid value -32769 for foreign type integer-16".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "set-$froz-x!: invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "set-$froz-w!: invalid value -32769 for foreign type integer-16".
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".
--- 7609,7634 ----
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>".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "invalid value 3 for foreign type single-float".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type unsigned-8".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type double-float".
! record.mo:Expected error in mat record17: "invalid value 2 for foreign type single-float".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type unsigned-16".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value 256 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value -129 for foreign type integer-8".
! record.mo:Expected error in mat record17: "invalid value 65536 for foreign type integer-16".
! record.mo:Expected error in mat record17: "invalid value -32769 for foreign type integer-16".
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".
***************
*** 7763,7801 ****
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>".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 1.0 for foreign type int".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 2.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value three for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 1/4 for foreign type short".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value "five" for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value (6) for foreign type long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value #(a b c d e f ...) for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value ate for foreign type iptr".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value #\9 for foreign type uptr".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 10 for foreign type float".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 11.0+0.0i for foreign type double".
! record.mo:Expected error in mat record25: "incorrect number of arguments to #<procedure make-r25-bar>".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 12.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "make-r25-bar: invalid value 13.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value 3.0 for foreign type int".
! record.mo:Expected error in mat record25: "set-r25-bar-b!: invalid value 3.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "set-r25-bar-c!: invalid value 3.0 for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "set-r25-bar-d!: invalid value 3.0 for foreign type short".
! record.mo:Expected error in mat record25: "set-r25-bar-e!: invalid value 3.0 for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "set-r25-bar-f!: invalid value 3.0 for foreign type long".
! record.mo:Expected error in mat record25: "set-r25-bar-g!: invalid value 3.0 for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "set-r25-bar-h!: invalid value 3.0 for foreign type iptr".
! record.mo:Expected error in mat record25: "set-r25-bar-i!: invalid value 3.0 for foreign type uptr".
! record.mo:Expected error in mat record25: "set-r25-bar-j!: invalid value 3 for foreign type float".
! record.mo:Expected error in mat record25: "set-r25-bar-k!: invalid value 3 for foreign type double".
! record.mo:Expected error in mat record25: "set-r25-bar-m!: invalid value 3.0 for foreign type char".
! record.mo:Expected error in mat record25: "set-r25-bar-n!: invalid value 3.0 for foreign type wchar".
! record.mo:Expected error in mat record25: "set-r25-bar-o!: invalid value 3.0 for foreign type fixnum".
! record.mo:Expected error in mat record25: "set-r25-bar-p!: invalid value 3.0 for foreign type void*".
! record.mo:Expected error in mat record25: "set-r25-bar-r!: invalid value 3.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-s!: invalid value 3.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value <int> for foreign type int".
! record.mo:Expected error in mat record25: "set-r25-bar-a!: invalid value <-int> for foreign type int".
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".
--- 7763,7801 ----
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>".
! record.mo:Expected error in mat record25: "invalid value 1.0 for foreign type int".
! record.mo:Expected error in mat record25: "invalid value 2.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "invalid value three for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "invalid value 1/4 for foreign type short".
! record.mo:Expected error in mat record25: "invalid value "five" for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "invalid value (6) for foreign type long".
! record.mo:Expected error in mat record25: "invalid value #(a b c d e f ...) for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "invalid value ate for foreign type iptr".
! 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".
! record.mo:Expected error in mat record25: "incorrect number of arguments to #<procedure>".
! 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".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-int".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type short".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-short".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type iptr".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type uptr".
! record.mo:Expected error in mat record25: "invalid value 3 for foreign type float".
! record.mo:Expected error in mat record25: "invalid value 3 for foreign type double".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type char".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type wchar".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type fixnum".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type void*".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type long-long".
! record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type unsigned-long-long".
! record.mo:Expected error in mat record25: "invalid value <int> for foreign type int".
! record.mo:Expected error in mat record25: "invalid value <-int> for foreign type int".
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".
***************
*** 7810,7866 ****
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".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure n>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure n>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure pcons>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure pcons>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect argument count in call (ccons 1)".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect argument count in call (ccons 1 2 3)".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect argument count in call (n (+ z 7) w "what?")".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect argument count in call ((p x 17) y (quote #(oops)))".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-x>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-y>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 0 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 1 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure make-point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point?>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-x>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure point-y>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure frob-widget-set!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure setwid!>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "parent record type is sealed ex3".
! record.mo:Expected error in mat r6rs-records-syntactic: "point-x: #<record of type point> is not of type #<record type point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "point-x: #<record of type cpoint> is not of type #<record type point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "cpoint-rgb: #<record of type cpoint> is not of type #<record type cpoint>".
! record.mo:Expected error in mat r6rs-records-syntactic: "cpoint-rgb: #<record of type cpoint> is not of type #<record type cpoint>".
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: "cpoint-rgb: #<record of type cpoint> is not of type #<record type cpoint>".
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".
--- 7810,7866 ----
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".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-procedural: "incorrect number of arguments to #<procedure constructor>".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 0 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "record-mutator: field 1 of #<record type point> is immutable".
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure constructor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure predicate>".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-x-set! is not bound".
record.mo:Expected error in mat r6rs-records-syntactic: "variable point-y-set! is not bound".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure accessor>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
! record.mo:Expected error in mat r6rs-records-syntactic: "incorrect number of arguments to #<procedure mutator>".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
record.mo:Expected error in mat r6rs-records-syntactic: "parent record type is sealed ex3".
! record.mo:Expected error in mat r6rs-records-syntactic: "#<record of type point> is not of type #<record type point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "#<record of type cpoint> is not of type #<record type point>".
! record.mo:Expected error in mat r6rs-records-syntactic: "#<record of type cpoint> is not of type #<record type cpoint>".
! record.mo:Expected error in mat r6rs-records-syntactic: "#<record of type cpoint> is not of type #<record type cpoint>".
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: "#<record of type cpoint> is not of type #<record type cpoint>".
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".
***************
*** 9039,9051 ****
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".
! fx.mo:Expected error in mat fx*: "fx*: fixnum overflow with arguments <int> and 2".
fx.mo:Expected error in mat fx*: "fx*: <int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: <-int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat r6rs:fx*: "fx*: (a . b) is not a fixnum".
! fx.mo:Expected error in mat r6rs:fx*: "fx*: fixnum overflow with arguments <int> and 2".
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".
--- 9039,9051 ----
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".
! fx.mo:Expected error in mat fx*: "fx*: fixnum overflow computing (fx* <int> 2)".
fx.mo:Expected error in mat fx*: "fx*: <int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: <-int> is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat fx*: "fx*: #f is not a fixnum".
fx.mo:Expected error in mat r6rs:fx*: "fx*: (a . b) is not a fixnum".
! fx.mo:Expected error in mat r6rs:fx*: "fx*: fixnum overflow computing (fx* <int> 2)".
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".
***************
*** 10535,10544 ****
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 ...)))".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure make-<a>>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure make-<a>>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure m1>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure m1>".
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".
--- 10535,10544 ----
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 ...)))".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure>".
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".

View file

@ -0,0 +1,519 @@
*** errors-compile-0-t-f-f 2020-02-29 01:59:01.462591702 -0500
--- errors-interpret-0-t-f-f 2020-02-29 02:22:49.553015774 -0500
***************
*** 1,3 ****
--- 1,9 ----
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 1 at line 1032, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 2 at line 1034, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 5 at line 1041, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 6 at line 1043, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 9 at line 1050, char 4 of ../6.ms
+ 6.mo:Bug in mat cp1in-verify-format-warnings clause 10 at line 1052, char 4 of ../6.ms
primvars.mo:Expected error testing (environment (quote 0)): Exception in environment: invalid library reference 0
primvars.mo:Expected error testing (environment (quote (a . b))): Exception in environment: invalid library reference (a . b)
primvars.mo:Expected error testing (environment (quote #f)): Exception in environment: invalid library reference #f
***************
*** 18,25 ****
primvars.mo:Expected error testing (environment (quote (chezscheme)) (quote (chezscheme)) (quote #f)): Exception in environment: invalid library reference #f
primvars.mo:Expected error testing (base-exception-handler (quote 0)): Exception in default-exception-handler: 0 is not a procedure
primvars.mo:Expected error testing (base-exception-handler (quote #f)): Exception in default-exception-handler: #f is not a procedure
! primvars.mo:Expected error testing (eval 1.0+2.0i (quote ((a . b)))): Exception in compile: ((a . b)) is not an environment
! primvars.mo:Expected error testing (eval 1.0+2.0i (quote #f)): Exception in compile: #f is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote ((a . b)))): Exception in sc-expand: ((a . b)) is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote #f)): Exception in sc-expand: #f is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote ((a . b))) 1.0+2.0i): Exception in sc-expand: ((a . b)) is not an environment
--- 24,31 ----
primvars.mo:Expected error testing (environment (quote (chezscheme)) (quote (chezscheme)) (quote #f)): Exception in environment: invalid library reference #f
primvars.mo:Expected error testing (base-exception-handler (quote 0)): Exception in default-exception-handler: 0 is not a procedure
primvars.mo:Expected error testing (base-exception-handler (quote #f)): Exception in default-exception-handler: #f is not a procedure
! primvars.mo:Expected error testing (eval 1.0+2.0i (quote ((a . b)))): Exception in interpret: ((a . b)) is not an environment
! primvars.mo:Expected error testing (eval 1.0+2.0i (quote #f)): Exception in interpret: #f is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote ((a . b)))): Exception in sc-expand: ((a . b)) is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote #f)): Exception in sc-expand: #f is not an environment
primvars.mo:Expected error testing (expand 1.0+2.0i (quote ((a . b))) 1.0+2.0i): Exception in sc-expand: ((a . b)) is not an environment
***************
*** 54,60 ****
primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".
primvars.mo:Expected error in mat make-parameter: "+: a is not a number".
primvars.mo:Expected error in mat make-parameter: "incorrect number of arguments to #<procedure>".
! primvars.mo:Expected error in mat parameterize: "incorrect number of arguments to #<procedure x>".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: a is not a positive fixnum".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: -1 is not a positive fixnum".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: 0 is not a positive fixnum".
--- 60,66 ----
primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".
primvars.mo:Expected error in mat make-parameter: "+: a is not a number".
primvars.mo:Expected error in mat make-parameter: "incorrect number of arguments to #<procedure>".
! primvars.mo:Expected error in mat parameterize: "incorrect number of arguments to #<procedure>".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: a is not a positive fixnum".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: -1 is not a positive fixnum".
primvars.mo:Expected error in mat collect-generation-radix: "collect-generation-radix: 0 is not a positive fixnum".
***************
*** 81,151 ****
primvars.mo:Expected error in mat print-radix: "print-radix: 1 is not between 2 and 36".
primvars.mo:Expected error in mat timer-interrupt-handler: "timer-interrupt-handler: midnight is not a procedure".
primvars.mo:Expected error in mat trace-output-port: "trace-output-port: #<input port string> is not a textual output port".
! 3.mo:Expected error in mat matrest1: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest2: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest2: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure matrestf>".
3.mo:Expected error in mat application: "attempt to apply non-procedure ((a b c))".
3.mo:Expected error in mat case-lambda: "incorrect argument count in call ((case-lambda))".
3.mo:Expected error in mat case-lambda: "incorrect argument count in call (f 3 4 5)".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
3.mo:Expected error in mat let: "incorrect argument count in call ((lambda (x . r) ((...) x (...))))".
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".
--- 87,157 ----
primvars.mo:Expected error in mat print-radix: "print-radix: 1 is not between 2 and 36".
primvars.mo:Expected error in mat timer-interrupt-handler: "timer-interrupt-handler: midnight is not a procedure".
primvars.mo:Expected error in mat trace-output-port: "trace-output-port: #<input port string> is not a textual output port".
! 3.mo:Expected error in mat matrest1: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest2: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest2: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest3: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest4: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest5: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest6: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest7: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest8: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest9: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat matrest10: "incorrect number of arguments to #<procedure>".
3.mo:Expected error in mat application: "attempt to apply non-procedure ((a b c))".
3.mo:Expected error in mat case-lambda: "incorrect argument count in call ((case-lambda))".
3.mo:Expected error in mat case-lambda: "incorrect argument count in call (f 3 4 5)".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
! 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure>".
3.mo:Expected error in mat let: "incorrect argument count in call ((lambda (x . r) ((...) x (...))))".
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".
***************
*** 4274,4289 ****
6.mo:Expected error in mat pretty-print: "pretty-format: invalid format (bad 0 ... ... 0 format)".
6.mo:Expected error in mat fasl: "separate-eval: Warning in fasl-write: fasl file content is compressed internally; compressing the file (#<binary output port testfile.ss>) is redundant and can slow fasl writing and reading significantly
6.mo:Expected error in mat fasl: "separate-eval: Warning in fasl-read: fasl file content is compressed internally; compressing the file (#<binary input port testfile.ss>) is redundant and can slow fasl writing and reading significantly
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "~a~~~s" in call to format".
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~a~a~a~s" in call to format".
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "~a~~~s" in call to format at line 1, char 28 of testfile.ss".
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~a~a~a~s" in call to format at line 1, char 28 of testfile.ss".
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "abc~s" in call to printf".
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~%~abc~adef~ag~s~~~%" in call to printf".
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "abc~s" in call to printf at line 1, char 28 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 printf at line 1, char 28 of testfile.ss".
- 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "abc~s" in call to fprintf".
- 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".
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)".
--- 4280,4289 ----
***************
*** 7248,7254 ****
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 include: file "testfile-mc-1a.ss" not found in source directories
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in include: failed for ./testfile-mc-3a.ss: no such file or directory
! 7.mo:Expected error in mat eval: "compile: 7 is not an environment".
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".
--- 7248,7254 ----
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 include: file "testfile-mc-1a.ss" not found in source directories
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in include: failed for ./testfile-mc-3a.ss: no such file or directory
! 7.mo:Expected error in mat eval: "interpret: 7 is not an environment".
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".
***************
*** 7627,7633 ****
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".
! record.mo:Expected error in mat record25: "incorrect number of arguments to #<procedure make-r25-bar>".
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".
--- 7627,7633 ----
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".
! record.mo:Expected error in mat record25: "incorrect number of arguments to #<procedure>".
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".
***************
*** 9657,9681 ****
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".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument 83076749736557242056487941267521535".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument #f".
! foreign.mo:Expected error in mat foreign-procedure: "idint32: invalid foreign-procedure argument "hi"".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument -5444517870735015415413993718908291383295".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument #f".
! foreign.mo:Expected error in mat foreign-procedure: "iduns32: invalid foreign-procedure argument "hi"".
! foreign.mo:Expected error in mat foreign-procedure: "idfix: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "idfix: invalid foreign-procedure argument <-int>".
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".
--- 9657,9681 ----
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".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument 83076749736557242056487941267521535".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument #f".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument "hi"".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument -5444517870735015415413993718908291383295".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument <-int>".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument #f".
! foreign.mo:Expected error in mat foreign-procedure: "id: invalid foreign-procedure argument "hi"".
! foreign.mo:Expected error in mat foreign-procedure: "idiptr: invalid foreign-procedure argument <int>".
! foreign.mo:Expected error in mat foreign-procedure: "idiptr: invalid foreign-procedure argument <-int>".
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".
***************
*** 9688,9719 ****
foreign.mo:Expected error in mat foreign-sizeof: "incorrect number of arguments to #<procedure foreign-sizeof>".
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".
! foreign.mo:Expected error in mat foreign-bytevectors: "u8*->u8*: invalid foreign-procedure argument "hello"".
! foreign.mo:Expected error in mat foreign-bytevectors: "u16*->u16*: invalid foreign-procedure argument "hello"".
! foreign.mo:Expected error in mat foreign-bytevectors: "u32*->u32*: invalid foreign-procedure argument "hello"".
! foreign.mo:Expected error in mat foreign-bytevectors: "u8*->u8*: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-bytevectors: "u16*->u16*: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-bytevectors: "u32*->u32*: invalid foreign-procedure argument 0".
foreign.mo:Expected error in mat foreign-bytevectors: "foreign-callable: invalid return value (#vu8(2 3 4 5) 4) from #<procedure>".
foreign.mo:Expected error in mat foreign-bytevectors: "foreign-callable: invalid return value (#vu8(3 4 5 6) 4) from #<procedure>".
foreign.mo:Expected error in mat foreign-bytevectors: "foreign-callable: invalid return value (#vu8(5 6 7 8) 4) from #<procedure>".
! foreign.mo:Expected error in mat foreign-bytevectors: "call-u8*: invalid foreign-procedure argument #(1 2 3 4 5 0)".
! foreign.mo:Expected error in mat foreign-bytevectors: "call-u16*: invalid foreign-procedure argument #(1 2 3 4 5 6 ...)".
! foreign.mo:Expected error in mat foreign-bytevectors: "call-u32*: invalid foreign-procedure argument #(1 2 3 4 5 6 ...)".
! foreign.mo:Expected error in mat foreign-strings: "utf-8->utf-8: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "utf-16le->utf-16le: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "utf-16be->utf-16be: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "utf-32le->utf-32le: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "utf-32be->utf-32be: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "string->string: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "wstring->wstring: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "utf-8->utf-8: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "utf-16le->utf-16le: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "utf-16be->utf-16be: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "utf-32le->utf-32le: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "utf-32be->utf-32be: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "string->string: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "wstring->wstring: invalid foreign-procedure argument 0".
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>".
--- 9688,9719 ----
foreign.mo:Expected error in mat foreign-sizeof: "incorrect number of arguments to #<procedure foreign-sizeof>".
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".
! foreign.mo:Expected error in mat foreign-bytevectors: "u8_star_to_u8_star: invalid foreign-procedure argument "hello"".
! foreign.mo:Expected error in mat foreign-bytevectors: "u16_star_to_u16_star: invalid foreign-procedure argument "hello"".
! foreign.mo:Expected error in mat foreign-bytevectors: "u32_star_to_u32_star: invalid foreign-procedure argument "hello"".
! foreign.mo:Expected error in mat foreign-bytevectors: "u8_star_to_u8_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-bytevectors: "u16_star_to_u16_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-bytevectors: "u32_star_to_u32_star: invalid foreign-procedure argument 0".
foreign.mo:Expected error in mat foreign-bytevectors: "foreign-callable: invalid return value (#vu8(2 3 4 5) 4) from #<procedure>".
foreign.mo:Expected error in mat foreign-bytevectors: "foreign-callable: invalid return value (#vu8(3 4 5 6) 4) from #<procedure>".
foreign.mo:Expected error in mat foreign-bytevectors: "foreign-callable: invalid return value (#vu8(5 6 7 8) 4) from #<procedure>".
! foreign.mo:Expected error in mat foreign-bytevectors: "call_u8_star: invalid foreign-procedure argument #(1 2 3 4 5 0)".
! foreign.mo:Expected error in mat foreign-bytevectors: "call_u16_star: invalid foreign-procedure argument #(1 2 3 4 5 6 ...)".
! foreign.mo:Expected error in mat foreign-bytevectors: "call_u32_star: invalid foreign-procedure argument #(1 2 3 4 5 6 ...)".
! foreign.mo:Expected error in mat foreign-strings: "u8_star_to_u8_star: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "u16_star_to_u16_star: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "u16_star_to_u16_star: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "u32_star_to_u32_star: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "u32_star_to_u32_star: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "char_star_to_char_star: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "wchar_star_to_wchar_star: invalid foreign-procedure argument #vu8(1 2 3 4 0 0 ...)".
! foreign.mo:Expected error in mat foreign-strings: "u8_star_to_u8_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "u16_star_to_u16_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "u16_star_to_u16_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "u32_star_to_u32_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "u32_star_to_u32_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "char_star_to_char_star: invalid foreign-procedure argument 0".
! foreign.mo:Expected error in mat foreign-strings: "wchar_star_to_wchar_star: invalid foreign-procedure argument 0".
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>".
***************
*** 9721,9746 ****
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>".
! foreign.mo:Expected error in mat foreign-fixed-types: "i8-to-i8: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u8-to-u8: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i16-to-i16: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u16-to-u16: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i24-to-i24: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u24-to-u24: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i32-to-i32: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u32-to-u32: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i64-to-i64: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u64-to-u64: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i8-to-i8: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u8-to-u8: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "i16-to-i16: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u16-to-u16: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "i32-to-i32: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u32-to-u32: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "i64-to-i64: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u64-to-u64: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "sf-to-sf: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "df-to-df: invalid foreign-procedure argument qqq".
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>".
--- 9721,9746 ----
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>".
! foreign.mo:Expected error in mat foreign-fixed-types: "i8_to_i8: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u8_to_u8: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i16_to_i16: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u16_to_u16: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i32_to_i32: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u32_to_u32: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i32_to_i32: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u32_to_u32: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i64_to_i64: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "u64_to_u64: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "i8_to_i8: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u8_to_u8: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "i16_to_i16: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u16_to_u16: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "i32_to_i32: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u32_to_u32: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "i64_to_i64: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "u64_to_u64: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-fixed-types: "sf_to_sf: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-fixed-types: "df_to_df: invalid foreign-procedure argument qqq".
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>".
***************
*** 9751,9785 ****
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>".
! foreign.mo:Expected error in mat foreign-C-types: "int-to-int: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-to-unsigned: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-int-to-unsigned-int: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-short-to-unsigned-short: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "short-to-short: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "long-to-long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-long-to-unsigned-long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "long-long-to-long-long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-long-long-to-unsigned-long-long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "iptr-to-iptr: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "uptr-to-uptr: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "void*-to-void*: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "int-to-int: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-to-unsigned: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-int-to-unsigned-int: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-short-to-unsigned-short: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "short-to-short: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "long-to-long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-long-to-unsigned-long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "long-long-to-long-long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned-long-long-to-unsigned-long-long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "iptr-to-iptr: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "uptr-to-uptr: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "void*-to-void*: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "char-to-char: invalid foreign-procedure argument 73".
! foreign.mo:Expected error in mat foreign-C-types: "char-to-char: invalid foreign-procedure argument #\U+100".
! foreign.mo:Expected error in mat foreign-C-types: "wchar-to-wchar: invalid foreign-procedure argument 73".
! foreign.mo:Expected error in mat foreign-C-types: "float-to-float: invalid foreign-procedure argument qqq.5".
! foreign.mo:Expected error in mat foreign-C-types: "double-to-double: invalid foreign-procedure argument qqq.5".
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>".
--- 9751,9785 ----
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>".
! foreign.mo:Expected error in mat foreign-C-types: "int_to_int: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_to_unsigned: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_to_unsigned: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_short_to_unsigned_short: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "short_to_short: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "long_to_long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_long_to_unsigned_long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "long_long_to_long_long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_long_long_to_unsigned_long_long: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "iptr_to_iptr: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "uptr_to_uptr: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "uptr_to_uptr: invalid foreign-procedure argument qqq".
! foreign.mo:Expected error in mat foreign-C-types: "int_to_int: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_to_unsigned: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_to_unsigned: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_short_to_unsigned_short: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "short_to_short: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "long_to_long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_long_to_unsigned_long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "long_long_to_long_long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "unsigned_long_long_to_unsigned_long_long: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "iptr_to_iptr: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "uptr_to_uptr: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "uptr_to_uptr: invalid foreign-procedure argument "oops"".
! foreign.mo:Expected error in mat foreign-C-types: "char_to_char: invalid foreign-procedure argument 73".
! foreign.mo:Expected error in mat foreign-C-types: "char_to_char: invalid foreign-procedure argument #\U+100".
! foreign.mo:Expected error in mat foreign-C-types: "wchar_to_wchar: invalid foreign-procedure argument 73".
! foreign.mo:Expected error in mat foreign-C-types: "float_to_float: invalid foreign-procedure argument qqq.5".
! foreign.mo:Expected error in mat foreign-C-types: "double_to_double: invalid foreign-procedure argument qqq.5".
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>".
***************
*** 10386,10395 ****
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 ...)))".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure make-<a>>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure make-<a>>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure m1>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure m1>".
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".
--- 10386,10395 ----
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 ...)))".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure>".
! oop.mo:Expected error in mat oop: "incorrect number of arguments to #<procedure>".
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".

Some files were not shown because too many files have changed in this diff Show more