math.c (8096B)
1 /* zlib License 2 * 3 * Copyright (c) 2017-2020 Ed van Bruggen 4 * 5 * This software is provided 'as-is', without any express or implied 6 * warranty. In no event will the authors be held liable for any damages 7 * arising from the use of this software. 8 * 9 * Permission is granted to anyone to use this software for any purpose, 10 * including commercial applications, and to alter it and redistribute it 11 * freely, subject to the following restrictions: 12 * 13 * 1. The origin of this software must not be misrepresented; you must not 14 * claim that you wrote the original software. If you use this software 15 * in a product, an acknowledgment in the product documentation would be 16 * appreciated but is not required. 17 * 2. Altered source versions must be plainly marked as such, and must not be 18 * misrepresented as being the original software. 19 * 3. This notice may not be removed or altered from any source distribution. 20 */ 21 #include <assert.h> 22 #include <math.h> 23 #include <stdio.h> 24 #include <stdlib.h> 25 26 #include "../tisp.h" 27 28 #define EVAL_CHECK(A, V, NAME, TYPE) do { \ 29 if (!(A = tisp_eval(st, vars, V))) \ 30 return NULL; \ 31 tsp_arg_type(A, NAME, TYPE); \ 32 } while(0) 33 34 static Val 35 prim_numerator(Tsp st, Hash vars, Val args) 36 { 37 Val a; 38 tsp_arg_num(args, "numerator", 1); 39 EVAL_CHECK(a, car(args), "numerator", RATIONAL); 40 return mk_int(num(a)); 41 } 42 43 static Val 44 prim_denominator(Tsp st, Hash vars, Val args) 45 { 46 Val a; 47 tsp_arg_num(args, "denominator", 1); 48 EVAL_CHECK(a, car(args), "denominator", RATIONAL); 49 return mk_int(den(a)); 50 } 51 52 /* wrapper functions to be returned by mk_num, all need same arguments */ 53 static Val 54 create_int(double num, double den) 55 { 56 assert(den == 1); 57 return mk_int(num); 58 } 59 60 static Val 61 create_dec(double num, double den) 62 { 63 assert(den == 1); 64 return mk_dec(num); 65 } 66 67 static Val 68 create_rat(double num, double den) 69 { 70 return mk_rat(num, den); 71 } 72 73 /* return pointer to one of the preceding functions depending on what 74 * number should be created by the following arithmetic functions 75 * force arg is used to force number to one type: 76 * 0 -> no force, 1 -> force ratio/int, 2 -> force decimal */ 77 static Val 78 (*mk_num(Type a, Type b, int force))(double, double) 79 { 80 if (force == 1) 81 return &create_rat; 82 if (force == 2) 83 return &create_dec; 84 if (a & DECIMAL || b & DECIMAL) 85 return &create_dec; 86 if (a & RATIO || b & RATIO) 87 return &create_rat; 88 return &create_int; 89 } 90 91 #define PRIM_ROUND(NAME, FORCE) \ 92 static Val \ 93 prim_##NAME(Tsp st, Hash vars, Val args) \ 94 { \ 95 Val a; \ 96 tsp_arg_num(args, #NAME, 1); \ 97 EVAL_CHECK(a, car(args), #NAME, NUMBER); \ 98 return (mk_num(a->t, a->t, FORCE))(NAME(num(a)/den(a)), 1.); \ 99 } 100 101 /* define int and dec as identity functions to use them in the same macro */ 102 #define integer(X) (X) 103 PRIM_ROUND(integer, 1) 104 #undef integer 105 #define decimal(X) (X) 106 PRIM_ROUND(decimal, 2) 107 #undef decimal 108 PRIM_ROUND(round, 0) 109 PRIM_ROUND(floor, 0) 110 PRIM_ROUND(ceil, 0) 111 112 static Val 113 prim_add(Tsp st, Hash vars, Val args) 114 { 115 Val a, b; 116 tsp_arg_num(args, "+", 2); 117 EVAL_CHECK(a, car(args), "+", NUMBER); 118 EVAL_CHECK(b, car(cdr(args)), "+", NUMBER); 119 if (a->t & DECIMAL || b->t & DECIMAL) 120 return mk_dec((num(a)/den(a)) + (num(b)/den(b))); 121 return (mk_num(a->t, b->t, 0)) 122 (num(a) * den(b) + den(a) * num(b), 123 den(a) * den(b)); 124 } 125 126 static Val 127 prim_sub(Tsp st, Hash vars, Val args) 128 { 129 Val a, b; 130 int len = list_len(args); 131 if (len != 2 && len != 1) 132 tsp_warnf("-: expected 1 or 2 arguments, recieved %d", len); 133 EVAL_CHECK(a, car(args), "-", NUMBER); 134 if (len == 1) { 135 b = a; 136 a = mk_int(0); 137 } else { 138 EVAL_CHECK(b, car(cdr(args)), "-", NUMBER); 139 } 140 if (a->t & DECIMAL || b->t & DECIMAL) 141 return mk_dec((num(a)/den(a)) - (num(b)/den(b))); 142 return (mk_num(a->t, b->t, 0)) 143 (num(a) * den(b) - den(a) * num(b), 144 den(a) * den(b)); 145 } 146 147 static Val 148 prim_mul(Tsp st, Hash vars, Val args) 149 { 150 Val a, b; 151 tsp_arg_num(args, "*", 2); 152 EVAL_CHECK(a, car(args), "*", NUMBER); 153 EVAL_CHECK(b, car(cdr(args)), "*", NUMBER); 154 if (a->t & DECIMAL || b->t & DECIMAL) 155 return mk_dec((num(a)/den(a)) * (num(b)/den(b))); 156 return (mk_num(a->t, b->t, 0))(num(a) * num(b), den(a) * den(b)); 157 158 } 159 160 static Val 161 prim_div(Tsp st, Hash vars, Val args) 162 { 163 Val a, b; 164 int len = list_len(args); 165 if (len != 2 && len != 1) 166 tsp_warnf("/: expected 1 or 2 arguments, recieved %d", len); 167 EVAL_CHECK(a, car(args), "/", NUMBER); 168 if (len == 1) { 169 b = a; 170 a = mk_int(1); 171 } else { 172 EVAL_CHECK(b, car(cdr(args)), "/", NUMBER); 173 } 174 if (a->t & DECIMAL || b->t & DECIMAL) 175 return mk_dec((num(a)/den(a)) / (num(b)/den(b))); 176 return (mk_num(a->t, b->t, 1))(num(a) * den(b), den(a) * num(b)); 177 } 178 179 static Val 180 prim_mod(Tsp st, Hash vars, Val args) 181 { 182 Val a, b; 183 tsp_arg_num(args, "mod", 2); 184 EVAL_CHECK(a, car(args), "mod", INTEGER); 185 EVAL_CHECK(b, car(cdr(args)), "mod", INTEGER); 186 if (num(b) == 0) 187 tsp_warn("division by zero"); 188 return mk_int((int)num(a) % abs((int)num(b))); 189 } 190 191 /* TODO if given function as 2nd arg run it on first arg */ 192 static Val 193 prim_pow(Tsp st, Hash vars, Val args) 194 { 195 double bnum, bden; 196 Val b, p; 197 tsp_arg_num(args, "pow", 2); 198 EVAL_CHECK(b, car(args), "pow", EXPRESSION); 199 EVAL_CHECK(p, car(cdr(args)), "pow", EXPRESSION); 200 bnum = pow(num(b), num(p)/den(p)); 201 bden = pow(den(b), num(p)/den(p)); 202 if ((bnum == (int)bnum && bden == (int)bden) || 203 b->t & DECIMAL || p->t & DECIMAL) 204 return mk_num(b->t, p->t, 0)(bnum, bden); 205 return mk_pair(mk_sym(st, "^"), mk_pair(b, mk_pair(p, st->nil))); 206 } 207 208 #define PRIM_COMPARE(NAME, OP) \ 209 static Val \ 210 prim_##NAME(Tsp st, Hash vars, Val args) \ 211 { \ 212 Val v; \ 213 if (!(v = tisp_eval_list(st, vars, args))) \ 214 return NULL; \ 215 if (list_len(v) != 2) \ 216 return st->t; \ 217 tsp_arg_type(car(v), #OP, NUMBER); \ 218 tsp_arg_type(car(cdr(v)), #OP, NUMBER); \ 219 return ((num(car(v))*den(car(cdr(v)))) OP \ 220 (num(car(cdr(v)))*den(car(v)))) ? \ 221 st->t : st->nil; \ 222 } 223 224 PRIM_COMPARE(lt, <) 225 PRIM_COMPARE(gt, >) 226 PRIM_COMPARE(lte, <=) 227 PRIM_COMPARE(gte, >=) 228 229 #define PRIM_TRIG(NAME) \ 230 static Val \ 231 prim_##NAME(Tsp st, Hash vars, Val args) \ 232 { \ 233 Val v; \ 234 tsp_arg_num(args, #NAME, 1); \ 235 EVAL_CHECK(v, car(args), #NAME, EXPRESSION); \ 236 if (v->t & DECIMAL) \ 237 return mk_dec(NAME(num(v))); \ 238 return mk_pair(mk_sym(st, #NAME), mk_pair(v, st->nil)); \ 239 } 240 241 PRIM_TRIG(sin) 242 PRIM_TRIG(cos) 243 PRIM_TRIG(tan) 244 PRIM_TRIG(sinh) 245 PRIM_TRIG(cosh) 246 PRIM_TRIG(tanh) 247 PRIM_TRIG(asin) 248 PRIM_TRIG(acos) 249 PRIM_TRIG(atan) 250 PRIM_TRIG(asinh) 251 PRIM_TRIG(acosh) 252 PRIM_TRIG(atanh) 253 PRIM_TRIG(exp) 254 PRIM_TRIG(log) 255 256 void 257 tib_env_math(Tsp st) 258 { 259 tsp_env_fn(numerator); 260 tsp_env_fn(denominator); 261 262 tsp_env_fn(integer); 263 tsp_env_fn(decimal); 264 tsp_env_fn(floor); 265 tsp_env_fn(ceil); 266 tsp_env_fn(round); 267 268 tsp_env_name_fn(+, add); 269 tsp_env_name_fn(-, sub); 270 tsp_env_name_fn(*, mul); 271 tsp_env_name_fn(/, div); 272 tsp_env_fn(mod); 273 tsp_env_name_fn(^, pow); 274 275 tsp_env_name_fn(<, lt); 276 tsp_env_name_fn(>, gt); 277 tsp_env_name_fn(<=, lte); 278 tsp_env_name_fn(>=, gte); 279 280 tsp_env_fn(sin); 281 tsp_env_fn(cos); 282 tsp_env_fn(tan); 283 tsp_env_fn(sinh); 284 tsp_env_fn(cosh); 285 tsp_env_fn(tanh); 286 tsp_env_name_fn(arcsin, asin); 287 tsp_env_name_fn(arccos, acos); 288 tsp_env_name_fn(arctan, atan); 289 tsp_env_name_fn(arcsinh, asinh); 290 tsp_env_name_fn(arccosh, acosh); 291 tsp_env_name_fn(arctanh, atanh); 292 tsp_env_fn(exp); 293 tsp_env_fn(log); 294 }