static Obj MPD_STRING(Obj self, Obj s, Obj prec) { while (!IsStringConv(s)) { s = ErrorReturnObj("MPD_STRING: object to be converted must be a string, not a %s", (Int)TNAM_OBJ(s),0, "You can return a string to continue" ); } TEST_IS_INTOBJ("MPD_STRING",prec); int n = INT_INTOBJ(prec); if (n == 0) n = GET_LEN_STRING(s)*1000 / 301; Obj g = NEW_MPD(INT_INTOBJ(prec)); char *p = (char *) CHARS_STRING(s), *newp; int sign = 1; mpd_set_ui(MPD_OBJ(g), 0, MPD_RNDNN); mpfr_ptr f = MPD_OBJ(g)->re; Obj newg = NEW_MPFR(INT_INTOBJ(prec)); for (;;) { printf("<%c>",*p); switch (*p) { case '-': case '+': case 0: if (!mpfr_nan_p(MPFR_OBJ(newg))) { /* drop the last read float */ mpfr_add (f, f, MPFR_OBJ(newg), GMP_RNDN); mpfr_set_nan (MPFR_OBJ(newg)); f = MPD_OBJ(g)->re; sign = 1; } if (!*p) return g; if (*p == '-') sign = -sign; case '*': p++; break; case 'i': case 'I': if (f == GET_MPD(g)->re) { f = MPD_OBJ(g)->im; if (mpfr_nan_p(MPFR_OBJ(newg))) mpfr_set_si (MPFR_OBJ(newg), sign, GMP_RNDN); /* accept 'i' as '1*i' */ } else return Fail; p++; break; default: mpfr_strtofr(MPFR_OBJ(newg), p, &newp, 10, GMP_RNDN); if (newp == p && f != GET_MPD(g)->im) return Fail; /* no valid characters read */ if (sign == -1) mpfr_neg(MPFR_OBJ(newg), MPFR_OBJ(newg), GMP_RNDN); p = newp; } } return g; }
Obj FuncMACFLOAT_STRING( Obj self, Obj s ) { while (!IsStringConv(s)) { s = ErrorReturnObj("MACFLOAT_STRING: object to be converted must be a string not a %s", (Int)(InfoBags[TNUM_OBJ(s)].name),0,"You can return a string to continue" ); } char * endptr; UChar *sp = CHARS_STRING(s); Obj res= NEW_MACFLOAT((Double) STRTOD((char *)sp,&endptr)); if ((UChar *)endptr != sp + GET_LEN_STRING(s)) return Fail; return res; }
/**************************************************************************** ** *F RNamObj(<obj>) . . . . . . . . . . . convert an object to a record name ** ** 'RNamObj' returns the record name corresponding to the object <obj>, ** which currently must be a string or an integer. */ UInt RNamObj ( Obj obj ) { /* convert integer object */ if ( IS_INTOBJ(obj) ) { return RNamIntg( INT_INTOBJ(obj) ); } /* convert string object (empty string may have type T_PLIST) */ else if ( IsStringConv(obj) && IS_STRING_REP(obj) ) { return RNamName( CSTR_STRING(obj) ); } /* otherwise fail */ else { obj = ErrorReturnObj( "Record: '<rec>.(<obj>)' <obj> must be a string or an integer", 0L, 0L, "you can replace <obj> via 'return <obj>;'" ); return RNamObj( obj ); } }