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 != &scm_nil)
  26     {
  27       assert (x->car->type == NUMBER);
  28       if (x->car->value >= n) return &scm_f;
  29       n = x->car->value;
  30       x = cdr (x);
  31     }
  32   return &scm_t;
  33 }
  34
  35 scm *
  36 less_p (scm *x) ///((name . "<") (arity . n))
  37 {
  38   int n = INT_MIN;
  39   while (x != &scm_nil)
  40     {
  41       assert (x->car->type == NUMBER);
  42       if (x->car->value <= n) return &scm_f;
  43       n = x->car->value;
  44       x = cdr (x);
  45     }
  46   return &scm_t;
  47 }
  48
  49 scm *
  50 is_p (scm *x) ///((name . "=") (arity . n))
  51 {
  52   if (x == &scm_nil) return &scm_t;
  53   assert (x->car->type == NUMBER);
  54   int n = x->car->value;
  55   x = cdr (x);
  56   while (x != &scm_nil)
  57     {
  58       if (x->car->value != n) return &scm_f;
  59       x = cdr (x);
  60     }
  61   return &scm_t;
  62 }
  63
  64 scm *
  65 minus (scm *x) ///((name . "-") (arity . n))
  66 {
  67   scm *a = car (x);
  68   assert (a->type == NUMBER);
  69   int n = a->value;
  70   x = cdr (x);
  71   if (x == &scm_nil)
  72     n = -n;
  73   while (x != &scm_nil)
  74     {
  75       assert (x->car->type == NUMBER);
  76       n -= x->car->value;
  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 != &scm_nil)
  87     {
  88       assert (x->car->type == NUMBER);
  89       n += x->car->value;
  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 != &scm_nil) {
 100     assert (x->car->type == NUMBER);
 101     n = x->car->value;
 102     x = cdr (x);
 103   }
 104   while (x != &scm_nil)
 105     {
 106       assert (x->car->type == NUMBER);
 107       n /= x->car->value;
 108       x = cdr (x);
 109     }
 110   return make_number (n);
 111 }
 112
 113 scm *
 114 modulo (scm *a, scm *b)
 115 {
 116   assert (a->type == NUMBER);
 117   assert (b->type == NUMBER);
 118   return make_number (a->value % b->value);
 119 }
 120
 121 scm *
 122 multiply (scm *x) ///((name . "*") (arity . n))
 123 {
 124   int n = 1;
 125   while (x != &scm_nil)
 126     {
 127       assert (x->car->type == NUMBER);
 128       n *= x->car->value;
 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 != &scm_nil)
 139     {
 140       assert (x->car->type == NUMBER);
 141       n |= x->car->value;
 142       x = cdr (x);
 143     }
 144   return make_number (n);
 145 }