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