string mpcomplex::to_string(int precision) {
int base = 10;
char * stringRepresentation = mpc_get_str( base , precision , mpc_val , mpc_rnd );
string returnValue = stringRepresentation;
mpc_free_str( stringRepresentation );
return returnValue;
}
static void FBIF_str (void) /* Convert a number to a string. */
{
FACT_t push_val;
push_val.type = NUM_TYPE;
push_val.ap = FACT_stona (mpc_get_str (GET_ARG_NUM ()->value));
push_v (push_val);
}
SEXP print_mpc(SEXP ptr) {
mpc_ptr z = (mpc_ptr)R_ExternalPtrAddr(ptr);
SEXP retVal;
Rprintf("Rounding: %s\n",
CHAR(STRING_ELT(Rf_GetOption(Rf_install("mpc.rounding"),
R_BaseEnv), 0)));
if (z) {
char *mystring = mpc_get_str(10, 0, z, Rmpc_get_rounding());
PROTECT(retVal = Rf_mkString(mystring));
UNPROTECT(1);
return retVal;
}
return R_NilValue;
}
static void FBIF_print (void) /* Print an ASCII string or numerical value. */
{
int len;
FACT_num_t arg;
static pthread_mutex_t print_lock = PTHREAD_MUTEX_INITIALIZER;
arg = GET_ARG_NUM();
pthread_mutex_lock(&print_lock);
/* If the argument is an array, print it as a string. Otherwise, print the
* numerical value.
*/
if (arg->array_size == 0) /* Print a newline, as it is a number */
len = printf("%s\n", mpc_get_str(arg->value)) - 1;
else
len = printf("%s", FACT_natos(arg));
fflush(stdout);
pthread_mutex_unlock(&print_lock);
push_constant_ui(len);
}
void
shell (func_t * scope)
{
/**
* shell - when FACT is run by default it comes to here. The
* main user interface for FACT, this function grabs an
* expression of input, parses it, runs it, and repeats. It
* will continue to do so until the user does a C-d, C-c,
* returns a value from the main scope, or calls the exit
* function.
*
* @scope - the scope to use when evaluating expressions.
*/
FACT_t returned; // The value returned by the interpreter.
unsigned int end_line; // ...
unsigned int hold_line; // ...
int *newlines;
char *input;
char *hold_input; // Used in the main loop to check for else clauses.
char **tokenized; // input, tokenized.
char **hold_tokens; // Also used to check for else clauses.
/* Before we start, print out the copyright info, logo and
* a guide to some helpful functions.
*/
print_logo ();
printf ("The FACT programming language interactive shell\n"
"© 2010, 2011 Matthew Plant, under the GPL version 3.\n");
hold_input = NULL;
scope->file_name = "stdin";
scope->line = 1;
end_line = 0;
for (;;) // Heh, that looks like a spider.
{
/* Set the line number to end_line, in case we missed any while evaluating
* the last expression.
*/
scope->line += end_line;
end_line = 0;
// Then, get raw input for an entire expression.
if (hold_input == NULL)
input = get_input (stdin, &end_line, "S>", "C>");
else
{
input = hold_input;
hold_input = NULL;
}
/* We do two checks for EOF signals: once before tokenizing, and once after.
* I am not completely sure as to why this is the case, but I do remember at
* some point it didn't exit so I added the second check.
*/
if (input == NULL)
break;
// Tokenize the input.
tokenized = get_words (input);
if (tokenized == NULL)
break;
/* If the first token in the expression is if/on_error, continue to get input
* as long as the first token is else. I could forsee this being an issue in
* places where the else is placed erroneosly, but that'll be fixed later I
* assume.
*/
if ((tokenized[0][0] == '\n'
&& (!tokcmp (tokenized[1], "if")
|| !tokcmp (tokenized[1], "error")))
|| (!tokcmp (tokenized[0], "if")
|| !tokcmp (tokenized[0], "error")))
{
for (;;)
{
/* Go through all the steps we went through from the start of the loop
* down to here.
*/
hold_input = get_input (stdin, &end_line, "?>", "C>");
if (hold_input == NULL|| (hold_tokens = get_words (hold_input)) == NULL)
break;
// Check to see if the statement starts with else.
if ((hold_tokens[0][0] == '\n'
&& !tokcmp (hold_tokens[1], "else"))
|| !tokcmp (hold_tokens[0], "else"))
{
input[strlen (input) - 1] = '\0';
input = combine_strs (input, hold_input);
hold_input = NULL;
}
else
break;
}
printf ("\n");
tokenized = get_words (input);
}
// Get the newlines and parse the string.
tokenized = parse (tokenized, "stdin", scope->line, &newlines);
if (tokenized == NULL)
continue;
// Reset the instruction pointer.
reset_ip ();
// Evaluate the expression.
returned = eval_expression (scope, make_syn_tree (tokenized, newlines));
/* If there were errors, print them out. Otherwise,
* print the value of the variable or the name of
* the function returned.
*/
if (returned.type == ERROR_TYPE)
errorman_dump (returned.error);
else if (returned.type == VAR_TYPE)
printf ("Returned value: %s\n", mpc_get_str (returned.v_point->data));
else
printf ("Returned object [%s]\n", returned.f_point->name);
/* Check to see if the value is to be returned, and
* if so, exit.
*/
if (returned.return_signal)
break;
}
puts ("\nExiting...");
}
static void
check_set_str (mpfr_exp_t exp_max)
{
mpc_t expected;
mpc_t got;
char *str;
mpfr_prec_t prec;
mpfr_exp_t exp_min;
int base;
mpc_init2 (expected, 1024);
mpc_init2 (got, 1024);
exp_min = mpfr_get_emin ();
if (exp_max <= 0)
exp_max = mpfr_get_emax ();
else if (exp_max > mpfr_get_emax ())
exp_max = mpfr_get_emax();
if (-exp_max > exp_min)
exp_min = - exp_max;
for (prec = 2; prec < 1024; prec += 7)
{
mpc_set_prec (got, prec);
mpc_set_prec (expected, prec);
base = 2 + (int) gmp_urandomm_ui (rands, 35);
/* uses external variable rands from random.c */
mpfr_set_nan (MPC_RE (expected));
mpfr_set_inf (MPC_IM (expected), prec % 2 - 1);
str = mpc_get_str (base, 0, expected, MPC_RNDNN);
if (mpfr_nan_p (MPC_RE (got)) == 0
|| mpfr_cmp (MPC_IM (got), MPC_IM (expected)) != 0)
{
printf ("Error: mpc_set_str o mpc_get_str != Id\n"
"in base %u with str=\"%s\"\n", base, str);
MPC_OUT (expected);
printf (" ");
MPC_OUT (got);
exit (1);
}
mpc_free_str (str);
test_default_random (expected, exp_min, exp_max, 128, 25);
str = mpc_get_str (base, 0, expected, MPC_RNDNN);
if (mpc_set_str (got, str, base, MPC_RNDNN) == -1
|| mpc_cmp (got, expected) != 0)
{
printf ("Error: mpc_set_str o mpc_get_str != Id\n"
"in base %u with str=\"%s\"\n", base, str);
MPC_OUT (expected);
printf (" ");
MPC_OUT (got);
exit (1);
}
mpc_free_str (str);
}
#ifdef HAVE_SETLOCALE
{
/* Check with ',' as a decimal point */
char *old_locale;
old_locale = setlocale (LC_ALL, "de_DE");
if (old_locale != NULL)
{
str = mpc_get_str (10, 0, expected, MPC_RNDNN);
if (mpc_set_str (got, str, 10, MPC_RNDNN) == -1
|| mpc_cmp (got, expected) != 0)
{
printf ("Error: mpc_set_str o mpc_get_str != Id\n"
"with str=\"%s\"\n", str);
MPC_OUT (expected);
printf (" ");
MPC_OUT (got);
exit (1);
}
mpc_free_str (str);
setlocale (LC_ALL, old_locale);
}
}
#endif /* HAVE_SETLOCALE */
/* the real part has a zero exponent in base ten (fixed in r439) */
mpc_set_prec (expected, 37);
mpc_set_prec (got, 37);
mpc_set_str (expected, "921FC04EDp-35 ", 16, GMP_RNDN);
str = mpc_get_str (10, 0, expected, MPC_RNDNN);
if (mpc_set_str (got, str, 10, MPC_RNDNN) == -1
|| mpc_cmp (got, expected) != 0)
{
printf ("Error: mpc_set_str o mpc_get_str != Id\n"
"with str=\"%s\"\n", str);
MPC_OUT (expected);
printf (" ");
MPC_OUT (got);
exit (1);
}
mpc_free_str (str);
str = mpc_get_str (1, 0, expected, MPC_RNDNN);
if (str != NULL)
{
printf ("Error: mpc_get_str with base==1 should fail\n");
exit (1);
}
mpc_clear (expected);
mpc_clear (got);
}
