Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

guard against opcodes

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

3
lib/srfi/229.sld
View file

@ -1,6 +1,6 @@
(define-library (srfi 229) (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) (export case-lambda/tag lambda/tag procedure/tag? procedure-tag)
(begin (begin
(define procedure-tag-object (list 'procedure-tag)) (define procedure-tag-object (list 'procedure-tag))
@ -20,6 +20,7 @@
(procedure->tagged (case-lambda . clauses) tag-expr)))) (procedure->tagged (case-lambda . clauses) tag-expr))))
(define (procedure/tag? f) (define (procedure/tag? f)
(and (procedure? f) (and (procedure? f)
(not (opcode? f))
(let ((vars (procedure-vars f))) (let ((vars (procedure-vars f)))
(and (vector? vars) (and (vector? vars)
(> (vector-length vars) 1) (> (vector-length vars) 1)

1
lib/srfi/229/test.sld
View file

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