Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-09 14:07:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Allow (vector?) to recognize and disregard record types

Browse source
This commit is contained in:
Justin Ethier 2020-12-21 23:00:43 -05:00
parent cc3c8f5bac
commit a5fb3b1b14
4 changed files with 35 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
include/cyclone/runtime.h
View file

@ -476,7 +476,14 @@ object Cyc_is_integer(object o);
//object Cyc_is_cond_var(object o);
//object Cyc_is_symbol(object o);
//object Cyc_is_string(object o);
#define Cyc_is_vector(o) (make_boolean(is_object_type(o) && ((list) o)->tag == vector_tag))
object Cyc_is_record(object o);
#define Cyc_is_vector_not_record_type(o) \
(make_boolean(is_object_type(o) && \
((vector) o)->tag == vector_tag && \
( ((vector) o)->num_elements == 0 || \
((vector) o)->elements[0] != Cyc_RECORD_MARKER ) \
))
#define Cyc_is_vector(o) (make_boolean(is_object_type(o) && ((vector) o)->tag == vector_tag))
#define Cyc_is_bytevector(o) (make_boolean(is_object_type(o) && ((list) o)->tag == bytevector_tag))
#define Cyc_is_port(o) (make_boolean(is_object_type(o) && ((list) o)->tag == port_tag))
#define Cyc_is_mutex(o) (make_boolean(is_object_type(o) && ((list) o)->tag == mutex_tag))

14
runtime.c
View file

@ -1990,6 +1990,18 @@ object Cyc_is_integer(object o)
// return boolean_f;
//}
object Cyc_is_record(object o)
{
vector v = o;
if (is_object_type(o) &&
v->tag == vector_tag &&
v->num_elements > 0 &&
v->elements[0] == Cyc_RECORD_MARKER) {
return boolean_t;
}
return boolean_f;
}
object Cyc_is_procedure(void *data, object o)
{
int tag;
@ -5099,7 +5111,7 @@ void _bytevector_127(void *data, object cont, object args)
void _vector_127(void *data, object cont, object args)
{
Cyc_check_num_args(data, "vector?", 1, args);
return_closcall1(data, cont, Cyc_is_vector(car(args)));
return_closcall1(data, cont, Cyc_is_vector_not_record_type(car(args)));
}
void _string_127(void *data, object cont, object args)

27
scheme/base.sld
View file

@ -1978,12 +1978,7 @@
(vector record-marker name field-tags))
(define (make-type-predicate pred name)
(lambda (obj)
(and (vector? obj)
(= (vector-length obj) 3)
(or
(equal? (vector-ref obj 0) record-marker)
(equal? (vector-ref obj 0) (list 'record-marker))
)
(and (record? obj)
(equal? (vector-ref obj 1) name))))
(define (make-constructor make name)
(lambda args
@ -2029,14 +2024,18 @@
(and (not (null? lis))
(if (eq? e (car lis)) n (lp (cdr lis) (+ n 1)))))))
(define (record? obj)
(and (vector? obj)
(> (vector-length obj) 0)
(or
(equal? record-marker (vector-ref obj 0))
(equal? (list 'record-marker) (vector-ref obj 0))
)
))
;(define (record? obj)
; (and (vector? obj)
; (> (vector-length obj) 0)
; (or
; (equal? record-marker (vector-ref obj 0))
; (equal? (list 'record-marker) (vector-ref obj 0))
; )
; ))
(define-c record?
"(void *data, int argc, closure _, object k, object obj)"
" return_closcall1(data, k, Cyc_is_record(obj)); ")
(define (is-a? obj rtype)
(and (record? obj)

2
scheme/cyclone/primitives.sld
View file

@ -680,7 +680,7 @@
((eq? p 'procedure?) "Cyc_is_procedure")
((eq? p 'Cyc-macro?) "Cyc_is_macro")
((eq? p 'port?) "Cyc_is_port")
((eq? p 'vector?) "Cyc_is_vector")
((eq? p 'vector?) "Cyc_is_vector_not_record_type")
((eq? p 'bytevector?) "Cyc_is_bytevector")
((eq? p 'string?) "Cyc_is_string")
((eq? p 'eof-object?) "Cyc_is_eof_object")