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

Added remaining list/pair functions

Browse source
This commit is contained in:
Justin Ethier 2015-03-25 14:09:49 -04:00
parent c85c13d1d9
commit 19ccf7cda3
4 changed files with 24 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
cgen.scm
View file

@ -482,7 +482,10 @@
((eq? p 'symbol->string) "Cyc_symbol2string") ((eq? p 'symbol->string) "Cyc_symbol2string")
((eq? p 'number->string) "Cyc_number2string") ((eq? p 'number->string) "Cyc_number2string")
((eq? p 'assq) "assq") ((eq? p 'assq) "assq")
((eq? p 'assv) "assq")
((eq? p 'assoc) "assoc") ((eq? p 'assoc) "assoc")
((eq? p 'memq) "memqp")
((eq? p 'memv) "memqp")
((eq? p 'member) "memberp") ((eq? p 'member) "memberp")
((eq? p 'length) "Cyc_length") ((eq? p 'length) "Cyc_length")
((eq? p 'set-car!) "Cyc_set_car") ((eq? p 'set-car!) "Cyc_set_car")

3
eval.scm
View file

@ -212,6 +212,9 @@
(list 'equal? equal?) (list 'equal? equal?)
(list 'assoc assoc) (list 'assoc assoc)
(list 'assq assq) (list 'assq assq)
(list 'assv assv)
(list 'memq memq)
(list 'memv memv)
(list 'member member) (list 'member member)
(list 'length length) (list 'length length)
(list 'set-car! set-car!) (list 'set-car! set-car!)

15
runtime.h
View file

@ -352,6 +352,7 @@ static list assq(object,list);
static object get(object,object); static object get(object,object);
static object equalp(object,object); static object equalp(object,object);
static object memberp(object,list); static object memberp(object,list);
static object memqp(object,list);
static char *transport(char *,int); static char *transport(char *,int);
static void GC(closure,object*,int) never_returns; static void GC(closure,object*,int) never_returns;
@ -701,10 +702,15 @@ static object Cyc_write(x) object x;
/* Some of these non-consing functions have been optimized from CPS. */ /* Some of these non-consing functions have been optimized from CPS. */
// TODO: should not be a predicate, may end up moving these to Scheme code
static object memberp(x,l) object x; list l; static object memberp(x,l) object x; list l;
{for (; !nullp(l); l = cdr(l)) if (boolean_f != equalp(x,car(l))) return boolean_t; {for (; !nullp(l); l = cdr(l)) if (boolean_f != equalp(x,car(l))) return boolean_t;
return boolean_f;} return boolean_f;}
static object memqp(x,l) object x; list l;
{for (; !nullp(l); l = cdr(l)) if (eq(x,car(l))) return boolean_t;
return boolean_f;}
static object get(x,i) object x,i; static object get(x,i) object x,i;
{register object plist; register object plistd; {register object plist; register object plistd;
if (nullp(x)) return x; if (nullp(x)) return x;
@ -1220,8 +1226,14 @@ static void _assoc (object cont, object args) {
return_funcall1(cont, assoc(car(args), cadr(args)));} return_funcall1(cont, assoc(car(args), cadr(args)));}
static void _assq (object cont, object args) { static void _assq (object cont, object args) {
return_funcall1(cont, assq(car(args), cadr(args)));} return_funcall1(cont, assq(car(args), cadr(args)));}
static void _assv (object cont, object args) {
return_funcall1(cont, assq(car(args), cadr(args)));}
static void _member(object cont, object args) { static void _member(object cont, object args) {
return_funcall1(cont, memberp(car(args), cadr(args)));} return_funcall1(cont, memberp(car(args), cadr(args)));}
static void _memq(object cont, object args) {
return_funcall1(cont, memqp(car(args), cadr(args)));}
static void _memv(object cont, object args) {
return_funcall1(cont, memqp(car(args), cadr(args)));}
static void _char_91_125integer(object cont, object args) { static void _char_91_125integer(object cont, object args) {
integer_type i = Cyc_char2integer(car(args)); integer_type i = Cyc_char2integer(car(args));
return_funcall1(cont, &i);} return_funcall1(cont, &i);}
@ -1311,7 +1323,10 @@ defprimitive(eqv_127, eqv?, &_eqv_127); /* eqv? */
defprimitive(equal_127, equal?, &_equal_127); /* equal? */ defprimitive(equal_127, equal?, &_equal_127); /* equal? */
defprimitive(assoc, assoc, &_assoc); /* assoc */ defprimitive(assoc, assoc, &_assoc); /* assoc */
defprimitive(assq, assq, &_assq); /* assq */ defprimitive(assq, assq, &_assq); /* assq */
defprimitive(assv, assv, &_assv); /* assq */
defprimitive(member, member, &_member); /* member */ defprimitive(member, member, &_member); /* member */
defprimitive(memq, memq, &_memq); /* memq */
defprimitive(memv, memv, &_memv); /* memv */
defprimitive(length, length, &_length); /* length */ defprimitive(length, length, &_length); /* length */
defprimitive(set_91car_67, set-car!, &_set_91car_67); /* set-car! */ defprimitive(set_91car_67, set-car!, &_set_91car_67); /* set-car! */
defprimitive(set_91cdr_67, set-cdr!, &_set_91cdr_67); /* set-cdr! */ defprimitive(set_91cdr_67, set-cdr!, &_set_91cdr_67); /* set-cdr! */

3
trans.scm
View file

@ -625,6 +625,9 @@
equal? equal?
assoc assoc
assq assq
assv
memq
memv
member member
length length
set-car! set-car!