mescc: Add missing defines.
[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 //MINI_MES
22 // SCM
23 // greater_p (SCM x) ///((name . ">") (arity . n))
24 // {
25 //   int n = INT_MAX;
26 //   while (x != cell_nil)
27 //     {
28 //       assert (TYPE (car (x)) == TNUMBER);
29 //       if (VALUE (car (x)) >= n) return cell_f;
30 //       n = VALUE (car (x));
31 //       x = cdr (x);
32 //     }
33 //   return cell_t;
34 // }
35
36 // SCM
37 // less_p (SCM x) ///((name . "<") (arity . n))
38 // {
39 //   int n = INT_MIN;
40 //   while (x != cell_nil)
41 //     {
42 //       assert (TYPE (car (x)) == TNUMBER);
43 //       if (VALUE (car (x)) <= n) return cell_f;
44 //       n = VALUE (car (x));
45 //       x = cdr (x);
46 //     }
47 //   return cell_t;
48 // }
49
50 SCM
51 is_p (SCM x) ///((name . "=") (arity . n))
52 {
53   if (x == cell_nil) return cell_t;
54   assert (TYPE (car (x)) == TNUMBER);
55   int n = VALUE (car (x));
56   x = cdr (x);
57   while (x != cell_nil)
58     {
59       if (VALUE (car (x)) != n) return cell_f;
60       x = cdr (x);
61     }
62   return cell_t;
63 }
64
65 SCM
66 minus (SCM x) ///((name . "-") (arity . n))
67 {
68   SCM a = car (x);
69   assert (TYPE (a) == TNUMBER);
70   int n = VALUE (a);
71   x = cdr (x);
72   if (x == cell_nil)
73     n = -n;
74   while (x != cell_nil)
75     {
76       assert (TYPE (car (x)) == TNUMBER);
77       n -= VALUE (car (x));
78       x = cdr (x);
79     }
80   return MAKE_NUMBER (n);
81 }
82
83 SCM
84 plus (SCM x) ///((name . "+") (arity . n))
85 {
86   int n = 0;
87   while (x != cell_nil)
88     {
89       assert (TYPE (car (x)) == TNUMBER);
90       n += VALUE (car (x));
91       x = cdr (x);
92     }
93   return MAKE_NUMBER (n);
94 }
95
96 SCM
97 divide (SCM x) ///((name . "/") (arity . n))
98 {
99   int n = 1;
100   if (x != cell_nil) {
101     assert (TYPE (car (x)) == TNUMBER);
102     n = VALUE (car (x));
103     x = cdr (x);
104   }
105   while (x != cell_nil)
106     {
107       assert (TYPE (car (x)) == TNUMBER);
108       n /= VALUE (car (x));
109       x = cdr (x);
110     }
111   return MAKE_NUMBER (n);
112 }
113
114 SCM
115 modulo (SCM a, SCM b)
116 {
117   assert (TYPE (a) == TNUMBER);
118   assert (TYPE (b) == TNUMBER);
119   int x = VALUE (a);
120   while (x < 0) x += VALUE (b);
121   return MAKE_NUMBER (x % VALUE (b));
122 }
123
124 SCM
125 multiply (SCM x) ///((name . "*") (arity . n))
126 {
127   int n = 1;
128   while (x != cell_nil)
129     {
130       assert (TYPE (car (x)) == TNUMBER);
131       n *= VALUE (car (x));
132       x = cdr (x);
133     }
134   return MAKE_NUMBER (n);
135 }
136
137 SCM
138 logior (SCM x) ///((arity . n))
139 {
140   int n = 0;
141   while (x != cell_nil)
142     {
143       assert (TYPE (car (x)) == TNUMBER);
144       n |= VALUE (car (x));
145       x = cdr (x);
146     }
147   return MAKE_NUMBER (n);
148 }
149
150 SCM
151 ash (SCM n, SCM count)
152 {
153   assert (TYPE (n) == TNUMBER);
154   assert (TYPE (count) == TNUMBER);
155   int cn = VALUE (n);
156   int ccount = VALUE (count);
157   return MAKE_NUMBER ((ccount < 0) ? cn >> -ccount : cn << ccount);
158 }