2 * Copyright © 2016 Keith Packard <keithp@keithp.com>
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.
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.
16 #include "ao_scheme.h"
22 builtin_size(void *addr)
25 return sizeof (struct ao_scheme_builtin);
29 builtin_mark(void *addr)
35 builtin_move(void *addr)
40 const struct ao_scheme_type ao_scheme_builtin_type = {
46 #ifdef AO_SCHEME_MAKE_CONST
48 #define AO_SCHEME_BUILTIN_CASENAME
49 #include "ao_scheme_builtin.h"
51 char *ao_scheme_args_name(uint8_t args) {
52 args &= AO_SCHEME_FUNC_MASK;
54 case AO_SCHEME_FUNC_LAMBDA: return ao_scheme_poly_atom(_ao_scheme_atom_lambda)->name;
55 case AO_SCHEME_FUNC_NLAMBDA: return ao_scheme_poly_atom(_ao_scheme_atom_nlambda)->name;
56 case AO_SCHEME_FUNC_MACRO: return ao_scheme_poly_atom(_ao_scheme_atom_macro)->name;
57 default: return (char *) "???";
62 #define AO_SCHEME_BUILTIN_ARRAYNAME
63 #include "ao_scheme_builtin.h"
66 ao_scheme_builtin_name(enum ao_scheme_builtin_id b) {
67 if (b < _builtin_last)
68 return ao_scheme_poly_atom(builtin_names[b])->name;
69 return (char *) "???";
72 static const ao_poly ao_scheme_args_atoms[] = {
73 [AO_SCHEME_FUNC_LAMBDA] = _ao_scheme_atom_lambda,
74 [AO_SCHEME_FUNC_NLAMBDA] = _ao_scheme_atom_nlambda,
75 [AO_SCHEME_FUNC_MACRO] = _ao_scheme_atom_macro,
79 ao_scheme_args_name(uint8_t args)
81 args &= AO_SCHEME_FUNC_MASK;
82 if (args < sizeof ao_scheme_args_atoms / sizeof ao_scheme_args_atoms[0])
83 return ao_scheme_poly_atom(ao_scheme_args_atoms[args])->name;
84 return (char *) "(unknown)";
89 ao_scheme_builtin_write(FILE *out, ao_poly b, bool write)
91 struct ao_scheme_builtin *builtin = ao_scheme_poly_builtin(b);
93 fputs(ao_scheme_builtin_name(builtin->func), out);
97 ao_scheme_typecheck(ao_poly actual, int formal_type) {
100 if ((formal_type & AO_SCHEME_ARG_MASK) == AO_SCHEME_POLY)
104 if (actual == AO_SCHEME_NIL)
105 return (formal_type & AO_SCHEME_ARG_NIL_OK) != 0;
107 actual_type = ao_scheme_poly_type(actual);
108 formal_type &= AO_SCHEME_ARG_MASK;
110 if (actual_type == formal_type)
112 if (actual_type == AO_SCHEME_BUILTIN && formal_type == AO_SCHEME_LAMBDA)
115 #ifdef AO_SCHEME_FEATURE_BIGINT
116 if (ao_scheme_integer_typep(actual_type) && formal_type == AO_SCHEME_INT)
119 #ifdef AO_SCHEME_FEATURE_FLOAT
120 if (ao_scheme_number_typep(actual_type) && formal_type == AO_SCHEME_FLOAT)
127 ao_scheme_parse_args(ao_poly name, struct ao_scheme_cons *cons, ...)
135 while ((formal = va_arg(ap, int)) != AO_SCHEME_ARG_END) {
136 if (formal & AO_SCHEME_ARG_OPTIONAL)
137 car = (ao_poly) va_arg(ap, int);
140 cons = ao_scheme_cons_cdr(cons);
141 if (!ao_scheme_typecheck(car, formal)) {
142 ao_scheme_error(AO_SCHEME_INVALID, "%v: arg %d invalid type %v", name, argc, car);
145 } else if (!(formal & AO_SCHEME_ARG_OPTIONAL)) {
148 if (formal & AO_SCHEME_ARG_RET_POLY)
149 formal = AO_SCHEME_POLY;
151 switch (formal & AO_SCHEME_ARG_MASK) {
153 #ifdef AO_SCHEME_FEATURE_BIGINT
154 case AO_SCHEME_BIGINT:
156 *(va_arg(ap, int32_t *)) = ao_scheme_poly_integer(car);
158 #ifdef AO_SCHEME_FEATURE_FLOAT
159 case AO_SCHEME_FLOAT:
160 *(va_arg(ap, float *)) = ao_scheme_poly_number(car);
164 *(va_arg(ap, ao_poly *)) = car;
167 *(va_arg(ap, void **)) = ao_scheme_ref(car);
174 ao_scheme_error(AO_SCHEME_INVALID, "%v: invalid arg count", name);
181 ao_scheme_arg(struct ao_scheme_cons *cons, int argc)
185 return AO_SCHEME_NIL;
188 cons = ao_scheme_cons_cdr(cons);
194 ao_scheme_do_quote(struct ao_scheme_cons *cons)
198 if (!ao_scheme_parse_args(_ao_scheme_atom_quote, cons,
199 AO_SCHEME_POLY, &val,
201 return AO_SCHEME_NIL;
206 ao_scheme_do_cond(struct ao_scheme_cons *cons)
208 ao_scheme_set_cond(cons);
209 return AO_SCHEME_NIL;
213 ao_scheme_do_begin(struct ao_scheme_cons *cons)
215 ao_scheme_stack->state = eval_begin;
216 ao_scheme_stack->sexprs = ao_scheme_cons_poly(cons);
217 return AO_SCHEME_NIL;
221 ao_scheme_do_while(struct ao_scheme_cons *cons)
223 ao_scheme_stack->state = eval_while;
224 ao_scheme_stack->sexprs = ao_scheme_cons_poly(cons);
225 return AO_SCHEME_NIL;
229 ao_scheme_do_display_or_write(ao_poly proc, struct ao_scheme_cons *cons, bool write)
231 #ifndef AO_SCHEME_FEATURE_PORT
235 if (!ao_scheme_parse_args(proc, cons,
236 AO_SCHEME_POLY, &val,
237 AO_SCHEME_POLY | AO_SCHEME_ARG_OPTIONAL, AO_SCHEME_NIL, &port,
239 return AO_SCHEME_NIL;
240 ao_scheme_poly_write(stdout, val, write);
243 struct ao_scheme_port *port;
246 if (!ao_scheme_parse_args(proc, cons,
247 AO_SCHEME_POLY, &val,
248 AO_SCHEME_PORT | AO_SCHEME_ARG_OPTIONAL, AO_SCHEME_NIL, &port,
250 return AO_SCHEME_NIL;
254 return _ao_scheme_bool_true;
256 ao_scheme_poly_write(file, val, write);
258 return _ao_scheme_bool_true;
262 ao_scheme_do_write(struct ao_scheme_cons *cons)
264 return ao_scheme_do_display_or_write(_ao_scheme_atom_write, cons, true);
268 ao_scheme_do_display(struct ao_scheme_cons *cons)
270 return ao_scheme_do_display_or_write(_ao_scheme_atom_display, cons, false);
274 ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op)
276 struct ao_scheme_cons *cons;
277 ao_poly ret = AO_SCHEME_NIL;
279 for (cons = orig_cons; cons; cons = ao_scheme_cons_cdr(cons)) {
280 ao_poly car = cons->car;
281 uint8_t rt = ao_scheme_poly_type(ret);
282 uint8_t ct = ao_scheme_poly_type(car);
284 if (cons == orig_cons) {
286 ao_scheme_cons_stash(cons);
287 if (cons->cdr == AO_SCHEME_NIL) {
290 if (ao_scheme_integer_typep(ct))
291 ret = ao_scheme_integer_poly(-ao_scheme_poly_integer(ret));
292 #ifdef AO_SCHEME_FEATURE_FLOAT
293 else if (ct == AO_SCHEME_FLOAT)
294 ret = ao_scheme_float_get(-ao_scheme_poly_number(ret));
298 if (ao_scheme_poly_integer(ret) == 1) {
300 #ifdef AO_SCHEME_FEATURE_FLOAT
301 if (ao_scheme_number_typep(ct)) {
302 float v = ao_scheme_poly_number(ret);
303 ret = ao_scheme_float_get(1/v);
306 ret = ao_scheme_integer_poly(0);
314 cons = ao_scheme_cons_fetch();
315 } else if (ao_scheme_integer_typep(rt) && ao_scheme_integer_typep(ct)) {
316 int32_t r = ao_scheme_poly_integer(ret);
317 int32_t c = ao_scheme_poly_integer(car);
318 #ifdef AO_SCHEME_FEATURE_FLOAT
326 #ifdef AO_SCHEME_FEATURE_FLOAT
327 if (r < AO_SCHEME_MIN_BIGINT || AO_SCHEME_MAX_BIGINT < r)
336 #ifdef AO_SCHEME_FEATURE_FLOAT
337 t = (int64_t) r * (int64_t) c;
338 if (t < AO_SCHEME_MIN_BIGINT || AO_SCHEME_MAX_BIGINT < t)
346 #ifdef AO_SCHEME_FEATURE_FLOAT
347 if (c != 0 && (r % c) == 0)
355 case builtin_quotient:
357 return ao_scheme_error(AO_SCHEME_DIVIDE_BY_ZERO, "quotient by zero");
360 case builtin_floor_quotient:
362 return ao_scheme_error(AO_SCHEME_DIVIDE_BY_ZERO, "floor-quotient by zero");
363 if (r % c != 0 && (c < 0) != (r < 0))
368 case builtin_remainder:
370 return ao_scheme_error(AO_SCHEME_DIVIDE_BY_ZERO, "remainder by zero");
375 return ao_scheme_error(AO_SCHEME_DIVIDE_BY_ZERO, "modulo by zero");
377 if ((r < 0) != (c < 0))
383 ao_scheme_cons_stash(cons);
384 ret = ao_scheme_integer_poly(r);
385 cons = ao_scheme_cons_fetch();
386 #ifdef AO_SCHEME_FEATURE_FLOAT
387 } else if (ao_scheme_number_typep(rt) && ao_scheme_number_typep(ct)) {
390 r = ao_scheme_poly_number(ret);
391 c = ao_scheme_poly_number(car);
405 case builtin_quotient:
406 case builtin_floor_quotient:
407 case builtin_remainder:
409 return ao_scheme_error(AO_SCHEME_INVALID, "non-integer value in integer divide");
413 ao_scheme_cons_stash(cons);
414 ret = ao_scheme_float_get(r);
415 cons = ao_scheme_cons_fetch();
418 else if (rt == AO_SCHEME_STRING && ct == AO_SCHEME_STRING && op == builtin_plus) {
419 ao_scheme_cons_stash(cons);
420 ret = ao_scheme_string_poly(ao_scheme_string_cat(ao_scheme_poly_string(ret),
421 ao_scheme_poly_string(car)));
422 cons = ao_scheme_cons_fetch();
427 return ao_scheme_error(AO_SCHEME_INVALID, "invalid args");
433 ao_scheme_do_plus(struct ao_scheme_cons *cons)
435 return ao_scheme_math(cons, builtin_plus);
439 ao_scheme_do_minus(struct ao_scheme_cons *cons)
441 return ao_scheme_math(cons, builtin_minus);
445 ao_scheme_do_times(struct ao_scheme_cons *cons)
447 return ao_scheme_math(cons, builtin_times);
451 ao_scheme_do_divide(struct ao_scheme_cons *cons)
453 return ao_scheme_math(cons, builtin_divide);
457 ao_scheme_do_quotient(struct ao_scheme_cons *cons)
459 return ao_scheme_math(cons, builtin_quotient);
463 ao_scheme_do_floor_quotient(struct ao_scheme_cons *cons)
465 return ao_scheme_math(cons, builtin_floor_quotient);
469 ao_scheme_do_modulo(struct ao_scheme_cons *cons)
471 return ao_scheme_math(cons, builtin_modulo);
475 ao_scheme_do_remainder(struct ao_scheme_cons *cons)
477 return ao_scheme_math(cons, builtin_remainder);
481 ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op)
486 return _ao_scheme_bool_true;
489 for (cons = ao_scheme_cons_cdr(cons); cons; cons = ao_scheme_cons_cdr(cons)) {
490 ao_poly right = cons->car;
492 if (op == builtin_equal && left == right) {
495 uint8_t lt = ao_scheme_poly_type(left);
496 uint8_t rt = ao_scheme_poly_type(right);
497 if (ao_scheme_integer_typep(lt) && ao_scheme_integer_typep(rt)) {
498 int32_t l = ao_scheme_poly_integer(left);
499 int32_t r = ao_scheme_poly_integer(right);
504 return _ao_scheme_bool_false;
506 case builtin_greater:
508 return _ao_scheme_bool_false;
510 case builtin_less_equal:
512 return _ao_scheme_bool_false;
514 case builtin_greater_equal:
516 return _ao_scheme_bool_false;
520 return _ao_scheme_bool_false;
524 #ifdef AO_SCHEME_FEATURE_FLOAT
525 } else if (ao_scheme_number_typep(lt) && ao_scheme_number_typep(rt)) {
528 l = ao_scheme_poly_number(left);
529 r = ao_scheme_poly_number(right);
534 return _ao_scheme_bool_false;
536 case builtin_greater:
538 return _ao_scheme_bool_false;
540 case builtin_less_equal:
542 return _ao_scheme_bool_false;
544 case builtin_greater_equal:
546 return _ao_scheme_bool_false;
550 return _ao_scheme_bool_false;
554 #endif /* AO_SCHEME_FEATURE_FLOAT */
555 } else if (lt == AO_SCHEME_STRING && rt == AO_SCHEME_STRING) {
556 int c = strcmp(ao_scheme_poly_string(left)->val,
557 ao_scheme_poly_string(right)->val);
561 return _ao_scheme_bool_false;
563 case builtin_greater:
565 return _ao_scheme_bool_false;
567 case builtin_less_equal:
569 return _ao_scheme_bool_false;
571 case builtin_greater_equal:
573 return _ao_scheme_bool_false;
577 return _ao_scheme_bool_false;
583 return _ao_scheme_bool_false;
587 return _ao_scheme_bool_true;
591 ao_scheme_do_equal(struct ao_scheme_cons *cons)
593 return ao_scheme_compare(cons, builtin_equal);
597 ao_scheme_do_less(struct ao_scheme_cons *cons)
599 return ao_scheme_compare(cons, builtin_less);
603 ao_scheme_do_greater(struct ao_scheme_cons *cons)
605 return ao_scheme_compare(cons, builtin_greater);
609 ao_scheme_do_less_equal(struct ao_scheme_cons *cons)
611 return ao_scheme_compare(cons, builtin_less_equal);
615 ao_scheme_do_greater_equal(struct ao_scheme_cons *cons)
617 return ao_scheme_compare(cons, builtin_greater_equal);
621 ao_scheme_do_flush_output(struct ao_scheme_cons *cons)
623 #ifndef AO_SCHEME_FEATURE_PORT
625 if (!ao_scheme_parse_args(_ao_scheme_atom_flush2doutput, cons,
626 AO_SCHEME_POLY|AO_SCHEME_ARG_OPTIONAL, AO_SCHEME_NIL, &port,
628 return AO_SCHEME_NIL;
631 struct ao_scheme_port *port;
633 if (!ao_scheme_parse_args(_ao_scheme_atom_flush2doutput, cons,
634 AO_SCHEME_PORT|AO_SCHEME_ARG_OPTIONAL, AO_SCHEME_NIL, &port,
636 return AO_SCHEME_NIL;
644 return _ao_scheme_bool_true;
647 #ifdef AO_SCHEME_FEATURE_GPIO
650 ao_scheme_do_led(struct ao_scheme_cons *cons)
653 if (!ao_scheme_parse_args(_ao_scheme_atom_led, cons,
656 return AO_SCHEME_NIL;
657 ao_scheme_os_led(led);
658 return _ao_scheme_bool_true;
664 ao_scheme_do_eval(struct ao_scheme_cons *cons)
669 if (!ao_scheme_parse_args(_ao_scheme_atom_eval, cons,
670 AO_SCHEME_POLY, &expr,
671 AO_SCHEME_POLY|AO_SCHEME_ARG_OPTIONAL, AO_SCHEME_NIL, &env,
673 return AO_SCHEME_NIL;
674 ao_scheme_stack->state = eval_sexpr;
675 ao_scheme_stack->frame = AO_SCHEME_NIL;
676 ao_scheme_frame_current = NULL;
681 ao_scheme_do_apply(struct ao_scheme_cons *cons)
683 ao_scheme_stack->state = eval_apply;
684 return ao_scheme_cons_poly(cons);
688 ao_scheme_do_read(struct ao_scheme_cons *cons)
691 #ifndef AO_SCHEME_FEATURE_PORT
693 if (!ao_scheme_parse_args(_ao_scheme_atom_read, cons,
694 AO_SCHEME_POLY|AO_SCHEME_ARG_OPTIONAL, AO_SCHEME_NIL, &port,
696 return AO_SCHEME_NIL;
698 struct ao_scheme_port *port;
700 if (!ao_scheme_parse_args(_ao_scheme_atom_read, cons,
701 AO_SCHEME_PORT|AO_SCHEME_ARG_OPTIONAL, AO_SCHEME_NIL, &port,
703 return AO_SCHEME_NIL;
707 return _ao_scheme_atom_eof;
710 return ao_scheme_read(file);
714 ao_scheme_do_collect(struct ao_scheme_cons *cons)
718 free = ao_scheme_collect(AO_SCHEME_COLLECT_FULL);
719 return ao_scheme_integer_poly(free);
723 ao_scheme_do_nullp(struct ao_scheme_cons *cons)
727 if (!ao_scheme_parse_args(_ao_scheme_atom_not, cons,
728 AO_SCHEME_POLY, &val,
730 return AO_SCHEME_NIL;
731 if (val == AO_SCHEME_NIL)
732 return _ao_scheme_bool_true;
734 return _ao_scheme_bool_false;
738 ao_scheme_do_not(struct ao_scheme_cons *cons)
742 if (!ao_scheme_parse_args(_ao_scheme_atom_not, cons,
743 AO_SCHEME_POLY, &val,
745 return AO_SCHEME_NIL;
746 if (val == _ao_scheme_bool_false)
747 return _ao_scheme_bool_true;
749 return _ao_scheme_bool_false;
753 ao_scheme_do_typep(ao_poly proc, int type, struct ao_scheme_cons *cons)
757 if (!ao_scheme_parse_args(proc, cons,
758 AO_SCHEME_POLY, &val,
760 return AO_SCHEME_NIL;
761 if (ao_scheme_poly_type(val) == type)
762 return _ao_scheme_bool_true;
763 return _ao_scheme_bool_false;
767 ao_scheme_do_procedurep(struct ao_scheme_cons *cons)
771 if (!ao_scheme_parse_args(_ao_scheme_atom_pair3f, cons,
772 AO_SCHEME_POLY, &val,
774 return AO_SCHEME_NIL;
775 switch (ao_scheme_poly_type(val)) {
776 case AO_SCHEME_BUILTIN:
777 case AO_SCHEME_LAMBDA:
778 return _ao_scheme_bool_true;
780 return _ao_scheme_bool_false;
785 ao_scheme_do_read_char(struct ao_scheme_cons *cons)
788 #ifndef AO_SCHEME_FEATURE_PORT
790 if (!ao_scheme_parse_args(_ao_scheme_atom_read2dchar, cons,
791 AO_SCHEME_POLY|AO_SCHEME_ARG_OPTIONAL, AO_SCHEME_NIL, &port,
793 return AO_SCHEME_NIL;
796 struct ao_scheme_port *port;
798 if (!ao_scheme_parse_args(_ao_scheme_atom_read2dchar, cons,
799 AO_SCHEME_PORT|AO_SCHEME_ARG_OPTIONAL, AO_SCHEME_NIL, &port,
801 return AO_SCHEME_NIL;
803 c = ao_scheme_port_getc(port);
808 return _ao_scheme_atom_eof;
809 return ao_scheme_integer_poly(c);
813 ao_scheme_do_write_char(struct ao_scheme_cons *cons)
816 #ifndef AO_SCHEME_FEATURE_PORT
818 if (!ao_scheme_parse_args(_ao_scheme_atom_write2dchar, cons,
820 AO_SCHEME_POLY|AO_SCHEME_ARG_OPTIONAL, AO_SCHEME_NIL, &port,
822 return AO_SCHEME_NIL;
825 struct ao_scheme_port *port;
826 if (!ao_scheme_parse_args(_ao_scheme_atom_write2dchar, cons,
828 AO_SCHEME_PORT|AO_SCHEME_ARG_OPTIONAL, AO_SCHEME_NIL, &port,
830 return AO_SCHEME_NIL;
832 ao_scheme_port_putc(port, c);
836 return _ao_scheme_bool_true;
840 ao_scheme_do_exit(struct ao_scheme_cons *cons)
844 if (!ao_scheme_parse_args(_ao_scheme_atom_exit, cons,
845 AO_SCHEME_POLY|AO_SCHEME_ARG_OPTIONAL, _ao_scheme_bool_true, &val,
847 return AO_SCHEME_NIL;
848 ao_scheme_exception |= AO_SCHEME_EXIT;
852 #ifdef AO_SCHEME_FEATURE_TIME
855 ao_scheme_do_current_jiffy(struct ao_scheme_cons *cons)
857 if (!ao_scheme_parse_args(_ao_scheme_atom_current2djiffy, cons,
859 return AO_SCHEME_NIL;
860 return ao_scheme_integer_poly(ao_scheme_os_jiffy());
864 ao_scheme_do_jiffies_per_second(struct ao_scheme_cons *cons)
866 if (!ao_scheme_parse_args(_ao_scheme_atom_jiffies2dper2dsecond, cons,
868 return AO_SCHEME_NIL;
869 return ao_scheme_integer_poly(AO_SCHEME_JIFFIES_PER_SECOND);
873 ao_scheme_do_delay(struct ao_scheme_cons *cons)
877 if (!ao_scheme_parse_args(_ao_scheme_atom_delay, cons,
878 AO_SCHEME_INT, &delay,
880 return AO_SCHEME_NIL;
881 ao_scheme_os_delay(delay);
886 #ifdef AO_SCHEME_FEATURE_POSIX
890 static char **ao_scheme_argv;
893 ao_scheme_set_argv(char **argv)
895 ao_scheme_argv = argv;
899 ao_scheme_do_command_line(struct ao_scheme_cons *cons)
901 ao_poly args = AO_SCHEME_NIL;
905 if (!ao_scheme_parse_args(_ao_scheme_atom_command2dline, cons,
907 return AO_SCHEME_NIL;
909 for (i = 0; ao_scheme_argv[i]; i++);
912 ao_scheme_poly_stash(args);
913 arg = ao_scheme_string_poly(ao_scheme_string_new(ao_scheme_argv[i]));
914 args = ao_scheme_poly_fetch();
916 return AO_SCHEME_NIL;
917 args = ao_scheme_cons(arg, args);
919 return AO_SCHEME_NIL;
925 ao_scheme_do_get_environment_variables(struct ao_scheme_cons *cons)
927 ao_poly envs = AO_SCHEME_NIL;
931 if (!ao_scheme_parse_args(_ao_scheme_atom_get2denvironment2dvariables, cons,
933 return AO_SCHEME_NIL;
934 for (i = 0; environ[i]; i++);
937 ao_scheme_poly_stash(envs);
938 env = ao_scheme_string_poly(ao_scheme_string_new(environ[i]));
939 envs = ao_scheme_poly_fetch();
941 return AO_SCHEME_NIL;
942 envs = ao_scheme_cons(env, envs);
944 return AO_SCHEME_NIL;
950 ao_scheme_do_get_environment_variable(struct ao_scheme_cons *cons)
952 struct ao_scheme_string *name;
955 if (!ao_scheme_parse_args(_ao_scheme_atom_get2denvironment2dvariable, cons,
956 AO_SCHEME_STRING, &name,
958 return AO_SCHEME_NIL;
959 val = secure_getenv(name->val);
961 return _ao_scheme_bool_false;
962 return ao_scheme_string_poly(ao_scheme_string_new(val));
966 ao_scheme_do_file_existsp(struct ao_scheme_cons *cons)
968 struct ao_scheme_string *name;
970 if (!ao_scheme_parse_args(_ao_scheme_atom_file2dexists3f, cons,
971 AO_SCHEME_STRING, &name,
973 return AO_SCHEME_NIL;
974 if (access(name->val, F_OK) == 0)
975 return _ao_scheme_bool_true;
976 return _ao_scheme_bool_false;
980 ao_scheme_do_delete_file(struct ao_scheme_cons *cons)
982 struct ao_scheme_string *name;
984 if (!ao_scheme_parse_args(_ao_scheme_atom_delete2dfile, cons,
985 AO_SCHEME_STRING, &name,
987 return AO_SCHEME_NIL;
988 if (unlink(name->val) == 0)
989 return _ao_scheme_bool_true;
990 return _ao_scheme_bool_false;
994 ao_scheme_do_current_second(struct ao_scheme_cons *cons)
998 if (!ao_scheme_parse_args(_ao_scheme_atom_current2dsecond, cons,
1000 return AO_SCHEME_NIL;
1001 second = (int32_t) time(NULL);
1002 return ao_scheme_integer_poly(second);
1005 #endif /* AO_SCHEME_FEATURE_POSIX */
1007 #define AO_SCHEME_BUILTIN_FUNCS
1008 #include "ao_scheme_builtin.h"