core: One SCM type for function.
[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 != &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 }