mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
guard against opcodes
This commit is contained in:
parent
9a48a110b8
commit
9a17254536
2 changed files with 3 additions and 1 deletions
|
@ -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)
|
||||
|
|
|
@ -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*))
|
||||
|
|
Loading…
Add table
Reference in a new issue