Permalink
Browse files

added assoc-strcmp-all

  • Loading branch information...
1 parent ea113c9 commit e2a59f697e15afa1588c228bdd5bbfd5c42d2cae @digego committed Feb 28, 2014
Showing with 63 additions and 5 deletions.
  1. +1 −0 include/Scheme.h
  2. +1 −0 include/SchemeFFI.h
  3. +2 −5 runtime/llvmir.xtm
  4. +51 −0 src/Scheme.cpp
  5. +8 −0 src/SchemeFFI.cpp
View
@@ -214,6 +214,7 @@ pointer reverse_in_place(scheme *sc, pointer term, pointer list);
pointer append(scheme *sc, pointer a, pointer b);
int list_length(scheme *sc, pointer a);
pointer assoc_strcmp(scheme *sc, pointer key, pointer alist);
+pointer assoc_strcmp_all(scheme *sc, pointer key, pointer alist);
int is_real(pointer a);
char * string_value(pointer p);
pointer list_ref(scheme* sc, int pos, pointer a);
View
@@ -75,6 +75,7 @@ namespace extemp {
// misc scheme ties
static pointer assocstrcmp(scheme* _sc, pointer args);
+ static pointer assocstrcmpall(scheme* _sc, pointer args);
// num stuff
static pointer randomReal(scheme* _sc, pointer args);
View
@@ -803,11 +803,8 @@
ags))))
(else (set! type (make-list (+ 1 arity) "_"))))
;; (println 'type_b: type)
- (let ((res (cl:remove-if (lambda (x)
- (or
- (<> arity (cadr x))
- (not (string=? name (symbol->string (car x))))))
- *impc:ir:gpolys*)))
+ (let* ((tmp (assoc-strcmp-all (string->symbol name) *impc:ir:gpolys*))
+ (res (cl:remove-if (lambda (x) (<> arity (cadr x))) tmp)))
(if (null? res)
#f
(let* ((weights (map (lambda (gp)
View
@@ -4966,6 +4966,57 @@ static pointer opexe_2(scheme *sc, enum scheme_opcodes op) {
}
return sc->F;
}
+
+// keys of assoc lst MUST be strings OR symbols
+/*static*/ pointer assoc_strcmp_all(scheme *sc, pointer key, pointer lst) {
+ pointer x;
+ pointer pair;
+ pointer r1;
+ char* lkey;
+ char* skey;
+ pointer retlst = sc->NIL;
+
+ if(is_symbol(key)) {
+ skey = strvalue(car(key));
+ for (x = lst; is_pair(x); x = cdr(x)) {
+ pair = pair_car_sc(sc,x);
+ if(is_pair(pair)) {
+ r1 = pair_car_sc(sc,pair);
+ if(!is_symbol(r1)) return sc->NIL;
+ lkey = strvalue(car(r1));
+ if(0 == strcmp(lkey,skey)) {
+ retlst = cons(sc, pair, retlst);
+ continue;
+ }
+ } else {
+ return sc->NIL;
+ }
+ }
+ } else if(is_string(key)) {
+ skey = strvalue(key);
+ for (x = lst; is_pair(x); x = cdr(x)) {
+ pair = pair_car_sc(sc,x);
+ if(is_pair(pair)) {
+ lkey = strvalue(pair_car_sc(sc,pair));
+ if(0 == strcmp(lkey,skey)) {
+ retlst = cons(sc, pair, retlst);
+ continue;
+ }
+ } else {
+ return sc->NIL;
+ }
+ }
+ } else {
+ // it not neccessarily a problem for the key to be a non-symbol/string
+ // although it should return false of course
+ // which it does after falling through to the final return
+ }
+ if (retlst == sc->NIL) {
+ return sc->NIL;
+ }else{
+ return retlst;
+ }
+}
/*static*/ pointer list_ref(scheme *sc, const int pos, pointer a) {
View
@@ -427,6 +427,7 @@ namespace extemp {
// misc scheme ties
{ "assoc-strcmp", &SchemeFFI::assocstrcmp },
+ { "assoc-strcmp-all", &SchemeFFI::assocstrcmpall },
// number stuff
{ "random-real", &SchemeFFI::randomReal },
@@ -1019,6 +1020,13 @@ namespace extemp {
return assoc_strcmp(_sc,key,alist);
}
+ pointer SchemeFFI::assocstrcmpall(scheme* _sc, pointer args)
+ {
+ pointer key = pair_car(args);
+ pointer alist = pair_cadr(args);
+ return assoc_strcmp_all(_sc,key,alist);
+ }
+
// number stuff
pointer SchemeFFI::randomReal(scheme* _sc, pointer args)
{

0 comments on commit e2a59f6

Please sign in to comment.