set indexing now compiles in C-land

parent b228c8d1
......@@ -12,6 +12,8 @@
compile-set-representation
mktree
find-matching-sets
get-translation-data
order-the-set
))
;; Syntax helpers
......@@ -509,3 +511,23 @@ from c-land in the indexer.
(if (pair? l)
(cons (reverse-lookup theory (car l)) (lp (cdr l)))
'()))))
(define get-translation-data
(case-lambda
(() (get-translation-data (fluid-ref *current-set-theory*)))
((theory)
(let lp ((theory theory) (l '()))
(let ((p (get-parent theory)))
(if p
(lp p (cons* (get-set theory) (get-i->j theory)
(get-i->subs theory) l))
(cons (get-set->i theory) l)))))))
(define order-the-set
(case-lambda
(()
(fluid-set! *current-set-theory*
(order-the-set (fluid-ref *current-set-theory*))))
((theory)
(compile-set-representation theory))))
#include <gmp.h>
#include <stdio.h>
#include "../dynlist.c"
#include "../inh.c"
#if ((__GNUC__ >= 4) || ((__GNUC__ == 3) && (__GNUC_MINOR__ >= 4)))
#define bsf(r, i) \
do { \
......@@ -13,6 +14,7 @@
} while(0)
#endif
inline int getNsol(scm_t_bits x)
{
int i;
......@@ -302,7 +304,7 @@ SCM gp_type_attribute_tag = SCM_BOOL_F;
// #define DB(X) X
// Fast but horribly hard really, this need to be in C
void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus)
void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus, SCM trset)
{
ulong data2[200];
int n2;
......@@ -390,7 +392,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus)
if(scm_is_true(dcar))
{
//printf("CAR\n");
get_index_set_0(s,x,dcar, n, data, isPlus);
get_index_set_0(s,x,dcar, n, data, isPlus, trset);
}
int nsol = 0;
......@@ -402,7 +404,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus)
if(nsol > 1 && scm_is_true(dcdr))
{
//printf("CDR\n");
get_index_set_0(s,l,dcdr, n, data, isPlus);
get_index_set_0(s,l,dcdr, n, data, isPlus, trset);
}
// printf("finish v\n");fflush(stdout);
......@@ -550,9 +552,9 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus)
for(i = 0; i < *n; i++)
data2[i] = data[i];
get_index_set_0(s, e, a, &n2, data2, isPlus);
get_index_set_0(s, e, b, n, data, isPlus);
get_index_set_0(s, e, c, n, data, isPlus);
get_index_set_0(s, e, a, &n2, data2, isPlus, trset);
get_index_set_0(s, e, b, n, data, isPlus, trset);
get_index_set_0(s, e, c, n, data, isPlus, trset);
if(*n < n2)
{
......@@ -577,7 +579,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus)
SCM b = SCM_CADDR(db_);
if(scm_is_false(a))
return get_index_set_0(s, e, b, n, data, 0);
return get_index_set_0(s, e, b, n, data, 0, trset);
int n2 = *n;
......@@ -587,8 +589,8 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus)
{
data2[i]=data[i];
}
get_index_set_0(s, e, b, &n2, data2, 0);
get_index_set_0(s, e, a, n, data, isPlus);
get_index_set_0(s, e, b, &n2, data2, 0, trset);
get_index_set_0(s, e, a, n, data, isPlus, trset);
if(n2<*n)
{
......@@ -614,7 +616,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus)
SCM adata = gp_get_attr(e, gp_type_attribute_tag, s);
//data = (set . args)
if(scm_is_true(data))
if(scm_is_true(adata))
{
SCM set = SCM_CAR(adata);
SCM args = SCM_CDR(adata);
......@@ -623,7 +625,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus)
if(SCM_CONSP(db_))
{
SCM tree = SCM_CADR(db_);
SCM bits = get_bits_from_set(set);
SCM bits = get_bits_from_set(set, trset);
SCM v = get_set(tree, bits);
if(SCM_I_INUMP (v))
......@@ -668,7 +670,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus)
SCM b = SCM_CADDR(db_);
if(scm_is_false(a))
return get_index_set_0(s, e, b, n, data, 1);
return get_index_set_0(s, e, b, n, data, 1, trset);
int n2 = *n;
......@@ -678,8 +680,8 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus)
{
data2[i]=data[i];
}
get_index_set_0(s, e, b, &n2, data2, 1);
get_index_set_0(s, e, a, n, data, isPlus);
get_index_set_0(s, e, b, &n2, data2, 1, trset);
get_index_set_0(s, e, a, n, data, isPlus, trset);
if(n2<*n)
{
......@@ -721,8 +723,8 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus)
data3 = (*mpv)->_mp_d;
}
get_index_set_0(s, e, b, &n2, data2, isPlus);
get_index_set_0(s, e, a, n, data, isPlus);
get_index_set_0(s, e, b, &n2, data2, isPlus, trset);
get_index_set_0(s, e, a, n, data, isPlus, trset);
if(n2 < n3)
{
......@@ -754,7 +756,7 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus)
{
SCM a = SCM_CADR(db_);
SCM l = SCM_CDDR(db_);
get_index_set_0(s, e, a, &n2, data, isPlus);
get_index_set_0(s, e, a, &n2, data, isPlus, trset);
while(SCM_CONSP(l))
{
......@@ -801,13 +803,13 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data, int isPlus)
}
//#define DB(X)
SCM get_index_set(SCM s, SCM e, SCM db, int isPlus)
SCM get_index_set(SCM s, SCM e, SCM db, int isPlus, SCM trset)
{
ulong data[200];
int i,j,b,n = 0;
SCM ret;
get_index_set_0(s, e, db, &n, data, isPlus);
get_index_set_0(s, e, db, &n, data, isPlus, trset);
//printf("Got %p %p\n",data[0],data[1]);
......@@ -837,11 +839,11 @@ SCM get_index_set(SCM s, SCM e, SCM db, int isPlus)
//return scm_from_int(10);
}
SCM_DEFINE(scm_get_index_set, "get-index-set", 3, 0, 0,
(SCM s, SCM e, SCM db), "")
SCM_DEFINE(scm_get_index_set, "get-index-set", 4, 0, 0,
(SCM s, SCM e, SCM db, SCM trset), "")
#define FUNC_NAME s_scm_get_index_set
{
return get_index_set(s, e, db, 1);
return get_index_set(s, e, db, 1, trset);
}
#undef FUNC_NAME
......@@ -851,9 +853,9 @@ SCM_DEFINE(scm_get_index_test, "get-index-test", 4, 0, 0,
{
int n = scm_to_int(n_);
for(;n>0;n--)
get_index_set(s, e, db, 1);
get_index_set(s, e, db, 1, SCM_EOL);
return get_index_set(s, e, db, 1);
return get_index_set(s, e, db, 1, SCM_EOL);
}
#undef FUNC_NAME
......
SCM_API SCM scm_get_index_set(SCM s, SCM e, SCM db);
SCM_API SCM scm_get_index_set(SCM s, SCM e, SCM db, SCM trset);
SCM_API SCM scm_get_index_test(SCM s, SCM e, SCM db, SCM n_);
SCM_API SCM scm_get_index_tags();
SCM_API SCM scm_set_type_attribute(SCM x);
inline SCM scm_high_bit(SCM x)
{
return scm_from_int(0);
}
SCM get_bits_from_set(SCM set, SCM trdata)
{
SCM i, ubermap, bits, outbits, mask, map, ijmap, hstar, h, hbits;
i = scm_hash_ref(SCM_CAR(trdata), set, SCM_BOOL_F);
if(scm_is_false(i)) return scm_from_int(0);
trdata = SCM_CDR(trdata);
ubermap = SCM_CAR(trdata);
bits = scm_hash_ref(ubermap, i, SCM_BOOL_F);
if(scm_is_false(bits)) return scm_from_int(0);
outbits = scm_from_int(0);
trdata = SCM_CDR(trdata);
mask = SCM_CAR(trdata);
trdata = SCM_CDR (trdata);
ijmap = SCM_CAR (trdata);
map = SCM_CADR(trdata);
bits = scm_logand(mask, bits);
retry:
if(scm_is_true(scm_equal_p(scm_from_int(0), bits)))
return outbits;
h = scm_high_bit(bits);
hbits = scm_hash_ref(ubermap, h, SCM_BOOL_F);
bits = scm_logand(bits, scm_lognot(hbits));
hstar = scm_hash_ref(ijmap, h, SCM_BOOL_F);
outbits = scm_logior(outbits, scm_hash_ref(map, hstar, SCM_BOOL_F));
goto retry;
}
......@@ -147,4 +147,3 @@ SCM_API SCM gp_lookup_1(SCM x, SCM s);
SCM_API SCM gp_get_taglist();
SCM_API SCM gp_match(SCM e, SCM run, SCM s);
SCM_API SCM scm_set_type_attribute(SCM x);
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment