6c0e10324a3a9fb9b7c82bdfe7ddd3c9f656e9fa
[mes.git] / 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 (g_cells[car (x)].type == 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 (g_cells[car (x)].type == 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 (g_cells[car (x)].type == 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 (g_cells[a].type == 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 (g_cells[car (x)].type == 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 (g_cells[car (x)].type == 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 (g_cells[car (x)].type == NUMBER);
101     n = value (car (x));
102     x = cdr (x);
103   }
104   while (x != cell_nil)
105     {
106       assert (g_cells[car (x)].type == 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 (g_cells[a].type == NUMBER);
117   assert (g_cells[b].type == 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 (g_cells[car (x)].type == 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 (g_cells[car (x)].type == NUMBER);
141       n |= value (car (x));
142       x = cdr (x);
143     }
144   return make_number (n);
145 }