tests: Move (ice-9 syncase) into cond-expand.
[mes.git] / math.c
diff --git a/math.c b/math.c
index 6c0e10324a3a9fb9b7c82bdfe7ddd3c9f656e9fa..b2ca402edd13ec4c7574fa8411d9f2618513fea2 100644 (file)
--- a/math.c
+++ b/math.c
@@ -24,9 +24,9 @@ greater_p (SCM x) ///((name . ">") (arity . n))
   int n = INT_MAX;
   while (x != cell_nil)
     {
-      assert (g_cells[car (x)].type == NUMBER);
-      if (value (car (x)) >= n) return cell_f;
-      n = value (car (x));
+      assert (TYPE (car (x)) == NUMBER);
+      if (VALUE (car (x)) >= n) return cell_f;
+      n = VALUE (car (x));
       x = cdr (x);
     }
   return cell_t;
@@ -38,9 +38,9 @@ less_p (SCM x) ///((name . "<") (arity . n))
   int n = INT_MIN;
   while (x != cell_nil)
     {
-      assert (g_cells[car (x)].type == NUMBER);
-      if (value (car (x)) <= n) return cell_f;
-      n = value (car (x));
+      assert (TYPE (car (x)) == NUMBER);
+      if (VALUE (car (x)) <= n) return cell_f;
+      n = VALUE (car (x));
       x = cdr (x);
     }
   return cell_t;
@@ -50,12 +50,12 @@ SCM
 is_p (SCM x) ///((name . "=") (arity . n))
 {
   if (x == cell_nil) return cell_t;
-  assert (g_cells[car (x)].type == NUMBER);
-  int n = value (car (x));
+  assert (TYPE (car (x)) == NUMBER);
+  int n = VALUE (car (x));
   x = cdr (x);
   while (x != cell_nil)
     {
-      if (value (car (x)) != n) return cell_f;
+      if (VALUE (car (x)) != n) return cell_f;
       x = cdr (x);
     }
   return cell_t;
@@ -65,18 +65,18 @@ SCM
 minus (SCM x) ///((name . "-") (arity . n))
 {
   SCM a = car (x);
-  assert (g_cells[a].type == NUMBER);
-  int n = value (a);
+  assert (TYPE (a) == NUMBER);
+  int n = VALUE (a);
   x = cdr (x);
   if (x == cell_nil)
     n = -n;
   while (x != cell_nil)
     {
-      assert (g_cells[car (x)].type == NUMBER);
-      n -= value (car (x));
+      assert (TYPE (car (x)) == NUMBER);
+      n -= VALUE (car (x));
       x = cdr (x);
     }
-  return make_number (n);
+  return MAKE_NUMBER (n);
 }
 
 SCM
@@ -85,11 +85,11 @@ plus (SCM x) ///((name . "+") (arity . n))
   int n = 0;
   while (x != cell_nil)
     {
-      assert (g_cells[car (x)].type == NUMBER);
-      n += value (car (x));
+      assert (TYPE (car (x)) == NUMBER);
+      n += VALUE (car (x));
       x = cdr (x);
     }
-  return make_number (n);
+  return MAKE_NUMBER (n);
 }
 
 SCM
@@ -97,25 +97,27 @@ divide (SCM x) ///((name . "/") (arity . n))
 {
   int n = 1;
   if (x != cell_nil) {
-    assert (g_cells[car (x)].type == NUMBER);
-    n = value (car (x));
+    assert (TYPE (car (x)) == NUMBER);
+    n = VALUE (car (x));
     x = cdr (x);
   }
   while (x != cell_nil)
     {
-      assert (g_cells[car (x)].type == NUMBER);
-      n /= value (car (x));
+      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)
 {
-  assert (g_cells[a].type == NUMBER);
-  assert (g_cells[b].type == NUMBER);
-  return make_number (value (a) % value (b));
+  assert (TYPE (a) == NUMBER);
+  assert (TYPE (b) == NUMBER);
+  int x = VALUE (a);
+  while (x < 0) x += VALUE (b);
+  return MAKE_NUMBER (x % VALUE (b));
 }
 
 SCM
@@ -124,11 +126,11 @@ multiply (SCM x) ///((name . "*") (arity . n))
   int n = 1;
   while (x != cell_nil)
     {
-      assert (g_cells[car (x)].type == NUMBER);
-      n *= value (car (x));
+      assert (TYPE (car (x)) == NUMBER);
+      n *= VALUE (car (x));
       x = cdr (x);
     }
-  return make_number (n);
+  return MAKE_NUMBER (n);
 }
 
 SCM
@@ -137,9 +139,19 @@ logior (SCM x) ///((arity . n))
   int n = 0;
   while (x != cell_nil)
     {
-      assert (g_cells[car (x)].type == NUMBER);
-      n |= value (car (x));
+      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);
 }