From b3b4731fcb89cb404433f37a7704a503567c43bd Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Thu, 16 Nov 2017 17:49:47 -0800 Subject: altos/lisp: Add scheme-style bools (#t and #f) Cond and while compare against #f, just like scheme says to. Signed-off-by: Keith Packard --- src/lisp/ao_lisp_bool.c | 73 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 73 insertions(+) create mode 100644 src/lisp/ao_lisp_bool.c (limited to 'src/lisp/ao_lisp_bool.c') diff --git a/src/lisp/ao_lisp_bool.c b/src/lisp/ao_lisp_bool.c new file mode 100644 index 00000000..ad25afba --- /dev/null +++ b/src/lisp/ao_lisp_bool.c @@ -0,0 +1,73 @@ +/* + * Copyright © 2017 Keith Packard + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * General Public License for more details. + */ + +#include "ao_lisp.h" + +static void bool_mark(void *addr) +{ + (void) addr; +} + +static int bool_size(void *addr) +{ + (void) addr; + return sizeof (struct ao_lisp_bool); +} + +static void bool_move(void *addr) +{ + (void) addr; +} + +const struct ao_lisp_type ao_lisp_bool_type = { + .mark = bool_mark, + .size = bool_size, + .move = bool_move, + .name = "bool" +}; + +void +ao_lisp_bool_print(ao_poly v) +{ + struct ao_lisp_bool *b = ao_lisp_poly_bool(v); + + if (b->value) + printf("#t"); + else + printf("#f"); +} + +#ifdef AO_LISP_MAKE_CONST + +struct ao_lisp_bool *ao_lisp_true, *ao_lisp_false; + +struct ao_lisp_bool * +ao_lisp_bool_get(uint8_t value) +{ + struct ao_lisp_bool **b; + + if (value) + b = &ao_lisp_true; + else + b = &ao_lisp_false; + + if (!*b) { + *b = ao_lisp_alloc(sizeof (struct ao_lisp_bool)); + (*b)->type = AO_LISP_BOOL; + (*b)->value = value; + } + return *b; +} + +#endif -- cgit v1.2.3