/* * 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); } } }