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

Revert memq, memv, assq, assv back to primitives

Browse source
This commit is contained in:
Justin Ethier 2016-10-17 23:42:53 -04:00
parent 86e3b0fbd9
commit e636f40f99
5 changed files with 70 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
include/cyclone/runtime.h
View file

@ -347,6 +347,10 @@ extern const object primitive_cell;
extern const object primitive_eq_127;
extern const object primitive_eqv_127;
extern const object primitive_equal_127;
extern const object primitive_assq;
extern const object primitive_assv;
extern const object primitive_memq;
extern const object primitive_memv;
extern const object primitive_length;
extern const object primitive_vector_91length;
extern const object primitive_bytevector_91length;

32
runtime.c
View file

@ -3410,6 +3410,30 @@ void _apply(void *data, object cont, object args)
dispatch(data, obj_obj2int(argc), (function_type)dispatch_apply_va, cont, cont, args);
}
void _assq(void *data, object cont, object args)
{
Cyc_check_num_args(data, "assq ", 2, args);
return_closcall1(data, cont, assq(data, car(args), cadr(args)));
}
void _assv(void *data, object cont, object args)
{
Cyc_check_num_args(data, "assv ", 2, args);
return_closcall1(data, cont, assq(data, car(args), cadr(args)));
}
void _memq(void *data, object cont, object args)
{
Cyc_check_num_args(data, "memq", 2, args);
return_closcall1(data, cont, memqp(data, car(args), cadr(args)));
}
void _memv(void *data, object cont, object args)
{
Cyc_check_num_args(data, "memv", 2, args);
return_closcall1(data, cont, memqp(data, car(args), cadr(args)));
}
void _char_91_125integer(void *data, object cont, object args)
{
Cyc_check_num_args(data, "char->integer", 1, args);
@ -4316,6 +4340,10 @@ static primitive_type eqv_127_primitive =
{ {0}, primitive_tag, "eqv?", &_eqv_127 };
static primitive_type equal_127_primitive =
{ {0}, primitive_tag, "equal?", &_equal_127 };
static primitive_type assq_primitive = { {0}, primitive_tag, "assq", &_assq };
static primitive_type assv_primitive = { {0}, primitive_tag, "assv", &_assv };
static primitive_type memq_primitive = { {0}, primitive_tag, "memq", &_memq };
static primitive_type memv_primitive = { {0}, primitive_tag, "memv", &_memv };
static primitive_type length_primitive =
{ {0}, primitive_tag, "length", &_length };
static primitive_type bytevector_91length_primitive =
@ -4539,6 +4567,10 @@ const object primitive_cell = &cell_primitive;
const object primitive_eq_127 = &eq_127_primitive;
const object primitive_eqv_127 = &eqv_127_primitive;
const object primitive_equal_127 = &equal_127_primitive;
const object primitive_assq = &assq_primitive;
const object primitive_assv = &assv_primitive;
const object primitive_memq = &memq_primitive;
const object primitive_memv = &memv_primitive;
const object primitive_length = &length_primitive;
const object primitive_bytevector_91length = &bytevector_91length_primitive;
const object primitive_vector_91length = &vector_91length_primitive;

16
scheme/base.sld
View file

@ -10,11 +10,11 @@
(import (scheme cyclone common))
(export
member
memv
memq
;memv
;memq
assoc
assv
assq
;assv
;assq
cons-source
syntax-rules
letrec*
@ -542,8 +542,8 @@
(if (pair? compare)
(member-helper obj lst (car compare))
(member-helper obj lst equal?)))
(define (memq obj lst) (member-helper obj lst eq?))
(define (memv obj lst) (member-helper obj lst eqv?))
;(define (memq obj lst) (member-helper obj lst eq?))
;(define (memv obj lst) (member-helper obj lst eqv?))
(define (assoc-helper obj lst cmp?)
(cond
@ -557,8 +557,8 @@
(if (pair? compare)
(assoc-helper obj alist (car compare))
(assoc-helper obj alist equal?)))
(define (assq obj alist) (assoc-helper obj alist eq?))
(define (assv obj alist) (assoc-helper obj alist eqv?))
;(define (assq obj alist) (assoc-helper obj alist eq?))
;(define (assv obj alist) (assoc-helper obj alist eqv?))
(define (foldl func accum lst)
(if (null? lst)

36
scheme/cyclone/primitives.sld
View file

@ -97,12 +97,11 @@
eqv?
equal?
Cyc-fast-member
;assoc
;assq
;assv
;memq
;memv
;member
Cyc-fast-assoc
assv
assq
memq
memv
length
set-car!
set-cdr!
@ -224,12 +223,11 @@
(eqv? 2 2)
(equal? 2 2)
(Cyc-fast-member 2 2)
;(assoc 2 2)
;(assq 2 2)
;(assv 2 2)
;(memq 2 2)
;(memv 2 2)
;(member 2 2)
(Cyc-fast-assoc 2 2)
(assq 2 2)
(assv 2 2)
(memq 2 2)
(memv 2 2)
(length 1 1)
(set-car! 2 2)
(set-cdr! 2 2)
@ -531,6 +529,11 @@
((eq? p 'eqv?) "Cyc_eq")
((eq? p 'equal?) "equalp")
((eq? p 'Cyc-fast-member) "memberp")
((eq? p 'Cyc-fast-assoc) "assoc")
((eq? p 'assq) "assq")
((eq? p 'assv) "assq")
((eq? p 'memq) "memqp")
((eq? p 'memv) "memqp")
((eq? p 'boolean?) "Cyc_is_boolean")
((eq? p 'char?) "Cyc_is_char")
((eq? p 'null?) "Cyc_is_null")
@ -576,6 +579,7 @@
>=
<=
Cyc-fast-member
Cyc-fast-assoc
apply
car
cdr
@ -627,11 +631,11 @@
Cyc-installation-dir
Cyc-compilation-environment
command-line-arguments
;assq
;assv
assq
assv
;assoc
;memq
;memv
memq
memv
;member
length
set-car!

12
scheme/eval.sld
View file

@ -199,12 +199,12 @@
(list 'eq? eq?)
(list 'eqv? eqv?)
(list 'equal? equal?)
;(list 'assoc assoc)
;(list 'assq assq)
;(list 'assv assv)
;(list 'memq memq)
;(list 'memv memv)
;(list 'member member)
;(list 'Cyc-fast-assoc Cyc-fast-assoc)
(list 'assq assq)
(list 'assv assv)
(list 'memq memq)
(list 'memv memv)
;(list 'Cyc-fast-member Cyc-fast-member)
(list 'length length)
(list 'set-car! set-car!)
(list 'set-cdr! set-cdr!)