From 19ccf7cda3c1276ed6e04c4d52f4c8eaf1f51a37 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 25 Mar 2015 14:09:49 -0400 Subject: [PATCH] Added remaining list/pair functions --- cgen.scm | 3 +++ eval.scm | 3 +++ runtime.h | 15 +++++++++++++++ trans.scm | 3 +++ 4 files changed, 24 insertions(+) diff --git a/cgen.scm b/cgen.scm index 30ad0010..fd354ba8 100644 --- a/cgen.scm +++ b/cgen.scm @@ -482,7 +482,10 @@ ((eq? p 'symbol->string) "Cyc_symbol2string") ((eq? p 'number->string) "Cyc_number2string") ((eq? p 'assq) "assq") + ((eq? p 'assv) "assq") ((eq? p 'assoc) "assoc") + ((eq? p 'memq) "memqp") + ((eq? p 'memv) "memqp") ((eq? p 'member) "memberp") ((eq? p 'length) "Cyc_length") ((eq? p 'set-car!) "Cyc_set_car") diff --git a/eval.scm b/eval.scm index adcb2ab0..b986c82e 100644 --- a/eval.scm +++ b/eval.scm @@ -212,6 +212,9 @@ (list 'equal? equal?) (list 'assoc assoc) (list 'assq assq) + (list 'assv assv) + (list 'memq memq) + (list 'memv memv) (list 'member member) (list 'length length) (list 'set-car! set-car!) diff --git a/runtime.h b/runtime.h index be04edd3..7441ded4 100644 --- a/runtime.h +++ b/runtime.h @@ -352,6 +352,7 @@ static list assq(object,list); static object get(object,object); static object equalp(object,object); static object memberp(object,list); +static object memqp(object,list); static char *transport(char *,int); 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. */ +// TODO: should not be a predicate, may end up moving these to Scheme code 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; 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; {register object plist; register object plistd; if (nullp(x)) return x; @@ -1220,8 +1226,14 @@ static void _assoc (object cont, object args) { return_funcall1(cont, assoc(car(args), cadr(args)));} static void _assq (object cont, object 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) { 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) { integer_type i = Cyc_char2integer(car(args)); return_funcall1(cont, &i);} @@ -1311,7 +1323,10 @@ defprimitive(eqv_127, eqv?, &_eqv_127); /* eqv? */ defprimitive(equal_127, equal?, &_equal_127); /* equal? */ defprimitive(assoc, assoc, &_assoc); /* assoc */ defprimitive(assq, assq, &_assq); /* assq */ +defprimitive(assv, assv, &_assv); /* assq */ defprimitive(member, member, &_member); /* member */ +defprimitive(memq, memq, &_memq); /* memq */ +defprimitive(memv, memv, &_memv); /* memv */ defprimitive(length, length, &_length); /* length */ defprimitive(set_91car_67, set-car!, &_set_91car_67); /* set-car! */ defprimitive(set_91cdr_67, set-cdr!, &_set_91cdr_67); /* set-cdr! */ diff --git a/trans.scm b/trans.scm index 859e3da6..6352c819 100644 --- a/trans.scm +++ b/trans.scm @@ -625,6 +625,9 @@ equal? assoc assq + assv + memq + memv member length set-car!