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