/** * lake.c * Lake Scheme * * Copyright 2011 Sami Samhuri * MIT License * * A quick and dirty scheme written in C for fun and to use while * reading The Little Schemer. * */ #include #include #include #include "env.h" #include "lake.h" #include "parse.h" static LakeVal _NIL = { TYPE_NIL, sizeof(LakeVal) }; LakeVal *NIL = &_NIL; void die(char *msg) { printf("error: %s\n", msg); exit(1); } void oom(void) { die("out of memory"); } Env *primitive_bindings(void) { Env *env = shared_env(); /* TODO */ return env; } void print(LakeVal *val) { puts(repr(val)); } LakeVal *prompt_read(char *prompt) { static int n = 1024; printf("%s", prompt); char buf[n]; if (!fgets(buf, n, stdin)) { if (ferror(stdin)) { printf("error: cannot read from stdin"); } return NULL; } return parse_expr(buf, strlen(buf)); } void run_repl_with_env(Env *env) { puts("Lake Scheme v" LAKE_VERSION); LakeVal *expr; LakeVal *result; for (;;) { expr = prompt_read("> "); if (!expr) return; result = env_eval(env, expr); print(result); } } void run_repl(void) { run_repl_with_env(primitive_bindings()); } void run_one_then_repl(int argc, char const *args[]) { /* create a top level environment */ Env *env = primitive_bindings(); /* bind args */ /* LakeList *lakeArgs = list_of_strings_from_array(argc, args); env_bind(env, "args", lakeArgs); */ /* eval (load args[0]) in env */ run_repl_with_env(env); } static char *list_repr(LakeList *list) { char s[1024]; size_t n = 0; s[n++] = '('; int i; char *s2; size_t len; for (i = 0; i < LIST_N(list); ++i) { s2 = repr(LIST_VAL(list, i)); len = strlen(s2); memcpy(s + n, s2, len); n += len; free(s2); if (i != LIST_N(list) - 1) s[n++] = ' '; } s[n++] = ')'; s[n] = 0; return strdup(s); } char *repr(LakeVal *expr) { char *s = NULL; LakeStr *str; switch (expr->type) { case TYPE_NIL: s = strdup("nil"); break; case TYPE_SYM: s = sym_repr(SYM(expr)); break; case TYPE_BOOL: printf("%s:%d TODO: repr for bools", __FILE__, __LINE__); s = strdup("[bool]"); break; case TYPE_INT: str = int_to_str(INT(expr)); s = str_val(str); str_free(str); break; case TYPE_STR: str = STR(expr); s = malloc(STR_N(str) + 3); sprintf(s, "\"%s\"", STR_S(str)); break; case TYPE_LIST: s = list_repr(LIST(expr)); break; default: printf("unrecognized value, type %d, size %lu bytes", expr->type, expr->size); s = strdup("unrecognized value"); } return s; } int main (int argc, char const *argv[]) { if (argc == 1) { run_repl(); } else { run_one_then_repl(argc, argv); } return 0; }