git.gag.com Git - fw/altos/blob - src/scheme/ao_scheme_builtin.c

   1 /*
   2  * Copyright © 2016 Keith Packard <keithp@keithp.com>
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation, either version 2 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful, but
  10  * WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12  * General Public License for more details.
  13  */
  14
  15 #include "ao_scheme.h"
  16 #include <limits.h>
  17 #include <math.h>
  18
  19 static int
  20 builtin_size(void *addr)
  21 {
  22         (void) addr;
  23         return sizeof (struct ao_scheme_builtin);
  24 }
  25
  26 static void
  27 builtin_mark(void *addr)
  28 {
  29         (void) addr;
  30 }
  31
  32 static void
  33 builtin_move(void *addr)
  34 {
  35         (void) addr;
  36 }
  37
  38 const struct ao_scheme_type ao_scheme_builtin_type = {
  39         .size = builtin_size,
  40         .mark = builtin_mark,
  41         .move = builtin_move
  42 };
  43
  44 #ifdef AO_SCHEME_MAKE_CONST
  45
  46 #define AO_SCHEME_BUILTIN_CASENAME
  47 #include "ao_scheme_builtin.h"
  48
  49 char *ao_scheme_args_name(uint8_t args) {
  50         args &= AO_SCHEME_FUNC_MASK;
  51         switch (args) {
  52         case AO_SCHEME_FUNC_LAMBDA: return ao_scheme_poly_atom(_ao_scheme_atom_lambda)->name;
  53         case AO_SCHEME_FUNC_NLAMBDA: return ao_scheme_poly_atom(_ao_scheme_atom_nlambda)->name;
  54         case AO_SCHEME_FUNC_MACRO: return ao_scheme_poly_atom(_ao_scheme_atom_macro)->name;
  55         default: return (char *) "???";
  56         }
  57 }
  58 #else
  59
  60 #define AO_SCHEME_BUILTIN_ARRAYNAME
  61 #include "ao_scheme_builtin.h"
  62
  63 static char *
  64 ao_scheme_builtin_name(enum ao_scheme_builtin_id b) {
  65         if (b < _builtin_last)
  66                 return ao_scheme_poly_atom(builtin_names[b])->name;
  67         return (char *) "???";
  68 }
  69
  70 static const ao_poly ao_scheme_args_atoms[] = {
  71         [AO_SCHEME_FUNC_LAMBDA] = _ao_scheme_atom_lambda,
  72         [AO_SCHEME_FUNC_NLAMBDA] = _ao_scheme_atom_nlambda,
  73         [AO_SCHEME_FUNC_MACRO] = _ao_scheme_atom_macro,
  74 };
  75
  76 char *
  77 ao_scheme_args_name(uint8_t args)
  78 {
  79         args &= AO_SCHEME_FUNC_MASK;
  80         if (args < sizeof ao_scheme_args_atoms / sizeof ao_scheme_args_atoms[0])
  81                 return ao_scheme_poly_atom(ao_scheme_args_atoms[args])->name;
  82         return (char *) "(unknown)";
  83 }
  84 #endif
  85
  86 void
  87 ao_scheme_builtin_write(ao_poly b, bool write)
  88 {
  89         struct ao_scheme_builtin *builtin = ao_scheme_poly_builtin(b);
  90         (void) write;
  91         printf("%s", ao_scheme_builtin_name(builtin->func));
  92 }
  93
  94 ao_poly
  95 ao_scheme_check_argc(ao_poly name, struct ao_scheme_cons *cons, int min, int max)
  96 {
  97         int     argc = 0;
  98
  99         while (cons && argc <= max) {
 100                 argc++;
 101                 cons = ao_scheme_cons_cdr(cons);
 102         }
 103         if (argc < min || argc > max)
 104                 return ao_scheme_error(AO_SCHEME_INVALID, "%s: invalid arg count", ao_scheme_poly_atom(name)->name);
 105         return _ao_scheme_bool_true;
 106 }
 107
 108 ao_poly
 109 ao_scheme_arg(struct ao_scheme_cons *cons, int argc)
 110 {
 111         if (!cons)
 112                 return AO_SCHEME_NIL;
 113         while (argc--) {
 114                 if (!cons)
 115                         return AO_SCHEME_NIL;
 116                 cons = ao_scheme_cons_cdr(cons);
 117         }
 118         return cons->car;
 119 }
 120
 121 ao_poly
 122 ao_scheme_check_argt(ao_poly name, struct ao_scheme_cons *cons, int argc, int type, int nil_ok)
 123 {
 124         ao_poly car = ao_scheme_arg(cons, argc);
 125
 126         if ((!car && !nil_ok) || ao_scheme_poly_type(car) != type)
 127                 return ao_scheme_error(AO_SCHEME_INVALID, "%v: arg %d invalid type %v", name, argc, car);
 128         return _ao_scheme_bool_true;
 129 }
 130
 131 static int32_t
 132 ao_scheme_arg_int(ao_poly name, struct ao_scheme_cons *cons, int argc)
 133 {
 134         ao_poly         p = ao_scheme_arg(cons, argc);
 135         bool            fail = false;
 136         int32_t         i = ao_scheme_poly_integer(p, &fail);
 137
 138         if (fail)
 139                 (void) ao_scheme_error(AO_SCHEME_INVALID, "%v: arg %d invalid type %v", name, argc, p);
 140         return i;
 141 }
 142
 143 ao_poly
 144 ao_scheme_do_car(struct ao_scheme_cons *cons)
 145 {
 146         if (!ao_scheme_check_argc(_ao_scheme_atom_car, cons, 1, 1))
 147                 return AO_SCHEME_NIL;
 148         if (!ao_scheme_check_argt(_ao_scheme_atom_car, cons, 0, AO_SCHEME_CONS, 0))
 149                 return AO_SCHEME_NIL;
 150         return ao_scheme_poly_cons(cons->car)->car;
 151 }
 152
 153 ao_poly
 154 ao_scheme_do_cdr(struct ao_scheme_cons *cons)
 155 {
 156         if (!ao_scheme_check_argc(_ao_scheme_atom_cdr, cons, 1, 1))
 157                 return AO_SCHEME_NIL;
 158         if (!ao_scheme_check_argt(_ao_scheme_atom_cdr, cons, 0, AO_SCHEME_CONS, 0))
 159                 return AO_SCHEME_NIL;
 160         return ao_scheme_poly_cons(cons->car)->cdr;
 161 }
 162
 163 ao_poly
 164 ao_scheme_do_cons(struct ao_scheme_cons *cons)
 165 {
 166         ao_poly car, cdr;
 167         if(!ao_scheme_check_argc(_ao_scheme_atom_cons, cons, 2, 2))
 168                 return AO_SCHEME_NIL;
 169         car = ao_scheme_arg(cons, 0);
 170         cdr = ao_scheme_arg(cons, 1);
 171         return ao_scheme_cons(car, cdr);
 172 }
 173
 174 ao_poly
 175 ao_scheme_do_last(struct ao_scheme_cons *cons)
 176 {
 177         struct ao_scheme_cons   *list;
 178         if (!ao_scheme_check_argc(_ao_scheme_atom_last, cons, 1, 1))
 179                 return AO_SCHEME_NIL;
 180         if (!ao_scheme_check_argt(_ao_scheme_atom_last, cons, 0, AO_SCHEME_CONS, 1))
 181                 return AO_SCHEME_NIL;
 182         for (list = ao_scheme_poly_cons(ao_scheme_arg(cons, 0));
 183              list;
 184              list = ao_scheme_cons_cdr(list))
 185         {
 186                 if (!list->cdr)
 187                         return list->car;
 188         }
 189         return AO_SCHEME_NIL;
 190 }
 191
 192 ao_poly
 193 ao_scheme_do_length(struct ao_scheme_cons *cons)
 194 {
 195         if (!ao_scheme_check_argc(_ao_scheme_atom_length, cons, 1, 1))
 196                 return AO_SCHEME_NIL;
 197         if (!ao_scheme_check_argt(_ao_scheme_atom_length, cons, 0, AO_SCHEME_CONS, 1))
 198                 return AO_SCHEME_NIL;
 199         return ao_scheme_int_poly(ao_scheme_cons_length(ao_scheme_poly_cons(ao_scheme_arg(cons, 0))));
 200 }
 201
 202 ao_poly
 203 ao_scheme_do_list_copy(struct ao_scheme_cons *cons)
 204 {
 205         struct ao_scheme_cons *new;
 206
 207         if (!ao_scheme_check_argc(_ao_scheme_atom_length, cons, 1, 1))
 208                 return AO_SCHEME_NIL;
 209         if (!ao_scheme_check_argt(_ao_scheme_atom_length, cons, 0, AO_SCHEME_CONS, 1))
 210                 return AO_SCHEME_NIL;
 211         new = ao_scheme_cons_copy(ao_scheme_poly_cons(ao_scheme_arg(cons, 0)));
 212         return ao_scheme_cons_poly(new);
 213 }
 214
 215 ao_poly
 216 ao_scheme_do_quote(struct ao_scheme_cons *cons)
 217 {
 218         if (!ao_scheme_check_argc(_ao_scheme_atom_quote, cons, 1, 1))
 219                 return AO_SCHEME_NIL;
 220         return ao_scheme_arg(cons, 0);
 221 }
 222
 223 ao_poly
 224 ao_scheme_do_set(struct ao_scheme_cons *cons)
 225 {
 226         if (!ao_scheme_check_argc(_ao_scheme_atom_set, cons, 2, 2))
 227                 return AO_SCHEME_NIL;
 228         if (!ao_scheme_check_argt(_ao_scheme_atom_set, cons, 0, AO_SCHEME_ATOM, 0))
 229                 return AO_SCHEME_NIL;
 230
 231         return ao_scheme_atom_set(ao_scheme_arg(cons, 0), ao_scheme_arg(cons, 1));
 232 }
 233
 234 ao_poly
 235 ao_scheme_do_def(struct ao_scheme_cons *cons)
 236 {
 237         if (!ao_scheme_check_argc(_ao_scheme_atom_def, cons, 2, 2))
 238                 return AO_SCHEME_NIL;
 239         if (!ao_scheme_check_argt(_ao_scheme_atom_def, cons, 0, AO_SCHEME_ATOM, 0))
 240                 return AO_SCHEME_NIL;
 241
 242         return ao_scheme_atom_def(ao_scheme_arg(cons, 0), ao_scheme_arg(cons, 1));
 243 }
 244
 245 ao_poly
 246 ao_scheme_do_setq(struct ao_scheme_cons *cons)
 247 {
 248         ao_poly name;
 249         if (!ao_scheme_check_argc(_ao_scheme_atom_set21, cons, 2, 2))
 250                 return AO_SCHEME_NIL;
 251         name = cons->car;
 252         if (ao_scheme_poly_type(name) != AO_SCHEME_ATOM)
 253                 return ao_scheme_error(AO_SCHEME_INVALID, "set! of non-atom %v", name);
 254         if (!ao_scheme_atom_ref(name, NULL))
 255                 return ao_scheme_error(AO_SCHEME_INVALID, "atom %v not defined", name);
 256         return ao_scheme_cons(_ao_scheme_atom_set,
 257                               ao_scheme_cons(ao_scheme_cons(_ao_scheme_atom_quote,
 258                                                             ao_scheme_cons(name, AO_SCHEME_NIL)),
 259                                              cons->cdr));
 260 }
 261
 262 ao_poly
 263 ao_scheme_do_cond(struct ao_scheme_cons *cons)
 264 {
 265         ao_scheme_set_cond(cons);
 266         return AO_SCHEME_NIL;
 267 }
 268
 269 ao_poly
 270 ao_scheme_do_begin(struct ao_scheme_cons *cons)
 271 {
 272         ao_scheme_stack->state = eval_begin;
 273         ao_scheme_stack->sexprs = ao_scheme_cons_poly(cons);
 274         return AO_SCHEME_NIL;
 275 }
 276
 277 ao_poly
 278 ao_scheme_do_while(struct ao_scheme_cons *cons)
 279 {
 280         ao_scheme_stack->state = eval_while;
 281         ao_scheme_stack->sexprs = ao_scheme_cons_poly(cons);
 282         return AO_SCHEME_NIL;
 283 }
 284
 285 ao_poly
 286 ao_scheme_do_write(struct ao_scheme_cons *cons)
 287 {
 288         ao_poly val = AO_SCHEME_NIL;
 289         while (cons) {
 290                 val = cons->car;
 291                 ao_scheme_poly_write(val, true);
 292                 cons = ao_scheme_cons_cdr(cons);
 293                 if (cons)
 294                         printf(" ");
 295         }
 296         return _ao_scheme_bool_true;
 297 }
 298
 299 ao_poly
 300 ao_scheme_do_display(struct ao_scheme_cons *cons)
 301 {
 302         ao_poly val = AO_SCHEME_NIL;
 303         while (cons) {
 304                 val = cons->car;
 305                 ao_scheme_poly_write(val, false);
 306                 cons = ao_scheme_cons_cdr(cons);
 307         }
 308         return _ao_scheme_bool_true;
 309 }
 310
 311 static ao_poly
 312 ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op)
 313 {
 314         struct ao_scheme_cons *cons;
 315         ao_poly ret = AO_SCHEME_NIL;
 316
 317         for (cons = orig_cons; cons; cons = ao_scheme_cons_cdr(cons)) {
 318                 ao_poly         car = cons->car;
 319                 uint8_t         rt = ao_scheme_poly_type(ret);
 320                 uint8_t         ct = ao_scheme_poly_type(car);
 321
 322                 if (cons == orig_cons) {
 323                         ret = car;
 324                         ao_scheme_cons_stash(cons);
 325                         if (cons->cdr == AO_SCHEME_NIL) {
 326                                 switch (op) {
 327                                 case builtin_minus:
 328                                         if (ao_scheme_integer_typep(ct))
 329                                                 ret = ao_scheme_integer_poly(-ao_scheme_poly_integer(ret, NULL));
 330 #ifdef AO_SCHEME_FEATURE_FLOAT
 331                                         else if (ct == AO_SCHEME_FLOAT)
 332                                                 ret = ao_scheme_float_get(-ao_scheme_poly_number(ret));
 333 #endif
 334                                         break;
 335                                 case builtin_divide:
 336                                         if (ao_scheme_poly_integer(ret, NULL) == 1) {
 337                                         } else {
 338 #ifdef AO_SCHEME_FEATURE_FLOAT
 339                                                 if (ao_scheme_number_typep(ct)) {
 340                                                         float   v = ao_scheme_poly_number(ret);
 341                                                         ret = ao_scheme_float_get(1/v);
 342                                                 }
 343 #else
 344                                                 ret = ao_scheme_integer_poly(0);
 345 #endif
 346                                         }
 347                                         break;
 348                                 default:
 349                                         break;
 350                                 }
 351                         }
 352                         cons = ao_scheme_cons_fetch();
 353                 } else if (ao_scheme_integer_typep(rt) && ao_scheme_integer_typep(ct)) {
 354                         int32_t r = ao_scheme_poly_integer(ret, NULL);
 355                         int32_t c = ao_scheme_poly_integer(car, NULL);
 356 #ifdef AO_SCHEME_FEATURE_FLOAT
 357                         int64_t t;
 358 #endif
 359
 360                         switch(op) {
 361                         case builtin_plus:
 362                                 r += c;
 363                         check_overflow:
 364 #ifdef AO_SCHEME_FEATURE_FLOAT
 365                                 if (r < AO_SCHEME_MIN_BIGINT || AO_SCHEME_MAX_BIGINT < r)
 366                                         goto inexact;
 367 #endif
 368                                 break;
 369                         case builtin_minus:
 370                                 r -= c;
 371                                 goto check_overflow;
 372                                 break;
 373                         case builtin_times:
 374 #ifdef AO_SCHEME_FEATURE_FLOAT
 375                                 t = (int64_t) r * (int64_t) c;
 376                                 if (t < AO_SCHEME_MIN_BIGINT || AO_SCHEME_MAX_BIGINT < t)
 377                                         goto inexact;
 378                                 r = (int32_t) t;
 379 #else
 380                                 r = r * c;
 381 #endif
 382                                 break;
 383                         case builtin_divide:
 384 #ifdef AO_SCHEME_FEATURE_FLOAT
 385                                 if (c != 0 && (r % c) == 0)
 386                                         r /= c;
 387                                 else
 388                                         goto inexact;
 389 #else
 390                                 r /= c;
 391 #endif
 392                                 break;
 393                         case builtin_quotient:
 394                                 if (c == 0)
 395                                         return ao_scheme_error(AO_SCHEME_DIVIDE_BY_ZERO, "quotient by zero");
 396                                 r = r / c;
 397                                 break;
 398                         case builtin_floor_quotient:
 399                                 if (c == 0)
 400                                         return ao_scheme_error(AO_SCHEME_DIVIDE_BY_ZERO, "floor-quotient by zero");
 401                                 if (r % c != 0 && (c < 0) != (r < 0))
 402                                         r = r / c - 1;
 403                                 else
 404                                         r = r / c;
 405                                 break;
 406                         case builtin_remainder:
 407                                 if (c == 0)
 408                                         return ao_scheme_error(AO_SCHEME_DIVIDE_BY_ZERO, "remainder by zero");
 409                                 r %= c;
 410                                 break;
 411                         case builtin_modulo:
 412                                 if (c == 0)
 413                                         return ao_scheme_error(AO_SCHEME_DIVIDE_BY_ZERO, "modulo by zero");
 414                                 r %= c;
 415                                 if ((r < 0) != (c < 0))
 416                                         r += c;
 417                                 break;
 418                         default:
 419                                 break;
 420                         }
 421                         ao_scheme_cons_stash(cons);
 422                         ret = ao_scheme_integer_poly(r);
 423                         cons = ao_scheme_cons_fetch();
 424 #ifdef AO_SCHEME_FEATURE_FLOAT
 425                 } else if (ao_scheme_number_typep(rt) && ao_scheme_number_typep(ct)) {
 426                         float r, c;
 427                 inexact:
 428                         r = ao_scheme_poly_number(ret);
 429                         c = ao_scheme_poly_number(car);
 430                         switch(op) {
 431                         case builtin_plus:
 432                                 r += c;
 433                                 break;
 434                         case builtin_minus:
 435                                 r -= c;
 436                                 break;
 437                         case builtin_times:
 438                                 r *= c;
 439                                 break;
 440                         case builtin_divide:
 441                                 r /= c;
 442                                 break;
 443                         case builtin_quotient:
 444                         case builtin_floor_quotient:
 445                         case builtin_remainder:
 446                         case builtin_modulo:
 447                                 return ao_scheme_error(AO_SCHEME_INVALID, "non-integer value in integer divide");
 448                         default:
 449                                 break;
 450                         }
 451                         ao_scheme_cons_stash(cons);
 452                         ret = ao_scheme_float_get(r);
 453                         cons = ao_scheme_cons_fetch();
 454 #endif
 455                 }
 456                 else if (rt == AO_SCHEME_STRING && ct == AO_SCHEME_STRING && op == builtin_plus) {
 457                         ao_scheme_cons_stash(cons);
 458                         ret = ao_scheme_string_poly(ao_scheme_string_cat(ao_scheme_poly_string(ret),
 459                                                                          ao_scheme_poly_string(car)));
 460                         cons = ao_scheme_cons_fetch();
 461                         if (!ret)
 462                                 return ret;
 463                 }
 464                 else
 465                         return ao_scheme_error(AO_SCHEME_INVALID, "invalid args");
 466         }
 467         return ret;
 468 }
 469
 470 ao_poly
 471 ao_scheme_do_plus(struct ao_scheme_cons *cons)
 472 {
 473         return ao_scheme_math(cons, builtin_plus);
 474 }
 475
 476 ao_poly
 477 ao_scheme_do_minus(struct ao_scheme_cons *cons)
 478 {
 479         return ao_scheme_math(cons, builtin_minus);
 480 }
 481
 482 ao_poly
 483 ao_scheme_do_times(struct ao_scheme_cons *cons)
 484 {
 485         return ao_scheme_math(cons, builtin_times);
 486 }
 487
 488 ao_poly
 489 ao_scheme_do_divide(struct ao_scheme_cons *cons)
 490 {
 491         return ao_scheme_math(cons, builtin_divide);
 492 }
 493
 494 ao_poly
 495 ao_scheme_do_quotient(struct ao_scheme_cons *cons)
 496 {
 497         return ao_scheme_math(cons, builtin_quotient);
 498 }
 499
 500 ao_poly
 501 ao_scheme_do_floor_quotient(struct ao_scheme_cons *cons)
 502 {
 503         return ao_scheme_math(cons, builtin_floor_quotient);
 504 }
 505
 506 ao_poly
 507 ao_scheme_do_modulo(struct ao_scheme_cons *cons)
 508 {
 509         return ao_scheme_math(cons, builtin_modulo);
 510 }
 511
 512 ao_poly
 513 ao_scheme_do_remainder(struct ao_scheme_cons *cons)
 514 {
 515         return ao_scheme_math(cons, builtin_remainder);
 516 }
 517
 518 static ao_poly
 519 ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op)
 520 {
 521         ao_poly left;
 522
 523         if (!cons)
 524                 return _ao_scheme_bool_true;
 525
 526         left = cons->car;
 527         for (cons = ao_scheme_cons_cdr(cons); cons; cons = ao_scheme_cons_cdr(cons)) {
 528                 ao_poly right = cons->car;
 529
 530                 if (op == builtin_equal && left == right) {
 531                         ;
 532                 } else {
 533                         uint8_t lt = ao_scheme_poly_type(left);
 534                         uint8_t rt = ao_scheme_poly_type(right);
 535                         if (ao_scheme_integer_typep(lt) && ao_scheme_integer_typep(rt)) {
 536                                 int32_t l = ao_scheme_poly_integer(left, NULL);
 537                                 int32_t r = ao_scheme_poly_integer(right, NULL);
 538
 539                                 switch (op) {
 540                                 case builtin_less:
 541                                         if (!(l < r))
 542                                                 return _ao_scheme_bool_false;
 543                                         break;
 544                                 case builtin_greater:
 545                                         if (!(l > r))
 546                                                 return _ao_scheme_bool_false;
 547                                         break;
 548                                 case builtin_less_equal:
 549                                         if (!(l <= r))
 550                                                 return _ao_scheme_bool_false;
 551                                         break;
 552                                 case builtin_greater_equal:
 553                                         if (!(l >= r))
 554                                                 return _ao_scheme_bool_false;
 555                                         break;
 556                                 case builtin_equal:
 557                                         if (!(l == r))
 558                                                 return _ao_scheme_bool_false;
 559                                 default:
 560                                         break;
 561                                 }
 562 #ifdef AO_SCHEME_FEATURE_FLOAT
 563                         } else if (ao_scheme_number_typep(lt) && ao_scheme_number_typep(rt)) {
 564                                 float l, r;
 565
 566                                 l = ao_scheme_poly_number(left);
 567                                 r = ao_scheme_poly_number(right);
 568
 569                                 switch (op) {
 570                                 case builtin_less:
 571                                         if (!(l < r))
 572                                                 return _ao_scheme_bool_false;
 573                                         break;
 574                                 case builtin_greater:
 575                                         if (!(l > r))
 576                                                 return _ao_scheme_bool_false;
 577                                         break;
 578                                 case builtin_less_equal:
 579                                         if (!(l <= r))
 580                                                 return _ao_scheme_bool_false;
 581                                         break;
 582                                 case builtin_greater_equal:
 583                                         if (!(l >= r))
 584                                                 return _ao_scheme_bool_false;
 585                                         break;
 586                                 case builtin_equal:
 587                                         if (!(l == r))
 588                                                 return _ao_scheme_bool_false;
 589                                 default:
 590                                         break;
 591                                 }
 592 #endif /* AO_SCHEME_FEATURE_FLOAT */
 593                         } else if (lt == AO_SCHEME_STRING && rt == AO_SCHEME_STRING) {
 594                                 int c = strcmp(ao_scheme_poly_string(left)->val,
 595                                                ao_scheme_poly_string(right)->val);
 596                                 switch (op) {
 597                                 case builtin_less:
 598                                         if (!(c < 0))
 599                                                 return _ao_scheme_bool_false;
 600                                         break;
 601                                 case builtin_greater:
 602                                         if (!(c > 0))
 603                                                 return _ao_scheme_bool_false;
 604                                         break;
 605                                 case builtin_less_equal:
 606                                         if (!(c <= 0))
 607                                                 return _ao_scheme_bool_false;
 608                                         break;
 609                                 case builtin_greater_equal:
 610                                         if (!(c >= 0))
 611                                                 return _ao_scheme_bool_false;
 612                                         break;
 613                                 case builtin_equal:
 614                                         if (!(c == 0))
 615                                                 return _ao_scheme_bool_false;
 616                                         break;
 617                                 default:
 618                                         break;
 619                                 }
 620                         } else
 621                                 return _ao_scheme_bool_false;
 622                 }
 623                 left = right;
 624         }
 625         return _ao_scheme_bool_true;
 626 }
 627
 628 ao_poly
 629 ao_scheme_do_equal(struct ao_scheme_cons *cons)
 630 {
 631         return ao_scheme_compare(cons, builtin_equal);
 632 }
 633
 634 ao_poly
 635 ao_scheme_do_less(struct ao_scheme_cons *cons)
 636 {
 637         return ao_scheme_compare(cons, builtin_less);
 638 }
 639
 640 ao_poly
 641 ao_scheme_do_greater(struct ao_scheme_cons *cons)
 642 {
 643         return ao_scheme_compare(cons, builtin_greater);
 644 }
 645
 646 ao_poly
 647 ao_scheme_do_less_equal(struct ao_scheme_cons *cons)
 648 {
 649         return ao_scheme_compare(cons, builtin_less_equal);
 650 }
 651
 652 ao_poly
 653 ao_scheme_do_greater_equal(struct ao_scheme_cons *cons)
 654 {
 655         return ao_scheme_compare(cons, builtin_greater_equal);
 656 }
 657
 658 ao_poly
 659 ao_scheme_do_list_to_string(struct ao_scheme_cons *cons)
 660 {
 661         if (!ao_scheme_check_argc(_ao_scheme_atom_list2d3estring, cons, 1, 1))
 662                 return AO_SCHEME_NIL;
 663         if (!ao_scheme_check_argt(_ao_scheme_atom_list2d3estring, cons, 0, AO_SCHEME_CONS, 1))
 664                 return AO_SCHEME_NIL;
 665         return ao_scheme_string_pack(ao_scheme_poly_cons(ao_scheme_arg(cons, 0)));
 666 }
 667
 668 ao_poly
 669 ao_scheme_do_string_to_list(struct ao_scheme_cons *cons)
 670 {
 671         if (!ao_scheme_check_argc(_ao_scheme_atom_string2d3elist, cons, 1, 1))
 672                 return AO_SCHEME_NIL;
 673         if (!ao_scheme_check_argt(_ao_scheme_atom_string2d3elist, cons, 0, AO_SCHEME_STRING, 0))
 674                 return AO_SCHEME_NIL;
 675         return ao_scheme_string_unpack(ao_scheme_poly_string(ao_scheme_arg(cons, 0)));
 676 }
 677
 678 ao_poly
 679 ao_scheme_do_string_ref(struct ao_scheme_cons *cons)
 680 {
 681         char    *string;
 682         int32_t ref;
 683         if (!ao_scheme_check_argc(_ao_scheme_atom_string2dref, cons, 2, 2))
 684                 return AO_SCHEME_NIL;
 685         if (!ao_scheme_check_argt(_ao_scheme_atom_string2dref, cons, 0, AO_SCHEME_STRING, 0))
 686                 return AO_SCHEME_NIL;
 687         ref = ao_scheme_arg_int(_ao_scheme_atom_string2dref, cons, 1);
 688         if (ao_scheme_exception)
 689                 return AO_SCHEME_NIL;
 690         string = ao_scheme_poly_string(ao_scheme_arg(cons, 0))->val;
 691         while (*string && ref) {
 692                 ++string;
 693                 --ref;
 694         }
 695         if (!*string)
 696                 return ao_scheme_error(AO_SCHEME_INVALID, "%v: string %v ref %v invalid",
 697                                        _ao_scheme_atom_string2dref,
 698                                        ao_scheme_arg(cons, 0),
 699                                        ao_scheme_arg(cons, 1));
 700         return ao_scheme_int_poly(*string);
 701 }
 702
 703 ao_poly
 704 ao_scheme_do_string_length(struct ao_scheme_cons *cons)
 705 {
 706         struct ao_scheme_string *string;
 707
 708         if (!ao_scheme_check_argc(_ao_scheme_atom_string2dlength, cons, 1, 1))
 709                 return AO_SCHEME_NIL;
 710         if (!ao_scheme_check_argt(_ao_scheme_atom_string2dlength, cons, 0, AO_SCHEME_STRING, 0))
 711                 return AO_SCHEME_NIL;
 712         string = ao_scheme_poly_string(ao_scheme_arg(cons, 0));
 713         return ao_scheme_integer_poly(strlen(string->val));
 714 }
 715
 716 ao_poly
 717 ao_scheme_do_string_copy(struct ao_scheme_cons *cons)
 718 {
 719         struct ao_scheme_string *string;
 720
 721         if (!ao_scheme_check_argc(_ao_scheme_atom_string2dcopy, cons, 1, 1))
 722                 return AO_SCHEME_NIL;
 723         if (!ao_scheme_check_argt(_ao_scheme_atom_string2dcopy, cons, 0, AO_SCHEME_STRING, 0))
 724                 return AO_SCHEME_NIL;
 725         string = ao_scheme_poly_string(ao_scheme_arg(cons, 0));
 726         return ao_scheme_string_poly(ao_scheme_string_copy(string));
 727 }
 728
 729 ao_poly
 730 ao_scheme_do_string_set(struct ao_scheme_cons *cons)
 731 {
 732         char    *string;
 733         int32_t ref;
 734         int32_t val;
 735
 736         if (!ao_scheme_check_argc(_ao_scheme_atom_string2dset21, cons, 3, 3))
 737                 return AO_SCHEME_NIL;
 738         if (!ao_scheme_check_argt(_ao_scheme_atom_string2dset21, cons, 0, AO_SCHEME_STRING, 0))
 739                 return AO_SCHEME_NIL;
 740         string = ao_scheme_poly_string(ao_scheme_arg(cons, 0))->val;
 741         ref = ao_scheme_arg_int(_ao_scheme_atom_string2dset21, cons, 1);
 742         if (ao_scheme_exception)
 743                 return AO_SCHEME_NIL;
 744         val = ao_scheme_arg_int(_ao_scheme_atom_string2dset21, cons, 2);
 745         if (ao_scheme_exception)
 746                 return AO_SCHEME_NIL;
 747         while (*string && ref) {
 748                 ++string;
 749                 --ref;
 750         }
 751         if (!*string)
 752                 return ao_scheme_error(AO_SCHEME_INVALID, "%v: string %v ref %v invalid",
 753                                        _ao_scheme_atom_string2dset21,
 754                                        ao_scheme_arg(cons, 0),
 755                                        ao_scheme_arg(cons, 1));
 756         *string = val;
 757         return ao_scheme_int_poly(*string);
 758 }
 759
 760 ao_poly
 761 ao_scheme_do_flush_output(struct ao_scheme_cons *cons)
 762 {
 763         if (!ao_scheme_check_argc(_ao_scheme_atom_flush2doutput, cons, 0, 0))
 764                 return AO_SCHEME_NIL;
 765         ao_scheme_os_flush();
 766         return _ao_scheme_bool_true;
 767 }
 768
 769 ao_poly
 770 ao_scheme_do_led(struct ao_scheme_cons *cons)
 771 {
 772         int32_t led;
 773         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
 774                 return AO_SCHEME_NIL;
 775         led = ao_scheme_arg_int(_ao_scheme_atom_led, cons, 0);
 776         if (ao_scheme_exception)
 777                 return AO_SCHEME_NIL;
 778         led = ao_scheme_arg(cons, 0);
 779         ao_scheme_os_led(ao_scheme_poly_int(led));
 780         return led;
 781 }
 782
 783 ao_poly
 784 ao_scheme_do_delay(struct ao_scheme_cons *cons)
 785 {
 786         int32_t delay;
 787
 788         if (!ao_scheme_check_argc(_ao_scheme_atom_delay, cons, 1, 1))
 789                 return AO_SCHEME_NIL;
 790         delay = ao_scheme_arg_int(_ao_scheme_atom_delay, cons, 0);
 791         if (ao_scheme_exception)
 792                 return AO_SCHEME_NIL;
 793         ao_scheme_os_delay(delay);
 794         return delay;
 795 }
 796
 797 ao_poly
 798 ao_scheme_do_eval(struct ao_scheme_cons *cons)
 799 {
 800         if (!ao_scheme_check_argc(_ao_scheme_atom_eval, cons, 1, 1))
 801                 return AO_SCHEME_NIL;
 802         ao_scheme_stack->state = eval_sexpr;
 803         return cons->car;
 804 }
 805
 806 ao_poly
 807 ao_scheme_do_apply(struct ao_scheme_cons *cons)
 808 {
 809         if (!ao_scheme_check_argc(_ao_scheme_atom_apply, cons, 2, INT_MAX))
 810                 return AO_SCHEME_NIL;
 811         ao_scheme_stack->state = eval_apply;
 812         return ao_scheme_cons_poly(cons);
 813 }
 814
 815 ao_poly
 816 ao_scheme_do_read(struct ao_scheme_cons *cons)
 817 {
 818         if (!ao_scheme_check_argc(_ao_scheme_atom_read, cons, 0, 0))
 819                 return AO_SCHEME_NIL;
 820         return ao_scheme_read();
 821 }
 822
 823 ao_poly
 824 ao_scheme_do_collect(struct ao_scheme_cons *cons)
 825 {
 826         int     free;
 827         (void) cons;
 828         free = ao_scheme_collect(AO_SCHEME_COLLECT_FULL);
 829         return ao_scheme_integer_poly(free);
 830 }
 831
 832 ao_poly
 833 ao_scheme_do_nullp(struct ao_scheme_cons *cons)
 834 {
 835         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
 836                 return AO_SCHEME_NIL;
 837         if (ao_scheme_arg(cons, 0) == AO_SCHEME_NIL)
 838                 return _ao_scheme_bool_true;
 839         else
 840                 return _ao_scheme_bool_false;
 841 }
 842
 843 ao_poly
 844 ao_scheme_do_not(struct ao_scheme_cons *cons)
 845 {
 846         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
 847                 return AO_SCHEME_NIL;
 848         if (ao_scheme_arg(cons, 0) == _ao_scheme_bool_false)
 849                 return _ao_scheme_bool_true;
 850         else
 851                 return _ao_scheme_bool_false;
 852 }
 853
 854 static ao_poly
 855 ao_scheme_do_typep(int type, struct ao_scheme_cons *cons)
 856 {
 857         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
 858                 return AO_SCHEME_NIL;
 859         if (ao_scheme_poly_type(ao_scheme_arg(cons, 0)) == type)
 860                 return _ao_scheme_bool_true;
 861         return _ao_scheme_bool_false;
 862 }
 863
 864 ao_poly
 865 ao_scheme_do_pairp(struct ao_scheme_cons *cons)
 866 {
 867         ao_poly v;
 868         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
 869                 return AO_SCHEME_NIL;
 870         v = ao_scheme_arg(cons, 0);
 871         if (ao_scheme_is_pair(v))
 872                 return _ao_scheme_bool_true;
 873         return _ao_scheme_bool_false;
 874 }
 875
 876 ao_poly
 877 ao_scheme_do_integerp(struct ao_scheme_cons *cons)
 878 {
 879 #ifdef AO_SCHEME_FEATURE_BIGINT
 880         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
 881                 return AO_SCHEME_NIL;
 882         switch (ao_scheme_poly_type(ao_scheme_arg(cons, 0))) {
 883         case AO_SCHEME_INT:
 884         case AO_SCHEME_BIGINT:
 885                 return _ao_scheme_bool_true;
 886         default:
 887                 return _ao_scheme_bool_false;
 888         }
 889 #else
 890         return ao_scheme_do_typep(AO_SCHEME_INT, cons);
 891 #endif
 892 }
 893
 894 ao_poly
 895 ao_scheme_do_numberp(struct ao_scheme_cons *cons)
 896 {
 897 #if defined(AO_SCHEME_FEATURE_BIGINT) || defined(AO_SCHEME_FEATURE_FLOAT)
 898         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
 899                 return AO_SCHEME_NIL;
 900         switch (ao_scheme_poly_type(ao_scheme_arg(cons, 0))) {
 901         case AO_SCHEME_INT:
 902 #ifdef AO_SCHEME_FEATURE_BIGINT
 903         case AO_SCHEME_BIGINT:
 904 #endif
 905 #ifdef AO_SCHEME_FEATURE_FLOAT
 906         case AO_SCHEME_FLOAT:
 907 #endif
 908                 return _ao_scheme_bool_true;
 909         default:
 910                 return _ao_scheme_bool_false;
 911         }
 912 #else
 913         return ao_scheme_do_integerp(cons);
 914 #endif
 915 }
 916
 917 ao_poly
 918 ao_scheme_do_stringp(struct ao_scheme_cons *cons)
 919 {
 920         return ao_scheme_do_typep(AO_SCHEME_STRING, cons);
 921 }
 922
 923 ao_poly
 924 ao_scheme_do_symbolp(struct ao_scheme_cons *cons)
 925 {
 926         return ao_scheme_do_typep(AO_SCHEME_ATOM, cons);
 927 }
 928
 929 ao_poly
 930 ao_scheme_do_booleanp(struct ao_scheme_cons *cons)
 931 {
 932         return ao_scheme_do_typep(AO_SCHEME_BOOL, cons);
 933 }
 934
 935 ao_poly
 936 ao_scheme_do_procedurep(struct ao_scheme_cons *cons)
 937 {
 938         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
 939                 return AO_SCHEME_NIL;
 940         switch (ao_scheme_poly_type(ao_scheme_arg(cons, 0))) {
 941         case AO_SCHEME_BUILTIN:
 942         case AO_SCHEME_LAMBDA:
 943                 return _ao_scheme_bool_true;
 944         default:
 945         return _ao_scheme_bool_false;
 946         }
 947 }
 948
 949 /* This one is special -- a list is either nil or
 950  * a 'proper' list with only cons cells
 951  */
 952 ao_poly
 953 ao_scheme_do_listp(struct ao_scheme_cons *cons)
 954 {
 955         ao_poly v;
 956         if (!ao_scheme_check_argc(_ao_scheme_atom_list3f, cons, 1, 1))
 957                 return AO_SCHEME_NIL;
 958         v = ao_scheme_arg(cons, 0);
 959         for (;;) {
 960                 if (v == AO_SCHEME_NIL)
 961                         return _ao_scheme_bool_true;
 962                 if (!ao_scheme_is_cons(v))
 963                         return _ao_scheme_bool_false;
 964                 v = ao_scheme_poly_cons(v)->cdr;
 965         }
 966 }
 967
 968 ao_poly
 969 ao_scheme_do_set_car(struct ao_scheme_cons *cons)
 970 {
 971         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 2, 2))
 972                 return AO_SCHEME_NIL;
 973         if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_CONS, 0))
 974                 return AO_SCHEME_NIL;
 975         return ao_scheme_poly_cons(ao_scheme_arg(cons, 0))->car = ao_scheme_arg(cons, 1);
 976 }
 977
 978 ao_poly
 979 ao_scheme_do_set_cdr(struct ao_scheme_cons *cons)
 980 {
 981         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 2, 2))
 982                 return AO_SCHEME_NIL;
 983         if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_CONS, 0))
 984                 return AO_SCHEME_NIL;
 985         return ao_scheme_poly_cons(ao_scheme_arg(cons, 0))->cdr = ao_scheme_arg(cons, 1);
 986 }
 987
 988 ao_poly
 989 ao_scheme_do_symbol_to_string(struct ao_scheme_cons *cons)
 990 {
 991         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
 992                 return AO_SCHEME_NIL;
 993         if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_ATOM, 0))
 994                 return AO_SCHEME_NIL;
 995         return ao_scheme_string_poly(ao_scheme_atom_to_string(ao_scheme_poly_atom(ao_scheme_arg(cons, 0))));
 996 }
 997
 998 ao_poly
 999 ao_scheme_do_string_to_symbol(struct ao_scheme_cons *cons)
1000 {
1001         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
1002                 return AO_SCHEME_NIL;
1003         if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_STRING, 0))
1004                 return AO_SCHEME_NIL;
1005
1006         return ao_scheme_atom_poly(ao_scheme_string_to_atom(ao_scheme_poly_string(ao_scheme_arg(cons, 0))));;
1007 }
1008
1009 ao_poly
1010 ao_scheme_do_read_char(struct ao_scheme_cons *cons)
1011 {
1012         int     c;
1013         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 0, 0))
1014                 return AO_SCHEME_NIL;
1015         c = getchar();
1016         return ao_scheme_int_poly(c);
1017 }
1018
1019 ao_poly
1020 ao_scheme_do_write_char(struct ao_scheme_cons *cons)
1021 {
1022         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
1023                 return AO_SCHEME_NIL;
1024         if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_INT, 0))
1025                 return AO_SCHEME_NIL;
1026         putchar(ao_scheme_poly_integer(ao_scheme_arg(cons, 0), NULL));
1027         return _ao_scheme_bool_true;
1028 }
1029
1030 ao_poly
1031 ao_scheme_do_exit(struct ao_scheme_cons *cons)
1032 {
1033         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 0, 0))
1034                 return AO_SCHEME_NIL;
1035         ao_scheme_exception |= AO_SCHEME_EXIT;
1036         return _ao_scheme_bool_true;
1037 }
1038
1039 ao_poly
1040 ao_scheme_do_current_jiffy(struct ao_scheme_cons *cons)
1041 {
1042         int     jiffy;
1043
1044         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 0, 0))
1045                 return AO_SCHEME_NIL;
1046         jiffy = ao_scheme_os_jiffy();
1047         return (ao_scheme_int_poly(jiffy));
1048 }
1049
1050 ao_poly
1051 ao_scheme_do_current_second(struct ao_scheme_cons *cons)
1052 {
1053         int     second;
1054
1055         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 0, 0))
1056                 return AO_SCHEME_NIL;
1057         second = ao_scheme_os_jiffy() / AO_SCHEME_JIFFIES_PER_SECOND;
1058         return (ao_scheme_int_poly(second));
1059 }
1060
1061 ao_poly
1062 ao_scheme_do_jiffies_per_second(struct ao_scheme_cons *cons)
1063 {
1064         if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 0, 0))
1065                 return AO_SCHEME_NIL;
1066         return (ao_scheme_int_poly(AO_SCHEME_JIFFIES_PER_SECOND));
1067 }
1068
1069 #ifdef AO_SCHEME_FEATURE_VECTOR
1070
1071 ao_poly
1072 ao_scheme_do_vector(struct ao_scheme_cons *cons)
1073 {
1074         return ao_scheme_vector_poly(ao_scheme_list_to_vector(cons));
1075 }
1076
1077 ao_poly
1078 ao_scheme_do_make_vector(struct ao_scheme_cons *cons)
1079 {
1080         int32_t k;
1081
1082         if (!ao_scheme_check_argc(_ao_scheme_atom_make2dvector, cons, 2, 2))
1083                 return AO_SCHEME_NIL;
1084         k = ao_scheme_arg_int(_ao_scheme_atom_make2dvector, cons, 0);
1085         if (ao_scheme_exception)
1086                 return AO_SCHEME_NIL;
1087         return ao_scheme_vector_poly(ao_scheme_vector_alloc(k, ao_scheme_arg(cons, 1)));
1088 }
1089
1090 ao_poly
1091 ao_scheme_do_vector_ref(struct ao_scheme_cons *cons)
1092 {
1093         if (!ao_scheme_check_argc(_ao_scheme_atom_vector2dref, cons, 2, 2))
1094                 return AO_SCHEME_NIL;
1095         if (!ao_scheme_check_argt(_ao_scheme_atom_vector2dref, cons, 0, AO_SCHEME_VECTOR, 0))
1096                 return AO_SCHEME_NIL;
1097         return ao_scheme_vector_get(ao_scheme_arg(cons, 0), ao_scheme_arg(cons, 1));
1098 }
1099
1100 ao_poly
1101 ao_scheme_do_vector_set(struct ao_scheme_cons *cons)
1102 {
1103         if (!ao_scheme_check_argc(_ao_scheme_atom_vector2dset21, cons, 3, 3))
1104                 return AO_SCHEME_NIL;
1105         if (!ao_scheme_check_argt(_ao_scheme_atom_vector2dset21, cons, 0, AO_SCHEME_VECTOR, 0))
1106                 return AO_SCHEME_NIL;
1107         return ao_scheme_vector_set(ao_scheme_arg(cons, 0), ao_scheme_arg(cons, 1), ao_scheme_arg(cons, 2));
1108 }
1109
1110 ao_poly
1111 ao_scheme_do_list_to_vector(struct ao_scheme_cons *cons)
1112 {
1113         if (!ao_scheme_check_argc(_ao_scheme_atom_list2d3evector, cons, 1, 1))
1114                 return AO_SCHEME_NIL;
1115         if (!ao_scheme_check_argt(_ao_scheme_atom_list2d3evector, cons, 0, AO_SCHEME_CONS, 0))
1116                 return AO_SCHEME_NIL;
1117         return ao_scheme_vector_poly(ao_scheme_list_to_vector(ao_scheme_poly_cons(ao_scheme_arg(cons, 0))));
1118 }
1119
1120 ao_poly
1121 ao_scheme_do_vector_to_list(struct ao_scheme_cons *cons)
1122 {
1123         if (!ao_scheme_check_argc(_ao_scheme_atom_vector2d3elist, cons, 1, 1))
1124                 return AO_SCHEME_NIL;
1125         if (!ao_scheme_check_argt(_ao_scheme_atom_vector2d3elist, cons, 0, AO_SCHEME_VECTOR, 0))
1126                 return AO_SCHEME_NIL;
1127         return ao_scheme_cons_poly(ao_scheme_vector_to_list(ao_scheme_poly_vector(ao_scheme_arg(cons, 0))));
1128 }
1129
1130 ao_poly
1131 ao_scheme_do_vector_length(struct ao_scheme_cons *cons)
1132 {
1133         if (!ao_scheme_check_argc(_ao_scheme_atom_vector2d3elist, cons, 1, 1))
1134                 return AO_SCHEME_NIL;
1135         if (!ao_scheme_check_argt(_ao_scheme_atom_vector2d3elist, cons, 0, AO_SCHEME_VECTOR, 0))
1136                 return AO_SCHEME_NIL;
1137         return ao_scheme_integer_poly(ao_scheme_poly_vector(ao_scheme_arg(cons, 0))->length);
1138 }
1139
1140 ao_poly
1141 ao_scheme_do_vectorp(struct ao_scheme_cons *cons)
1142 {
1143         return ao_scheme_do_typep(AO_SCHEME_VECTOR, cons);
1144 }
1145
1146 #endif /* AO_SCHEME_FEATURE_VECTOR */
1147
1148 #define AO_SCHEME_BUILTIN_FUNCS
1149 #include "ao_scheme_builtin.h"