guard against opcodes

This commit is contained in:
Alex Shinn 2021-12-03 08:33:28 +09:00
parent 9a48a110b8
commit 9a17254536
2 changed files with 3 additions and 1 deletions

View file

@ -1,6 +1,6 @@
(define-library (srfi 229)
(import (scheme base) (scheme case-lambda) (chibi ast))
(import (scheme base) (scheme case-lambda) (chibi ast) (only (chibi) opcode?))
(export case-lambda/tag lambda/tag procedure/tag? procedure-tag)
(begin
(define procedure-tag-object (list 'procedure-tag))
@ -20,6 +20,7 @@
(procedure->tagged (case-lambda . clauses) tag-expr))))
(define (procedure/tag? f)
(and (procedure? f)
(not (opcode? f))
(let ((vars (procedure-vars f)))
(and (vector? vars)
(> (vector-length vars) 1)

View file

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