math.c (7667B)
1 /* zlib License 2 * 3 * Copyright (c) 2017-2022 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 /* wrapper functions to be returned by mk_num, all need same arguments */ 35 static Val 36 create_int(double num, double den) 37 { 38 assert(den == 1); 39 return mk_int(num); 40 } 41 42 static Val 43 create_dec(double num, double den) 44 { 45 assert(den == 1); 46 return mk_dec(num); 47 } 48 49 static Val 50 create_rat(double num, double den) 51 { 52 return mk_rat(num, den); 53 } 54 55 /* return pointer to one of the preceding functions depending on what 56 * number should be created by the following arithmetic functions 57 * force arg is used to force number to one type: 58 * 0 -> no force, 1 -> force ratio/int, 2 -> force decimal */ 59 static Val 60 (*mk_num(TspType a, TspType b, int force))(double, double) 61 { 62 if (force == 1) 63 return &create_rat; 64 if (force == 2) 65 return &create_dec; 66 if (a & TSP_DEC || b & TSP_DEC) 67 return &create_dec; 68 if (a & TSP_RATIO || b & TSP_RATIO) 69 return &create_rat; 70 return &create_int; 71 } 72 73 #define PRIM_ROUND(NAME, FORCE) \ 74 static Val \ 75 prim_##NAME(Tsp st, Hash vars, Val args) \ 76 { \ 77 Val n; \ 78 tsp_arg_num(args, #NAME, 1); \ 79 n = car(args); \ 80 tsp_arg_type(n, #NAME, TSP_NUM); \ 81 return (mk_num(n->t, n->t, FORCE))(NAME(num(n)/den(n)), 1.); \ 82 } 83 84 /* define int and dec as identity functions to use them in the same macro */ 85 #define Int(X) (X) 86 #define Dec(X) (X) 87 PRIM_ROUND(Int, 1) 88 PRIM_ROUND(Dec, 2) 89 #undef Int 90 #undef Dec 91 PRIM_ROUND(round, 0) 92 PRIM_ROUND(floor, 0) 93 PRIM_ROUND(ceil, 0) 94 95 static Val 96 prim_add(Tsp st, Hash vars, Val args) 97 { 98 Val a, b; 99 tsp_arg_num(args, "+", 2); 100 a = car(args), b = cadr(args); 101 tsp_arg_type(a, "+", TSP_NUM); 102 tsp_arg_type(b, "+", TSP_NUM); 103 if (a->t & TSP_DEC || b->t & TSP_DEC) 104 return mk_dec((num(a)/den(a)) + (num(b)/den(b))); 105 return (mk_num(a->t, b->t, 0)) 106 (num(a) * den(b) + den(a) * num(b), 107 den(a) * den(b)); 108 } 109 110 static Val 111 prim_sub(Tsp st, Hash vars, Val args) 112 { 113 Val a, b; 114 int len = list_len(args); 115 if (len != 2 && len != 1) 116 tsp_warnf("-: expected 1 or 2 arguments, recieved %d", len); 117 a = car(args); 118 tsp_arg_type(a, "-", TSP_NUM); 119 if (len == 1) { 120 b = a; 121 a = mk_int(0); 122 } else { 123 b = cadr(args); 124 tsp_arg_type(b, "-", TSP_NUM); 125 } 126 if (a->t & TSP_DEC || b->t & TSP_DEC) 127 return mk_dec((num(a)/den(a)) - (num(b)/den(b))); 128 return (mk_num(a->t, b->t, 0)) 129 (num(a) * den(b) - den(a) * num(b), 130 den(a) * den(b)); 131 } 132 133 static Val 134 prim_mul(Tsp st, Hash vars, Val args) 135 { 136 Val a, b; 137 tsp_arg_num(args, "*", 2); 138 a = car(args), b = cadr(args); 139 tsp_arg_type(a, "*", TSP_NUM); 140 tsp_arg_type(b, "*", TSP_NUM); 141 if (a->t & TSP_DEC || b->t & TSP_DEC) 142 return mk_dec((num(a)/den(a)) * (num(b)/den(b))); 143 return (mk_num(a->t, b->t, 0))(num(a) * num(b), den(a) * den(b)); 144 145 } 146 147 static Val 148 prim_div(Tsp st, Hash vars, Val args) 149 { 150 Val a, b; 151 int len = list_len(args); 152 if (len != 2 && len != 1) 153 tsp_warnf("/: expected 1 or 2 arguments, recieved %d", len); 154 a = car(args); 155 tsp_arg_type(a, "/", TSP_NUM); 156 if (len == 1) { 157 b = a; 158 a = mk_int(1); 159 } else { 160 b = cadr(args); 161 tsp_arg_type(b, "/", TSP_NUM); 162 } 163 if (a->t & TSP_DEC || b->t & TSP_DEC) 164 return mk_dec((num(a)/den(a)) / (num(b)/den(b))); 165 return (mk_num(a->t, b->t, 1))(num(a) * den(b), den(a) * num(b)); 166 } 167 168 static Val 169 prim_mod(Tsp st, Hash vars, Val args) 170 { 171 Val a, b; 172 tsp_arg_num(args, "mod", 2); 173 a = car(args), b = cadr(args); 174 tsp_arg_type(a, "mod", TSP_INT); 175 tsp_arg_type(b, "mod", TSP_INT); 176 if (num(b) == 0) 177 tsp_warn("division by zero"); 178 return mk_int((int)num(a) % abs((int)num(b))); 179 } 180 181 /* TODO if given function as 2nd arg run it on first arg */ 182 static Val 183 prim_pow(Tsp st, Hash vars, Val args) 184 { 185 Val b, p; 186 double bnum, bden; 187 tsp_arg_num(args, "pow", 2); 188 b = car(args), p = cadr(args); 189 tsp_arg_type(b, "pow", TSP_EXPR); 190 tsp_arg_type(p, "pow", TSP_EXPR); 191 bnum = pow(num(b), num(p)/den(p)); 192 bden = pow(den(b), num(p)/den(p)); 193 if ((bnum == (int)bnum && bden == (int)bden) || 194 b->t & TSP_DEC || p->t & TSP_DEC) 195 return mk_num(b->t, p->t, 0)(bnum, bden); 196 return mk_list(st, 3, mk_sym(st, "^"), b, p); 197 } 198 199 #define PRIM_COMPARE(NAME, OP) \ 200 static Val \ 201 prim_##NAME(Tsp st, Hash vars, Val args) \ 202 { \ 203 if (list_len(args) != 2) \ 204 return st->t; \ 205 tsp_arg_type(car(args), #OP, TSP_NUM); \ 206 tsp_arg_type(car(cdr(args)), #OP, TSP_NUM); \ 207 return ((num(car(args))*den(car(cdr(args)))) OP \ 208 (num(car(cdr(args)))*den(car(args)))) ? \ 209 st->t : st->nil; \ 210 } 211 212 PRIM_COMPARE(lt, <) 213 PRIM_COMPARE(gt, >) 214 PRIM_COMPARE(lte, <=) 215 PRIM_COMPARE(gte, >=) 216 217 #define PRIM_TRIG(NAME) \ 218 static Val \ 219 prim_##NAME(Tsp st, Hash vars, Val args) \ 220 { \ 221 tsp_arg_num(args, #NAME, 1); \ 222 tsp_arg_type(car(args), #NAME, TSP_EXPR); \ 223 if (car(args)->t & TSP_DEC) \ 224 return mk_dec(NAME(num(car(args)))); \ 225 return mk_list(st, 2, mk_sym(st, #NAME), car(args)); \ 226 } 227 228 PRIM_TRIG(sin) 229 PRIM_TRIG(cos) 230 PRIM_TRIG(tan) 231 PRIM_TRIG(sinh) 232 PRIM_TRIG(cosh) 233 PRIM_TRIG(tanh) 234 PRIM_TRIG(asin) 235 PRIM_TRIG(acos) 236 PRIM_TRIG(atan) 237 PRIM_TRIG(asinh) 238 PRIM_TRIG(acosh) 239 PRIM_TRIG(atanh) 240 PRIM_TRIG(exp) 241 PRIM_TRIG(log) 242 243 void 244 tib_env_math(Tsp st) 245 { 246 tsp_env_prim(Int); 247 tsp_env_prim(Dec); 248 tsp_env_prim(floor); 249 tsp_env_prim(ceil); 250 tsp_env_prim(round); 251 252 tsp_env_name_prim(+, add); 253 tsp_env_name_prim(-, sub); 254 tsp_env_name_prim(*, mul); 255 tsp_env_name_prim(/, div); 256 tsp_env_prim(mod); 257 tsp_env_name_prim(^, pow); 258 259 tsp_env_name_prim(<, lt); 260 tsp_env_name_prim(>, gt); 261 tsp_env_name_prim(<=, lte); 262 tsp_env_name_prim(>=, gte); 263 264 tsp_env_prim(sin); 265 tsp_env_prim(cos); 266 tsp_env_prim(tan); 267 tsp_env_prim(sinh); 268 tsp_env_prim(cosh); 269 tsp_env_prim(tanh); 270 tsp_env_name_prim(arcsin, asin); 271 tsp_env_name_prim(arccos, acos); 272 tsp_env_name_prim(arctan, atan); 273 tsp_env_name_prim(arcsinh, asinh); 274 tsp_env_name_prim(arccosh, acosh); 275 tsp_env_name_prim(arctanh, atanh); 276 tsp_env_prim(exp); 277 tsp_env_prim(log); 278 }