math.c

   1 /* -*-comment-start: "//";comment-end:""-*-
   2  * Mes --- Maxwell Equations of Software
   3  * Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
   4  *
   5  * This file is part of Mes.
   6  *
   7  * Mes is free software; you can redistribute it and/or modify it
   8  * under the terms of the GNU General Public License as published by
   9  * the Free Software Foundation; either version 3 of the License, or (at
  10  * your option) any later version.
  11  *
  12  * Mes is distributed in the hope that it will be useful, but
  13  * WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  19  */
  20
  21 SCM
  22 greater_p (SCM x) ///((name . ">") (arity . n))
  23 {
  24   int n = INT_MAX;
  25   while (x != cell_nil)
  26     {
  27       assert (TYPE (car (x)) == NUMBER);
  28       if (VALUE (car (x)) >= n) return cell_f;
  29       n = VALUE (car (x));
  30       x = cdr (x);
  31     }
  32   return cell_t;
  33 }
  34
  35 SCM
  36 less_p (SCM x) ///((name . "<") (arity . n))
  37 {
  38   int n = INT_MIN;
  39   while (x != cell_nil)
  40     {
  41       assert (TYPE (car (x)) == NUMBER);
  42       if (VALUE (car (x)) <= n) return cell_f;
  43       n = VALUE (car (x));
  44       x = cdr (x);
  45     }
  46   return cell_t;
  47 }
  48
  49 SCM
  50 is_p (SCM x) ///((name . "=") (arity . n))
  51 {
  52   if (x == cell_nil) return cell_t;
  53   assert (TYPE (car (x)) == NUMBER);
  54   int n = VALUE (car (x));
  55   x = cdr (x);
  56   while (x != cell_nil)
  57     {
  58       if (VALUE (car (x)) != n) return cell_f;
  59       x = cdr (x);
  60     }
  61   return cell_t;
  62 }
  63
  64 SCM
  65 minus (SCM x) ///((name . "-") (arity . n))
  66 {
  67   SCM a = car (x);
  68   assert (TYPE (a) == NUMBER);
  69   int n = VALUE (a);
  70   x = cdr (x);
  71   if (x == cell_nil)
  72     n = -n;
  73   while (x != cell_nil)
  74     {
  75       assert (TYPE (car (x)) == NUMBER);
  76       n -= VALUE (car (x));
  77       x = cdr (x);
  78     }
  79   return make_number (n);
  80 }
  81
  82 SCM
  83 plus (SCM x) ///((name . "+") (arity . n))
  84 {
  85   int n = 0;
  86   while (x != cell_nil)
  87     {
  88       assert (TYPE (car (x)) == NUMBER);
  89       n += VALUE (car (x));
  90       x = cdr (x);
  91     }
  92   return make_number (n);
  93 }
  94
  95 SCM
  96 divide (SCM x) ///((name . "/") (arity . n))
  97 {
  98   int n = 1;
  99   if (x != cell_nil) {
 100     assert (TYPE (car (x)) == NUMBER);
 101     n = VALUE (car (x));
 102     x = cdr (x);
 103   }
 104   while (x != cell_nil)
 105     {
 106       assert (TYPE (car (x)) == NUMBER);
 107       n /= VALUE (car (x));
 108       x = cdr (x);
 109     }
 110   return make_number (n);
 111 }
 112
 113 SCM
 114 modulo (SCM a, SCM b)
 115 {
 116   assert (TYPE (a) == NUMBER);
 117   assert (TYPE (b) == NUMBER);
 118   return make_number (VALUE (a) % VALUE (b));
 119 }
 120
 121 SCM
 122 multiply (SCM x) ///((name . "*") (arity . n))
 123 {
 124   int n = 1;
 125   while (x != cell_nil)
 126     {
 127       assert (TYPE (car (x)) == NUMBER);
 128       n *= VALUE (car (x));
 129       x = cdr (x);
 130     }
 131   return make_number (n);
 132 }
 133
 134 SCM
 135 logior (SCM x) ///((arity . n))
 136 {
 137   int n = 0;
 138   while (x != cell_nil)
 139     {
 140       assert (TYPE (car (x)) == NUMBER);
 141       n |= VALUE (car (x));
 142       x = cdr (x);
 143     }
 144   return make_number (n);
 145 }
 146
 147 SCM
 148 ash (SCM n, SCM count)
 149 {
 150   assert (TYPE (n) == NUMBER);
 151   assert (TYPE (count) == NUMBER);
 152   int cn = VALUE (n);
 153   int ccount = VALUE (count);
 154   return make_number ((ccount < 0) ? cn >> -ccount : cn << ccount);
 155 }