void lispTask(void *pvParameters) { startTask = xPortGetFreeHeapSize(); lisp env = lisp_init(); afterInit = xPortGetFreeHeapSize(); lisp_run(&env); return; // TODO: move into a mem info and profile function! xQueueHandle *queue = (xQueueHandle *)pvParameters; printf("Hello from lispTask!\r\n"); uint32 count = 0; while(1) { //vTaskDelay(300); // 3s lisp_run(&env); xQueueSend(*queue, &count, 0); count++; } }
int main(int argc, char* argv[]) { value_t v; stack_bottom = ((char*)&v) - PROCESS_STACK_SIZE; lisp_init(); if (setjmp(toplevel)) { SP = 0; fprintf(stderr, "\n"); if (infile) { fprintf(stderr, "error loading file \"%s\"\n", infile); infile = NULL; } goto repl; } load_file("system.lsp"); if (argc > 1) { load_file(argv[1]); return 0; } printf("Welcome to femtoLisp ----------------------------------------------------------\n"); repl: while (1) { printf("> "); v = read_sexpr(stdin); if (feof(stdin)) break; print(stdout, v=toplevel_eval(v)); set(symbol("that"), v); printf("\n\n"); } return 0; }
int main(int argc, char **argv) { lisp_runtime rt; lisp_init(&rt); lisp_scope *scope = (lisp_scope*)lisp_new(&rt, type_scope); lisp_scope_populate_builtins(&rt, scope); while (true) { char *input = readline("> "); if (input == NULL) { break; } lisp_value *value = lisp_parse(&rt, input); add_history(input); free(input); lisp_value *result = lisp_eval(&rt, scope, value); lisp_print(stdout, result); fprintf(stdout, "\n"); lisp_mark(&rt, (lisp_value*)scope); lisp_sweep(&rt); } lisp_destroy(&rt); return 0; }
main(int argc, char **argv) { lisp_init(100000,0x2000); char *use_file="install.lsp"; for (int i=1;i<argc;i++) { if (!strcmp(argv[i],"-f")) { i++; use_file=argv[i]; } } char prog[100],*s; sprintf(prog,"(compile-file \"%s\")\n",use_file); s=prog; if (!eval(compile(s))) { printf("unable to open file %s",use_file); exit(0); } return 0; }
int main(int argc, char **argv) { if (argc > 1) while (++argv, --argc) { if (!strcmp("-c", argv[0])) color_on = 1; else if (!strcmp("-h", argv[0])) printf("liblisp unit tests\n\tusage ./%s (-c)? (-h)?\n", argv[0]); else printf("unknown argument '%s'\n", argv[0]); } unit_test_start("liblisp"); { print_note("util.c"); test(is_number("0xfAb")); test(is_number("-01234567")); test(is_number("+1000000000000000000000000000003")); test(!is_number("")); test(!is_number("+")); test(!is_number("-")); test(unbalanced("(((", '(', ')') > 0); test(unbalanced("))", '(', ')') < 0); test(unbalanced("", '(', ')') == 0); test(unbalanced("\"(", '(', ')') == 0); test(unbalanced("( \"))))(()()()(()\\\"())\")", '(', ')') == 0); test(unbalanced("(a (b) c (d (e (f) \")\" g)))", '(', ')') == 0); test(unbalanced("((a b) c", '(', ')') > 0); test(!is_fnumber("")); test(!is_fnumber("1e")); test(!is_fnumber("-1e")); test(!is_fnumber("1-e")); test(is_fnumber("+0.")); test(is_fnumber("123")); /*this passes, see header */ test(is_fnumber("1e-3")); test(is_fnumber("1.003e+34")); test(is_fnumber("1e34")); test(is_fnumber("93.04")); test(match("", "")); test(match("abc", "abc")); test(!match("abC", "abc")); test(match("aaa*", "aaaXX")); test(!match("aaa*", "XXaaaXX")); test(match(".bc", "abc")); test(match("a.c", "aXc")); test(!match("a\\.c", "aXc")); test(match("a\\.c", "a.c")); char *s = NULL; state(s = vstrcatsep(",", "a", "b", "c", "", "foo", "bar", NULL)); test(!sstrcmp("a,b,c,,foo,bar", s)); free(s); char *t = NULL, *s1 = "Hello,", *s2 = " World!"; state(t = calloc(16, 1)); state(strcpy(t, s1)); test(((size_t) (lstrcatend(t, s2) - t)) == (strlen(s1) + strlen(s2))); free(t); /*test tr, or translate, functionality */ size_t trinsz = 0; uint8_t trout[128] = { 0 }, *trin = (uint8_t *) "aaabbbcdaacccdeeefxxxa"; tr_state_t *tr1; state(tr1 = tr_new()); state(trinsz = strlen((char *)trin)); test(tr_init(tr1, "", (uint8_t *) "abc", (uint8_t *) "def") == TR_OK); test(tr_block(tr1, trin, trout, trinsz) == trinsz); test(!strcmp((char *)trout, "dddeeefdddfffdeeefxxxd")); test(tr_init(tr1, "s", (uint8_t *) "abc", (uint8_t *) "def") == TR_OK); state(memset(trout, 0, 128)); test(tr_block(tr1, trin, trout, trinsz) <= trinsz); test(!strcmp((char *)trout, "defddfdeeefxxxd")); state(tr_delete(tr1)); /*know collisions for the djb2 hash algorithm */ test(djb2("heliotropes", strlen("heliotropes")) == djb2("neurospora", strlen("neurospora"))); test(djb2("depravement", strlen("depravement")) == djb2("serafins", strlen("serafins"))); /*should not collide */ test(djb2("heliotropes", strlen("heliotropes")) != djb2("serafins", strlen("serafins"))); } { /*io.c test */ io_t *in, *out; print_note("io.c"); /*string input */ static const char hello[] = "Hello\n"; /**@note io_sin currently duplicates "hello" internally*/ state(in = io_sin(hello, strlen(hello))); test(io_is_in(in)); test(io_getc(in) == 'H'); test(io_getc(in) == 'e'); test(io_getc(in) == 'l'); test(io_getc(in) == 'l'); test(io_getc(in) == 'o'); test(io_getc(in) == '\n'); test(io_getc(in) == EOF); test(io_getc(in) == EOF); test(!io_error(in)); test(io_seek(in, 0, SEEK_SET) >= 0); test(io_getc(in) == 'H'); test(io_seek(in, 3, SEEK_SET) >= 0); test(io_getc(in) == 'l'); test(io_ungetc('x', in) == 'x'); test(io_getc(in) == 'x'); test(io_getc(in) == 'o'); state(io_close(in)); /*string output */ char *s = NULL; static const char hello_world[] = "Hello,\n\tWorld!\n"; /**@note io_sin currently duplicates hello_world internally*/ state(in = io_sin(hello_world, strlen(hello_world))); test(!strcmp(s = io_getline(in), "Hello,")); s = (free(s), NULL); test(!strcmp(s = io_getline(in), "\tWorld!")); s = (free(s), NULL); test(!io_getline(in)); test(io_seek(in, 0, SEEK_SET) >= 0); test(!strcmp(s = io_getdelim(in, EOF), "Hello,\n\tWorld!\n")); s = (free(s), NULL); state(io_close(in)); state(out = io_sout(1)); test(io_puts("Hello, World", out) != EOF); test(!strcmp("Hello, World", io_get_string(out))); test(io_putc('\n', out) != EOF); test(!strcmp("Hello, World\n", io_get_string(out))); test(io_seek(out, -6, SEEK_CUR) >= 0); test(io_puts("Mars\n", out) != EOF); test(!strcmp("Hello, Mars\n\n", io_get_string(out))); free(io_get_string(out)); state(io_close(out)); static const char block_in[16] = {1, 3, 4, 6}; static char block_out[16] = {0}; state((in = io_sin(block_in, 16))); test(io_getc(in) == 1); test(io_read(block_out, 15, in) == 15); test(!memcmp(block_out, block_in+1, 15)); state(io_close(in)); } { /* hash.c hash table tests */ hash_table_t *h = NULL; print_note("hash.c"); state(h = hash_create(1)); return_if(!h); test(!hash_insert(h, "key1", "val1")); test(!hash_insert(h, "key2", "val2")); /* assuming the hash algorithm is djb2, then * "heliotropes" collides with "neurospora" * "depravement" collides with "serafins" * "playwright" collides with "snush" (for djb2a) * See: * <https://programmers.stackexchange.com/questions/49550/which-hashing-algorithm-is-best-for-uniqueness-and-speed> */ test(!hash_insert(h, "heliotropes", "val3")); test(!hash_insert(h, "neurospora", "val4")); test(!hash_insert(h, "depravement", "val5")); test(!hash_insert(h, "serafins", "val6")); test(!hash_insert(h, "playwright", "val7")); test(!hash_insert(h, "snush", "val8")); test(!hash_insert(h, "", "val9")); test(!hash_insert(h, "nil", "")); test(!hash_insert(h, "a", "x")); test(!hash_insert(h, "a", "y")); test(!hash_insert(h, "a", "z")); test(!sstrcmp("val1", hash_lookup(h, "key1"))); test(!sstrcmp("val2", hash_lookup(h, "key2"))); test(!sstrcmp("val3", hash_lookup(h, "heliotropes"))); test(!sstrcmp("val4", hash_lookup(h, "neurospora"))); test(!sstrcmp("val5", hash_lookup(h, "depravement"))); test(!sstrcmp("val6", hash_lookup(h, "serafins"))); test(!sstrcmp("val7", hash_lookup(h, "playwright"))); test(!sstrcmp("val8", hash_lookup(h, "snush"))); test(!sstrcmp("val9", hash_lookup(h, ""))); test(!sstrcmp("", hash_lookup(h, "nil"))); test(!sstrcmp("z", hash_lookup(h, "a"))); test(hash_get_load_factor(h) <= 0.75f); state(hash_destroy(h)); } { /* lisp.c (and the lisp interpreter in general) */ lisp_t *l; print_note("lisp.c"); /*while unit testing eschews state being held across tests it is makes *little sense in this case*/ state(l = lisp_init()); state(io_close(lisp_get_logging(l))); test(!lisp_set_logging(l, io_nout())); return_if(!l); test(!lisp_eval_string(l, "")); test(is_int(lisp_eval_string(l, "2"))); test(get_int(lisp_eval_string(l, "(+ 2 2)")) == 4); test(get_int(lisp_eval_string(l, "(* 3 2)")) == 6); lisp_cell_t *x = NULL, *y = NULL, *z = NULL; char *t = NULL; state(x = lisp_intern(l, lstrdup_or_abort("foo"))); state(y = lisp_intern(l, t = lstrdup_or_abort("foo"))); /*this one needs freeing! */ state(z = lisp_intern(l, lstrdup_or_abort("bar"))); test(x == y && x != NULL); test(x != z); free(t); /*free the non-interned string */ test(is_proc(lisp_eval_string(l, "(define square (lambda (x) (* x x)))"))); test(get_int(lisp_eval_string(l, "(square 4)")) == 16); test(!is_list(cons(l, gsym_tee(), gsym_tee()))); test(is_list(cons(l, gsym_tee(), gsym_nil()))); test(!is_list(cons(l, gsym_nil(), cons(l, gsym_tee(), gsym_tee())))); test(is_list(mk_list(l, gsym_tee(), gsym_nil(), gsym_tee(), NULL))); test(gsym_error() == lisp_eval_string(l, "(> 'a 1)")); test(is_sym(x)); test(is_asciiz(x)); test(!is_str(x)); test(gsym_error() == lisp_eval_string(l, "(eval (cons quote 0))")); char *serial = NULL; test(!strcmp((serial = lisp_serialize(l, cons(l, gsym_tee(), gsym_error()))), "(t . error)")); state(free(serial)); state(lisp_destroy(l)); } return unit_test_end("liblisp"); /*should be zero! */ }