GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it

1
/* mpf expression evaluation
2

3
Copyright 2000, 2001, 2002, 2004 Free Software Foundation, Inc.
4

5
This file is part of the GNU MP Library.
6

7
The GNU MP Library is free software; you can redistribute it and/or modify
8
it under the terms of the GNU Lesser General Public License as published by
9
the Free Software Foundation; either version 2.1 of the License, or (at your
10
option) any later version.
11

12
The GNU MP Library is distributed in the hope that it will be useful, but
13
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
14
or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
15
License for more details.
16

17
You should have received a copy of the GNU Lesser General Public License
18
along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
19
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
20
MA 02110-1301, USA. */
21

22

23
/* Future: Bitwise "&", "|" and "&" could be done, if desired.  Not sure
24
   those functions would be much value though.  */
25

26

27
#include <ctype.h>
28
#include <stdio.h>
29
#include <string.h>
30

31
#include "gmp.h"
32
#include "expr-impl.h"
33

34

35
/* Change this to "#define TRACE(x) x" to get some traces. */
36
#define TRACE(x)
37

38

39
static size_t
40
e_mpf_number (mpf_ptr res, __gmp_const char *e, size_t elen, int base)
41
{
42
  char    *edup;
43
  size_t  i, ret, extra=0;
44
  int     mant_base, exp_base;
45
  void    *(*allocate_func) (size_t);
46
  void    (*free_func) (void *, size_t);
47

48
  TRACE (printf ("mpf_number base=%d \"%.*s\"\n", base, (int) elen, e));
49

50
  /* mpf_set_str doesn't currently accept 0x for hex in base==0, so do it
51
     here instead.  FIXME: Would prefer to let mpf_set_str handle this.  */
52
  if (base == 0 && elen >= 2 && e[0] == '0' && (e[1] == 'x' || e[1] == 'X'))
53
    {
54
      base = 16;
55
      extra = 2;
56
      e += extra;
57
      elen -= extra;
58
    }
59

60
  if (base == 0)
61
    mant_base = 10;
62
  else if (base < 0)
63
    mant_base = -base;
64
  else
65
    mant_base = base;
66

67
  /* exponent in decimal if base is negative */
68
  if (base < 0)
69
    exp_base = 10;
70
  else if (base == 0)
71
    exp_base = 10;
72
  else
73
    exp_base = base;
74

75
#define IS_EXPONENT(c) \
76
  (c == '@' || (base <= 10 && base >= -10 && (e[i] == 'e' || e[i] == 'E')))
77

78
  i = 0;
79
  for (;;)
80
    {
81
      if (i >= elen)
82
        goto parsed;
83
      if (e[i] == '.')
84
        break;
85
      if (IS_EXPONENT (e[i]))
86
        goto exponent;
87
      if (! isasciidigit_in_base (e[i], mant_base))
88
        goto parsed;
89
      i++;
90
    }
91

92
  /* fraction */
93
  i++;
94
  for (;;)
95
    {
96
      if (i >= elen)
97
        goto parsed;
98
      if (IS_EXPONENT (e[i]))
99
        goto exponent;
100
      if (! isasciidigit_in_base (e[i], mant_base))
101
        goto parsed;
102
      i++;
103
    }
104

105
 exponent:
106
  i++;
107
  if (i >= elen)
108
    goto parsed;
109
  if (e[i] == '-')
110
    i++;
111
  for (;;)
112
    {
113
      if (i >= elen)
114
        goto parsed;
115
      if (! isasciidigit_in_base (e[i], exp_base))
116
        break;
117
      i++;
118
    }
119

120
 parsed:
121
  TRACE (printf ("  parsed i=%u \"%.*s\"\n", i, (int) i, e));
122

123
  mp_get_memory_functions (&allocate_func, NULL, &free_func);
124
  edup = (*allocate_func) (i+1);
125
  memcpy (edup, e, i);
126
  edup[i] = '\0';
127

128
  if (mpf_set_str (res, edup, base) == 0)
129
    ret = i + extra;
130
  else
131
    ret = 0;
132

133
  (*free_func) (edup, i+1);
134
  return ret;
135
}
136

137
static int
138
e_mpf_ulong_p (mpf_srcptr f)
139
{
140
  return mpf_integer_p (f) && mpf_fits_ulong_p (f);
141
}
142

143
/* Don't want to change the precision of w, can only do an actual swap when
144
   w and x have the same precision.  */
145
static void
146
e_mpf_set_or_swap (mpf_ptr w, mpf_ptr x)
147
{
148
  if (mpf_get_prec (w) == mpf_get_prec (x))
149
    mpf_swap (w, x);
150
  else
151
    mpf_set (w, x);
152
}
153

154

155
int
156
mpf_expr_a (__gmp_const struct mpexpr_operator_t *table,
157
            mpf_ptr res, int base, unsigned long prec,
158
            __gmp_const char *e, size_t elen,
159
            mpf_srcptr var[26])
160
{
161
  struct mpexpr_parse_t  p;
162

163
  p.table = table;
164
  p.res = (mpX_ptr) res;
165
  p.base = base;
166
  p.prec = prec;
167
  p.e = e;
168
  p.elen = elen;
169
  p.var = (mpX_srcptr *) var;
170

171
  p.mpX_clear       = (mpexpr_fun_one_t)      mpf_clear;
172
  p.mpX_ulong_p     = (mpexpr_fun_i_unary_t)  e_mpf_ulong_p;
173
  p.mpX_get_ui      = (mpexpr_fun_get_ui_t)   mpf_get_ui;
174
  p.mpX_init        = (mpexpr_fun_unary_ui_t) mpf_init2;
175
  p.mpX_number      = (mpexpr_fun_number_t)   e_mpf_number;
176
  p.mpX_set         = (mpexpr_fun_unary_t)    mpf_set;
177
  p.mpX_set_or_swap = (mpexpr_fun_unary_t)    e_mpf_set_or_swap;
178
  p.mpX_set_si      = (mpexpr_fun_set_si_t)   mpf_set_si;
179
  p.mpX_swap        = (mpexpr_fun_swap_t)     mpf_swap;
180

181
  return mpexpr_evaluate (&p);
182
}
183

184