guile 0.0.2

Safe bindings to GNU Guile.
Documentation 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149

/* This code in included by numbers.c to generate integer conversion
   functions like scm_to_int and scm_from_int.  It is only for signed
   types, see conv-uinteger.i.c for the unsigned variant.
*/

/* You need to define the following macros before including this
   template.  They are undefined at the end of this file to give a
   clean slate for the next inclusion.

   TYPE         - the integral type to be converted
   TYPE_MIN     - the smallest representable number of TYPE
   TYPE_MAX     - the largest representable number of TYPE
   SIZEOF_TYPE  - the size of TYPE, equal to "sizeof (TYPE)" but
                  in a form that can be computed by the preprocessor.
		  When this number is 0, the preprocessor is not used
		  to select which code to compile; the most general
		  code is always used.

   SCM_TO_TYPE_PROTO(arg), SCM_FROM_TYPE_PROTO(arg) 
                - These two macros should expand into the prototype
                  for the two defined functions, without the return
                  type.

*/

TYPE
SCM_TO_TYPE_PROTO (SCM val)
{
  if (SCM_I_INUMP (val))
    {
      scm_t_signed_bits n = SCM_I_INUM (val);
#if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SIZEOF_SCM_T_BITS
      return n;
#else
      if (n >= TYPE_MIN && n <= TYPE_MAX)
	return n;
      else
	{
	  goto out_of_range;
	}
#endif
    }
  else if (SCM_BIGP (val))
    {
      if (TYPE_MIN >= SCM_MOST_NEGATIVE_FIXNUM
	  && TYPE_MAX <= SCM_MOST_POSITIVE_FIXNUM)
	goto out_of_range;
      else if (TYPE_MIN >= LONG_MIN && TYPE_MAX <= LONG_MAX)
	{
	  if (mpz_fits_slong_p (SCM_I_BIG_MPZ (val)))
	    {
	      long n = mpz_get_si (SCM_I_BIG_MPZ (val));
#if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SCM_SIZEOF_LONG
	      return n;
#else
	      if (n >= TYPE_MIN && n <= TYPE_MAX)
		return n;
	      else
		goto out_of_range;
#endif
	    } 
	  else
	    goto out_of_range;
	}
      else
	{
	  scm_t_intmax n;
	  size_t count;

	  if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2)
	      > CHAR_BIT*sizeof (scm_t_uintmax))
	    goto out_of_range;
	  
	  mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0,
		      SCM_I_BIG_MPZ (val));

	  if (mpz_sgn (SCM_I_BIG_MPZ (val)) >= 0)
	    {
	      if (n < 0)
		goto out_of_range;
	    }
	  else
	    {
	      n = -n;
	      if (n >= 0)
		goto out_of_range;
	    }

	  if (n >= TYPE_MIN && n <= TYPE_MAX)
	    return n;
	  else
	    {
	    out_of_range:
	      scm_i_range_error (val,
				 scm_from_signed_integer (TYPE_MIN),
				 scm_from_signed_integer (TYPE_MAX));
	      return 0;
	    }
	}
    }
  else
    {
      scm_wrong_type_arg_msg (NULL, 0, val, "exact integer");
      return 0;
    }
}

SCM
SCM_FROM_TYPE_PROTO (TYPE val)
{
#if SIZEOF_TYPE != 0 && SIZEOF_TYPE < SIZEOF_SCM_T_BITS
  return SCM_I_MAKINUM (val);
#else
  if (SCM_FIXABLE (val))
    return SCM_I_MAKINUM (val);
  else if (val >= LONG_MIN && val <= LONG_MAX)
    return scm_i_long2big (val);
  else
    {
      SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
      mpz_init (SCM_I_BIG_MPZ (z));
      if (val < 0)
	{
	  val = -val;
	  mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (TYPE), 0, 0,
		      &val);
	  mpz_neg (SCM_I_BIG_MPZ (z), SCM_I_BIG_MPZ (z));
	}
      else
	mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (TYPE), 0, 0,
		    &val);
      return z;
    }
#endif
}

/* clean up */
#undef TYPE
#undef TYPE_MIN
#undef TYPE_MAX
#undef SIZEOF_TYPE
#undef SCM_TO_TYPE_PROTO
#undef SCM_FROM_TYPE_PROTO

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/