/*
* 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;
}
}
}
DataField getData(const char *varname,const char *filename, unsigned int size, SimulationResult_Globals* srg)
{
DataField res;
void *cmpvar,*dataset,*lst,*datasetBackup;
double *newvars;
double d;
unsigned int i;
unsigned int ncmpvars = 0;
res.n = 0;
res.data = NULL;
/* fprintf(stderr, "getData of Var: %s from file %s\n", varname,filename); */
cmpvar = mk_nil();
cmpvar = mk_cons(mk_scon(varname),cmpvar);
dataset = SimulationResultsImpl__readDataset(filename,cmpvar,size,srg);
if (dataset==NULL) {
/* fprintf(stderr, "getData of Var: %s failed!\n",varname); */
return res;
}
/* fprintf(stderr, "Data of Var: %s\n", varname);
First calculate the length of the matrix */
datasetBackup = dataset;
while (RML_NILHDR != RML_GETHDR(dataset)) {
lst = RML_CAR(dataset);
while (RML_NILHDR != RML_GETHDR(lst)) {
res.n++;
lst = RML_CDR(lst);
}
dataset = RML_CDR(dataset);
}
if (res.n == 0) return res;
/* The allocate and read the values */
dataset = datasetBackup;
i = res.n;
res.data = (double*) malloc(sizeof(double)*res.n);
while (RML_NILHDR != RML_GETHDR(dataset)) {
lst = RML_CAR(dataset);
while (RML_NILHDR != RML_GETHDR(lst)) {
res.data[--i] = rml_prim_get_real(RML_CAR(lst));
lst = RML_CDR(lst);
}
dataset = RML_CDR(dataset);
}
assert(i == 0);
/* for (i=0;i<res.n;i++)
fprintf(stderr, "%d: %.6g\n", i, res.data[i]); */
return res;
}
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);
}
}
}
void print_rcon(FILE *fp, void *rcon) {
fprintf(fp, "%.15g", rml_prim_get_real(rcon));
}
