/*
* p_equal.c -- implements polymorphic equality for RML
* (This is the reason why reference nodes must still be distinguishable
* from all other values.)
*/
void *rml_prim_equal(void *p, void *q)
{
tail_recur:
/* INV: ISIMM(p) <==> ISIMM(q) */
if( p == q ) {
/* Identical objects are always equal. */
return RML_TRUE;
} else if( RML_ISIMM(p) ) {
/* Different immediate values. */
return RML_FALSE;
} else {
/* Non-identical boxed values. */
rml_uint_t phdr = RML_GETHDR(p);
rml_uint_t qhdr = RML_GETHDR(q);
if( phdr == qhdr ) {
if( phdr == RML_REALHDR ) {
return (rml_prim_get_real(p) == rml_prim_get_real(q))
? RML_TRUE
: RML_FALSE;
} else if( RML_HDRISSTRING(phdr) ) {
if( !memcmp(RML_STRINGDATA(p), RML_STRINGDATA(q), RML_HDRSTRLEN(phdr)) )
return RML_TRUE;
else
return RML_FALSE;
} else if( RML_HDRISSTRUCT(phdr) ) {
rml_uint_t slots = RML_HDRSLOTS(phdr);
void **pp = RML_STRUCTDATA(p);
void **qq = RML_STRUCTDATA(q);
if( slots == 0 )
return RML_TRUE;
while( --slots > 0 )
if( rml_prim_equal(*pp++, *qq++) == RML_FALSE )
return RML_FALSE;
p = *pp;
q = *qq;
goto tail_recur;
} else {
/* Non-identical reference nodes. */
return RML_FALSE;
}
} else {
/* Different sized strings, different constructors of some datatype,
* or reference nodes with different instantiation states.
*/
return RML_FALSE;
}
}
}
RML_END_LABEL
RML_BEGIN_LABEL(BackendDAEEXT__setAssignment)
{
int nelts=0;
int nass1 = RML_UNTAGFIXNUM(rmlA0);
int nass2 = RML_UNTAGFIXNUM(rmlA1);
int i=0;
nelts = RML_HDRSLOTS(RML_GETHDR(rmlA2));
if (nelts > 0) {
n = nass1;
if(match) {
free(match);
}
match = (int*) malloc(n * sizeof(int));
memset(match,-1,n * sizeof(int));
for(i=0; i<n; ++i) {
match[i] = RML_UNTAGFIXNUM(RML_STRUCTDATA(rmlA2)[i])-1;
if (match[i]<0) match[i] = -1;
}
}
nelts = RML_HDRSLOTS(RML_GETHDR(rmlA3));
if (nelts > 0) {
m = nass2;
if(row_match) {
free(row_match);
}
row_match = (int*) malloc(m * sizeof(int));
memset(row_match,-1,m * sizeof(int));
for(i=0; i<m; ++i) {
row_match[i] = RML_UNTAGFIXNUM(RML_STRUCTDATA(rmlA3)[i])-1;
if (row_match[i]<0) row_match[i] = -1;
}
}
rmlA0 = mk_bcon(1);
RML_TAILCALLK(rmlSC);
}
RML_END_LABEL
RML_BEGIN_LABEL(BackendDAEEXT__getAssignment)
{
int i=0;
if (match != NULL) {
for(i=0; i<n; ++i) {
if (match[i] >= 0)
RML_STRUCTDATA(rmlA0)[i] = mk_icon(match[i]+1);
else
RML_STRUCTDATA(rmlA0)[i] = mk_icon(-1);
}
}
if (row_match != NULL) {
for(i=0; i<m; ++i) {
if (row_match[i] >= 0)
RML_STRUCTDATA(rmlA1)[i] = mk_icon(row_match[i]+1);
else
RML_STRUCTDATA(rmlA1)[i] = mk_icon(-1);
}
}
RML_TAILCALLK(rmlSC);
}
RML_END_LABEL
void rmldb_var_print(void *p)
{
/* printf("[%p]", p); */
if (!p) { printf ("NIL"); fflush(stdout); return; }
if( RML_ISIMM(p) )
{
printf ("%d", RML_UNTAGFIXNUM(p));
}
else
{
rml_uint_t phdr = RML_GETHDR(p);
if( phdr == RML_REALHDR )
{
printf ("%f", rml_prim_get_real(p));
fflush(stdout);
} else
if( RML_HDRISSTRING(phdr) )
{
printf ("\"%s\"", RML_STRINGDATA(p));
fflush(stdout);
/* use if neccesarry RML_HDRSTRLEN(phdr) */
} else
if( RML_HDRISSTRUCT(phdr) )
{
rml_uint_t slots = RML_HDRSLOTS(phdr);
rml_uint_t constr = RML_HDRCTOR(phdr);
void **pp = NULL;
if (slots == 0)
{
printf ("{S(%d)[%d]=NIL}", constr, slots);
fflush(stdout);
return;
}
printf ("S(%d)[%d](", constr, slots);
pp = RML_STRUCTDATA(p);
fflush(stdout);
// function definition
if ((constr == 64 || constr==13) &&
slots > 1000000) return;
if( slots != 0 )
{
// printf ("\n\t");
while( --slots > 0 )
{
rmldb_var_print(*pp++);
printf (",");
fflush(stdout);
}
p = *pp;
rmldb_var_print(*pp); printf (")"); fflush(stdout);
// goto tail_recur_debug;
}
}
else
{
printf ("UNKNOWN"); fflush(stdout);
}
}
}
