core: Remove last_pair, list_ref, string_ref.

[mes.git] / math.c

diff --git a/math.c b/math.c
index c7dd3d7d5d16bdce0ecd4e3528d1069f1f445241..8b7ebb35796784dc329937a6e9c80a2062a60e82 100644 (file)
--- a/math.c
+++ b/math.c
@@ -18,128 +18,138 @@
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-scm *
-greater_p (scm *x) ///((name . ">") (arity . n))
+SCM
+greater_p (SCM x) ///((name . ">") (arity . n))
 {
   int n = INT_MAX;
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      assert (x->car->type == NUMBER);
-      if (x->car->value >= n) return &scm_f;
-      n = x->car->value;
+      assert (TYPE (car (x)) == NUMBER);
+      if (VALUE (car (x)) >= n) return cell_f;
+      n = VALUE (car (x));
       x = cdr (x);
     }
-  return &scm_t;
+  return cell_t;
 }
 
-scm *
-less_p (scm *x) ///((name . "<") (arity . n))
+SCM
+less_p (SCM x) ///((name . "<") (arity . n))
 {
   int n = INT_MIN;
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      assert (x->car->type == NUMBER);
-      if (x->car->value <= n) return &scm_f;
-      n = x->car->value;
+      assert (TYPE (car (x)) == NUMBER);
+      if (VALUE (car (x)) <= n) return cell_f;
+      n = VALUE (car (x));
       x = cdr (x);
     }
-  return &scm_t;
+  return cell_t;
 }
 
-scm *
-is_p (scm *x) ///((name . "=") (arity . n))
+SCM
+is_p (SCM x) ///((name . "=") (arity . n))
 {
-  if (x == &scm_nil) return &scm_t;
-  assert (x->car->type == NUMBER);
-  int n = x->car->value;
+  if (x == cell_nil) return cell_t;
+  assert (TYPE (car (x)) == NUMBER);
+  int n = VALUE (car (x));
   x = cdr (x);
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      if (x->car->value != n) return &scm_f;
+      if (VALUE (car (x)) != n) return cell_f;
       x = cdr (x);
     }
-  return &scm_t;
+  return cell_t;
 }
 
-scm *
-minus (scm *x) ///((name . "-") (arity . n))
+SCM
+minus (SCM x) ///((name . "-") (arity . n))
 {
-  scm *a = car (x);
-  assert (a->type == NUMBER);
-  int n = a->value;
+  SCM a = car (x);
+  assert (TYPE (a) == NUMBER);
+  int n = VALUE (a);
   x = cdr (x);
-  if (x == &scm_nil)
+  if (x == cell_nil)
     n = -n;
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      assert (x->car->type == NUMBER);
-      n -= x->car->value;
+      assert (TYPE (car (x)) == NUMBER);
+      n -= VALUE (car (x));
       x = cdr (x);
     }
-  return make_number (n);
+  return MAKE_NUMBER (n);
 }
 
-scm *
-plus (scm *x) ///((name . "+") (arity . n))
+SCM
+plus (SCM x) ///((name . "+") (arity . n))
 {
   int n = 0;
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      assert (x->car->type == NUMBER);
-      n += x->car->value;
+      assert (TYPE (car (x)) == NUMBER);
+      n += VALUE (car (x));
       x = cdr (x);
     }
-  return make_number (n);
+  return MAKE_NUMBER (n);
 }
 
-scm *
-divide (scm *x) ///((name . "/") (arity . n))
+SCM
+divide (SCM x) ///((name . "/") (arity . n))
 {
   int n = 1;
-  if (x != &scm_nil) {
-    assert (x->car->type == NUMBER);
-    n = x->car->value;
+  if (x != cell_nil) {
+    assert (TYPE (car (x)) == NUMBER);
+    n = VALUE (car (x));
     x = cdr (x);
   }
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      assert (x->car->type == NUMBER);
-      n /= x->car->value;
+      assert (TYPE (car (x)) == NUMBER);
+      n /= VALUE (car (x));
       x = cdr (x);
     }
-  return make_number (n);
+  return MAKE_NUMBER (n);
 }
 
-scm *
-modulo (scm *a, scm *b)
+SCM
+modulo (SCM a, SCM b)
 {
-  assert (a->type == NUMBER);
-  assert (b->type == NUMBER);
-  return make_number (a->value % b->value);
+  assert (TYPE (a) == NUMBER);
+  assert (TYPE (b) == NUMBER);
+  return MAKE_NUMBER (VALUE (a) % VALUE (b));
 }
 
-scm *
-multiply (scm *x) ///((name . "*") (arity . n))
+SCM
+multiply (SCM x) ///((name . "*") (arity . n))
 {
   int n = 1;
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      assert (x->car->type == NUMBER);
-      n *= x->car->value;
+      assert (TYPE (car (x)) == NUMBER);
+      n *= VALUE (car (x));
       x = cdr (x);
     }
-  return make_number (n);
+  return MAKE_NUMBER (n);
 }
 
-scm *
-logior (scm *x) ///((arity . n))
+SCM
+logior (SCM x) ///((arity . n))
 {
   int n = 0;
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      assert (x->car->type == NUMBER);
-      n |= x->car->value;
+      assert (TYPE (car (x)) == NUMBER);
+      n |= VALUE (car (x));
       x = cdr (x);
     }
-  return make_number (n);
+  return MAKE_NUMBER (n);
+}
+
+SCM
+ash (SCM n, SCM count)
+{
+  assert (TYPE (n) == NUMBER);
+  assert (TYPE (count) == NUMBER);
+  int cn = VALUE (n);
+  int ccount = VALUE (count);
+  return MAKE_NUMBER ((ccount < 0) ? cn >> -ccount : cn << ccount);
 }