newlib/system.ajla

   1 {*
   2  * Copyright (C) 2024, 2025 Mikulas Patocka
   3  *
   4  * This file is part of Ajla.
   5  *
   6  * Ajla is free software: you can redistribute it and/or modify it under the
   7  * terms of the GNU General Public License as published by the Free Software
   8  * Foundation, either version 3 of the License, or (at your option) any later
   9  * version.
  10  *
  11  * Ajla is distributed in the hope that it will be useful, but WITHOUT ANY
  12  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  13  * A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License along with
  16  * Ajla. If not, see <https://www.gnu.org/licenses/>.
  17  *}
  18
  19 unit system;
  20
  21 // types hardcoded in type.ajla
  22 type byte;
  23 type bytes;
  24 type char;
  25 type string;
  26 type list(t : type);
  27 private type xarray~inline(dim : list(int), t : type);
  28
  29 type array(t : type, dim : list(int)) := xarray(dim, t);
  30
  31 type unit_type;
  32 const unit_value~inline : unit_type;
  33 type bottom_type;
  34
  35 private fn sysprop(p : int) : int;
  36 private fn is_privileged : bool;
  37
  38 type sint(n : int);
  39 type uint(n : int);
  40
  41 type real := real64;
  42
  43 type floating(ex_bits sig_bits : int);
  44 private fn floating_internal(const ex_bits sig_bits : int, f : floating(ex_bits, sig_bits)) : int;
  45
  46 record rational [
  47         num den : int;
  48 ]
  49
  50 type fixed_point(base digits : int);
  51 type decimal(digits : int) := fixed_point(10, digits);
  52
  53 type byte := uint8;
  54 type bytes := list(byte);
  55
  56 type char := int32;
  57 type string := list(char);
  58
  59 record class_eq(t : type) [
  60         equal : fn(t, t) : bool;
  61 ]
  62
  63 record class_ord(t : type) [
  64         equal : fn(t, t) : bool;
  65         less : fn(t, t) : bool;
  66 ]
  67
  68 record class_logical(t : type) [
  69         and : fn(t, t) : t;
  70         or : fn(t, t) : t;
  71         xor : fn(t, t) : t;
  72         not : fn(t) : t;
  73 ]
  74
  75 record class_show(t : type) [
  76         to_bytes : fn(t) : bytes;
  77         from_bytes : fn(bytes) : t;
  78 ]
  79
  80 record class_magma(t : type) [
  81         add : fn(t, t) : t;
  82 ]
  83
  84 record class_monoid(t : type) [
  85         add : fn(t, t) : t;
  86         zero : t;
  87 ]
  88
  89 record class_group(t : type) [
  90         add : fn(t, t) : t;
  91         zero : t;
  92         neg : fn(t) : t;
  93         subtract : fn(t, t) : t;
  94 ]
  95
  96 record class_unit_ring(t : type) [
  97         add : fn(t, t) : t;
  98         zero : t;
  99         neg : fn(t) : t;
 100         subtract : fn(t, t) : t;
 101         multiply : fn(t, t) : t;
 102         one : t;
 103 ]
 104
 105 record class_division_ring(t : type) [
 106         add : fn(t, t) : t;
 107         zero : t;
 108         neg : fn(t) : t;
 109         subtract : fn(t, t) : t;
 110         multiply : fn(t, t) : t;
 111         one : t;
 112         recip : fn(t) : t;
 113         divide : fn(t, t) : t;
 114 ]
 115
 116 record class_integer_number(t : type) [
 117         add : fn(t, t) : t;
 118         zero : t;
 119         neg : fn(t) : t;
 120         subtract : fn(t, t) : t;
 121         multiply : fn(t, t) : t;
 122         one : t;
 123         div : fn(t, t) : t;
 124         mod : fn(t, t) : t;
 125         power : fn(t, t) : t;
 126         and : fn(t, t) : t;
 127         or : fn(t, t) : t;
 128         xor : fn(t, t) : t;
 129         shl : fn(t, t) : t;
 130         shr : fn(t, t) : t;
 131         bts : fn(t, t) : t;
 132         btr : fn(t, t) : t;
 133         btc : fn(t, t) : t;
 134         equal : fn(t, t) : bool;
 135         less : fn(t, t) : bool;
 136         bt : fn(t, t) : bool;
 137         not : fn(t) : t;
 138         bsf : fn(t) : t;
 139         bsr : fn(t) : t;
 140         popcnt : fn(t) : t;
 141         to_int : fn(t) : int;
 142         from_int : fn(int) : t;
 143         to_bytes : fn(t) : bytes;
 144         to_bytes_base : fn(t, int) : bytes;
 145         from_bytes : fn(bytes) : t;
 146         from_bytes_base : fn(bytes, int) : t;
 147 ]
 148
 149 record class_fixed_integer_number(t : type) [
 150         bits : int;
 151         unsigned : bool;
 152         add : fn(t, t) : t;
 153         zero : t;
 154         neg : fn(t) : t;
 155         subtract : fn(t, t) : t;
 156         multiply : fn(t, t) : t;
 157         one : t;
 158         div : fn(t, t) : t;
 159         mod : fn(t, t) : t;
 160         power : fn(t, t) : t;
 161         and : fn(t, t) : t;
 162         or : fn(t, t) : t;
 163         xor : fn(t, t) : t;
 164         shl : fn(t, t) : t;
 165         shr : fn(t, t) : t;
 166         bts : fn(t, t) : t;
 167         btr : fn(t, t) : t;
 168         btc : fn(t, t) : t;
 169         equal : fn(t, t) : bool;
 170         less : fn(t, t) : bool;
 171         bt : fn(t, t) : bool;
 172         not : fn(t) : t;
 173         bsf : fn(t) : t;
 174         bsr : fn(t) : t;
 175         popcnt : fn(t) : t;
 176         to_int : fn(t) : int;
 177         from_int : fn(int) : t;
 178         to_bytes : fn(t) : bytes;
 179         to_bytes_base : fn(t, int) : bytes;
 180         from_bytes : fn(bytes) : t;
 181         from_bytes_base : fn(bytes, int) : t;
 182         rol : fn(t, t) : t;
 183         ror : fn(t, t) : t;
 184         bswap : fn(t) : t;
 185         brev : fn(t) : t;
 186 ]
 187
 188 record class_real_number(t : type) [
 189         add : fn(t, t) : t;
 190         zero : t;
 191         neg : fn(t) : t;
 192         subtract : fn(t, t) : t;
 193         multiply : fn(t, t) : t;
 194         one : t;
 195         recip : fn(t) : t;
 196         divide : fn(t, t) : t;
 197         modulo : fn(t, t) : t;
 198         power : fn(t, t) : t;
 199         ldexp : fn(t, t) : t;
 200         atan2 : fn(t, t) : t;
 201         pi : t;
 202         sqrt : fn(t) : t;
 203         cbrt : fn(t) : t;
 204         sin : fn(t) : t;
 205         cos : fn(t) : t;
 206         tan : fn(t) : t;
 207         asin : fn(t) : t;
 208         acos : fn(t) : t;
 209         atan : fn(t) : t;
 210         sinh : fn(t) : t;
 211         cosh : fn(t) : t;
 212         tanh : fn(t) : t;
 213         asinh : fn(t) : t;
 214         acosh : fn(t) : t;
 215         atanh : fn(t) : t;
 216         exp2 : fn(t) : t;
 217         exp : fn(t) : t;
 218         exp10 : fn(t) : t;
 219         log2 : fn(t) : t;
 220         log : fn(t) : t;
 221         log10 : fn(t) : t;
 222         round : fn(t) : t;
 223         ceil : fn(t) : t;
 224         floor : fn(t) : t;
 225         trunc : fn(t) : t;
 226         fract : fn(t) : t;
 227         mantissa : fn(t) : t;
 228         exponent : fn(t) : t;
 229         next_number : fn(t) : t;
 230         prev_number : fn(t) : t;
 231         is_negative : fn(t) : bool;
 232         is_infinity : fn(t) : bool;
 233         equal : fn(t, t) : bool;
 234         less : fn(t, t) : bool;
 235         to_int : fn(t) : int;
 236         from_int : fn(int) : t;
 237         to_rational : fn(t) : rational;
 238         from_rational : fn(rational) : t;
 239         to_bytes : fn(t) : bytes;
 240         to_bytes_base_precision : fn(t, int, int) : bytes;
 241         from_bytes : fn(bytes) : t;
 242         from_bytes_base : fn(bytes, int) : t;
 243 ]
 244
 245 record class_functor(f : fn(type) : type) [
 246         map : fn (t u : type, l : f(t), m : fn(t) : u) : f(u);
 247 ]
 248 fn map(t u : type, const f : fn(type) : type, c : class_functor(f), l : f(t), m : fn(t) : u) : f(u);
 249
 250 implicit fn inherit_eq_ord~inline(t : type, c : class_ord(t)) : class_eq(t);
 251 implicit fn inherit_magma_monoid~inline(t : type, c : class_monoid(t)) : class_magma(t);
 252 implicit fn inherit_monoid_group~inline(t : type, c : class_group(t)) : class_monoid(t);
 253 implicit fn inherit_group_unit_ring~inline(t : type, c : class_unit_ring(t)) : class_group(t);
 254 implicit fn inherit_unit_ring_division_ring~inline(t : type, c : class_division_ring(t)) : class_unit_ring(t);
 255 implicit fn inherit_show_integer_number~inline(t : type, c : class_integer_number(t)) : class_show(t);
 256 implicit fn inherit_show_real_number~inline(t : type, c : class_real_number(t)) : class_show(t);
 257 implicit fn inherit_ord_integer_number~inline(t : type, c : class_integer_number(t)) : class_ord(t);
 258 implicit fn inherit_logical_integer_number~inline(t : type, c : class_integer_number(t)) : class_logical(t);
 259 implicit fn inherit_unit_ring_integer_number~inline(t : type, c : class_integer_number(t)) : class_unit_ring(t);
 260 implicit fn inherit_integer_number_fixed_integer_number~inline(t : type, c : class_fixed_integer_number(t)) : class_integer_number(t);
 261 implicit fn inherit_ord_real_number~inline(t : type, c : class_real_number(t)) : class_ord(t);
 262 implicit fn inherit_division_ring_real_number~inline(t : type, c : class_real_number(t)) : class_division_ring(t);
 263
 264 implicit fn inherit_eq_list~inline(t : type, c : class_eq(t)) : class_eq(list(t));
 265 implicit fn inherit_ord_list~inline(t : type, c : class_ord(t)) : class_ord(list(t));
 266 implicit fn instance_monoid_list~inline(t : type) : class_monoid(list(t));
 267 implicit fn instance_functor_list~inline : class_functor(list);
 268
 269 implicit fn inherit_eq_array~inline(t : type, c : class_eq(t), const dim : list(int)) : class_eq(array(t, dim));
 270 implicit fn inherit_ord_array~inline(t : type, c : class_ord(t), const dim : list(int)) : class_ord(array(t, dim));
 271 implicit fn instance_functor_array~inline(const dim : list(int)) : class_functor(xarray(dim,));
 272
 273 implicit fn instance_logical_bool~inline : class_logical(bool);
 274 implicit fn instance_ord_bool~inline : class_ord(bool);
 275 implicit fn instance_number_int~inline : class_integer_number(int);
 276
 277 operator prefix + 1000 ~inline (t : type, c : class_group(t), val : t) : t;
 278 operator prefix - 1000 ~inline ~Un_Neg (t : type, c : class_group(t), val : t) : t;
 279 operator * 2000 ~inline ~Bin_Multiply (t : type, c : class_unit_ring(t), val1 val2 : t) : t;
 280 operator / 2000 ~inline ~Bin_Divide_Real(t : type, c : class_division_ring(t), val1 val2 : t) : t;
 281 operator div 2000 ~inline ~Bin_Divide_Int (t : type, c : class_integer_number(t), val1 val2 : t) : t;
 282 operator mod 2000 ~inline ~Bin_Modulo (t : type, c : class_integer_number(t), val1 val2 : t) : t;
 283 operator + 3000 ~inline ~Bin_Add (t : type, c : class_magma(t), val1 val2 : t) : t;
 284 operator - 3000 ~inline ~Bin_Subtract (t : type, c : class_group(t), val1 val2 : t) : t;
 285 operator shl 4000 ~inline ~Bin_Shl (t : type, c : class_integer_number(t), val1 val2 : t) : t;
 286 operator shr 4000 ~inline ~Bin_Shr (t : type, c : class_integer_number(t), val1 val2 : t) : t;
 287 operator rol 4000 ~inline ~Bin_Rol (t : type, c : class_fixed_integer_number(t), val1 val2 : t) : t;
 288 operator ror 4000 ~inline ~Bin_Ror (t : type, c : class_fixed_integer_number(t), val1 val2 : t) : t;
 289 operator bts 4000 ~inline ~Bin_Bts (t : type, c : class_integer_number(t), val1 val2 : t) : t;
 290 operator btr 4000 ~inline ~Bin_Btr (t : type, c : class_integer_number(t), val1 val2 : t) : t;
 291 operator btc 4000 ~inline ~Bin_Btc (t : type, c : class_integer_number(t), val1 val2 : t) : t;
 292 operator bt 4000 ~inline ~Bin_Bt (t : type, c : class_integer_number(t), val1 val2 : t) : bool;
 293 operator prefix bswap 4000 ~inline ~Un_Bswap (t : type, c : class_fixed_integer_number(t), val : t) : t;
 294 operator prefix brev 4000 ~inline ~Un_Brev (t : type, c : class_fixed_integer_number(t), val : t) : t;
 295 operator prefix bsf 4000 ~inline ~Un_Bsf (t : type, c : class_integer_number(t), val : t) : t;
 296 operator prefix bsr 4000 ~inline ~Un_Bsr (t : type, c : class_integer_number(t), val : t) : t;
 297 operator prefix popcnt 4000 ~inline ~Un_Popcnt (t : type, c : class_integer_number(t), val : t) : t;
 298
 299 operator prefix is_negative 5000 ~inline (t : type, c : class_real_number(t), val : t) : bool;
 300 operator prefix is_infinity 5000 ~inline (t : type, c : class_real_number(t), val : t) : bool;
 301 operator prefix is_exception 5000 ~inline (t : type, v : t) : bool;
 302 operator prefix exception_class 5000 ~inline (t : type, v : t) : int;
 303 operator prefix exception_type 5000 ~inline (t : type, v : t) : int;
 304 operator prefix exception_aux 5000 ~inline (t : type, v : t) : int;
 305 operator prefix exception_string 5000 ~inline (t : type, v : t) : bytes;
 306 operator prefix exception_payload 5000 ~inline (t : type, v : t) : bytes;
 307 operator prefix exception_stack 5000 ~inline (t : type, v : t) : bytes;
 308
 309 operator = 6000 ~inline ~Bin_Equal (t : type, c : class_eq(t), val1 val2 : t) : bool;
 310 operator <> 6000 ~inline ~Bin_NotEqual (t : type, c : class_eq(t), val1 val2 : t) : bool;
 311 operator < 6000 ~inline ~Bin_Less (t : type, c : class_ord(t), val1 val2 : t) : bool;
 312 operator <= 6000 ~inline ~Bin_LessEqual (t : type, c : class_ord(t), val1 val2 : t) : bool;
 313 operator > 6000 ~inline ~Bin_Greater (t : type, c : class_ord(t), val1 val2 : t) : bool;
 314 operator >= 6000 ~inline ~Bin_GreaterEqual (t : type, c : class_ord(t), val1 val2 : t) : bool;
 315 operator prefix not 7000 ~inline ~Un_Not (t : type, c : class_logical(t), val : t) : t;
 316 operator and 8000 ~inline ~Bin_And (t : type, c : class_logical(t), val1 val2 : t) : t;
 317 operator xor 9000 ~inline ~Bin_Xor (t : type, c : class_logical(t), val1 val2 : t) : t;
 318 operator or 10000 ~inline ~Bin_Or (t : type, c : class_logical(t), val1 val2 : t) : t;
 319
 320 operator +< 3000 ~inline (t : type, x : list(t), y : t) : list(t) := x + list(t).[ y ];
 321 operator ==> 11000 ~inline (val1 val2 : bool) : bool := val1 <= val2;
 322
 323 fn ipower~inline(t : type, c : class_integer_number(t), val1 val2 : t) : t;
 324 fn fmod~inline(t : type, c : class_real_number(t), val1 val2 : t) : t;
 325 fn power~inline(t : type, c : class_real_number(t), val1 val2 : t) : t;
 326 fn ldexp~inline(t : type, c : class_real_number(t), val1 val2 : t) : t;
 327 fn atan2~inline(t : type, c : class_real_number(t), val1 val2 : t) : t;
 328 fn sqrt~inline(t : type, c : class_real_number(t), val : t) : t;
 329 fn cbrt~inline(t : type, c : class_real_number(t), val : t) : t;
 330 fn sin~inline(t : type, c : class_real_number(t), val : t) : t;
 331 fn cos~inline(t : type, c : class_real_number(t), val : t) : t;
 332 fn tan~inline(t : type, c : class_real_number(t), val : t) : t;
 333 fn asin~inline(t : type, c : class_real_number(t), val : t) : t;
 334 fn acos~inline(t : type, c : class_real_number(t), val : t) : t;
 335 fn atan~inline(t : type, c : class_real_number(t), val : t) : t;
 336 fn sinh~inline(t : type, c : class_real_number(t), val : t) : t;
 337 fn cosh~inline(t : type, c : class_real_number(t), val : t) : t;
 338 fn tanh~inline(t : type, c : class_real_number(t), val : t) : t;
 339 fn asinh~inline(t : type, c : class_real_number(t), val : t) : t;
 340 fn acosh~inline(t : type, c : class_real_number(t), val : t) : t;
 341 fn atanh~inline(t : type, c : class_real_number(t), val : t) : t;
 342 fn exp2~inline(t : type, c : class_real_number(t), val : t) : t;
 343 fn exp~inline(t : type, c : class_real_number(t), val : t) : t;
 344 fn exp10~inline(t : type, c : class_real_number(t), val : t) : t;
 345 fn log2~inline(t : type, c : class_real_number(t), val : t) : t;
 346 fn log~inline(t : type, c : class_real_number(t), val : t) : t;
 347 fn log10~inline(t : type, c : class_real_number(t), val : t) : t;
 348 fn round~inline(t : type, c : class_real_number(t), val : t) : t;
 349 fn ceil~inline(t : type, c : class_real_number(t), val : t) : t;
 350 fn floor~inline(t : type, c : class_real_number(t), val : t) : t;
 351 fn trunc~inline(t : type, c : class_real_number(t), val : t) : t;
 352 fn fract~inline(t : type, c : class_real_number(t), val : t) : t;
 353 fn mantissa~inline(t : type, c : class_real_number(t), val : t) : t;
 354 fn exponent~inline(t : type, c : class_real_number(t), val : t) : t;
 355 fn next_number~inline(t : type, c : class_real_number(t), val : t) : t;
 356 fn prev_number~inline(t : type, c : class_real_number(t), val : t) : t;
 357
 358 conversion fn integer_number_to_integer_number~inline(t1 : type, c1 : class_integer_number(t1), t2 : type, c2 : class_integer_number(t2), val : t1) : t2;
 359 conversion fn integer_number_to_real_number~inline(t1 : type, c1 : class_integer_number(t1), t2 : type, c2 : class_real_number(t2), val : t1) : t2;
 360 conversion fn real_number_to_integer_number~inline(t1 : type, c1 : class_real_number(t1), t2 : type, c2 : class_integer_number(t2), val : t1) : t2;
 361 conversion fn real_number_to_real_number~inline(t1 : type, c1 : class_real_number(t1), t2 : type, c2 : class_real_number(t2), val : t1) : t2;
 362
 363 implicit fn instance_number_int8~inline : class_integer_number(int8);
 364 implicit fn instance_number_int16~inline : class_integer_number(int16);
 365 implicit fn instance_number_int32~inline : class_integer_number(int32);
 366 implicit fn instance_number_int64~inline : class_integer_number(int64);
 367 implicit fn instance_number_int128~inline : class_integer_number(int128);
 368
 369 implicit fn instance_fixed_integer_number_sint8~inline : class_fixed_integer_number(sint8);
 370 implicit fn instance_fixed_integer_number_sint16~inline : class_fixed_integer_number(sint16);
 371 implicit fn instance_fixed_integer_number_sint32~inline : class_fixed_integer_number(sint32);
 372 implicit fn instance_fixed_integer_number_sint64~inline : class_fixed_integer_number(sint64);
 373 implicit fn instance_fixed_integer_number_sint128~inline : class_fixed_integer_number(sint128);
 374
 375 implicit fn instance_fixed_integer_number_uint8~inline : class_fixed_integer_number(uint8);
 376 implicit fn instance_fixed_integer_number_uint16~inline : class_fixed_integer_number(uint16);
 377 implicit fn instance_fixed_integer_number_uint32~inline : class_fixed_integer_number(uint32);
 378 implicit fn instance_fixed_integer_number_uint64~inline : class_fixed_integer_number(uint64);
 379 implicit fn instance_fixed_integer_number_uint128~inline : class_fixed_integer_number(uint128);
 380
 381 implicit fn instance_fixed_integer_number_sint~inline(const n : int) : class_fixed_integer_number(sint(n));
 382 implicit fn instance_fixed_integer_number_uint~inline(const n : int) : class_fixed_integer_number(uint(n));
 383
 384 implicit fn instance_real_number_real16~inline : class_real_number(real16);
 385 implicit fn instance_real_number_real32~inline : class_real_number(real32);
 386 implicit fn instance_real_number_real64~inline : class_real_number(real64);
 387 implicit fn instance_real_number_real80~inline : class_real_number(real80);
 388 implicit fn instance_real_number_real128~inline : class_real_number(real128);
 389
 390 implicit fn instance_real_number_floating~inline(const ex_bits sig_bits : int) : class_real_number(floating(ex_bits, sig_bits));
 391
 392 implicit fn instance_real_number_rational~inline : class_real_number(rational);
 393
 394 implicit fn instance_real_number_fixed_point~inline(const base digits : int) : class_real_number(fixed_point(base, digits));
 395
 396 {---------
 397  - DEBUG -
 398  ---------}
 399
 400 fn debug(m : bytes) : unit_type;
 401 fn internal(m : bytes) : unit_type;
 402 fn stop(m : bytes) : unit_type;
 403 fn report_memory_summary(m : bytes) : unit_type;
 404 fn report_memory_most(m : bytes) : unit_type;
 405 fn report_memory_largest(m : bytes) : unit_type;
 406 fn assert~inline(v : bool, b : bytes) : unit_type;
 407 fn stacktrace(t : type, v : t) : unit_type;
 408 fn trace_on : unit_type;
 409 fn trace_off : unit_type;
 410
 411 {-----------
 412  - GENERAL -
 413  -----------}
 414
 415 fn join(t : type, w1 w2 : t) : t;
 416 fn any~lazy(t1 t2 : type, w1 : t1, w2 : t2) : bool;
 417 fn any_list~lazy(t : type, wx : list(t)) : int;
 418 fn is_ready(t : type, v : t) : bool;
 419 fn never(t : type) : t;
 420 fn fork(t : type, w : t) : (t, t);
 421
 422 {------------------
 423  - LIST FUNCTIONS -
 424  ------------------}
 425
 426 fn len~inline(t : type, a : list(t)) : int;
 427 fn len_at_least~inline(t : type, a : list(t), l : int) : bool;
 428 fn len_greater_than~inline(t : type, a : list(t), l : int) : bool;
 429 fn empty~inline(t : type) : list(t);
 430 fn fill~inline(t : type, const x : t, const n : int) : list(t);
 431 fn sparse~inline(t : type, const x : t, const n : int) : list(t);
 432
 433 fn infinite(t : type, x : t) : list(t);
 434 fn infinite_repeat(t : type, x : list(t)) : list(t);
 435 fn uninitialized(t : type) : t;
 436 fn uninitialized_record(t : type) : t;
 437 fn infinite_uninitialized(t : type) : list(t);
 438 fn is_uninitialized(t : type, v : t) : bool;
 439 fn is_uninitialized_record(t : type, v : t) : bool;
 440
 441 fn identity~inline(t : type, v : t) : t := v;
 442 fn select~inline(t : type, b : bool, v1 v2 : t) : t
 443 [
 444         if b then
 445                 return v2;
 446         return v1;
 447 ]
 448 fn min~inline(t : type, implicit c : class_ord(t), a b : t) : t := select(a < b, b, a);
 449 fn max~inline(t : type, implicit c : class_ord(t), a b : t) : t := select(a < b, a, b);
 450 fn abs~inline(t : type, implicit cg : class_group(t), implicit co : class_ord(t), x : t) : t := select(x <= cg.zero, x, cg.zero - x);
 451 fn sgn~inline(t : type, implicit cu : class_unit_ring(t), implicit co : class_ord(t), x : t) : t := select(x >= cu.zero, -cu.one, select(x = cu.zero, cu.one, x));
 452
 453
 454 fn list_search(t : type, c : class_eq(t), x : list(t), v : t) : int;
 455 fn list_search_fn(t : type, x : list(t), f : fn(t) : bool) : int;
 456 fn list_search_backwards(t : type, c : class_eq(t), x : list(t), v : t) : int;
 457 fn list_search_backwards_fn(t : type, x : list(t), f : fn(t) : bool) : int;
 458 fn list_search_substring(t : type, c : class_eq(t), x v : list(t)) : int;
 459 fn list_replace_substring(t : type, c : class_eq(t), x v r : list(t)) : list(t);
 460 fn list_left_pad(t : type, x : list(t), width : int, padding : t) : list(t);
 461 fn list_right_pad(t : type, x : list(t), width : int, padding : t) : list(t);
 462 fn list_repeat(t : type, x : list(t), num : int) : list(t);
 463 fn list_begins_with(t : type, c : class_eq(t), x y : list(t)) : bool;
 464 fn list_ends_with(t : type, c : class_eq(t), x y : list(t)) : bool;
 465 fn list_break(t : type, implicit c : class_eq(t), l : list(t), bnd : t) : list(list(t));
 466 fn list_break_to_lines(b : bytes) : list(bytes);
 467 fn list_string_break_to_lines(b : string) : list(string);
 468 fn list_break_whitespace(l : bytes) : list(bytes);
 469 fn list_join(t : type, lines : list(list(t)), bnd : list(t)) : list(t);
 470 fn list_join_lines(lines : list(bytes)) : bytes;
 471 fn list_filter(t : type, lst : list(t), test : fn(t) : bool) : list(t);
 472 fn list_filter_idx(t : type, lst : list(t), test : fn(int, t) : bool) : list(t);
 473 fn list_fold(t v : type, ini : t, lst : list(v), fold : fn(t, v) : t) : t;
 474 fn list_fold_monoid(t : type, c : class_monoid(t), lst : list(t)) : t;
 475 fn list_map_fold(t v : type, ini : v, lst : list(t), mp : fn(t) : v, re : fn(v, v) : v) : v;
 476 fn list_map_fold_monoid(t v : type, c : class_monoid(v), lst : list(t), mp : fn(t) : v) : v;
 477 fn list_reverse(t : type, l : list(t)) : list(t);
 478 fn list_sort(t : type, implicit c : class_ord(t), l : list(t)) : list(t);
 479 fn list_flatten~inline(t : type, a : list(t)) : list(t);
 480
 481 const nl : bytes;
 482
 483 {---------
 484  - ARRAY -
 485  ---------}
 486
 487 fn list_to_array(t : type, const dim : list(int), v : list(t)) : array(t, dim);
 488 fn array_to_list(t : type, const dim : list(int), v : array(t, dim)) : list(t);
 489 fn array_fill~inline(t : type, const x : t, const dim : list(int)) : array(t, dim);
 490 fn array_sparse~inline(t : type, const x : t, const dim : list(int)) : array(t, dim);
 491 fn array_read(t : type, const dim : list(int), v : array(t, dim), idx : list(int)) : t;
 492 fn array_write(t : type, const dim : list(int), v : array(t, dim), idx : list(int), val : t) : array(t, dim);
 493 fn array_reverse(t : type, const ln : int, implicit c : class_ord(t), v : array(t, [ln])) : array(t, [ln]);
 494 fn array_sort(t : type, const ln : int, implicit c : class_ord(t), v : array(t, [ln])) : array(t, [ln]);
 495 fn array_flatten~inline(t : type, const dim : list(int), v : array(t, dim)) : array(t, dim);
 496
 497 {---------
 498  - TUPLE -
 499  ---------}
 500
 501 record tuple2(t1 : type, t2 : type) [ v1 : t1; v2 : t2; ]
 502 record tuple3(t1 : type, t2 : type, t3 : type) [ v1 : t1; v2 : t2; v3 : t3; ]
 503 record tuple4(t1 : type, t2 : type, t3 : type, t4 : type) [ v1 : t1; v2 : t2; v3 : t3; v4 : t4; ]
 504 record tuple5(t1 : type, t2 : type, t3 : type, t4 : type, t5 : type) [ v1 : t1; v2 : t2; v3 : t3; v4 : t4; v5 : t5; ]
 505
 506 fn mktuple2(t1 t2 : type, v1 : t1, v2 : t2) : tuple2(t1, t2) := tuple2(t1, t2).[ v1 : v1, v2 : v2 ];
 507 fn mktuple3(t1 t2 t3 : type, v1 : t1, v2 : t2, v3 : t3) : tuple3(t1, t2, t3) := tuple3(t1, t2, t3).[ v1 : v1, v2 : v2, v3 : v3 ];
 508 fn mktuple4(t1 t2 t3 t4 : type, v1 : t1, v2 : t2, v3 : t3, v4 : t4) : tuple4(t1, t2, t3, t4) := tuple4(t1, t2, t3, t4).[ v1 : v1, v2 : v2, v3 : v3, v4 : v4 ];
 509 fn mktuple5(t1 t2 t3 t4 t5 : type, v1 : t1, v2 : t2, v3 : t3, v4 : t4, v5 : t5) : tuple5(t1, t2, t3, t4, t5) := tuple5(t1, t2, t3, t4, t5).[ v1 : v1, v2 : v2, v3 : v3, v4 : v4, v5 : v5 ];
 510
 511 implicit fn inherit_eq_tuple2~inline(t1 t2 : type, c1 : class_eq(t1), c2 : class_eq(t2)) : class_eq(tuple2(t1, t2));
 512 implicit fn inherit_ord_tuple2~inline(t1 t2 : type, c1 : class_ord(t1), c2 : class_ord(t2)) : class_ord(tuple2(t1, t2));
 513
 514 implicit fn inherit_eq_tuple3~inline(t1 t2 t3 : type, c1 : class_eq(t1), c2 : class_eq(t2), c3 : class_eq(t3)) : class_eq(tuple3(t1, t2, t3));
 515 implicit fn inherit_ord_tuple3~inline(t1 t2 t3 : type, c1 : class_ord(t1), c2 : class_ord(t2), c3 : class_ord(t3)) : class_ord(tuple3(t1, t2, t3));
 516
 517 implicit fn inherit_eq_tuple4~inline(t1 t2 t3 t4 : type, c1 : class_eq(t1), c2 : class_eq(t2), c3 : class_eq(t3), c4 : class_eq(t4)) : class_eq(tuple4(t1, t2, t3, t4));
 518 implicit fn inherit_ord_tuple4~inline(t1 t2 t3 t4 : type, c1 : class_ord(t1), c2 : class_ord(t2), c3 : class_ord(t3), c4 : class_ord(t4)) : class_ord(tuple4(t1, t2, t3, t4));
 519
 520 implicit fn inherit_eq_tuple5~inline(t1 t2 t3 t4 t5 : type, c1 : class_eq(t1), c2 : class_eq(t2), c3 : class_eq(t3), c4 : class_eq(t4), c5 : class_eq(t5)) : class_eq(tuple5(t1, t2, t3, t4, t5));
 521 implicit fn inherit_ord_tuple5~inline(t1 t2 t3 t4 t5 : type, c1 : class_ord(t1), c2 : class_ord(t2), c3 : class_ord(t3), c4 : class_ord(t4), c5 : class_ord(t5)) : class_ord(tuple5(t1, t2, t3, t4, t5));
 522
 523 {---------
 524  - MAYBE -
 525  ---------}
 526
 527 option maybe~flat(t : type) [
 528         j : t;
 529         n;
 530 ]
 531
 532 fn mkmaybe~inline(t : type, v : t) : maybe(t);
 533
 534 {------------
 535  - ITERATOR -
 536  ------------}
 537
 538 record class_iterator [
 539         state : type;
 540         element : type;
 541         init : state;
 542         test : fn(state) : bool;
 543         get_element : fn(state) : element;
 544         increment : fn(state) : state;
 545 ]
 546
 547 private fn range_test~inline(t : type, implicit co : class_ord(t), j x : t) : bool := x < j;
 548 private fn range_increment~inline(t : type, implicit cm : class_magma(t), step x : t) : t := x + step;
 549 fn range~type(t : type, implicit cm : class_magma(t), implicit co : class_ord(t), i j step : t) : class_iterator :=
 550         class_iterator.[
 551                 state : t,
 552                 element : t,
 553                 init : i,
 554                 test : range_test(j,),
 555                 get_element : identity(t,),
 556                 increment : range_increment(step,),
 557         ];
 558
 559 fn list_iterator~type(t : type, l : list(t)) : class_iterator :=
 560         class_iterator.[
 561                 state : int,
 562                 element : int,
 563                 init : 0,
 564                 test : len_greater_than(l,),
 565                 get_element : identity(int,),
 566                 increment : instance_number_int.add(1,),
 567         ];
 568
 569 fn list_iterator_reverse~type(t : type, l : list(t)) : class_iterator :=
 570         class_iterator.[
 571                 state : int,
 572                 element : int,
 573                 init : len(l) - 1,
 574                 test : instance_number_int.less(-1,),
 575                 get_element : identity(int,),
 576                 increment : instance_number_int.add(-1,),
 577         ];
 578
 579 private fn list_consumer_non_empty~inline(t : type, l : list(t)) : bool := len_greater_than(l, 0);
 580 private fn list_consumer_get_head~inline(t : type, l : list(t)) : t := l[0];
 581 private fn list_consumer_get_tail~inline(t : type, l : list(t)) : list(t) := l[1 .. ];
 582 conversion fn list_consumer~type(t : type, l : list(t)) : class_iterator :=
 583         class_iterator.[
 584                 state : list(t),
 585                 element : t,
 586                 init : l,
 587                 test : list_consumer_non_empty(t,),
 588                 get_element : list_consumer_get_head(t,),
 589                 increment : list_consumer_get_tail(t,),
 590         ];
 591
 592 {----------
 593  - NUMBER -
 594  ----------}
 595
 596 fn ntos_base~inline(t : type, c : class_integer_number(t), n : t, base : int) : bytes;
 597 fn ntos_base_precision~inlnie(t : type, c : class_real_number(t), n : t, base digits : int) : bytes;
 598 fn ntos~inline(t : type, c : class_show(t), n : t) : bytes;
 599 fn ston_base~inline(b : bytes, base : int) : int;
 600 fn ston~inline(b : bytes) : int;
 601 fn format(t : type, implicit c : class_show(t), b : bytes, a : list(t)) : bytes;
 602
 603 {----------------
 604  - NATIVE TYPES -
 605  ----------------}
 606
 607 option native~flat [
 608         short;
 609         unsigned_short;
 610         integer;
 611         unsigned_integer;
 612         long;
 613         unsigned_long;
 614         long_long;
 615         unsigned_long_long;
 616         n_int16;
 617         n_uint16;
 618         n_int32;
 619         n_uint32;
 620         n_int64;
 621         n_uint64;
 622 ]
 623
 624 fn int_to_native~inline(n : native, i : int) : bytes;
 625 fn native_to_int~inline(n : native, b : bytes) : int;
 626
 627
 628 implementation
 629
 630 uses exception;
 631 uses pcode;
 632 uses private.show;
 633 uses private.rational;
 634 uses private.fixed_point;
 635 uses private.math;
 636
 637 type unit_type := byte;
 638 const unit_value~inline : unit_type := 0;
 639 option bottom_type [ ]
 640
 641
 642 private fn sysprop(p : int) : int
 643 [
 644         var r : int;
 645         pcode UnaryOp Un_SystemProperty =r 0 p;
 646         return r;
 647 ]
 648
 649 private fn is_privileged : bool
 650 [
 651         return sysprop(SystemProperty_Privileged) <> 0;
 652 ]
 653
 654
 655 implicit fn inherit_eq_ord(t : type, c : class_ord(t)) : class_eq(t) :=
 656         class_eq(t).[
 657                 equal : c.equal,
 658         ];
 659 implicit fn inherit_magma_monoid(t : type, c : class_monoid(t)) : class_magma(t) :=
 660         class_magma(t).[
 661                 add : c.add,
 662         ];
 663 implicit fn inherit_monoid_group(t : type, c : class_group(t)) : class_monoid(t) :=
 664         class_monoid(t).[
 665                 add : c.add,
 666                 zero : c.zero,
 667         ];
 668 implicit fn inherit_group_unit_ring(t : type, c : class_unit_ring(t)) : class_group(t) :=
 669         class_group(t).[
 670                 add : c.add,
 671                 zero : c.zero,
 672                 neg : c.neg,
 673                 subtract : c.subtract,
 674         ];
 675 implicit fn inherit_unit_ring_division_ring(t : type, c : class_division_ring(t)) : class_unit_ring(t) :=
 676         class_unit_ring(t).[
 677                 add : c.add,
 678                 zero : c.zero,
 679                 neg : c.neg,
 680                 subtract : c.subtract,
 681                 multiply : c.multiply,
 682                 one : c.one,
 683         ];
 684 implicit fn inherit_show_integer_number~inline(t : type, c : class_integer_number(t)) : class_show(t) :=
 685         class_show(t).[
 686                 to_bytes : c.to_bytes,
 687                 from_bytes : c.from_bytes,
 688         ];
 689 implicit fn inherit_show_real_number~inline(t : type, c : class_real_number(t)) : class_show(t) :=
 690         class_show(t).[
 691                 to_bytes : c.to_bytes,
 692                 from_bytes : c.from_bytes,
 693         ];
 694 implicit fn inherit_ord_integer_number(t : type, c : class_integer_number(t)) : class_ord(t) :=
 695         class_ord(t).[
 696                 equal : c.equal,
 697                 less : c.less,
 698         ];
 699 implicit fn inherit_logical_integer_number(t : type, c : class_integer_number(t)) : class_logical(t) :=
 700         class_logical(t).[
 701                 and : c.and,
 702                 or : c.or,
 703                 xor : c.xor,
 704                 not : c.not,
 705         ];
 706 implicit fn inherit_unit_ring_integer_number(t : type, c : class_integer_number(t)) : class_unit_ring(t) :=
 707         class_unit_ring(t).[
 708                 add : c.add,
 709                 zero : c.zero,
 710                 neg : c.neg,
 711                 subtract : c.subtract,
 712                 multiply : c.multiply,
 713                 one : c.one,
 714         ];
 715 implicit fn inherit_integer_number_fixed_integer_number(t : type, c : class_fixed_integer_number(t)) : class_integer_number(t) :=
 716         class_integer_number(t).[
 717                 add : c.add,
 718                 zero : c.zero,
 719                 neg : c.neg,
 720                 subtract : c.subtract,
 721                 multiply : c.multiply,
 722                 one : c.one,
 723                 div : c.div,
 724                 mod : c.mod,
 725                 power : c.power,
 726                 and : c.and,
 727                 or : c.or,
 728                 xor : c.xor,
 729                 shl : c.shl,
 730                 shr : c.shr,
 731                 bts : c.bts,
 732                 btr : c.btr,
 733                 btc : c.btc,
 734                 equal : c.equal,
 735                 less : c.less,
 736                 bt : c.bt,
 737                 not : c.not,
 738                 bsf : c.bsf,
 739                 bsr : c.bsr,
 740                 popcnt : c.popcnt,
 741                 to_int : c.to_int,
 742                 from_int : c.from_int,
 743                 to_bytes : c.to_bytes,
 744                 to_bytes_base : c.to_bytes_base,
 745                 from_bytes : c.from_bytes,
 746                 from_bytes_base : c.from_bytes_base,
 747         ];
 748 implicit fn inherit_ord_real_number(t : type, c : class_real_number(t)) : class_ord(t) :=
 749         class_ord(t).[
 750                 equal : c.equal,
 751                 less : c.less,
 752         ];
 753 implicit fn inherit_division_ring_real_number(t : type, c : class_real_number(t)) : class_division_ring(t) :=
 754         class_division_ring(t).[
 755                 add : c.add,
 756                 zero : c.zero,
 757                 neg : c.neg,
 758                 subtract : c.subtract,
 759                 multiply : c.multiply,
 760                 one : c.one,
 761                 recip : c.recip,
 762                 divide : c.divide,
 763         ];
 764
 765 fn list_equal~inline(t : type, implicit c : class_eq(t), l1 l2 : list(t)) : bool
 766 [
 767         while len_greater_than(l1, 0) and len_greater_than(l2, 0) do [
 768                 if l1[0] <> l2[0] then
 769                         return false;
 770                 l1 := l1[1 .. ];
 771                 l2 := l2[1 .. ];
 772         ]
 773         return len_greater_than(l1, 0) = len_greater_than(l2, 0);
 774 ]
 775 fn list_less~inline(t : type, implicit c : class_ord(t), l1 l2 : list(t)) : bool
 776 [
 777         while len_greater_than(l1, 0) and len_greater_than(l2, 0) do [
 778                 if l1[0] <> l2[0] then
 779                         return l1[0] < l2[0];
 780                 l1 := l1[1 .. ];
 781                 l2 := l2[1 .. ];
 782         ]
 783         return len_greater_than(l1, 0) < len_greater_than(l2, 0);
 784 ]
 785 implicit fn inherit_eq_list(t : type, c : class_eq(t)) : class_eq(list(t)) :=
 786         class_eq(list(t)).[
 787                 equal : list_equal(t, c,,),
 788         ];
 789 implicit fn inherit_ord_list(t : type, c : class_ord(t)) : class_ord(list(t)) :=
 790         class_ord(list(t)).[
 791                 equal : list_equal(t, inherit_eq_ord(c),,),
 792                 less : list_less(t, c,,),
 793         ];
 794 fn list_add~inline(t : type, l1 l2 : list(t)) : list(t)
 795 [
 796         var r : list(t);
 797         pcode Array_Append =r 0 l1 0 l2;
 798         return r;
 799 ]
 800 implicit fn instance_monoid_list~inline(t : type) : class_monoid(list(t)) :=
 801         class_monoid(list(t)).[
 802                 add : list_add(t,,),
 803                 zero : empty(t),
 804         ];
 805 fn list_map(t u : type, l : list(t), m : fn(t) : u) : list(u)
 806 [
 807         var steps := 64;
 808         var v := empty(u);
 809         if len_greater_than(l, steps) then [
 810                 for i := 0 to steps do
 811                         v +<= m(l[i]);
 812                 return v + list_map~lazy(l[steps .. ], m);
 813         ] else [
 814                 for i := 0 to len(l) do
 815                         v +<= m(l[i]);
 816                 return v;
 817         ]
 818 ]
 819 implicit fn instance_functor_list~inline : class_functor(list) :=
 820         class_functor(list).[
 821                 map : list_map,
 822         ];
 823
 824 fn array_equal(t : type, implicit c : class_eq(t), const dim : list(int), a1 a2 : array(t, dim)) : bool
 825 [
 826         var l1 := array_to_list(a1);
 827         var l2 := array_to_list(a2);
 828         for i := 0 to len(l1) do
 829                 if l1[i] <> l2[i] then
 830                         return false;
 831         return true;
 832 ]
 833 fn array_less(t : type, implicit c : class_ord(t), const dim : list(int), a1 a2 : array(t, dim)) : bool
 834 [
 835         var l1 := array_to_list(a1);
 836         var l2 := array_to_list(a2);
 837         for i := 0 to len(l1) do
 838                 if l1[i] <> l2[i] then
 839                         return l1[i] < l2[i];
 840         return false;
 841 ]
 842 implicit fn inherit_eq_array~inline(t : type, c : class_eq(t), const dim : list(int)) : class_eq(array(t, dim)) :=
 843         class_eq(array(t, dim)).[
 844                 equal : array_equal(t, c, dim,,),
 845         ];
 846
 847 implicit fn inherit_ord_array~inline(t : type, c : class_ord(t), const dim : list(int)) : class_ord(array(t, dim)) :=
 848         class_ord(array(t, dim)).[
 849                 equal : array_equal(t, inherit_eq_ord(c), dim,,),
 850                 less : array_less(t, c, dim,,),
 851         ];
 852
 853 fn array_map(const dim : list(int), t u : type, a : array(t, dim), m : fn(t) : u) : array(u, dim)
 854 [
 855         var tl := array_to_list(t, dim, a);
 856         var ul := empty(u);
 857         for i := 0 to len(tl) do
 858                 ul +<= m(tl[i]);
 859         return list_to_array(u, dim, ul);
 860 ]
 861 implicit fn instance_functor_array~inline(const dim : list(int)) : class_functor(xarray(dim,)) :=
 862         class_functor(xarray(dim,)).[
 863                 map : array_map(dim,,,,),
 864         ];
 865
 866 fn map(t u : type, const f : fn(type) : type, c : class_functor(f), l : f(t), m : fn(t) : u) : f(u)
 867 [
 868         return c.map(l, m);
 869 ]
 870
 871 {------------------
 872  - BOOL INSTANCES -
 873  ------------------}
 874
 875 fn bool_and~inline(b1 b2 : bool) : bool
 876 [
 877         var r : bool;
 878         pcode BinaryOp Bin_And =r 0 b1 0 b2;
 879         return r;
 880 ]
 881 fn bool_or~inline(b1 b2 : bool) : bool
 882 [
 883         var r : bool;
 884         pcode BinaryOp Bin_Or =r 0 b1 0 b2;
 885         return r;
 886 ]
 887 fn bool_not~inline(b1 : bool) : bool
 888 [
 889         var r : bool;
 890         pcode UnaryOp Un_Not =r 0 b1;
 891         return r;
 892 ]
 893 fn bool_equal~inline(b1 b2 : bool) : bool
 894 [
 895         var r : bool;
 896         pcode BinaryOp Bin_Equal =r 0 b1 0 b2;
 897         return r;
 898 ]
 899 fn bool_not_equal~inline(b1 b2 : bool) : bool
 900 [
 901         var r : bool;
 902         pcode BinaryOp Bin_NotEqual =r 0 b1 0 b2;
 903         return r;
 904 ]
 905 fn bool_less~inline(b1 b2 : bool) : bool
 906 [
 907         var r : bool;
 908         pcode BinaryOp Bin_Less =r 0 b1 0 b2;
 909         return r;
 910 ]
 911 implicit fn instance_logical_bool~inline : class_logical(bool) :=
 912         class_logical(bool).[
 913                 and : bool_and,
 914                 or : bool_or,
 915                 xor : bool_not_equal,
 916                 not : bool_not,
 917         ];
 918 implicit fn instance_ord_bool~inline : class_ord(bool) :=
 919         class_ord(bool).[
 920                 equal : bool_equal,
 921                 less : bool_less,
 922         ];
 923
 924 {----------------
 925  - INT INSTANCE -
 926  ----------------}
 927
 928 define int_instance [
 929 fn @1_add~inline(i1 i2 : @1) : @1
 930 [
 931         var r : @1;
 932         pcode BinaryOp Bin_Add =r 0 i1 0 i2;
 933         return r;
 934 ]
 935 fn @1_zero~inline : @1
 936 [
 937         var r : @1;
 938         pcode Load_Const =r 0;
 939         return r;
 940 ]
 941 fn @1_neg~inline(i1 : @1) : @1
 942 [
 943         var r : @1;
 944         pcode UnaryOp Un_Neg =r 0 i1;
 945         return r;
 946 ]
 947 fn @1_subtract~inline(i1 i2 : @1) : @1
 948 [
 949         var r : @1;
 950         pcode BinaryOp Bin_Subtract =r 0 i1 0 i2;
 951         return r;
 952 ]
 953 fn @1_multiply~inline(i1 i2 : @1) : @1
 954 [
 955         var r : @1;
 956         pcode BinaryOp Bin_Multiply =r 0 i1 0 i2;
 957         return r;
 958 ]
 959 fn @1_one~inline : @1
 960 [
 961         var r : @1;
 962         pcode Load_Const =r 1 1;
 963         return r;
 964 ]
 965 fn @1_div~inline(i1 i2 : @1) : @1
 966 [
 967         var r : @1;
 968         pcode BinaryOp Bin_Divide_Int =r 0 i1 0 i2;
 969         return r;
 970 ]
 971 fn @1_mod~inline(i1 i2 : @1) : @1
 972 [
 973         var r : @1;
 974         pcode BinaryOp Bin_Modulo =r 0 i1 0 i2;
 975         return r;
 976 ]
 977 fn @1_power~inline(i1 i2 : @1) : @1
 978 [
 979         var r : @1;
 980         pcode BinaryOp Bin_Power =r 0 i1 0 i2;
 981         return r;
 982 ]
 983 fn @1_and~inline(i1 i2 : @1) : @1
 984 [
 985         var r : @1;
 986         pcode BinaryOp Bin_And =r 0 i1 0 i2;
 987         return r;
 988 ]
 989 fn @1_or~inline(i1 i2 : @1) : @1
 990 [
 991         var r : @1;
 992         pcode BinaryOp Bin_Or =r 0 i1 0 i2;
 993         return r;
 994 ]
 995 fn @1_xor~inline(i1 i2 : @1) : @1
 996 [
 997         var r : @1;
 998         pcode BinaryOp Bin_Xor =r 0 i1 0 i2;
 999         return r;
1000 ]
1001 fn @1_shl~inline(i1 i2 : @1) : @1
1002 [
1003         var r : @1;
1004         pcode BinaryOp Bin_Shl =r 0 i1 0 i2;
1005         return r;
1006 ]
1007 fn @1_shr~inline(i1 i2 : @1) : @1
1008 [
1009         var r : @1;
1010         pcode BinaryOp Bin_Shr =r 0 i1 0 i2;
1011         return r;
1012 ]
1013 fn @1_bts~inline(i1 i2 : @1) : @1
1014 [
1015         var r : @1;
1016         pcode BinaryOp Bin_Bts =r 0 i1 0 i2;
1017         return r;
1018 ]
1019 fn @1_btr~inline(i1 i2 : @1) : @1
1020 [
1021         var r : @1;
1022         pcode BinaryOp Bin_Btr =r 0 i1 0 i2;
1023         return r;
1024 ]
1025 fn @1_btc~inline(i1 i2 : @1) : @1
1026 [
1027         var r : @1;
1028         pcode BinaryOp Bin_Btc =r 0 i1 0 i2;
1029         return r;
1030 ]
1031 fn @1_equal~inline(i1 i2 : @1) : bool
1032 [
1033         var r : bool;
1034         pcode BinaryOp Bin_Equal =r 0 i1 0 i2;
1035         return r;
1036 ]
1037 fn @1_less~inline(i1 i2 : @1) : bool
1038 [
1039         var r : bool;
1040         pcode BinaryOp Bin_Less =r 0 i1 0 i2;
1041         return r;
1042 ]
1043 fn @1_bt~inline(i1 i2 : @1) : bool
1044 [
1045         var r : bool;
1046         pcode BinaryOp Bin_Bt =r 0 i1 0 i2;
1047         return r;
1048 ]
1049 fn @1_not~inline(i1 : @1) : @1
1050 [
1051         var r : @1;
1052         pcode UnaryOp Un_Not =r 0 i1;
1053         return r;
1054 ]
1055 fn @1_bsf~inline(i1 : @1) : @1
1056 [
1057         var r : @1;
1058         pcode UnaryOp Un_Bsf =r 0 i1;
1059         return r;
1060 ]
1061 fn @1_bsr~inline(i1 : @1) : @1
1062 [
1063         var r : @1;
1064         pcode UnaryOp Un_Bsr =r 0 i1;
1065         return r;
1066 ]
1067 fn @1_popcnt~inline(i1 : @1) : @1
1068 [
1069         var r : @1;
1070         pcode UnaryOp Un_Popcnt =r 0 i1;
1071         return r;
1072 ]
1073 fn @1_to_int~inline(i1 : @1) : int
1074 [
1075         var r : int;
1076         pcode UnaryOp Un_ConvertToInt =r 0 i1;
1077         return r;
1078 ]
1079 fn @1_from_int~inline(i1 : int) : @1
1080 [
1081         var r : @1;
1082         pcode UnaryOp Un_ConvertFromInt =r 0 i1;
1083         return r;
1084 ]
1085 fn @1_to_bytes(i1 : @1) : bytes
1086 [
1087         return integer_to_bytes(@1_to_int(i1));
1088 ]
1089 fn @1_to_bytes_base(i1 : @1, base : int) : bytes
1090 [
1091         return integer_to_bytes_base(@1_to_int(i1), base);
1092 ]
1093 fn @1_from_bytes(i1 : bytes) : @1
1094 [
1095         return @1_from_int(bytes_to_integer(i1));
1096 ]
1097 fn @1_from_bytes_base(i1 : bytes, base : int) : @1
1098 [
1099         return @1_from_int(bytes_to_integer_base(i1, base));
1100 ]
1101 implicit fn instance_number_@1~inline : class_integer_number(@1) :=
1102         class_integer_number(@1).[
1103                 add : @1_add,
1104                 zero : @1_zero,
1105                 neg : @1_neg,
1106                 subtract : @1_subtract,
1107                 multiply : @1_multiply,
1108                 one : @1_one,
1109                 div : @1_div,
1110                 mod : @1_mod,
1111                 power : @1_power,
1112                 and : @1_and,
1113                 or : @1_or,
1114                 xor : @1_xor,
1115                 shl : @1_shl,
1116                 shr : @1_shr,
1117                 bts : @1_bts,
1118                 btr : @1_btr,
1119                 btc : @1_btc,
1120                 equal : @1_equal,
1121                 less : @1_less,
1122                 bt : @1_bt,
1123                 not : @1_not,
1124                 bsf : @1_bsf,
1125                 bsr : @1_bsr,
1126                 popcnt : @1_popcnt,
1127                 to_int : @1_to_int,
1128                 from_int : @1_from_int,
1129                 to_bytes : @1_to_bytes,
1130                 to_bytes_base : @1_to_bytes_base,
1131                 from_bytes : @1_from_bytes,
1132                 from_bytes_base : @1_from_bytes_base,
1133         ];
1134 ]
1135
1136 int_instance(int);
1137
1138 int_instance(int8);
1139 int_instance(int16);
1140 int_instance(int32);
1141 int_instance(int64);
1142 int_instance(int128);
1143
1144 {------------------
1145  - FIXED INSTANCE -
1146  ------------------}
1147
1148 define fixed_instance [
1149 fn @1_add~inline(i1 i2 : @1) : @1
1150 [
1151         var r : @1;
1152         pcode BinaryOp Bin_Add =r 0 i1 0 i2;
1153         return r;
1154 ]
1155 fn @1_zero~inline : @1
1156 [
1157         var r : @1;
1158         pcode Load_Const =r 0;
1159         return r;
1160 ]
1161 fn @1_neg~inline(i1 : @1) : @1
1162 [
1163         var r : @1;
1164         pcode UnaryOp Un_Neg =r 0 i1;
1165         return r;
1166 ]
1167 fn @1_subtract~inline(i1 i2 : @1) : @1
1168 [
1169         var r : @1;
1170         pcode BinaryOp Bin_Subtract =r 0 i1 0 i2;
1171         return r;
1172 ]
1173 fn @1_multiply~inline(i1 i2 : @1) : @1
1174 [
1175         var r : @1;
1176         pcode BinaryOp Bin_Multiply =r 0 i1 0 i2;
1177         return r;
1178 ]
1179 fn @1_one~inline : @1
1180 [
1181         var r : @1;
1182         pcode Load_Const =r 1 1;
1183         return r;
1184 ]
1185 fn @1_div~inline(i1 i2 : @1) : @1
1186 [
1187         var r : @1;
1188         pcode BinaryOp Bin_Divide_Int =r 0 i1 0 i2;
1189         return r;
1190 ]
1191 fn @1_mod~inline(i1 i2 : @1) : @1
1192 [
1193         var r : @1;
1194         pcode BinaryOp Bin_Modulo =r 0 i1 0 i2;
1195         return r;
1196 ]
1197 fn @1_power~inline(i1 i2 : @1) : @1
1198 [
1199         var r : @1;
1200         pcode BinaryOp Bin_Power =r 0 i1 0 i2;
1201         return r;
1202 ]
1203 fn @1_and~inline(i1 i2 : @1) : @1
1204 [
1205         var r : @1;
1206         pcode BinaryOp Bin_And =r 0 i1 0 i2;
1207         return r;
1208 ]
1209 fn @1_or~inline(i1 i2 : @1) : @1
1210 [
1211         var r : @1;
1212         pcode BinaryOp Bin_Or =r 0 i1 0 i2;
1213         return r;
1214 ]
1215 fn @1_xor~inline(i1 i2 : @1) : @1
1216 [
1217         var r : @1;
1218         pcode BinaryOp Bin_Xor =r 0 i1 0 i2;
1219         return r;
1220 ]
1221 fn @1_shl~inline(i1 i2 : @1) : @1
1222 [
1223         var r : @1;
1224         pcode BinaryOp Bin_Shl =r 0 i1 0 i2;
1225         return r;
1226 ]
1227 fn @1_shr~inline(i1 i2 : @1) : @1
1228 [
1229         var r : @1;
1230         pcode BinaryOp Bin_Shr =r 0 i1 0 i2;
1231         return r;
1232 ]
1233 fn @1_bts~inline(i1 i2 : @1) : @1
1234 [
1235         var r : @1;
1236         pcode BinaryOp Bin_Bts =r 0 i1 0 i2;
1237         return r;
1238 ]
1239 fn @1_btr~inline(i1 i2 : @1) : @1
1240 [
1241         var r : @1;
1242         pcode BinaryOp Bin_Btr =r 0 i1 0 i2;
1243         return r;
1244 ]
1245 fn @1_btc~inline(i1 i2 : @1) : @1
1246 [
1247         var r : @1;
1248         pcode BinaryOp Bin_Btc =r 0 i1 0 i2;
1249         return r;
1250 ]
1251 fn @1_equal~inline(i1 i2 : @1) : bool
1252 [
1253         var r : bool;
1254         pcode BinaryOp Bin_Equal =r 0 i1 0 i2;
1255         return r;
1256 ]
1257 fn @1_less~inline(i1 i2 : @1) : bool
1258 [
1259         var r : bool;
1260         pcode BinaryOp Bin_Less =r 0 i1 0 i2;
1261         return r;
1262 ]
1263 fn @1_bt~inline(i1 i2 : @1) : bool
1264 [
1265         var r : bool;
1266         pcode BinaryOp Bin_Bt =r 0 i1 0 i2;
1267         return r;
1268 ]
1269 fn @1_not~inline(i1 : @1) : @1
1270 [
1271         var r : @1;
1272         pcode UnaryOp Un_Not =r 0 i1;
1273         return r;
1274 ]
1275 fn @1_bsf~inline(i1 : @1) : @1
1276 [
1277         var r : @1;
1278         pcode UnaryOp Un_Bsf =r 0 i1;
1279         return r;
1280 ]
1281 fn @1_bsr~inline(i1 : @1) : @1
1282 [
1283         var r : @1;
1284         pcode UnaryOp Un_Bsr =r 0 i1;
1285         return r;
1286 ]
1287 fn @1_popcnt~inline(i1 : @1) : @1
1288 [
1289         var r : @1;
1290         pcode UnaryOp Un_Popcnt =r 0 i1;
1291         return r;
1292 ]
1293 fn @1_to_int~inline(i1 : @1) : int
1294 [
1295         var r : int;
1296         pcode UnaryOp Un_ConvertToInt =r 0 i1;
1297         return r;
1298 ]
1299 fn @1_from_int~inline(i1 : int) : @1
1300 [
1301         var r : @1;
1302         pcode UnaryOp Un_ConvertFromInt =r 0 i1;
1303         return r;
1304 ]
1305 fn @1_to_bytes(i1 : @1) : bytes
1306 [
1307         return integer_to_bytes(@1_to_int(i1));
1308 ]
1309 fn @1_to_bytes_base(i1 : @1, base : int) : bytes
1310 [
1311         return integer_to_bytes_base(@1_to_int(i1), base);
1312 ]
1313 fn @1_from_bytes(i1 : bytes) : @1
1314 [
1315         return @1_from_int(bytes_to_integer(i1));
1316 ]
1317 fn @1_from_bytes_base(i1 : bytes, base : int) : @1
1318 [
1319         return @1_from_int(bytes_to_integer_base(i1, base));
1320 ]
1321 fn @1_rol~inline(i1 i2 : @1) : @1
1322 [
1323         var r : @1;
1324         pcode BinaryOp Bin_Rol =r 0 i1 0 i2;
1325         return r;
1326 ]
1327 fn @1_ror~inline(i1 i2 : @1) : @1
1328 [
1329         var r : @1;
1330         pcode BinaryOp Bin_Ror =r 0 i1 0 i2;
1331         return r;
1332 ]
1333 fn @1_bswap~inline(i1 : @1) : @1
1334 [
1335         var r : @1;
1336         pcode UnaryOp Un_Bswap =r 0 i1;
1337         return r;
1338 ]
1339 fn @1_brev~inline(i1 : @1) : @1
1340 [
1341         var r : @1;
1342         pcode UnaryOp Un_Brev =r 0 i1;
1343         return r;
1344 ]
1345 implicit fn instance_fixed_integer_number_@1~inline : class_fixed_integer_number(@1) :=
1346         class_fixed_integer_number(@1).[
1347                 bits : @2,
1348                 unsigned : @3,
1349                 add : @1_add,
1350                 zero : @1_zero,
1351                 neg : @1_neg,
1352                 subtract : @1_subtract,
1353                 multiply : @1_multiply,
1354                 one : @1_one,
1355                 div : @1_div,
1356                 mod : @1_mod,
1357                 power : @1_power,
1358                 and : @1_and,
1359                 or : @1_or,
1360                 xor : @1_xor,
1361                 shl : @1_shl,
1362                 shr : @1_shr,
1363                 bts : @1_bts,
1364                 btr : @1_btr,
1365                 btc : @1_btc,
1366                 equal : @1_equal,
1367                 less : @1_less,
1368                 bt : @1_bt,
1369                 not : @1_not,
1370                 bsf : @1_bsf,
1371                 bsr : @1_bsr,
1372                 popcnt : @1_popcnt,
1373                 to_int : @1_to_int,
1374                 from_int : @1_from_int,
1375                 to_bytes : @1_to_bytes,
1376                 to_bytes_base : @1_to_bytes_base,
1377                 from_bytes : @1_from_bytes,
1378                 from_bytes_base : @1_from_bytes_base,
1379                 rol : @1_rol,
1380                 ror : @1_ror,
1381                 bswap : @1_bswap,
1382                 brev : @1_brev,
1383         ];
1384 ]
1385
1386 fixed_instance(sint8, 8, false);
1387 fixed_instance(sint16, 16, false);
1388 fixed_instance(sint32, 32, false);
1389 fixed_instance(sint64, 64, false);
1390 fixed_instance(sint128, 128, false);
1391 fixed_instance(uint8, 8, true);
1392 fixed_instance(uint16, 16, true);
1393 fixed_instance(uint32, 32, true);
1394 fixed_instance(uint64, 64, true);
1395 fixed_instance(uint128, 128, true);
1396
1397 type suint_base := int128;
1398 type sint(n : int) := suint_base;
1399 type uint(n : int) := suint_base;
1400
1401 fn fx_wrap~inline(n : int, i : suint_base) : suint_base := i and ((1 shl n) - 1);
1402 fn fx_unwrap~inline(n : int, uns : bool, i : suint_base) : suint_base
1403 [
1404         if uns or not i bt n - 1 then
1405                 return i;
1406         return i - (1 shl n);
1407 ]
1408 fn fx_mod_n~inline(n : int, i : suint_base) : suint_base
1409 [
1410         var r := i mod n;
1411         if r < 0 then
1412                 r += n;
1413         return r;
1414 ]
1415
1416 fn fx_add~inline(n : int, i1 i2 : suint_base) : suint_base := fx_wrap(n, i1 + i2);
1417 fn fx_neg~inline(n : int, i1 : suint_base) : suint_base := fx_wrap(n, -i1);
1418 fn fx_subtract~inline(n : int, i1 i2 : suint_base) : suint_base := fx_wrap(n, i1 - i2);
1419 fn fx_multiply~inline(n : int, i1 i2 : suint_base) : suint_base := fx_wrap(n, i1 * i2);
1420 fn fx_div~inline(n : int, uns : bool, i1 i2 : suint_base) : suint_base
1421 [
1422         i1 := fx_unwrap(n, uns, i1);
1423         i2 := fx_unwrap(n, uns, i2);
1424         if i2 = 0 then
1425                 return 0;
1426         return fx_wrap(n, i1 div i2);
1427 ]
1428 fn fx_mod~inline(n : int, uns : bool, i1 i2 : suint_base) : suint_base
1429 [
1430         i1 := fx_unwrap(n, uns, i1);
1431         i2 := fx_unwrap(n, uns, i2);
1432         if i2 = 0 then
1433                 return i1;
1434         return fx_wrap(n, i1 mod i2);
1435 ]
1436 fn fx_power~inline(n : int, uns : bool, i1 i2 : suint_base) : suint_base
1437 [
1438         var r := 1;
1439         while i2 <> 0 do [
1440                 if i2 bt 0 then
1441                         r := fx_wrap(n, r * i1);
1442                 i1 := fx_wrap(n, i1 * i1);
1443                 i2 shr= 1;
1444         ]
1445         return r;
1446 ]
1447 fn fx_and~inline(i1 i2 : suint_base) : suint_base := i1 and i2;
1448 fn fx_or~inline(i1 i2 : suint_base) : suint_base := i1 or i2;
1449 fn fx_xor~inline(i1 i2 : suint_base) : suint_base := i1 xor i2;
1450 fn fx_shl~inline(n : int, i1 i2 : suint_base) : suint_base := fx_wrap(n, i1 shl fx_mod_n(n, i2));
1451 fn fx_shr~inline(n : int, uns : bool, i1 i2 : suint_base) : suint_base := fx_wrap(n, fx_unwrap(n, uns, i1) shr fx_mod_n(n, i2));
1452 fn fx_bts~inline(n : int, i1 i2 : suint_base) : suint_base := i1 bts fx_mod_n(n, i2);
1453 fn fx_btr~inline(n : int, i1 i2 : suint_base) : suint_base := i1 btr fx_mod_n(n, i2);
1454 fn fx_btc~inline(n : int, i1 i2 : suint_base) : suint_base := i1 btc fx_mod_n(n, i2);
1455 fn fx_equal~inline(i1 i2 : suint_base) : bool := i1 = i2;
1456 fn fx_less~inline(n : int, uns : bool, i1 i2 : suint_base) : bool := fx_unwrap(n, uns, i1) < fx_unwrap(n, uns, i2);
1457 fn fx_bt~inline(n : int, i1 i2 : suint_base) : bool := i1 bt fx_mod_n(n, i2);
1458 fn fx_not~inline(n : int, i1 : suint_base) : suint_base := fx_wrap(n, not i1);
1459 fn fx_bsf~inline(n : int, i1 : suint_base) : suint_base
1460 [
1461         if i1 = 0 then
1462                 return (1 shl n) - 1;
1463         return bsf i1;
1464 ]
1465 fn fx_bsr~inline(n : int, i1 : suint_base) : suint_base
1466 [
1467         if i1 = 0 then
1468                 return (1 shl n) - 1;
1469         return bsr i1;
1470 ]
1471 fn fx_popcnt~inline(i1 : suint_base) : suint_base := popcnt i1;
1472 fn fx_to_int~inline(n : int, uns : bool, i1 : suint_base) : int := fx_unwrap(n, uns, i1);
1473 fn fx_from_int~inline(n : int, uns : bool, i1 : int) : suint_base
1474 [
1475         if uns then [
1476                 if i1 < 0 or i1 >= 1 shl n then
1477                         abort exception_make(suint_base, ec_sync, error_doesnt_fit, 0, true);
1478                 return i1;
1479         ] else [
1480                 if i1 < -(1 shl n - 1) or i1 >= 1 shl n - 1 then
1481                         abort exception_make(suint_base, ec_sync, error_doesnt_fit, 0, true);
1482                 return fx_wrap(n, i1);
1483         ]
1484 ]
1485 fn fx_to_bytes~inline(n : int, uns : bool, i1 : suint_base) : bytes := int_to_bytes(fx_unwrap(n, uns, i1));
1486 fn fx_to_bytes_base~inline(n : int, uns : bool, i1 : suint_base, base : int) : bytes := int_to_bytes_base(fx_unwrap(n, uns, i1), base);
1487 fn fx_from_bytes~inline(n : int, uns : bool, a1 : bytes) : suint_base := fx_from_int(n, uns, int_from_bytes(a1));
1488 fn fx_from_bytes_base~inline(n : int, uns : bool, a1 : bytes, base : int) : suint_base := fx_from_int(n, uns, int_from_bytes_base(a1, base));
1489 fn fx_rol~inline(n : int, i1 i2 : suint_base) : suint_base := fx_wrap(n, i1 shl fx_mod_n(n, i2) or i1 shr fx_mod_n(n, n - i2));
1490 fn fx_ror~inline(n : int, i1 i2 : suint_base) : suint_base := fx_wrap(n, i1 shr fx_mod_n(n, i2) or i1 shl fx_mod_n(n, n - i2));
1491 fn fx_bswap~inline(n : int, i1 : suint_base) : suint_base
1492 [
1493         n := n shr 3;
1494         var result := 0;
1495         for i := 0 to n do [
1496                 result or= (i1 shr (i * 8) and #ff) shl (n - 1 - i) * 8;
1497         ]
1498         return result;
1499 ]
1500 fn fx_brev~inline(n : int, i1 : suint_base) : suint_base
1501 [
1502         var result := 0;
1503         for i := 0 to n do [
1504                 result or= (i1 shr i and 1) shl (n - 1 - i);
1505         ]
1506         return result;
1507 ]
1508
1509 fn instance_fixed_integer_number_int~inline(n : int, uns : bool) : class_fixed_integer_number(suint_base) :=
1510         class_fixed_integer_number(suint_base).[
1511                 bits : n,
1512                 unsigned : uns,
1513                 add : fx_add(n,,),
1514                 zero : 0,
1515                 neg : fx_neg(n,),
1516                 subtract : fx_subtract(n,,),
1517                 multiply : fx_multiply(n,,),
1518                 one : 1,
1519                 div : fx_div(n, uns,,),
1520                 mod : fx_mod(n, uns,,),
1521                 power : fx_power(n, uns,,),
1522                 and : fx_and,
1523                 or : fx_or,
1524                 xor : fx_xor,
1525                 shl : fx_shl(n,,),
1526                 shr : fx_shr(n,uns,,),
1527                 bts : fx_bts(n,,),
1528                 btr : fx_btr(n,,),
1529                 btc : fx_btc(n,,),
1530                 equal : fx_equal,
1531                 less : fx_less(n, uns,,),
1532                 bt : fx_bt(n,,),
1533                 not : fx_not(n,),
1534                 bsf : fx_bsf(n,),
1535                 bsr : fx_bsr(n,),
1536                 popcnt : fx_popcnt,
1537                 to_int : fx_to_int(n, uns,),
1538                 from_int : fx_from_int(n, uns,),
1539                 to_bytes : fx_to_bytes(n, uns,),
1540                 to_bytes_base : fx_to_bytes_base(n, uns,,),
1541                 from_bytes : fx_from_bytes(n, uns,),
1542                 from_bytes_base : fx_from_bytes_base(n, uns,,),
1543                 rol : fx_rol(n,,),
1544                 ror : fx_ror(n,,),
1545                 bswap : fx_bswap(n,),
1546                 brev : fx_brev(n,),
1547         ];
1548
1549 implicit fn instance_fixed_integer_number_sint~inline(const n : int) : class_fixed_integer_number(sint(n)) := instance_fixed_integer_number_int(n, false);
1550 implicit fn instance_fixed_integer_number_uint~inline(const n : int) : class_fixed_integer_number(uint(n)) := instance_fixed_integer_number_int(n, true);
1551
1552 {-----------------
1553  - REAL INSTANCE -
1554  -----------------}
1555
1556 define real_instance [
1557 fn @1_add~inline(i1 i2 : @1) : @1
1558 [
1559         var r : @1;
1560         pcode BinaryOp Bin_Add =r 0 i1 0 i2;
1561         return r;
1562 ]
1563 fn @1_zero~inline : @1
1564 [
1565         var r : @1;
1566         var i : int := 0;
1567         pcode UnaryOp Un_ConvertFromInt =r 0 i;
1568         return r;
1569 ]
1570 fn @1_neg~inline(i1 : @1) : @1
1571 [
1572         var r : @1;
1573         pcode UnaryOp Un_Neg =r 0 i1;
1574         return r;
1575 ]
1576 fn @1_subtract~inline(i1 i2 : @1) : @1
1577 [
1578         var r : @1;
1579         pcode BinaryOp Bin_Subtract =r 0 i1 0 i2;
1580         return r;
1581 ]
1582 fn @1_multiply~inline(i1 i2 : @1) : @1
1583 [
1584         var r : @1;
1585         pcode BinaryOp Bin_Multiply =r 0 i1 0 i2;
1586         return r;
1587 ]
1588 fn @1_one~inline : @1
1589 [
1590         var r : @1;
1591         var i : int := 1;
1592         pcode UnaryOp Un_ConvertFromInt =r 0 i;
1593         return r;
1594 ]
1595 fn @1_recip~inline(i1 : @1) : @1
1596 [
1597         var r : @1;
1598         var i0 := @1_one;
1599         pcode BinaryOp Bin_Divide_Real =r 0 i0 0 i1;
1600         return r;
1601 ]
1602 fn @1_pi : @1
1603 [
1604         return #1.921fb54442d18469898cc51701b8p+1;
1605 ]
1606 fn @1_divide~inline(i1 i2 : @1) : @1
1607 [
1608         var r : @1;
1609         pcode BinaryOp Bin_Divide_Real =r 0 i1 0 i2;
1610         return r;
1611 ]
1612 fn @1_modulo~inline(i1 i2 : @1) : @1
1613 [
1614         var r : @1;
1615         pcode BinaryOp Bin_Modulo =r 0 i1 0 i2;
1616         return r;
1617 ]
1618 fn @1_power~inline(i1 i2 : @1) : @1
1619 [
1620         var r : @1;
1621         pcode BinaryOp Bin_Power =r 0 i1 0 i2;
1622         return r;
1623 ]
1624 fn @1_ldexp~inline(i1 i2 : @1) : @1
1625 [
1626         var r : @1;
1627         pcode BinaryOp Bin_Shl =r 0 i1 0 i2;
1628         return r;
1629 ]
1630 fn @1_atan2~inline(i1 i2 : @1) : @1
1631 [
1632         var r : @1;
1633         pcode BinaryOp Bin_Atan2 =r 0 i1 0 i2;
1634         return r;
1635 ]
1636 fn @1_sqrt~inline(i1 : @1) : @1
1637 [
1638         var r : @1;
1639         pcode UnaryOp Un_Sqrt =r 0 i1;
1640         return r;
1641 ]
1642 fn @1_cbrt~inline(i1 : @1) : @1
1643 [
1644         var r : @1;
1645         pcode UnaryOp Un_Cbrt =r 0 i1;
1646         return r;
1647 ]
1648 fn @1_sin~inline(i1 : @1) : @1
1649 [
1650         var r : @1;
1651         pcode UnaryOp Un_Sin =r 0 i1;
1652         return r;
1653 ]
1654 fn @1_cos~inline(i1 : @1) : @1
1655 [
1656         var r : @1;
1657         pcode UnaryOp Un_Cos =r 0 i1;
1658         return r;
1659 ]
1660 fn @1_tan~inline(i1 : @1) : @1
1661 [
1662         var r : @1;
1663         pcode UnaryOp Un_Tan =r 0 i1;
1664         return r;
1665 ]
1666 fn @1_asin~inline(i1 : @1) : @1
1667 [
1668         var r : @1;
1669         pcode UnaryOp Un_Asin =r 0 i1;
1670         return r;
1671 ]
1672 fn @1_acos~inline(i1 : @1) : @1
1673 [
1674         var r : @1;
1675         pcode UnaryOp Un_Acos =r 0 i1;
1676         return r;
1677 ]
1678 fn @1_atan~inline(i1 : @1) : @1
1679 [
1680         var r : @1;
1681         pcode UnaryOp Un_Atan =r 0 i1;
1682         return r;
1683 ]
1684 fn @1_sinh~inline(i1 : @1) : @1
1685 [
1686         var r : @1;
1687         pcode UnaryOp Un_Sinh =r 0 i1;
1688         return r;
1689 ]
1690 fn @1_cosh~inline(i1 : @1) : @1
1691 [
1692         var r : @1;
1693         pcode UnaryOp Un_Cosh =r 0 i1;
1694         return r;
1695 ]
1696 fn @1_tanh~inline(i1 : @1) : @1
1697 [
1698         var r : @1;
1699         pcode UnaryOp Un_Tanh =r 0 i1;
1700         return r;
1701 ]
1702 fn @1_asinh~inline(i1 : @1) : @1
1703 [
1704         var r : @1;
1705         pcode UnaryOp Un_Asinh =r 0 i1;
1706         return r;
1707 ]
1708 fn @1_acosh~inline(i1 : @1) : @1
1709 [
1710         var r : @1;
1711         pcode UnaryOp Un_Acosh =r 0 i1;
1712         return r;
1713 ]
1714 fn @1_atanh~inline(i1 : @1) : @1
1715 [
1716         var r : @1;
1717         pcode UnaryOp Un_Atanh =r 0 i1;
1718         return r;
1719 ]
1720 fn @1_exp2~inline(i1 : @1) : @1
1721 [
1722         var r : @1;
1723         pcode UnaryOp Un_Exp2 =r 0 i1;
1724         return r;
1725 ]
1726 fn @1_exp~inline(i1 : @1) : @1
1727 [
1728         var r : @1;
1729         pcode UnaryOp Un_Exp =r 0 i1;
1730         return r;
1731 ]
1732 fn @1_exp10~inline(i1 : @1) : @1
1733 [
1734         var r : @1;
1735         pcode UnaryOp Un_Exp10 =r 0 i1;
1736         return r;
1737 ]
1738 fn @1_log2~inline(i1 : @1) : @1
1739 [
1740         var r : @1;
1741         pcode UnaryOp Un_Log2 =r 0 i1;
1742         return r;
1743 ]
1744 fn @1_log~inline(i1 : @1) : @1
1745 [
1746         var r : @1;
1747         pcode UnaryOp Un_Log =r 0 i1;
1748         return r;
1749 ]
1750 fn @1_log10~inline(i1 : @1) : @1
1751 [
1752         var r : @1;
1753         pcode UnaryOp Un_Log10 =r 0 i1;
1754         return r;
1755 ]
1756 fn @1_round~inline(i1 : @1) : @1
1757 [
1758         var r : @1;
1759         pcode UnaryOp Un_Round =r 0 i1;
1760         return r;
1761 ]
1762 fn @1_ceil~inline(i1 : @1) : @1
1763 [
1764         var r : @1;
1765         pcode UnaryOp Un_Ceil =r 0 i1;
1766         return r;
1767 ]
1768 fn @1_floor~inline(i1 : @1) : @1
1769 [
1770         var r : @1;
1771         pcode UnaryOp Un_Floor =r 0 i1;
1772         return r;
1773 ]
1774 fn @1_trunc~inline(i1 : @1) : @1
1775 [
1776         var r : @1;
1777         pcode UnaryOp Un_Trunc =r 0 i1;
1778         return r;
1779 ]
1780 fn @1_fract~inline(i1 : @1) : @1
1781 [
1782         var r : @1;
1783         pcode UnaryOp Un_Fract =r 0 i1;
1784         return r;
1785 ]
1786 fn @1_mantissa~inline(i1 : @1) : @1
1787 [
1788         var r : @1;
1789         pcode UnaryOp Un_Mantissa =r 0 i1;
1790         return r;
1791 ]
1792 fn @1_exponent~inline(i1 : @1) : @1
1793 [
1794         var r : @1;
1795         pcode UnaryOp Un_Exponent =r 0 i1;
1796         return r;
1797 ]
1798 fn @1_next_number~inline(i1 : @1) : @1
1799 [
1800         var r : @1;
1801         pcode UnaryOp Un_NextNumber =r 0 i1;
1802         return r;
1803 ]
1804 fn @1_prev_number~inline(i1 : @1) : @1
1805 [
1806         var r : @1;
1807         pcode UnaryOp Un_PrevNumber =r 0 i1;
1808         return r;
1809 ]
1810 fn @1_is_negative~inline(i1 : @1) : bool
1811 [
1812         if i1 <> 0 then
1813                 return i1 < 0;
1814         else
1815                 return @1_recip(i1) < 0;
1816 ]
1817 fn @1_is_infinity~inline(i1 : @1) : bool
1818 [
1819         return i1 <> 0 and i1 + i1 = i1;
1820 ]
1821 fn @1_equal~inline(i1 i2 : @1) : bool
1822 [
1823         var r : bool;
1824         pcode BinaryOp Bin_Equal =r 0 i1 0 i2;
1825         return r;
1826 ]
1827 fn @1_less~inline(i1 i2 : @1) : bool
1828 [
1829         var r : bool;
1830         pcode BinaryOp Bin_Less =r 0 i1 0 i2;
1831         return r;
1832 ]
1833 fn @1_to_int~inline(i1 : @1) : int
1834 [
1835         var r : int;
1836         pcode UnaryOp Un_ConvertToInt =r 0 i1;
1837         return r;
1838 ]
1839 fn @1_from_int~inline(i1 : int) : @1
1840 [
1841         var r : @1;
1842         pcode UnaryOp Un_ConvertFromInt =r 0 i1;
1843         return r;
1844 ]
1845 fn @1_to_rational(i1 : @1) : rational
1846 [
1847         return real_to_rational~inline(@1, instance_real_number_@1, i1);
1848 ]
1849 fn @1_from_rational(i1 : rational) : @1
1850 [
1851         return rational_to_real~inline(@1, instance_real_number_@1, i1);
1852 ]
1853 fn @1_to_bytes(i1 : @1) : bytes
1854 [
1855         return real_to_bytes~inline(@1, instance_real_number_@1, i1);
1856 ]
1857 fn @1_to_bytes_base_precision(i1 : @1, b : int, digits : int) : bytes
1858 [
1859         return real_to_bytes_base_precision~inline(@1, instance_real_number_@1, i1, b, digits);
1860 ]
1861 fn @1_from_bytes(a1 : bytes) : @1
1862 [
1863         return bytes_to_real~inline(@1, instance_real_number_@1, a1);
1864 ]
1865 fn @1_from_bytes_base(a1 : bytes, b : int) : @1
1866 [
1867         return bytes_to_real_base~inline(@1, instance_real_number_@1, a1, b);
1868 ]
1869 implicit fn instance_real_number_@1~inline : class_real_number(@1) :=
1870         class_real_number(@1).[
1871                 add : @1_add,
1872                 zero : @1_zero,
1873                 neg : @1_neg,
1874                 subtract : @1_subtract,
1875                 multiply : @1_multiply,
1876                 one : @1_one,
1877                 recip : @1_recip,
1878                 divide : @1_divide,
1879                 modulo : @1_modulo,
1880                 power : @1_power,
1881                 ldexp : @1_ldexp,
1882                 atan2 : @1_atan2,
1883                 pi : @1_pi~lazy,
1884                 sqrt : @1_sqrt,
1885                 cbrt : @1_cbrt,
1886                 sin : @1_sin,
1887                 cos : @1_cos,
1888                 tan : @1_tan,
1889                 asin : @1_asin,
1890                 acos : @1_acos,
1891                 atan : @1_atan,
1892                 sinh : @1_sinh,
1893                 cosh : @1_cosh,
1894                 tanh : @1_tanh,
1895                 asinh : @1_asinh,
1896                 acosh : @1_acosh,
1897                 atanh : @1_atanh,
1898                 exp2 : @1_exp2,
1899                 exp : @1_exp,
1900                 exp10 : @1_exp10,
1901                 log2 : @1_log2,
1902                 log : @1_log,
1903                 log10 : @1_log10,
1904                 round : @1_round,
1905                 ceil : @1_ceil,
1906                 floor : @1_floor,
1907                 trunc : @1_trunc,
1908                 fract : @1_fract,
1909                 mantissa : @1_mantissa,
1910                 exponent : @1_exponent,
1911                 next_number : @1_next_number,
1912                 prev_number : @1_prev_number,
1913                 is_negative : @1_is_negative,
1914                 is_infinity : @1_is_infinity,
1915                 equal : @1_equal,
1916                 less : @1_less,
1917                 to_int : @1_to_int,
1918                 from_int : @1_from_int,
1919                 to_rational : @1_to_rational,
1920                 from_rational : @1_from_rational,
1921                 to_bytes : @1_to_bytes,
1922                 to_bytes_base_precision : @1_to_bytes_base_precision,
1923                 from_bytes : @1_from_bytes,
1924                 from_bytes_base : @1_from_bytes_base,
1925         ];
1926 ]
1927
1928 real_instance(real16);
1929 real_instance(real32);
1930 real_instance(real64);
1931 real_instance(real80);
1932 real_instance(real128);
1933
1934 {---------------------
1935  - FLOATING INSTANCE -
1936  ---------------------}
1937
1938 fn floating_ex~inline(ex_bits : int) : int := ex_bits + 2;
1939 fn floating_sig~inline(sig_bits : int) : int := sig_bits + 8;
1940
1941 fn floating_modulo(const ex_bits sig_bits : int, x1 x2 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
1942 [
1943         return math_modulo(floating(ex_bits, sig_bits), instance_real_number_floating(ex_bits, sig_bits), x1, x2);
1944 ]
1945
1946 fn floating_power(const ex_bits sig_bits : int, x1 x2 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
1947 [
1948         return math_power(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1, x2);
1949 ]
1950
1951 // we must not call math_ldexp for integer arguments, otherwise there would be
1952 // infinite recursion; the reason is that we use ldexp in real_to_rational and
1953 // rational_to_real
1954 // warning: this logic is duplicated in math_ldexp
1955 fn floating_ldexp(const ex_bits sig_bits : int, x y : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
1956 [
1957         xeval x, y;
1958         var yi : int := y;
1959         if not is_exception yi, y = yi then [
1960                 if is_infinity x then
1961                         return x;
1962                 var q : floating(ex_bits, sig_bits) := 1 shl abs(yi);
1963                 if is_infinity q then [
1964                         var y1 := yi div 2;
1965                         var y2 := yi - y1;
1966                         x := floating_ldexp(x, y1);
1967                         x := floating_ldexp(x, y2);
1968                         return x;
1969                 ]
1970                 if yi >= 0 then
1971                         x *= q;
1972                 else
1973                         x /= q;
1974                 return x;
1975         ]
1976         return math_ldexp(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x, y);
1977 ]
1978
1979 fn floating_atan2(const ex_bits sig_bits : int, x1 x2 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
1980 [
1981         return math_atan2(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1, x2);
1982 ]
1983
1984 fn floating_pi(const ex_bits sig_bits : int) : floating(ex_bits, sig_bits)
1985 [
1986         return math_pi(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)));
1987 ]
1988
1989 fn floating_sqrt(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
1990 [
1991         return math_sqrt(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
1992 ]
1993
1994 fn floating_cbrt(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
1995 [
1996         return math_cbrt(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
1997 ]
1998
1999 fn floating_sin(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2000 [
2001         return math_sin(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2002 ]
2003
2004 fn floating_cos(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2005 [
2006         return math_cos(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2007 ]
2008
2009 fn floating_tan(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2010 [
2011         return math_tan(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2012 ]
2013
2014 fn floating_asin(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2015 [
2016         return math_asin(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2017 ]
2018
2019 fn floating_acos(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2020 [
2021         return math_acos(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2022 ]
2023
2024 fn floating_atan(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2025 [
2026         return math_atan(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2027 ]
2028
2029 fn floating_sinh(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2030 [
2031         return math_sinh(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2032 ]
2033
2034 fn floating_cosh(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2035 [
2036         return math_cosh(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2037 ]
2038
2039 fn floating_tanh(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2040 [
2041         return math_tanh(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2042 ]
2043
2044 fn floating_asinh(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2045 [
2046         return math_asinh(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2047 ]
2048
2049 fn floating_acosh(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2050 [
2051         return math_acosh(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2052 ]
2053
2054 fn floating_atanh(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2055 [
2056         return math_atanh(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2057 ]
2058
2059 fn floating_exp2(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2060 [
2061         return math_exp2(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2062 ]
2063
2064 fn floating_exp(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2065 [
2066         return math_exp(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2067 ]
2068
2069 fn floating_exp10(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2070 [
2071         return math_exp10(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2072 ]
2073
2074 fn floating_log2(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2075 [
2076         return math_log2(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2077 ]
2078
2079 fn floating_log(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2080 [
2081         return math_log(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2082 ]
2083
2084 fn floating_log10(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2085 [
2086         return math_log10(floating(floating_ex(ex_bits), floating_sig(sig_bits)), instance_real_number_floating(floating_ex(ex_bits), floating_sig(sig_bits)), x1);
2087 ]
2088
2089 fn floating_round(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2090 [
2091         return math_round(floating(ex_bits, sig_bits), instance_real_number_floating(ex_bits, sig_bits), x1);
2092 ]
2093
2094 fn floating_ceil(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2095 [
2096         return math_ceil(floating(ex_bits, sig_bits), instance_real_number_floating(ex_bits, sig_bits), x1);
2097 ]
2098
2099 fn floating_floor(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2100 [
2101         return math_floor(floating(ex_bits, sig_bits), instance_real_number_floating(ex_bits, sig_bits), x1);
2102 ]
2103
2104 fn floating_trunc(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2105 [
2106         return math_trunc(floating(ex_bits, sig_bits), instance_real_number_floating(ex_bits, sig_bits), x1);
2107 ]
2108
2109 fn floating_fract(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2110 [
2111         return math_fract(floating(ex_bits, sig_bits), instance_real_number_floating(ex_bits, sig_bits), x1);
2112 ]
2113
2114 fn floating_mantissa(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2115 [
2116         return math_mantissa(floating(ex_bits, sig_bits), instance_real_number_floating(ex_bits, sig_bits), x1);
2117 ]
2118
2119 fn floating_exponent(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2120 [
2121         return math_exponent(floating(ex_bits, sig_bits), instance_real_number_floating(ex_bits, sig_bits), x1);
2122 ]
2123
2124 type floating_base := int128;
2125 type sig_type := int128;
2126
2127 type floating(ex_bits sig_bits : int) := floating_base;
2128
2129 private fn floating_internal(const ex_bits sig_bits : int, f : floating(ex_bits, sig_bits)) : int
2130 [
2131         var fb : floating_base := f;
2132         return fb;
2133 ]
2134
2135 fn floating_divide(ex_bits sig_bits : int, x1 x2 : floating_base) : floating_base;
2136 fn floating_equal(ex_bits sig_bits : int, x1 x2 : floating_base) : bool;
2137 fn floating_less(ex_bits sig_bits : int, x1 x2 : floating_base) : bool;
2138 fn floating_to_int(ex_bits sig_bits : int, x1 : floating_base) : int;
2139 fn floating_from_int(ex_bits sig_bits : int, i1 : int) : floating_base;
2140 fn floating_to_bytes(const ex_bits sig_bits : int, x1 : floating_base) : bytes;
2141
2142 fn min_exp(ex_bits sig_bits : int) : int
2143 [
2144         if ex_bits > 19 then
2145                 ex_bits := 19;
2146         return -(1 shl ex_bits - 1) - sig_bits + 3;
2147 ]
2148
2149 fn max_exp(ex_bits sig_bits : int) : int
2150 [
2151         if ex_bits > 19 then
2152                 ex_bits := 19;
2153         //return min_exp(ex_bits, sig_bits) + (1 shl ex_bits) - 1;
2154         return (1 shl ex_bits - 1) - sig_bits + 1;
2155 ]
2156
2157 fn infinity_sig(ex_bits sig_bits : int) : floating_base
2158 [
2159         var one : sig_type := 1;
2160         return one shl sig_bits - 1;
2161 ]
2162
2163 fn pack(ex_bits sig_bits : int, neg : bool, e : int, s : sig_type) : floating_base
2164 [
2165         //eval debug("pack: " + ntos_base(e, 16) + ", " + ntos_base(s, 16) + ", " + ntos(select(neg, 0, 1)));
2166         var min_e := min_exp(ex_bits, sig_bits);
2167         if s = 0 then [
2168                 e := min_e;
2169         ] else [
2170                 var sb : int := (bsr s) + 1;
2171                 if sb < sig_bits then [
2172                         s shl= sig_bits - sb;
2173                         e -= sig_bits - sb;
2174                         sb := sig_bits;
2175                 ]
2176                 if e + sb - sig_bits < min_e then [
2177                         sb += min_e - (e + sb - sig_bits);
2178                 ]
2179                 var one : sig_type := 1;
2180                 var rnd := s and (one shl sb - sig_bits) - 1;
2181                 var bnd := one shl sb - sig_bits shr 1;
2182                 s shr= sb - sig_bits;
2183                 e += sb - sig_bits;
2184                 if bnd <> 0, rnd > bnd or rnd = bnd and s bt 0 then [
2185                         s += 1;
2186                         var nsb : int := (bsr s) + 1;
2187                         if nsb > sig_bits then [
2188                                 s shr= 1;
2189                                 e += 1;
2190                         ]
2191                 ]
2192                 if e >= max_exp(ex_bits, sig_bits) then [
2193                         e := max_exp(ex_bits, sig_bits);
2194                         s := infinity_sig(ex_bits, sig_bits);
2195                 ]
2196         ]
2197         if neg then
2198                 s bts= sig_bits;
2199         var ee : sig_type := e;
2200         s or= ee shl sig_bits + 1;
2201         //eval debug("result: " + ntos_base(s and #fffffffff, 16));
2202         return s;
2203 ]
2204
2205 fn unpack(ex_bits sig_bits : int, f : floating_base) : (bool, int, sig_type)
2206 [
2207         //eval debug("unpack: " + ntos_base(f and #fffffffff, 16));
2208         var neg := f bt sig_bits;
2209         var e : int := f shr sig_bits + 1;
2210         var one : sig_type := 1;
2211         var s : sig_type := f and (one shl sig_bits) - 1;
2212         //eval debug("result: " + ntos_base(e, 16) + ", " + ntos_base(s, 16) + ", " + ntos(select(neg, 0, 1)));
2213         return neg, e, s;
2214 ]
2215
2216 fn floating_zero(ex_bits sig_bits : int) : floating_base
2217 [
2218         //eval debug("zero");
2219         return pack(ex_bits, sig_bits, false, 0, 0);
2220 ]
2221
2222 fn floating_one(ex_bits sig_bits : int) : floating_base
2223 [
2224         //eval debug("one");
2225         return pack(ex_bits, sig_bits, false, 0, 1);
2226 ]
2227
2228 fn floating_neg(ex_bits sig_bits : int, x1 : floating_base) : floating_base
2229 [
2230         return x1 btc sig_bits;
2231 ]
2232
2233 fn floating_add(ex_bits sig_bits : int, x1 x2 : floating_base) : floating_base
2234 [
2235         var neg1, e1, s1 := unpack(ex_bits, sig_bits, x1);
2236         var neg2, e2, s2 := unpack(ex_bits, sig_bits, x2);
2237         if e1 > e2 or (e1 = e2 and s1 > s2) then [
2238                 neg1, neg2 := neg2, neg1;
2239                 e1, e2 := e2, e1;
2240                 s1, s2 := s2, s1;
2241         ]
2242         if e2 = max_exp(ex_bits, sig_bits) then [
2243                 if e1 = max_exp(ex_bits, sig_bits), neg1 <> neg2 then
2244                         abort exception_make(floating_base, ec_sync, error_nan, 0, true);
2245         ] else if e2 - e1 <= sig_bits + 1 then [
2246                 s2 shl= e2 - e1;
2247                 e2 := e1;
2248                 if neg1 <> neg2 then [
2249                         s2 -= s1;
2250                 ] else [
2251                         s2 += s1;
2252                 ]
2253         ]
2254         if s2 = 0 then
2255                 neg2 and= neg1;
2256         return pack(ex_bits, sig_bits, neg2, e2, s2);
2257 ]
2258
2259 fn floating_subtract(ex_bits sig_bits : int, x1 x2 : floating_base) : floating_base
2260 [
2261         return floating_add(ex_bits, sig_bits, x1, floating_neg(ex_bits, sig_bits, x2));
2262 ]
2263
2264 fn floating_multiply(ex_bits sig_bits : int, x1 x2 : floating_base) : floating_base
2265 [
2266         var neg1, e1, s1 := unpack(ex_bits, sig_bits, x1);
2267         var neg2, e2, s2 := unpack(ex_bits, sig_bits, x2);
2268         if e1 = max_exp(ex_bits, sig_bits) then [
2269                 if s2 = 0 then
2270                         abort exception_make(floating_base, ec_sync, error_nan, 0, true);
2271                 return pack(ex_bits, sig_bits, neg1 xor neg2, e1, s1);
2272         ]
2273         if e2 = max_exp(ex_bits, sig_bits) then [
2274                 if s1 = 0 then
2275                         abort exception_make(floating_base, ec_sync, error_nan, 0, true);
2276                 return pack(ex_bits, sig_bits, neg1 xor neg2, e2, s2);
2277         ]
2278         e1 += e2;
2279         s1 *= s2;
2280         return pack(ex_bits, sig_bits, neg1 xor neg2, e1, s1);
2281 ]
2282
2283 fn floating_recip(ex_bits sig_bits : int, x1 : floating_base) : floating_base
2284 [
2285         return floating_divide(ex_bits, sig_bits, floating_one(ex_bits, sig_bits), x1);
2286 ]
2287
2288 fn floating_divide(ex_bits sig_bits : int, x1 x2 : floating_base) : floating_base
2289 [
2290         var neg1, e1, s1 := unpack(ex_bits, sig_bits, x1);
2291         var neg2, e2, s2 := unpack(ex_bits, sig_bits, x2);
2292         if e1 = max_exp(ex_bits, sig_bits) then [
2293                 if e2 = max_exp(ex_bits, sig_bits) then
2294                         abort exception_make(floating_base, ec_sync, error_nan, 0, true);
2295                 return pack(ex_bits, sig_bits, neg1 xor neg2, e1, s1);
2296         ]
2297         if e2 = max_exp(ex_bits, sig_bits) then [
2298                 return pack(ex_bits, sig_bits, neg1 xor neg2, 0, 0);
2299         ]
2300         if s2 = 0 then [
2301                 if s1 = 0 then
2302                         abort exception_make(floating_base, ec_sync, error_nan, 0, true);
2303                 return pack(ex_bits, sig_bits, neg1 xor neg2, max_exp(ex_bits, sig_bits), infinity_sig(ex_bits, sig_bits));
2304         ]
2305         s1 shl= sig_bits * 3;
2306         e1 -= sig_bits * 3;
2307         e1 -= e2;
2308         s1 div= s2;
2309         return pack(ex_bits, sig_bits, neg1 xor neg2, e1, s1);
2310 ]
2311
2312 fn floating_next_number(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2313 [
2314         var neg1, e1, s1 := unpack(ex_bits, sig_bits, x1);
2315         if s1 = 0 then
2316                 return pack(ex_bits, sig_bits, false, e1, 1);
2317         var s2 := s1 + select(neg1, 1, -1);
2318         if s2 < s1 and s1 = infinity_sig(ex_bits, sig_bits) then [
2319                 s2 := s2 shl 1 or 1;
2320                 e1 -= 1;
2321         ]
2322         var x2 := pack(ex_bits, sig_bits, neg1, e1, s2);
2323         if x1 = x2 then
2324                 return pack(ex_bits, sig_bits, neg1, e1, s2 + select(neg1, 1, -1));
2325         return x2;
2326 ]
2327
2328 fn floating_prev_number(const ex_bits sig_bits : int, x1 : floating(ex_bits, sig_bits)) : floating(ex_bits, sig_bits)
2329 [
2330         var neg1, e1, s1 := unpack(ex_bits, sig_bits, x1);
2331         if s1 = 0 then
2332                 return pack(ex_bits, sig_bits, true, e1, 1);
2333         var s2 := s1 + select(neg1, -1, 1);
2334         if s2 < s1 and s1 = infinity_sig(ex_bits, sig_bits) then [
2335                 s2 := s2 shl 1 or 1;
2336                 e1 -= 1;
2337         ]
2338         var x2 := pack(ex_bits, sig_bits, neg1, e1, s2);
2339         if x1 = x2 then
2340                 return pack(ex_bits, sig_bits, neg1, e1, s2 + select(neg1, -1, 1));
2341         return x2;
2342 ]
2343
2344 fn floating_is_negative(ex_bits sig_bits : int, x1 : floating_base) : bool
2345 [
2346         return x1 bt sig_bits;
2347 ]
2348
2349 fn floating_is_infinity(ex_bits sig_bits : int, x1 : floating_base) : bool
2350 [
2351         var neg1, e1, s1 := unpack(ex_bits, sig_bits, x1);
2352         return e1 = max_exp(ex_bits, sig_bits);
2353 ]
2354
2355 fn floating_equal(ex_bits sig_bits : int, x1 x2 : floating_base) : bool
2356 [
2357         var neg1, e1, s1 := unpack(ex_bits, sig_bits, x1);
2358         var neg2, e2, s2 := unpack(ex_bits, sig_bits, x2);
2359         if s1 = 0, s2 = 0 then
2360                 return true;
2361         return x1 = x2;
2362 ]
2363
2364 fn floating_less(ex_bits sig_bits : int, x1 x2 : floating_base) : bool
2365 [
2366         var neg1, e1, s1 := unpack(ex_bits, sig_bits, x1);
2367         var neg2, e2, s2 := unpack(ex_bits, sig_bits, x2);
2368         if s1 = 0, s2 = 0 then
2369                 return false;
2370         if neg1 <> neg2 then
2371                 return neg1;
2372         if neg1 then
2373                 e1, e2, s1, s2 := e2, e1, s2, s1;
2374         if e1 <> e2 then
2375                 return e1 < e2;
2376         return s1 < s2;
2377 ]
2378
2379 fn floating_to_int(ex_bits sig_bits : int, x1 : floating_base) : int
2380 [
2381         var neg1, e1, s1 := unpack(ex_bits, sig_bits, x1);
2382         if e1 = max_exp(ex_bits, sig_bits) then
2383                 abort exception_make(int, ec_sync, error_infinity, 0, true);
2384         if e1 < 0 then
2385                 s1 shr= -e1;
2386         else
2387                 s1 shl= e1;
2388         if neg1 then
2389                 s1 := -s1;
2390         //eval debug("to_int result: " + ntos(s1));
2391         return s1;
2392 ]
2393
2394 fn floating_from_int(ex_bits sig_bits : int, i1 : int) : floating_base
2395 [
2396         var neg := false;
2397         if i1 < 0 then [
2398                 neg := true;
2399                 i1 := -i1;
2400         ]
2401         return pack(ex_bits, sig_bits, neg, 0, i1);
2402 ]
2403
2404 fn floating_to_rational(const ex_bits sig_bits : int, x1 : floating_base) : rational
2405 [
2406         return real_to_rational(floating(ex_bits, sig_bits), instance_real_number_floating(ex_bits, sig_bits), x1);
2407 ]
2408
2409 fn floating_from_rational(const ex_bits sig_bits : int, i1 : rational) : floating_base
2410 [
2411         return rational_to_real(floating(ex_bits, sig_bits), instance_real_number_floating(ex_bits, sig_bits), i1);
2412 ]
2413
2414 fn floating_to_bytes(const ex_bits sig_bits : int, x1 : floating_base) : bytes
2415 [
2416         return real_to_bytes(floating(ex_bits, sig_bits), instance_real_number_floating(ex_bits, sig_bits), x1);
2417 ]
2418
2419 fn floating_to_bytes_base_precision(const ex_bits sig_bits : int, x1 : floating_base, b : int, digits : int) : bytes
2420 [
2421         return real_to_bytes_base_precision(floating(ex_bits, sig_bits), instance_real_number_floating(ex_bits, sig_bits), x1, b, digits);
2422 ]
2423
2424 fn floating_from_bytes(const ex_bits sig_bits : int, a1 : bytes) : floating_base
2425 [
2426         return bytes_to_real(floating(ex_bits, sig_bits), instance_real_number_floating(ex_bits, sig_bits), a1);
2427 ]
2428
2429 fn floating_from_bytes_base(const ex_bits sig_bits : int, a1 : bytes, b : int) : floating_base
2430 [
2431         return bytes_to_real_base(floating(ex_bits, sig_bits), instance_real_number_floating(ex_bits, sig_bits), a1, b);
2432 ]
2433
2434 implicit fn instance_real_number_floating~inline(const ex_bits sig_bits : int) : class_real_number(floating(ex_bits, sig_bits)) :=
2435         class_real_number(floating(ex_bits, sig_bits)).[
2436                 add : floating_add(ex_bits, sig_bits,,),
2437                 zero : floating_zero(ex_bits, sig_bits),
2438                 neg : floating_neg(ex_bits, sig_bits,),
2439                 subtract : floating_subtract(ex_bits, sig_bits,,),
2440                 multiply : floating_multiply(ex_bits, sig_bits,,),
2441                 one : floating_one(ex_bits, sig_bits),
2442                 recip : floating_recip(ex_bits, sig_bits,),
2443                 divide : floating_divide(ex_bits, sig_bits,,),
2444                 modulo : floating_modulo(ex_bits, sig_bits,,),
2445                 power : floating_power(ex_bits, sig_bits,,),
2446                 ldexp : floating_ldexp(ex_bits, sig_bits,,),
2447                 atan2 : floating_atan2(ex_bits, sig_bits,,),
2448                 pi : floating_pi~lazy(ex_bits, sig_bits),
2449                 sqrt : floating_sqrt(ex_bits, sig_bits,),
2450                 cbrt : floating_cbrt(ex_bits, sig_bits,),
2451                 sin : floating_sin(ex_bits, sig_bits,),
2452                 cos : floating_cos(ex_bits, sig_bits,),
2453                 tan : floating_tan(ex_bits, sig_bits,),
2454                 asin : floating_asin(ex_bits, sig_bits,),
2455                 acos : floating_acos(ex_bits, sig_bits,),
2456                 atan : floating_atan(ex_bits, sig_bits,),
2457                 sinh : floating_sinh(ex_bits, sig_bits,),
2458                 cosh : floating_cosh(ex_bits, sig_bits,),
2459                 tanh : floating_tanh(ex_bits, sig_bits,),
2460                 asinh : floating_asinh(ex_bits, sig_bits,),
2461                 acosh : floating_acosh(ex_bits, sig_bits,),
2462                 atanh : floating_atanh(ex_bits, sig_bits,),
2463                 exp2 : floating_exp2(ex_bits, sig_bits,),
2464                 exp : floating_exp(ex_bits, sig_bits,),
2465                 exp10 : floating_exp10(ex_bits, sig_bits,),
2466                 log2 : floating_log2(ex_bits, sig_bits,),
2467                 log : floating_log(ex_bits, sig_bits,),
2468                 log10 : floating_log10(ex_bits, sig_bits,),
2469                 round : floating_round(ex_bits, sig_bits,),
2470                 ceil : floating_ceil(ex_bits, sig_bits,),
2471                 floor : floating_floor(ex_bits, sig_bits,),
2472                 trunc : floating_trunc(ex_bits, sig_bits,),
2473                 fract : floating_fract(ex_bits, sig_bits,),
2474                 mantissa : floating_mantissa(ex_bits, sig_bits,),
2475                 exponent : floating_exponent(ex_bits, sig_bits,),
2476                 next_number : floating_next_number(ex_bits, sig_bits,),
2477                 prev_number : floating_prev_number(ex_bits, sig_bits,),
2478                 is_negative : floating_is_negative(ex_bits, sig_bits,),
2479                 is_infinity : floating_is_infinity(ex_bits, sig_bits,),
2480                 equal : floating_equal(ex_bits, sig_bits,,),
2481                 less : floating_less(ex_bits, sig_bits,,),
2482                 to_int : floating_to_int(ex_bits, sig_bits,),
2483                 from_int : floating_from_int(ex_bits, sig_bits,),
2484                 to_rational : floating_to_rational(ex_bits, sig_bits,),
2485                 from_rational : floating_from_rational(ex_bits, sig_bits,),
2486                 to_bytes : floating_to_bytes(ex_bits, sig_bits,),
2487                 to_bytes_base_precision : floating_to_bytes_base_precision(ex_bits, sig_bits,,,),
2488                 from_bytes : floating_from_bytes(ex_bits, sig_bits,),
2489                 from_bytes_base : floating_from_bytes_base(ex_bits, sig_bits,,),
2490         ];
2491
2492 {---------------------
2493  - RATIONAL INSTANCE -
2494  ---------------------}
2495
2496 implicit fn instance_real_number_rational~inline : class_real_number(rational) :=
2497         class_real_number(rational).[
2498                 add : rational_add,
2499                 zero : rational_zero,
2500                 neg : rational_neg,
2501                 subtract : rational_subtract,
2502                 multiply : rational_multiply,
2503                 one : rational_one,
2504                 recip : rational_recip,
2505                 divide : rational_divide,
2506                 modulo : rational_modulo,
2507                 power : rational_power,
2508                 ldexp : rational_ldexp,
2509                 atan2 : rational_atan2,
2510                 pi : rational_pi~lazy,
2511                 sqrt : rational_sqrt,
2512                 cbrt : rational_cbrt,
2513                 sin : rational_sin,
2514                 cos : rational_cos,
2515                 tan : rational_tan,
2516                 asin : rational_asin,
2517                 acos : rational_acos,
2518                 atan : rational_atan,
2519                 sinh : rational_sinh,
2520                 cosh : rational_cosh,
2521                 tanh : rational_tanh,
2522                 asinh : rational_asinh,
2523                 acosh : rational_acosh,
2524                 atanh : rational_atanh,
2525                 exp2 : rational_exp2,
2526                 exp : rational_exp,
2527                 exp10 : rational_exp10,
2528                 log2 : rational_log2,
2529                 log : rational_log,
2530                 log10 : rational_log10,
2531                 round : rational_round,
2532                 ceil : rational_ceil,
2533                 floor : rational_floor,
2534                 trunc : rational_trunc,
2535                 fract : rational_fract,
2536                 mantissa : rational_mantissa,
2537                 exponent : rational_exponent,
2538                 next_number : rational_next_number,
2539                 prev_number : rational_prev_number,
2540                 is_negative : rational_is_negative,
2541                 is_infinity : rational_is_infinity,
2542                 equal : rational_equal,
2543                 less : rational_less,
2544                 to_int : rational_to_int,
2545                 from_int : rational_from_int,
2546                 to_rational : identity(rational,),
2547                 from_rational : identity(rational,),
2548                 to_bytes : rational_to_bytes,
2549                 to_bytes_base_precision : rational_to_bytes_base_precision,
2550                 from_bytes : rational_from_bytes,
2551                 from_bytes_base : rational_from_bytes_base,
2552         ];
2553
2554 type fixed_point(base digits : int) := fp_type;
2555
2556 implicit fn instance_real_number_fixed_point~inline(const base digits : int) : class_real_number(fixed_point(base, digits)) :=
2557         class_real_number(fixed_point(base, digits)).[
2558                 add : fixed_point_add(base, digits,,),
2559                 zero : fixed_point_zero(base, digits),
2560                 neg : fixed_point_neg(base, digits,),
2561                 subtract : fixed_point_subtract(base, digits,,),
2562                 multiply : fixed_point_multiply(base, digits,,),
2563                 one : fixed_point_one(base, digits),
2564                 recip : fixed_point_recip(base, digits,),
2565                 divide : fixed_point_divide(base, digits,,),
2566                 modulo : fixed_point_modulo(base, digits,,),
2567                 power : fixed_point_power(base, digits,,),
2568                 ldexp : fixed_point_ldexp(base, digits,,),
2569                 atan2 : fixed_point_atan2(base, digits,,),
2570                 pi : fixed_point_pi~lazy(base, digits),
2571                 sqrt : fixed_point_sqrt(base, digits,),
2572                 cbrt : fixed_point_cbrt(base, digits,),
2573                 sin : fixed_point_sin(base, digits,),
2574                 cos : fixed_point_cos(base, digits,),
2575                 tan : fixed_point_tan(base, digits,),
2576                 asin : fixed_point_asin(base, digits,),
2577                 acos : fixed_point_acos(base, digits,),
2578                 atan : fixed_point_atan(base, digits,),
2579                 sinh : fixed_point_sinh(base, digits,),
2580                 cosh : fixed_point_cosh(base, digits,),
2581                 tanh : fixed_point_tanh(base, digits,),
2582                 asinh : fixed_point_asinh(base, digits,),
2583                 acosh : fixed_point_acosh(base, digits,),
2584                 atanh : fixed_point_atanh(base, digits,),
2585                 exp2 : fixed_point_exp2(base, digits,),
2586                 exp : fixed_point_exp(base, digits,),
2587                 exp10 : fixed_point_exp10(base, digits,),
2588                 log2 : fixed_point_log2(base, digits,),
2589                 log : fixed_point_log(base, digits,),
2590                 log10 : fixed_point_log10(base, digits,),
2591                 round : fixed_point_round(base, digits,),
2592                 ceil : fixed_point_ceil(base, digits,),
2593                 floor : fixed_point_floor(base, digits,),
2594                 trunc : fixed_point_trunc(base, digits,),
2595                 fract : fixed_point_fract(base, digits,),
2596                 mantissa : fixed_point_mantissa(base, digits,),
2597                 exponent : fixed_point_exponent(base, digits,),
2598                 next_number : fixed_point_next_number(base, digits,),
2599                 prev_number : fixed_point_prev_number(base, digits,),
2600                 is_negative : fixed_point_is_negative(base, digits,),
2601                 is_infinity : fixed_point_is_infinity(base, digits,),
2602                 equal : fixed_point_equal(base, digits,,),
2603                 less : fixed_point_less(base, digits,,),
2604                 to_int : fixed_point_to_int(base, digits,),
2605                 from_int : fixed_point_from_int(base, digits,),
2606                 to_rational :fixed_point_to_rational(base, digits,),
2607                 from_rational :fixed_point_from_rational(base, digits,),
2608                 to_bytes : fixed_point_to_bytes(base, digits,),
2609                 to_bytes_base_precision : fixed_point_to_bytes_base_precision(base, digits,,,),
2610                 from_bytes : fixed_point_from_bytes(base, digits,),
2611                 from_bytes_base : fixed_point_from_bytes_base(base, digits,,),
2612         ];
2613
2614 {-------------
2615  - OPERATORS -
2616  -------------}
2617
2618 operator prefix + 1000 ~inline (t : type, c : class_group(t), val : t) : t := val;
2619 operator prefix - 1000 ~inline (t : type, c : class_group(t), val : t) : t := c.neg(val);
2620 operator * 2000 ~inline (t : type, c : class_unit_ring(t), val1 val2 : t) : t := c.multiply(val1, val2);
2621 operator / 2000 ~inline (t : type, c : class_division_ring(t), val1 val2 : t) : t := c.divide(val1, val2);
2622 operator div 2000 ~inline (t : type, c : class_integer_number(t), val1 val2 : t) : t := c.div(val1, val2);
2623 operator mod 2000 ~inline (t : type, c : class_integer_number(t), val1 val2 : t) : t := c.mod(val1, val2);
2624 operator + 3000 ~inline (t : type, c : class_magma(t), val1 val2 : t) : t := c.add(val1, val2);
2625 operator - 3000 ~inline (t : type, c : class_group(t), val1 val2 : t) : t := c.subtract(val1, val2);
2626 operator shl 4000 ~inline (t : type, c : class_integer_number(t), val1 val2 : t) : t := c.shl(val1, val2);
2627 operator shr 4000 ~inline (t : type, c : class_integer_number(t), val1 val2 : t) : t := c.shr(val1, val2);
2628 operator rol 4000 ~inline (t : type, c : class_fixed_integer_number(t), val1 val2 : t) : t := c.rol(val1, val2);
2629 operator ror 4000 ~inline (t : type, c : class_fixed_integer_number(t), val1 val2 : t) : t := c.ror(val1, val2);
2630 operator bts 4000 ~inline (t : type, c : class_integer_number(t), val1 val2 : t) : t := c.bts(val1, val2);
2631 operator btr 4000 ~inline (t : type, c : class_integer_number(t), val1 val2 : t) : t := c.btr(val1, val2);
2632 operator btc 4000 ~inline (t : type, c : class_integer_number(t), val1 val2 : t) : t := c.btc(val1, val2);
2633 operator bt 4000 ~inline (t : type, c : class_integer_number(t), val1 val2 : t) : bool := c.bt(val1, val2);
2634 operator prefix bswap 4000 ~inline (t : type, c : class_fixed_integer_number(t), val : t) : t := c.bswap(val);
2635 operator prefix brev 4000 ~inline (t : type, c : class_fixed_integer_number(t), val : t) : t := c.brev(val);
2636 operator prefix bsf 4000 ~inline (t : type, c : class_integer_number(t), val : t) : t := c.bsf(val);
2637 operator prefix bsr 4000 ~inline (t : type, c : class_integer_number(t), val : t) : t := c.bsr(val);
2638 operator prefix popcnt 4000 ~inline (t : type, c : class_integer_number(t), val : t) : t := c.popcnt(val);
2639
2640 operator prefix is_negative 5000 ~inline (t : type, c : class_real_number(t), val : t) : bool := c.is_negative(val);
2641 operator prefix is_infinity 5000 ~inline (t : type, c : class_real_number(t), val : t) : bool := c.is_infinity(val);
2642 operator prefix is_exception 5000 ~inline (t : type, v : t) : bool [ var r : bool; pcode UnaryOp Un_IsException =r 0 v; return r; ]
2643 operator prefix exception_class 5000 ~inline (t : type, v : t) : int [ var r : int; pcode UnaryOp Un_ExceptionClass =r 0 v; return r; ]
2644 operator prefix exception_type 5000 ~inline (t : type, v : t) : int [ var r : int; pcode UnaryOp Un_ExceptionType =r 0 v; return r; ]
2645 operator prefix exception_aux 5000 ~inline (t : type, v : t) : int [ var r : int; pcode UnaryOp Un_ExceptionAux =r 0 v; return r; ]
2646 operator prefix exception_string 5000 ~inline (t : type, v : t) : bytes [ var r : bytes; pcode IO IO_Exception_String 1 1 0 =r v ; return r; ]
2647 operator prefix exception_payload 5000 ~inline (t : type, v : t) : bytes [ var r : bytes; pcode IO IO_Exception_Payload 1 1 0 =r v ; return r; ]
2648 operator prefix exception_stack 5000 ~inline (t : type, v : t) : bytes [ var r : bytes; pcode IO IO_Exception_Stack 1 1 0 =r v ; return r; ]
2649
2650 operator = 6000 ~inline (t : type, c : class_eq(t), val1 val2 : t) : bool := c.equal(val1, val2);
2651 operator <> 6000 ~inline (t : type, c : class_eq(t), val1 val2 : t) : bool := not c.equal(val1, val2);
2652 operator < 6000 ~inline (t : type, c : class_ord(t), val1 val2 : t) : bool := c.less(val1, val2);
2653 operator <= 6000 ~inline (t : type, c : class_ord(t), val1 val2 : t) : bool := not c.less(val2, val1);
2654 operator > 6000 ~inline (t : type, c : class_ord(t), val1 val2 : t) : bool := c.less(val2, val1);
2655 operator >= 6000 ~inline (t : type, c : class_ord(t), val1 val2 : t) : bool := not c.less(val1, val2);
2656 operator prefix not 7000 ~inline (t : type, c : class_logical(t), val : t) : t := c.not(val);
2657 operator and 8000 ~inline (t : type, c : class_logical(t), val1 val2 : t) : t := c.and(val1, val2);
2658 operator xor 9000 ~inline (t : type, c : class_logical(t), val1 val2 : t) : t := c.xor(val1, val2);
2659 operator or 10000 ~inline (t : type, c : class_logical(t), val1 val2 : t) : t := c.or(val1, val2);
2660
2661 fn ipower~inline (t : type, c : class_integer_number(t), val1 val2 : t) : t := c.power(val1, val2);
2662 fn fmod~inline(t : type, c : class_real_number(t), val1 val2 : t) : t := c.modulo(val1, val2);
2663 fn power~inline(t : type, c : class_real_number(t), val1 val2 : t) : t := c.power(val1, val2);
2664 fn ldexp~inline(t : type, c : class_real_number(t), val1 val2 : t) : t := c.ldexp(val1, val2);
2665 fn atan2~inline(t : type, c : class_real_number(t), val1 val2 : t) : t := c.atan2(val1, val2);
2666 fn sqrt~inline(t : type, c : class_real_number(t), val : t) : t := c.sqrt(val);
2667 fn cbrt~inline(t : type, c : class_real_number(t), val : t) : t := c.cbrt(val);
2668 fn sin~inline(t : type, c : class_real_number(t), val : t) : t := c.sin(val);
2669 fn cos~inline(t : type, c : class_real_number(t), val : t) : t := c.cos(val);
2670 fn tan~inline(t : type, c : class_real_number(t), val : t) : t := c.tan(val);
2671 fn asin~inline(t : type, c : class_real_number(t), val : t) : t := c.asin(val);
2672 fn acos~inline(t : type, c : class_real_number(t), val : t) : t := c.acos(val);
2673 fn atan~inline(t : type, c : class_real_number(t), val : t) : t := c.atan(val);
2674 fn sinh~inline(t : type, c : class_real_number(t), val : t) : t := c.sinh(val);
2675 fn cosh~inline(t : type, c : class_real_number(t), val : t) : t := c.cosh(val);
2676 fn tanh~inline(t : type, c : class_real_number(t), val : t) : t := c.tanh(val);
2677 fn asinh~inline(t : type, c : class_real_number(t), val : t) : t := c.asinh(val);
2678 fn acosh~inline(t : type, c : class_real_number(t), val : t) : t := c.acosh(val);
2679 fn atanh~inline(t : type, c : class_real_number(t), val : t) : t := c.atanh(val);
2680 fn exp2~inline(t : type, c : class_real_number(t), val : t) : t := c.exp2(val);
2681 fn exp~inline(t : type, c : class_real_number(t), val : t) : t := c.exp(val);
2682 fn exp10~inline(t : type, c : class_real_number(t), val : t) : t := c.exp10(val);
2683 fn log2~inline(t : type, c : class_real_number(t), val : t) : t := c.log2(val);
2684 fn log~inline(t : type, c : class_real_number(t), val : t) : t := c.log(val);
2685 fn log10~inline(t : type, c : class_real_number(t), val : t) : t := c.log10(val);
2686 fn round~inline(t : type, c : class_real_number(t), val : t) : t := c.round(val);
2687 fn ceil~inline(t : type, c : class_real_number(t), val : t) : t := c.ceil(val);
2688 fn floor~inline(t : type, c : class_real_number(t), val : t) : t := c.floor(val);
2689 fn trunc~inline(t : type, c : class_real_number(t), val : t) : t := c.trunc(val);
2690 fn fract~inline(t : type, c : class_real_number(t), val : t) : t := c.fract(val);
2691 fn mantissa~inline(t : type, c : class_real_number(t), val : t) : t := c.mantissa(val);
2692 fn exponent~inline(t : type, c : class_real_number(t), val : t) : t := c.exponent(val);
2693 fn next_number~inline(t : type, c : class_real_number(t), val : t) : t := c.next_number(val);
2694 fn prev_number~inline(t : type, c : class_real_number(t), val : t) : t := c.prev_number(val);
2695
2696 conversion fn integer_number_to_integer_number~inline(t1 : type, c1 : class_integer_number(t1), t2 : type, c2 : class_integer_number(t2), val : t1) : t2 := c2.from_int(c1.to_int(val));
2697 conversion fn integer_number_to_real_number~inline(t1 : type, c1 : class_integer_number(t1), t2 : type, c2 : class_real_number(t2), val : t1) : t2 := c2.from_int(c1.to_int(val));
2698 conversion fn real_number_to_integer_number~inline(t1 : type, c1 : class_real_number(t1), t2 : type, c2 : class_integer_number(t2), val : t1) : t2 := c2.from_int(c1.to_int(val));
2699 conversion fn real_number_to_real_number~inline(t1 : type, c1 : class_real_number(t1), t2 : type, c2 : class_real_number(t2), val : t1) : t2 := c2.from_rational(c1.to_rational(val));
2700
2701 {---------
2702  - DEBUG -
2703  ---------}
2704
2705 fn debug(m : bytes) : unit_type
2706 [
2707         var b : unit_type;
2708         pcode IO IO_Debug 1 1 1 =b m 0;
2709         return b;
2710 ]
2711
2712 fn internal(m : bytes) : unit_type
2713 [
2714         var b : unit_type;
2715         pcode IO IO_Debug 1 1 1 =b m 1;
2716         return b;
2717 ]
2718
2719 fn stop(m : bytes) : unit_type
2720 [
2721         var b : unit_type;
2722         pcode IO IO_Debug 1 1 1 =b m 2;
2723         return b;
2724 ]
2725
2726 fn report_memory_summary(m : bytes) : unit_type
2727 [
2728         var b : unit_type;
2729         pcode IO IO_Debug 1 1 1 =b m 3;
2730         return b;
2731 ]
2732
2733 fn report_memory_most(m : bytes) : unit_type
2734 [
2735         var b : unit_type;
2736         pcode IO IO_Debug 1 1 1 =b m 4;
2737         return b;
2738 ]
2739
2740 fn report_memory_largest(m : bytes) : unit_type
2741 [
2742         var b : unit_type;
2743         pcode IO IO_Debug 1 1 1 =b m 5;
2744         return b;
2745 ]
2746
2747 fn assert~inline(v : bool, b : bytes) : unit_type
2748 [
2749         if not v then
2750                 return internal("assertion failure: " + b);
2751         return unit_value;
2752 ]
2753
2754 fn stacktrace(t : type, v : t) : unit_type
2755 [
2756         var b : unit_type;
2757         pcode IO IO_StackTrace 1 1 1 =b v 2;
2758         return b;
2759 ]
2760
2761 fn trace_on : unit_type
2762 [
2763         var b : unit_type;
2764         pcode IO IO_TraceCtl 1 0 1 =b 1;
2765         return b;
2766 ]
2767
2768 fn trace_off : unit_type
2769 [
2770         var b : unit_type;
2771         pcode IO IO_TraceCtl 1 0 1 =b 0;
2772         return b;
2773 ]
2774
2775 {-----------
2776  - GENERAL -
2777  -----------}
2778
2779 fn join(t : type, w1 w2 : t) : t
2780 [
2781         if is_exception w1 then [
2782                 eval w2;
2783                 return w1;
2784         ]
2785         if is_exception w2 then
2786                 return w2;
2787         return w1;
2788 ]
2789
2790 fn any~lazy(t1 t2 : type, w1 : t1, w2 : t2) : bool
2791 [
2792         var b : bool;
2793         pcode IO IO_Any 1 2 0 =b w1 w2;
2794         return b;
2795 ]
2796
2797 fn any_list~lazy(t : type, wx : list(t)) : int
2798 [
2799         if not len_greater_than(wx, 0) then
2800                 return never(int);
2801         var n := any_list~lazy(wx[1 .. ]);
2802         var b := any(wx[0], n);
2803         return select(b, 0, n + 1);
2804 ]
2805
2806 fn is_ready(t : type, v : t) : bool
2807 [
2808         return not any(v, unit_value);
2809 ]
2810
2811 fn never(t : type) : t
2812 [
2813         var w : t;
2814         pcode IO IO_Never 1 0 0 =w;
2815         return w;
2816 ]
2817
2818 fn fork(t : type, w : t) : (t, t)
2819 [
2820         var w1 w2 : t;
2821         pcode IO IO_Fork 2 1 0 =w1 =w2 w;
2822         return w1, w2;
2823 ]
2824
2825 {------------------
2826  - LIST FUNCTIONS -
2827  ------------------}
2828
2829 fn len~inline(t : type, a : list(t)) : int
2830 [
2831         var l : int;
2832         pcode Array_Len =l a 0;
2833         return l;
2834 ]
2835
2836 fn len_at_least~inline(t : type, a : list(t), l : int) : bool
2837 [
2838         return len_greater_than(t, a, l - 1);
2839 ]
2840
2841 fn len_greater_than~inline(t : type, a : list(t), l : int) : bool
2842 [
2843         var r : bool;
2844         pcode Array_Len_Greater_Than =r a l 0;
2845         return r;
2846 ]
2847
2848 fn empty~inline(t : type) : list(t) := list(t).[];
2849
2850 fn fill~inline(t : type, const x : t, const n : int) : list(t)
2851 [
2852         var l : list(t);
2853         pcode Array_Fill =l Undetermined 0 x n;
2854         return l;
2855 ]
2856
2857 fn sparse~inline(t : type, const x : t, const n : int) : list(t)
2858 [
2859         var l : list(t);
2860         pcode Array_Fill =l Undetermined Flag_Array_Fill_Sparse x n;
2861         return l;
2862 ]
2863
2864 fn infinite_internal(t : type, x : t, step : int) : list(t)
2865 [
2866         return sparse(x, step) + infinite_internal~lazy(t, x, step shl bsr step);
2867 ]
2868
2869 fn infinite(t : type, x : t) : list(t)
2870 [
2871         return infinite_internal(t, x, #40000000);
2872 ]
2873
2874 fn infinite_repeat(t : type, x : list(t)) : list(t)
2875 [
2876         return x + infinite_repeat~lazy(x);
2877 ]
2878
2879 fn uninitialized(t : type) : t
2880 [
2881         return exception_make(t, ec_sync, error_array_entry_not_initialized, 0, false);
2882 ]
2883
2884 fn uninitialized_record(t : type) : t
2885 [
2886         return exception_make(t, ec_sync, error_record_field_not_initialized, 0, false);
2887 ]
2888
2889 fn infinite_uninitialized(t : type) : list(t)
2890 [
2891         return infinite(uninitialized(t));
2892 ]
2893
2894 fn is_uninitialized(t : type, v : t) : bool
2895 [
2896         if is_exception v then [
2897                 if exception_class v = ec_sync and exception_type v = error_array_entry_not_initialized then
2898                         return true;
2899                 abort v;
2900         ]
2901         return false;
2902 ]
2903
2904 fn is_uninitialized_record(t : type, v : t) : bool
2905 [
2906         if is_exception v then [
2907                 if exception_class v = ec_sync and exception_type v = error_record_field_not_initialized then
2908                         return true;
2909                 abort v;
2910         ]
2911         return false;
2912 ]
2913
2914 fn list_search(t : type, implicit c : class_eq(t), x : list(t), v : t) : int
2915 [
2916         var i := 0;
2917         while len_greater_than(x, i) do [
2918                 if x[i] = v then
2919                         return i;
2920                 i += 1;
2921         ]
2922         return -1;
2923 ]
2924
2925 fn list_search_fn(t : type, x : list(t), f : fn(t) : bool) : int
2926 [
2927         var i := 0;
2928         while len_greater_than(x, i) do [
2929                 if f(x[i]) then
2930                         return i;
2931                 i += 1;
2932         ]
2933         return -1;
2934 ]
2935
2936 fn list_search_backwards(t : type, implicit c : class_eq(t), x : list(t), v : t) : int
2937 [
2938         var i := len(x) - 1;
2939         while i >= 0 do [
2940                 if x[i] = v then
2941                         return i;
2942                 i -= 1;
2943         ]
2944         return -1;
2945 ]
2946
2947 fn list_search_backwards_fn(t : type, x : list(t), f : fn(t) : bool) : int
2948 [
2949         var i := len(x) - 1;
2950         while i >= 0 do [
2951                 if f(x[i]) then
2952                         return i;
2953                 i -= 1;
2954         ]
2955         return -1;
2956 ]
2957
2958 fn list_search_substring(t : type, implicit c : class_eq(t), x v : list(t)) : int
2959 [
2960         var lv := len(v);
2961         var i := 0;
2962         while len_at_least(x, i + lv) do [
2963                 for j := 0 to lv do [
2964                         if x[i + j] <> v[j] then
2965                                 goto mismatch;
2966                 ]
2967                 return i;
2968 mismatch:
2969                 i += 1;
2970         ]
2971         return -1;
2972 ]
2973
2974 fn list_replace_substring(t : type, implicit c : class_eq(t), x v r : list(t)) : list(t)
2975 [
2976         var steps := 64;
2977         var len_v := len(v);
2978         var res := empty(t);
2979 again:
2980         var s := list_search_substring(x, v);
2981         if s = -1 then
2982                 return res + x;
2983         res += x[ .. s];
2984         res += r;
2985         x := x[s + len_v .. ];
2986         steps -= 1;
2987         if steps > 0 then
2988                 goto again;
2989         else
2990                 return res + list_replace_substring~lazy(x, v, r);
2991 ]
2992
2993 fn list_left_pad(t : type, x : list(t), width : int, padding : t) : list(t)
2994 [
2995         if len(x) < width then
2996                 x := fill(padding, width - len(x)) + x;
2997         return x;
2998 ]
2999
3000 fn list_right_pad(t : type, x : list(t), width : int, padding : t) : list(t)
3001 [
3002         if len(x) < width then
3003                 x += fill(padding, width - len(x));
3004         return x;
3005 ]
3006
3007 fn list_repeat(t : type, x : list(t), num : int) : list(t)
3008 [
3009         const step := 64;
3010         if num < 0 then
3011                 abort;
3012         var r := empty(t);
3013         var l := min(num, step);
3014         for i := 0 to l do
3015                 r += x;
3016         if l = num then
3017                 return r;
3018         return r + list_repeat~lazy(x, num - l);
3019 ]
3020
3021 fn list_begins_with(t : type, implicit c : class_eq(t), x y : list(t)) : bool
3022 [
3023         var ly := len(y);
3024         if not len_at_least(x, ly) then
3025                 return false;
3026         return x[ .. ly] = y;
3027 ]
3028
3029 fn list_ends_with(t : type, implicit c : class_eq(t), x y : list(t)) : bool
3030 [
3031         var lx := len(x);
3032         var ly := len(y);
3033         if lx < ly then
3034                 return false;
3035         for i := 0 to ly do [
3036                 if x[lx - ly + i] <> y[i] then
3037                         return false;
3038         ]
3039         return true;
3040 ]
3041
3042 fn list_break(t : type, implicit c : class_eq(t), l : list(t), bnd : t) : list(list(t))
3043 [
3044         var i := 0;
3045         while len_greater_than(l, i) do [
3046                 if l[i] = bnd then
3047                         return [ l[ .. i ] ] + list_break~lazy(l[ i + 1 .. ], bnd);
3048                 i += 1;
3049         ]
3050         if i > 0 then
3051                 return [ l ];
3052         return empty(list(t));
3053 ]
3054
3055 fn list_break_to_lines(b : bytes) : list(bytes)
3056 [
3057         var i := 0;
3058         while len_greater_than(b, i) do [
3059                 if b[i] = 13, len_greater_than(b, i + 1), b[i + 1] = 10 then [
3060                         return [ b[ .. i ] ] + list_break_to_lines~lazy(b[ i + 2 .. ]);
3061                 ]
3062                 if b[i] = 10 then [
3063                         return [ b[ .. i ] ] + list_break_to_lines~lazy(b[ i + 1 .. ]);
3064                 ]
3065                 i += 1;
3066         ]
3067         if i > 0 then
3068                 return [ b ];
3069         return empty(bytes);
3070 ]
3071
3072 fn list_string_break_to_lines(b : string) : list(string)
3073 [
3074         var i := 0;
3075         while len_greater_than(b, i) do [
3076                 if b[i] = 13, len_greater_than(b, i + 1), b[i + 1] = 10 then [
3077                         return [ b[ .. i ] ] + list_string_break_to_lines~lazy(b[ i + 2 .. ]);
3078                 ]
3079                 if b[i] = 10 then [
3080                         return [ b[ .. i ] ] + list_string_break_to_lines~lazy(b[ i + 1 .. ]);
3081                 ]
3082                 i += 1;
3083         ]
3084         if i > 0 then
3085                 return [ b ];
3086         return empty(string);
3087 ]
3088
3089 fn is_whitespace~inline(c : byte) : bool := c = 9 or c = 10 or c = 13 or c = ' ';
3090
3091 fn list_break_whitespace(l : bytes) : list(bytes)
3092 [
3093         var r := empty(bytes);
3094         var i := 0;
3095         while len_greater_than(l, i) do [
3096                 if is_whitespace(l[i]) then [
3097                         i += 1;
3098                         continue;
3099                 ]
3100                 var j := i + 1;
3101                 while len_greater_than(l, j), not is_whitespace(l[j]) do
3102                         j += 1;
3103                 r +<= l[i .. j];
3104                 i := j + 1;
3105         ]
3106         return r;
3107 ]
3108
3109 fn list_join(t : type, lines : list(list(t)), bnd : list(t)) : list(t)
3110 [
3111         const step := 64;
3112         var l : int;
3113         if len_greater_than(lines, step) then
3114                 l := step;
3115         else
3116                 l := len(lines);
3117         var result := empty(t);
3118         for i := 0 to l do [
3119                 result += lines[i];
3120                 result += bnd;
3121         ]
3122         if l = step then
3123                 return result + list_join~lazy(t, lines[l .. ], bnd);
3124         return result;
3125 ]
3126
3127 fn list_join_lines(lines : list(bytes)) : bytes
3128 [
3129         return list_join(lines, nl);
3130 ]
3131
3132 fn list_filter(t : type, lst : list(t), test : fn(t) : bool) : list(t)
3133 [
3134         const step := 64;
3135         var l : int;
3136         if len_greater_than(lst, step) then
3137                 l := step;
3138         else
3139                 l := len(lst);
3140         var result := empty(t);
3141         for i := 0 to l do [
3142                 if test(lst[i]) then
3143                         result +<= lst[i];
3144         ]
3145         if l = step then
3146                 return result + list_filter~lazy(lst[l .. ], test);
3147         return result;
3148 ]
3149
3150 fn list_filter_idx_internal(t : type, idx : int, lst : list(t), test : fn(int, t) : bool) : list(t)
3151 [
3152         const step := 64;
3153         var l : int;
3154         if len_greater_than(lst, step) then
3155                 l := step;
3156         else
3157                 l := len(lst);
3158         var result := empty(t);
3159         for i := 0 to l do [
3160                 if test(idx + i, lst[i]) then
3161                         result +<= lst[i];
3162         ]
3163         if l = step then
3164                 return result + list_filter_idx_internal~lazy(idx + l, lst[l .. ], test);
3165         return result;
3166 ]
3167
3168 fn list_filter_idx(t : type, lst : list(t), test : fn(int, t) : bool) : list(t)
3169 [
3170         return list_filter_idx_internal(0, lst, test);
3171 ]
3172
3173 fn list_fold(t u : type, ini : t, lst : list(u), fold : fn(t, u) : t) : t
3174 [
3175         for val in list_consumer(lst) do
3176                 ini := fold(ini, val);
3177         return ini;
3178 ]
3179
3180 fn list_fold_monoid(t : type, c : class_monoid(t), lst : list(t)) : t
3181 [
3182         return list_fold(c.zero, lst, c.add);
3183 ]
3184
3185 fn list_map_fold_internal(t u : type, lst : list(t), mp : fn(t) : u, re : fn(u, u) : u) : u
3186 [
3187         if len(lst) = 1 then
3188                 return mp(lst[0]);
3189         var half := len(lst) shr 1;
3190         return re(list_map_fold_internal(t, u, lst[ .. half], mp, re), list_map_fold_internal(t, u, lst[half .. ], mp, re));
3191 ]
3192
3193 fn list_map_fold(t u : type, ini : u, lst : list(t), mp : fn(t) : u, re : fn(u, u) : u) : u
3194 [
3195         if len(lst) = 0 then
3196                 return ini;
3197         return re(ini, list_map_fold_internal(t, u, lst, mp, re));
3198 ]
3199
3200 fn list_map_fold_monoid(t u : type, c : class_monoid(u), lst : list(t), mp : fn(t) : u) : u
3201 [
3202         return list_map_fold(c.zero, lst, mp, c.add);
3203 ]
3204
3205 fn list_reverse(t : type, l : list(t)) : list(t)
3206 [
3207         var ln := len(l);
3208         for i := 0 to ln div 2 do
3209                 l[i], l[ln - 1 - i] := l[ln - 1 - i], l[i];
3210         return l;
3211 ]
3212
3213 fn heap_left~inline(i : int) : int := i + i + 1;
3214 fn heap_right~inline(i : int) : int := i + i + 2;
3215 fn heap_parent~inline(i : int) : int := (i - 1) shr 1;
3216
3217 fn list_sort(t : type, implicit c : class_ord(t), l : list(t)) : list(t)
3218 [
3219         var n := len(l);
3220
3221         for i := 1 to n do [
3222                 var p := l[i];
3223                 var j := i;
3224                 while j > 0, p > l[heap_parent(j)] do [
3225                         l[j] := l[heap_parent(j)];
3226                         j := heap_parent(j);
3227                 ]
3228                 l[j] := p;
3229         ]
3230
3231         var i := n - 1;
3232         while i >= 0 do [
3233                 var p := l[i];
3234                 l[i] := l[0];
3235
3236                 var j := 0;
3237 continue_loop:
3238                 if heap_left(j) < i, l[heap_left(j)] > p then
3239                         goto do_loop;
3240                 if heap_right(j) < i, l[heap_right(j)] > p then
3241                         goto do_loop;
3242                 if false then [
3243 do_loop:
3244                         if heap_right(j) < i, l[heap_left(j)] < l[heap_right(j)] then [
3245                                 l[j] := l[heap_right(j)];
3246                                 j := heap_right(j);
3247                         ] else [
3248                                 l[j] := l[heap_left(j)];
3249                                 j := heap_left(j);
3250                         ]
3251                         goto continue_loop;
3252                 ]
3253                 l[j] := p;
3254
3255                 i -= 1;
3256         ]
3257
3258         return l;
3259 ]
3260
3261 fn list_flatten~inline(t : type, a : list(t)) : list(t)
3262 [
3263         var l : list(t);
3264         pcode Array_Flatten =l 0 a;
3265         return l;
3266 ]
3267
3268
3269 const nl : bytes
3270 [
3271         var os := sysprop(SystemProperty_OS);
3272         if os = SystemProperty_OS_DOS or
3273            os = SystemProperty_OS_OS2 or
3274            os = SystemProperty_OS_Windows then
3275                 return bytes.[ 13, 10 ];
3276         return bytes.[ 10 ];
3277 ]
3278
3279 {---------
3280  - TUPLE -
3281  ---------}
3282
3283 fn tuple2_equal(t1 t2 : type, implicit c1 : class_eq(t1), implicit c2 : class_eq(t2), l1 l2 : tuple2(t1, t2)) : bool
3284 [
3285         return l1.v1 = l2.v1 and l1.v2 = l2.v2;
3286 ]
3287 fn tuple2_less(t1 t2 : type, implicit c1 : class_ord(t1), implicit c2 : class_ord(t2), l1 l2 : tuple2(t1, t2)) : bool
3288 [
3289         if l1.v1 < l2.v1 then return true;
3290         if l1.v1 > l2.v1 then return false;
3291         if l1.v2 < l2.v2 then return true;
3292         if l1.v2 > l2.v2 then return false;
3293         return false;
3294 ]
3295 implicit fn inherit_eq_tuple2~inline(t1 t2 : type, c1 : class_eq(t1), c2 : class_eq(t2)) : class_eq(tuple2(t1, t2)) :=
3296         class_eq(tuple2(t1, t2)).[
3297                 equal : tuple2_equal(t1, t2, c1, c2,,),
3298         ];
3299 implicit fn inherit_ord_tuple2~inline(t1 t2 : type, c1 : class_ord(t1), c2 : class_ord(t2)) : class_ord(tuple2(t1, t2)) :=
3300         class_ord(tuple2(t1, t2)).[
3301                 equal : tuple2_equal(t1, t2, inherit_eq_ord(c1), inherit_eq_ord(c2),,),
3302                 less : tuple2_less(t1, t2, c1, c2,,),
3303         ];
3304
3305 fn tuple3_equal(t1 t2 t3 : type, implicit c1 : class_eq(t1), implicit c2 : class_eq(t2), implicit c3 : class_eq(t3), l1 l2 : tuple3(t1, t2, t3)) : bool
3306 [
3307         return l1.v1 = l2.v1 and l1.v2 = l2.v2 and l1.v3 = l2.v3;
3308 ]
3309 fn tuple3_less(t1 t2 t3 : type, implicit c1 : class_ord(t1), implicit c2 : class_ord(t2), implicit c3 : class_ord(t3), l1 l2 : tuple3(t1, t2, t3)) : bool
3310 [
3311         if l1.v1 < l2.v1 then return true;
3312         if l1.v1 > l2.v1 then return false;
3313         if l1.v2 < l2.v2 then return true;
3314         if l1.v2 > l2.v2 then return false;
3315         if l1.v3 < l2.v3 then return true;
3316         if l1.v3 > l2.v3 then return false;
3317         return false;
3318 ]
3319 implicit fn inherit_eq_tuple3~inline(t1 t2 t3 : type, c1 : class_eq(t1), c2 : class_eq(t2), c3 : class_eq(t3)) : class_eq(tuple3(t1, t2, t3)) :=
3320         class_eq(tuple3(t1, t2, t3)).[
3321                 equal : tuple3_equal(t1, t2, t3, c1, c2, c3,,),
3322         ];
3323 implicit fn inherit_ord_tuple3~inline(t1 t2 t3 : type, c1 : class_ord(t1), c2 : class_ord(t2), c3 : class_ord(t3)) : class_ord(tuple3(t1, t2, t3)) :=
3324         class_ord(tuple3(t1, t2, t3)).[
3325                 equal : tuple3_equal(t1, t2, t3, inherit_eq_ord(c1), inherit_eq_ord(c2), inherit_eq_ord(c3),,),
3326                 less : tuple3_less(t1, t2, t3, c1, c2, c3,,),
3327         ];
3328
3329 fn tuple4_equal(t1 t2 t3 t4 : type, implicit c1 : class_eq(t1), implicit c2 : class_eq(t2), implicit c3 : class_eq(t3), implicit c4 : class_eq(t4), l1 l2 : tuple4(t1, t2, t3, t4)) : bool
3330 [
3331         return l1.v1 = l2.v1 and l1.v2 = l2.v2 and l1.v3 = l2.v3 and l1.v4 = l2.v4;
3332 ]
3333 fn tuple4_less(t1 t2 t3 t4 : type, implicit c1 : class_ord(t1), implicit c2 : class_ord(t2), implicit c3 : class_ord(t3), implicit c4 : class_ord(t4), l1 l2 : tuple4(t1, t2, t3, t4)) : bool
3334 [
3335         if l1.v1 < l2.v1 then return true;
3336         if l1.v1 > l2.v1 then return false;
3337         if l1.v2 < l2.v2 then return true;
3338         if l1.v2 > l2.v2 then return false;
3339         if l1.v3 < l2.v3 then return true;
3340         if l1.v3 > l2.v3 then return false;
3341         if l1.v4 < l2.v4 then return true;
3342         if l1.v4 > l2.v4 then return false;
3343         return false;
3344 ]
3345 implicit fn inherit_eq_tuple4~inline(t1 t2 t3 t4 : type, c1 : class_eq(t1), c2 : class_eq(t2), c3 : class_eq(t3), c4 : class_eq(t4)) : class_eq(tuple4(t1, t2, t3, t4)) :=
3346         class_eq(tuple4(t1, t2, t3, t4)).[
3347                 equal : tuple4_equal(t1, t2, t3, t4, c1, c2, c3, c4,,),
3348         ];
3349 implicit fn inherit_ord_tuple4~inline(t1 t2 t3 t4 : type, c1 : class_ord(t1), c2 : class_ord(t2), c3 : class_ord(t3), c4 : class_ord(t4)) : class_ord(tuple4(t1, t2, t3, t4)) :=
3350         class_ord(tuple4(t1, t2, t3, t4)).[
3351                 equal : tuple4_equal(t1, t2, t3, t4, inherit_eq_ord(c1), inherit_eq_ord(c2), inherit_eq_ord(c3), inherit_eq_ord(c4),,),
3352                 less : tuple4_less(t1, t2, t3, t4, c1, c2, c3, c4,,),
3353         ];
3354
3355
3356 fn tuple5_equal(t1 t2 t3 t4 t5 : type, implicit c1 : class_eq(t1), implicit c2 : class_eq(t2), implicit c3 : class_eq(t3), implicit c4 : class_eq(t4), implicit c5 : class_eq(t5), l1 l2 : tuple5(t1, t2, t3, t4, t5)) : bool
3357 [
3358         return l1.v1 = l2.v1 and l1.v2 = l2.v2 and l1.v3 = l2.v3 and l1.v4 = l2.v4 and l1.v5 = l2.v5;
3359 ]
3360 fn tuple5_less(t1 t2 t3 t4 t5 : type, implicit c1 : class_ord(t1), implicit c2 : class_ord(t2), implicit c3 : class_ord(t3), implicit c4 : class_ord(t4), implicit c5 : class_ord(t5), l1 l2 : tuple5(t1, t2, t3, t4, t5)) : bool
3361 [
3362         if l1.v1 < l2.v1 then return true;
3363         if l1.v1 > l2.v1 then return false;
3364         if l1.v2 < l2.v2 then return true;
3365         if l1.v2 > l2.v2 then return false;
3366         if l1.v3 < l2.v3 then return true;
3367         if l1.v3 > l2.v3 then return false;
3368         if l1.v4 < l2.v4 then return true;
3369         if l1.v4 > l2.v4 then return false;
3370         if l1.v5 < l2.v5 then return true;
3371         if l1.v5 > l2.v5 then return false;
3372         return false;
3373 ]
3374 implicit fn inherit_eq_tuple5~inline(t1 t2 t3 t4 t5 : type, c1 : class_eq(t1), c2 : class_eq(t2), c3 : class_eq(t3), c4 : class_eq(t4), c5 : class_eq(t5)) : class_eq(tuple5(t1, t2, t3, t4, t5)) :=
3375         class_eq(tuple5(t1, t2, t3, t4, t5)).[
3376                 equal : tuple5_equal(t1, t2, t3, t4, t5, c1, c2, c3, c4, c5,,),
3377         ];
3378 implicit fn inherit_ord_tuple5~inline(t1 t2 t3 t4 t5 : type, c1 : class_ord(t1), c2 : class_ord(t2), c3 : class_ord(t3), c4 : class_ord(t4), c5 : class_ord(t5)) : class_ord(tuple5(t1, t2, t3, t4, t5)) :=
3379         class_ord(tuple5(t1, t2, t3, t4, t5)).[
3380                 equal : tuple5_equal(t1, t2, t3, t4, t5, inherit_eq_ord(c1), inherit_eq_ord(c2), inherit_eq_ord(c3), inherit_eq_ord(c4), inherit_eq_ord(c5),,),
3381                 less : tuple5_less(t1, t2, t3, t4, t5, c1, c2, c3, c4, c5,,),
3382         ];
3383
3384 {---------
3385  - MAYBE -
3386  ---------}
3387
3388 fn mkmaybe~inline(t : type, v : t) : maybe(t) := maybe(t).j.(v);
3389
3390 {----------
3391  - NUMBER -
3392  ----------}
3393
3394 fn ntos_base~inline(t : type, c : class_integer_number(t), n : t, base : int) : bytes
3395 [
3396         return c.to_bytes_base(n, base);
3397 ]
3398
3399 fn ntos_base_precision~inlnie(t : type, c : class_real_number(t), n : t, base digits : int) : bytes
3400 [
3401         return c.to_bytes_base_precision(n, base, digits);
3402 ]
3403
3404 fn ntos~inline(t : type, c : class_show(t), n : t) : bytes
3405 [
3406         return c.to_bytes(n);
3407 ]
3408
3409 fn ston_base~inline(b : bytes, base : int) : int
3410 [
3411         return instance_number_int.from_bytes_base(b, base);
3412 ]
3413
3414 fn ston~inline(b : bytes) : int
3415 [
3416         return instance_number_int.from_bytes(b);
3417 ]
3418
3419 fn format(t : type, implicit c : class_show(t), b : bytes, a : list(t)) : bytes
3420 [
3421         var r := empty(byte);
3422         var idx := 0;
3423         for i := 0 to len(b) do [
3424                 if b[i] = '%' then [
3425                         r += ntos(a[idx]);
3426                         idx += 1;
3427                 ] else [
3428                         r +<= b[i];
3429                 ]
3430         ]
3431         if idx <> len(a) then
3432                 return exception_make(bytes, ec_sync, error_invalid_operation, 0, true);
3433         return r;
3434 ]
3435
3436 {----------------
3437  - NATIVE TYPES -
3438  ----------------}
3439
3440 fn int_to_native~inline(n : native, i : int) : bytes
3441 [
3442         var r : bytes;
3443         pcode IO IO_Int_To_Native 1 2 0 =r n i;
3444         return r;
3445 ]
3446
3447 fn native_to_int~inline(n : native, b : bytes) : int
3448 [
3449         var r : int;
3450         pcode IO IO_Native_To_Int 1 2 0 =r n b;
3451         return r;
3452 ]
3453
3454 {---------
3455  - ARRAY -
3456  ---------}
3457
3458 fn array_size(dim : list(int)) : int
3459 [
3460         var prod := 1;
3461         for i := 0 to len(dim) do [
3462                 if dim[i] < 0 then
3463                         return exception_make(int, ec_sync, error_negative_index, 0, true);
3464                 prod *= dim[i];
3465         ]
3466         return prod;
3467 ]
3468
3469 fn list_to_array(t : type, const dim : list(int), v : list(t)) : array(t, dim)
3470 [
3471         var prod := array_size(dim);
3472         if prod <> len(v) then
3473                 return exception_make(array(t, dim), ec_sync, error_invalid_operation, 0, true);
3474         var l : array(t, dim);
3475         pcode Copy_Type_Cast =l 0 v;
3476         return l;
3477 ]
3478
3479 fn array_to_list(t : type, const dim : list(int), v : array(t, dim)) : list(t)
3480 [
3481         var l : list(t);
3482         pcode Copy_Type_Cast =l 0 v;
3483         return l;
3484 ]
3485
3486 fn array_fill~inline(t : type, const x : t, const dim : list(int)) : array(t, dim)
3487 [
3488         var prod := array_size(dim);
3489         var l : array(t, dim);
3490         pcode Array_Fill =l Undetermined 0 x prod;
3491         return l;
3492 ]
3493
3494 fn array_sparse~inline(t : type, const x : t, const dim : list(int)) : array(t, dim)
3495 [
3496         var prod := array_size(dim);
3497         var l : array(t, dim);
3498         pcode Array_Fill =l Undetermined Flag_Array_Fill_Sparse x prod;
3499         return l;
3500 ]
3501
3502 fn array_index(dim : list(int), idx : list(int)) : int
3503 [
3504         if len(dim) <> len(idx) then
3505                 return exception_make(int, ec_sync, error_invalid_operation, 0, true);
3506         var off := 0;
3507         var l := len(dim);
3508         for ii := 0 to l do [
3509                 var i := l - 1 - ii;
3510                 if idx[i] < 0 then
3511                         return exception_make(int, ec_sync, error_negative_index, 0, true);
3512                 if idx[i] >= dim[i] then
3513                         return exception_make(int, ec_sync, error_index_out_of_range, 0, true);
3514                 off *= dim[i];
3515                 off += idx[i];
3516         ]
3517         return off;
3518 ]
3519
3520 fn array_read(t : type, const dim : list(int), v : array(t, dim), idx : list(int)) : t
3521 [
3522         var off := array_index(dim, idx);
3523         return array_to_list(v)[off];
3524 ]
3525
3526 fn array_write(t : type, const dim : list(int), v : array(t, dim), idx : list(int), val : t) : array(t, dim)
3527 [
3528         var off := array_index(dim, idx);
3529         var l := array_to_list(v);
3530         l[off] := val;
3531         v := list_to_array(dim, l);
3532         return v;
3533 ]
3534
3535 fn array_reverse(t : type, const ln : int, implicit c : class_ord(t), v : array(t, [ln])) : array(t, [ln])
3536 [
3537         var l := array_to_list(v);
3538         l := list_reverse(l);
3539         return list_to_array([ln], l);
3540 ]
3541
3542 fn array_sort(t : type, const ln : int, implicit c : class_ord(t), v : array(t, [ln])) : array(t, [ln])
3543 [
3544         var l := array_to_list(v);
3545         l := list_sort(l);
3546         return list_to_array([ln], l);
3547 ]
3548
3549 fn array_flatten~inline(t : type, const dim : list(int), v : array(t, dim)) : array(t, dim)
3550 [
3551         var l : array(t, dim);
3552         pcode Array_Flatten =l 0 v;
3553         return l;
3554 ]
3555
3556 type xarray(dim : list(int), t : type)
3557 [
3558         var l : type;
3559         pcode Array_Fixed =l t dim;
3560         return l;
3561 ]
3562
3563 {-------------------
3564  - LIST DEFINITION -
3565  -------------------}
3566
3567 type list(t : type)
3568 [
3569         var l : type;
3570         pcode Array_Flexible =l t;
3571         return l;
3572 ]