add bounds check

This commit is contained in:
Alex Shinn 2021-12-02 22:07:57 +09:00
parent 0da288d053
commit 9a48a110b8
2 changed files with 2 additions and 0 deletions

View file

@ -22,6 +22,7 @@
(and (procedure? f)
(let ((vars (procedure-vars f)))
(and (vector? vars)
(> (vector-length vars) 1)
(eq? procedure-tag-object
(vector-ref vars (- (vector-length vars) 1)))))))
(define (procedure-tag f)

View file

@ -15,6 +15,7 @@
(x)
(* x x)))
(test-assert (procedure/tag? f))
(test-not (procedure/tag? (lambda (x) (* x x))))
(test 9 (f 3))
(test 42 (procedure-tag f))
(test-not (eqv? f f*))