From dc758810b463c1674991601edb0ba41d40831e7a Mon Sep 17 00:00:00 2001 From: Bad Diode Date: Mon, 11 Oct 2021 09:59:42 +0200 Subject: Remove most code for step-by-step guide --- src/bootstrap/environment.c | 42 --- src/bootstrap/lexer.c | 207 ------------- src/bootstrap/main.c | 124 ++------ src/bootstrap/objects.c | 149 ---------- src/bootstrap/parser.c | 78 ----- src/bootstrap/primitives.c | 710 -------------------------------------------- src/bootstrap/readline.c | 28 -- src/bootstrap/shorthand.h | 37 --- src/bootstrap/string_view.c | 43 --- 9 files changed, 17 insertions(+), 1401 deletions(-) delete mode 100644 src/bootstrap/environment.c delete mode 100644 src/bootstrap/lexer.c delete mode 100644 src/bootstrap/objects.c delete mode 100644 src/bootstrap/parser.c delete mode 100644 src/bootstrap/primitives.c delete mode 100644 src/bootstrap/readline.c delete mode 100755 src/bootstrap/shorthand.h delete mode 100644 src/bootstrap/string_view.c diff --git a/src/bootstrap/environment.c b/src/bootstrap/environment.c deleted file mode 100644 index fca2449..0000000 --- a/src/bootstrap/environment.c +++ /dev/null @@ -1,42 +0,0 @@ -// -// Environment. -// - -typedef struct EnvSymbol { - Object *symbol; - Object *value; -} EnvSymbol; - -typedef struct Environment { - struct Environment *parent; - EnvSymbol *memory; - size_t size; - size_t capacity; -} Environment; - -#define ENV_SIZE 256 -static EnvSymbol environment[ENV_SIZE]; -static size_t env_n = 0; - -Object * -env_find_symbol(Object *symbol) { - for (size_t i = 0; i < env_n; i++) { - if (symbol_eq(environment[i].symbol, symbol)) { - return environment[i].value; - } - } - return obj_nil; -} - -Environment * -env_create(Environment *parent) { - // TODO: calloc env and assign parent. - return NULL; -} - -void -env_add_symbol(EnvSymbol symbol, Environment *env) { - // TODO: If empty allocate enough for one object. - // TODO: If full double the capacity and realloc. - // TODO: Put the symbol on the next slot available. -} diff --git a/src/bootstrap/lexer.c b/src/bootstrap/lexer.c deleted file mode 100644 index b03db77..0000000 --- a/src/bootstrap/lexer.c +++ /dev/null @@ -1,207 +0,0 @@ -typedef enum TokenType { - TOKEN_UNKNOWN = 0, - TOKEN_LPAREN, - TOKEN_RPAREN, - TOKEN_FIXNUM, - TOKEN_SYMBOL, - TOKEN_BOOL, - TOKEN_STRING, -} TokenType; - -typedef struct Token { - TokenType type; - StringView value; -} Token; - -typedef struct Tokens { - Token *start; - size_t n; -} Tokens; - -#define TRUE_TOKEN (StringView){"true", 4} -#define FALSE_TOKEN (StringView){"false", 5} -#define LPAREN_TOKEN (StringView){"(", 1} -#define RPAREN_TOKEN (StringView){")", 1} - -TokenType -find_token_type(StringView value) { - bool is_fixnum = true; - for (size_t i = 0; i < value.n; i++) { - char c = value.start[i]; - if (i == 0 && c == '-' && value.n > 1) { - continue; - } - if (!isdigit(c)) { - is_fixnum = false; - break; - } - } - if (is_fixnum) { - return TOKEN_FIXNUM; - } - - if (sv_equal(value, TRUE_TOKEN) || sv_equal(value, FALSE_TOKEN)) { - return TOKEN_BOOL; - } - - return TOKEN_SYMBOL; -} - -Tokens -tokenize(StringView sv) { - // NOTE: Not allocating any memory for now, but we are limited by a maximum - // number of tokens we can process. - #define TOKENS_BUF_SIZE KB(64) - static Token tokens_buf[TOKENS_BUF_SIZE]; - - // Clear buffer. - for (size_t i = 0; i < TOKENS_BUF_SIZE; i++) { - tokens_buf[i] = (Token){0}; - } - - size_t n = 0; - size_t token_n = 0; - for (size_t i = 0; i < sv.n; i++) { - switch (sv.start[i]) { - case ' ': - case '\f': - case '\n': - case '\r': - case '\t': - case '\v': { - if (token_n != 0) { - Token token = (Token){ - .type = TOKEN_UNKNOWN, - .value = (StringView){ - .start = &sv.start[i - token_n], - .n = token_n, - } - }; - token.type = find_token_type(token.value); - tokens_buf[n++] = token; - token_n = 0; - } - } break; - case ';': { - if (token_n != 0) { - Token token = (Token){ - .type = TOKEN_UNKNOWN, - .value = (StringView){ - .start = &sv.start[i - token_n], - .n = token_n, - } - }; - token.type = find_token_type(token.value); - tokens_buf[n++] = token; - token_n = 0; - } - - // Advance until the next newline. - do { - i++; - } while (i < sv.n && sv.start[(i + 1)] != '\n'); - } break; - case '"': { - if (token_n != 0) { - fprintf(stderr, "error: string started inside symbol\n"); - return (Tokens){0}; - } - - // Find end delimiter. - size_t string_start = i + 1; - size_t string_end = i + 1; - while (true) { - if (sv.start[string_end] == '"' && sv.start[string_end - 1] != '\\') { - break; - } - if (string_end >= sv.n) { - fprintf(stderr, "error: string delimiter not found\n"); - return (Tokens){0}; - } - string_end++; - } - - Token token = (Token){ - .type = TOKEN_STRING, - .value = (StringView){ - .start = &sv.start[string_start], - .n = string_end - string_start, - } - }; - tokens_buf[n++] = token; - token_n = 0; - i += string_end - string_start + 1; - } break; - case '(': { - if ((i + 1) < sv.n) { - char next_c = sv.start[i + 1]; - if (isspace(next_c)) { - fprintf(stderr, "error: lparen delimiter followed by space\n"); - return (Tokens){0}; - } - } - - if (token_n != 0) { - fprintf(stderr, "error: lparen delimiter within symbol name\n"); - return (Tokens){0}; - } - - Token token = (Token){ - .type = TOKEN_LPAREN, - .value = LPAREN_TOKEN, - }; - tokens_buf[n++] = token; - } break; - case ')': { - if ((i + 1) < sv.n) { - char next_c = sv.start[i + 1]; - if ((next_c != ')' && !isspace(next_c))) { - fprintf(stderr, "error: rparen delimiter within symbol name\n"); - return (Tokens){0}; - } - } - - if (token_n != 0) { - // Push previous token. - Token token = (Token){ - .type = TOKEN_UNKNOWN, - .value = (StringView){ - .start = &sv.start[i - token_n], - .n = token_n, - } - }; - token.type = find_token_type(token.value); - tokens_buf[n++] = token; - token_n = 0; - } - - Token token = (Token){ - .type = TOKEN_RPAREN, - .value = RPAREN_TOKEN, - }; - tokens_buf[n++] = token; - } break; - case EOF: { - break; - } break; - default: { - token_n++; - } break; - } - } - if (token_n != 0) { - // End of line encountered. - Token token = (Token){ - .type = TOKEN_UNKNOWN, - .value = (StringView){ - .start = &sv.start[sv.n - token_n], - .n = token_n, - } - }; - token.type = find_token_type(token.value); - tokens_buf[n++] = token; - } - - return (Tokens){.start = (Token *)&tokens_buf, .n = n}; -} - diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c index 66c3780..c98f60c 100755 --- a/src/bootstrap/main.c +++ b/src/bootstrap/main.c @@ -1,151 +1,59 @@ -#include #include +#include #include #include -#include - -#include "shorthand.h" -#include "string_view.c" -#include "readline.c" -#include "lexer.c" -#include "objects.c" -#include "parser.c" -#include "environment.c" -#include "primitives.c" - -// FIXME: We are not worried right now about freeing memory, but we should in -// the future. -// TODO: Better error messages. - -#define REPL_PROMPT "bdl> " void -init(void) { - // Clear env. - for (size_t i = 0; i < ENV_SIZE; i++) { - environment[i] = (EnvSymbol){0}; - } - - // Initialize singletons. - obj_nil = make_empty_list(); - obj_true = make_boolean(true); - obj_false = make_boolean(false); - - // Add primitive functions. - environment[env_n++] = (EnvSymbol){MAKE_SYM("+"), make_procedure(proc_add)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("-"), make_procedure(proc_sub)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("*"), make_procedure(proc_mul)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("/"), make_procedure(proc_div)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("%"), make_procedure(proc_mod)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("<"), make_procedure(proc_num_less_than)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM(">"), make_procedure(proc_num_greater_than)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("="), make_procedure(proc_num_equal)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("<="), make_procedure(proc_num_lesseq_than)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM(">="), make_procedure(proc_num_greatereq_than)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("null?"), make_procedure(proc_is_null)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("boolean?"), make_procedure(proc_is_boolean)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("symbol?"), make_procedure(proc_is_symbol)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("string?"), make_procedure(proc_is_string)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("fixnum?"), make_procedure(proc_is_fixnum)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("pair?"), make_procedure(proc_is_pair)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("procedure?"), make_procedure(proc_is_procedure)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("not"), make_procedure(proc_not)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("and"), make_procedure(proc_and)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("or"), make_procedure(proc_or)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("if"), make_procedure(proc_if)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("else"), obj_true}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("true"), obj_true}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("false"), obj_false}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("nil"), obj_nil}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("cond"), make_procedure(proc_cond)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("car"), make_procedure(proc_car)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("cdr"), make_procedure(proc_cdr)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("cons"), make_procedure(proc_cons)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("list"), make_procedure(proc_list)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("eq?"), make_procedure(proc_equal)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("display"), make_procedure(proc_display)}; - environment[env_n++] = (EnvSymbol){MAKE_SYM("print"), make_procedure(proc_print)}; +process_input(FILE *file) { + // TODO: Implement. + getchar(); + (void)file; } -void -eval_line(FILE *fd, char delimiter) { - StringView line = read_line(fd, delimiter); - Tokens tokens = tokenize(line); -#if DEBUG - printf("N_TOKENS: %ld\n", tokens.n); - for (size_t i = 0; i < tokens.n; i++) { - printf("\tTYPE: %3d ", tokens.start[i].type); - printf("N: %3ld ", tokens.start[i].value.n); - printf("VALUE: "); - sv_write(tokens.start[i].value); - printf("\n"); - } -#endif - while (tokens.n > 0) { - Object *ast = parse(&tokens); - if (ast) { -#if DEBUG - printf("AST: "); - display(ast); - printf("\n"); - printf("EVAL: "); -#endif - if (display(eval(ast))) { - printf("\n"); - }; - } - } -} +#define REPL_PROMPT "bdl> " void run_repl(void) { printf("BDL REPL (Press Ctrl-C to exit)\n"); while (true) { printf(REPL_PROMPT); - eval_line(stdin, '\n'); + process_input(stdin); } } void run_file(char *file_name) { -#if DEBUG - printf("Executing file: %s\n", file_name); -#endif FILE *fd = fopen(file_name, "r"); if (!fd) { - fprintf(stderr, "couldn't open file: %s\n", file_name); + fprintf(stderr, "error: couldn't open input file: %s\n", file_name); exit(EXIT_FAILURE); } - eval_line(fd, EOF); + process_input(fd); fclose(fd); } +#ifndef BIN_NAME +#define BIN_NAME "bdl" +#endif + void print_usage(void) { - printf("Usage: %s [options] \n", BIN_NAME); + printf("Usage: %s [options] \n", BIN_NAME); printf("\n"); printf("\t-i\tInteractive mode (REPL).\n"); - printf("\t-x\tExecute expression from stdin.\n"); printf("\n"); } int main(int argc, char *argv[]) { - init(); - int option; - while ((option = getopt(argc, argv, "ix")) != -1) { + while ((option = getopt(argc, argv, "i")) != -1) { switch (option) { case 'i': { // Interactive mode. run_repl(); return EXIT_SUCCESS; } break; - case 'x': { - // Execute expression from stdin. - eval_line(stdin, EOF); - return EXIT_SUCCESS; - } break; default: { print_usage(); return EXIT_FAILURE; @@ -153,6 +61,8 @@ main(int argc, char *argv[]) { } } + // TODO: Run from stdin if no file is given. + // Run from file. if (optind != argc - 1) { fprintf(stderr, "%s: No input file given.\n", BIN_NAME); diff --git a/src/bootstrap/objects.c b/src/bootstrap/objects.c deleted file mode 100644 index 344cae9..0000000 --- a/src/bootstrap/objects.c +++ /dev/null @@ -1,149 +0,0 @@ -typedef enum ObjectType { - OBJ_TYPE_FIXNUM, - OBJ_TYPE_BOOL, - OBJ_TYPE_NIL, - OBJ_TYPE_SYMBOL, - OBJ_TYPE_STRING, - OBJ_TYPE_PAIR, - OBJ_TYPE_PROCEDURE, -} ObjectType; - -typedef struct Object { - ObjectType type; - union { - // OBJ_TYPE_FIXNUM - ssize_t fixnum; - - // OBJ_TYPE_BOOL - bool boolean; - - // OBJ_TYPE_STRING - struct { - char *string; - size_t string_n; - }; - - // OBJ_TYPE_PAIR - struct { - struct Object *car; - struct Object *cdr; - }; - - // OBJ_TYPE_SYMBOL - struct { - char *symbol; - size_t symbol_n; - }; - - // OBJ_TYPE_PROCEDURE - struct Object *(*proc)(struct Object *args); - }; -} Object; - -// -// Singletons. -// - -Object *obj_nil; -Object *obj_true; -Object *obj_false; - -// -// Constructors. -// - -Object * -make_fixnum(ssize_t num) { - Object *obj = malloc(sizeof(Object)); - obj->type = OBJ_TYPE_FIXNUM; - obj->fixnum = num; - return obj; -} - -Object * -make_boolean(bool b) { - Object *obj = malloc(sizeof(Object)); - obj->type = OBJ_TYPE_BOOL; - obj->boolean = b; - return obj; -} - -Object * -make_empty_string(void) { - Object *obj = malloc(sizeof(Object)); - obj->type = OBJ_TYPE_STRING; - obj->string = NULL; - obj->string_n = 0; - return obj; -} - -void -append_string(Object *string, StringView sv) { - assert(string != NULL); - assert(string->type == OBJ_TYPE_STRING); - - if (sv.n == 0) { - return; - } - - string->string = realloc(string->string, (string->string_n + sv.n) * sizeof(char)); - memcpy(string->string + string->string_n, sv.start, sv.n); - string->string_n += sv.n; -} - -Object * -make_symbol(const char *str, size_t n) { - Object *obj = malloc(sizeof(Object)); - obj->type = OBJ_TYPE_SYMBOL; - obj->string = malloc(sizeof(char) * n); - memcpy(obj->string, str, n); - obj->string_n = n; - return obj; -} - -Object * -make_empty_list(void) { - Object *obj = malloc(sizeof(Object)); - obj->type = OBJ_TYPE_NIL; - return obj; -} - -Object * -make_procedure(Object *(*proc)(struct Object *args)) { - Object *obj = malloc(sizeof(Object)); - obj->type = OBJ_TYPE_PROCEDURE; - obj->proc = proc; - return obj; -} - -Object * -make_pair(Object *car, Object *cdr) { - Object *obj = malloc(sizeof(Object)); - obj->type = OBJ_TYPE_PAIR; - obj->car = car; - obj->cdr = cdr; - return obj; -} - -// -// Comparative ops. -// - -bool -symbol_eq(Object *a, Object *b) { - if (a->type != b->type || a->type != OBJ_TYPE_SYMBOL || a->symbol_n != b->symbol_n) { - return false; - } - for (size_t i = 0; i < a->symbol_n; i++) { - if (a->symbol[i] != b->symbol[i]) { - return false; - } - } - return true; -} - -// -// Utility macros. -// - -#define MAKE_SYM(SYM) make_symbol((SYM), sizeof(SYM) - 1) diff --git a/src/bootstrap/parser.c b/src/bootstrap/parser.c deleted file mode 100644 index 7a5b516..0000000 --- a/src/bootstrap/parser.c +++ /dev/null @@ -1,78 +0,0 @@ -Token * -consume_token(Tokens *tokens) { - if (tokens->n == 0) { - return NULL; - } - Token *ret = tokens->start; - tokens->start = &tokens->start[1]; - tokens->n--; - return ret; -} - -Object * -parse(Tokens *tokens) { - while (tokens->n > 0) { - Token *token = consume_token(tokens); - if (token == NULL) { - return NULL; - } - - switch (token->type) { - case TOKEN_FIXNUM: { - ssize_t num = 0; - int sign = 1; - for (size_t i = 0; i < token->value.n; i++) { - char c = token->value.start[i]; - if (c == '-') { - sign = -1; - continue; - } - num = num * 10 + (c - '0'); - } - return make_fixnum(num * sign); - } break; - case TOKEN_BOOL: { - if (sv_equal(token->value, TRUE_TOKEN)) { - return obj_true; - } - if (sv_equal(token->value, FALSE_TOKEN)) { - return obj_false; - } - } break; - case TOKEN_RPAREN: { - return NULL; - } break; - case TOKEN_LPAREN: { - if (tokens->n > 0 && tokens->start[0].type == TOKEN_RPAREN) { - return obj_nil; - } - - Object *next_obj = parse(tokens); - if (next_obj == NULL) { - return NULL; - } - Object *root = make_pair(next_obj, obj_nil); - Object *list = root; - while (tokens->n > 0 && (next_obj = parse(tokens)) != NULL) { - list->cdr = make_pair(next_obj, obj_nil); - list = list->cdr; - } - return root; - } break; - case TOKEN_STRING: { - Object *obj = make_empty_string(); - append_string(obj, token->value); - return obj; - } break; - case TOKEN_SYMBOL: { - return make_symbol(token->value.start, token->value.n); - } break; - default: { - fprintf(stderr, "error: unknown token\n"); - } break; - } - } - - return NULL; -} - diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c deleted file mode 100644 index 3c03b99..0000000 --- a/src/bootstrap/primitives.c +++ /dev/null @@ -1,710 +0,0 @@ -bool display(Object *root); - -void -display_pair(Object *root) { - display(root->car); - if (root->cdr->type == OBJ_TYPE_PAIR) { - printf(" "); - display_pair(root->cdr); - } else if (root->cdr == obj_nil) { - return; - } else { - printf(" . "); - display(root->cdr); - } -} - -bool -display(Object *root) { - if (root == NULL) { - return false; - } - - switch (root->type) { - case OBJ_TYPE_FIXNUM: { - printf("%zd", root->fixnum); - } break; - case OBJ_TYPE_BOOL: { - if (root->boolean) { - printf("true"); - } else { - printf("false"); - } - } break; - case OBJ_TYPE_NIL: { - printf("()"); - } break; - case OBJ_TYPE_STRING: { - printf("\"%.*s\"", (int)root->string_n, root->string); - } break; - case OBJ_TYPE_SYMBOL: { - printf(":%.*s", (int)root->symbol_n, root->symbol); - } break; - case OBJ_TYPE_PAIR: { - printf("("); - display_pair(root); - printf(")"); - } break; - case OBJ_TYPE_PROCEDURE: { - printf("#{procedure}"); - } break; - } - return true; -} - -Object * -eval(Object *root) { - switch (root->type) { - case OBJ_TYPE_FIXNUM: - case OBJ_TYPE_BOOL: - case OBJ_TYPE_NIL: - case OBJ_TYPE_STRING: { - return root; - } break; - case OBJ_TYPE_SYMBOL: { - Object *value = env_find_symbol(root); - if (value == NULL) { - printf("error: symbol not found: `"); - display(root); - printf("`\n"); - return obj_nil; - } - return value; - } break; - case OBJ_TYPE_PAIR: { - if (root->car->type == OBJ_TYPE_SYMBOL) { - Object *value = env_find_symbol(root->car); - if (value == NULL) { - printf("error: symbol not found: `"); - display(root->car); - printf("`\n"); - return obj_nil; - } - if (value->type == OBJ_TYPE_PROCEDURE) { - return value->proc(root->cdr); - } - } - } break; - default: { - printf("error: can't eval type %d.\n", root->type); - } break; - } - return obj_nil; -} - -// -// Arithmetic procedures. -// - -Object * -proc_add(Object *args) { - // Extract first parameter. - Object *car = eval(args->car); - if (car == NULL) { - fprintf(stderr, "error: not enough arguments\n"); - return obj_nil; - } - if (car->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "addition not supported for type %d\n", car->type); - return obj_nil; - } - args = args->cdr; - ssize_t tot = car->fixnum; - - while (args->type == OBJ_TYPE_PAIR) { - Object *car = eval(args->car); - if (car == NULL) { - car = obj_nil; - } - if (car->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "addition not supported for type %d\n", car->type); - return obj_nil; - } - tot += car->fixnum; - args = args->cdr; - } - return make_fixnum(tot); -} - -Object * -proc_sub(Object *args) { - // Extract first parameter. - Object *car = eval(args->car); - if (car == NULL) { - fprintf(stderr, "error: not enough arguments\n"); - return obj_nil; - } - if (car->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: sub not supported for type %d\n", car->type); - return obj_nil; - } - args = args->cdr; - ssize_t tot = car->fixnum; - - while (args->type == OBJ_TYPE_PAIR) { - car = eval(args->car); - if (car == NULL) { - car = obj_nil; - } - if (car->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: sub not supported for type %d\n", car->type); - return obj_nil; - } - tot -= car->fixnum; - args = args->cdr; - } - return make_fixnum(tot); -} - -Object * -proc_mul(Object *args) { - // Extract first parameter. - Object *car = eval(args->car); - if (car == NULL) { - fprintf(stderr, "error: not enough arguments\n"); - return obj_nil; - } - if (car->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: mult not supported for type %d\n", car->type); - return obj_nil; - } - args = args->cdr; - ssize_t tot = car->fixnum; - - while (args->type == OBJ_TYPE_PAIR) { - Object *car = eval(args->car); - if (car == NULL) { - car = obj_nil; - } - if (car->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: mult not supported for type %d\n", car->type); - return obj_nil; - } - tot *= car->fixnum; - args = args->cdr; - } - return make_fixnum(tot); -} - -Object * -proc_div(Object *args) { - // Extract first parameter. - Object *car = eval(args->car); - if (car == NULL) { - fprintf(stderr, "error: not enough arguments\n"); - return obj_nil; - } - args = args->cdr; - ssize_t tot = car->fixnum; - - while (args->type == OBJ_TYPE_PAIR) { - Object *car = eval(args->car); - if (car == NULL) { - car = obj_nil; - } - if (car->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: div not supported for type %d\n", car->type); - return obj_nil; - } - if (car->fixnum == 0) { - fprintf(stderr, "error: division by zero\n"); - return obj_nil; - } - tot /= car->fixnum; - args = args->cdr; - } - return make_fixnum(tot); -} - -Object * -proc_mod(Object *args) { - // Extract first parameter. - Object *car = eval(args->car); - if (car == NULL) { - fprintf(stderr, "error: not enough arguments\n"); - return obj_nil; - } - args = args->cdr; - ssize_t tot = car->fixnum; - - while (args->type == OBJ_TYPE_PAIR) { - Object *car = eval(args->car); - if (car == NULL) { - car = obj_nil; - } - if (car->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: div not supported for type %d\n", car->type); - return obj_nil; - } - if (car->fixnum == 0) { - fprintf(stderr, "error: division by zero\n"); - return obj_nil; - } - tot %= car->fixnum; - args = args->cdr; - } - return make_fixnum(tot); -} - -// -// Display/Evaluation procedues. -// - -Object * -proc_display(Object *args) { - if (args == NULL) { - return obj_nil; - } - if (args->type == OBJ_TYPE_PAIR) { - display(eval(args->car)); - } - return obj_nil; -} - -Object * -proc_print(Object *args) { - if (args == NULL) { - return NULL; - } - if (args->type == OBJ_TYPE_PAIR) { - Object *obj = args->car; - if (obj->type == OBJ_TYPE_STRING) { - StringView scanner = (StringView) { - .start = obj->string, - .n = obj->string_n, - }; - while (scanner.n != 0) { - char c = sv_next(&scanner); - if (c == '\\' && sv_peek(&scanner) == 'n') { - putchar('\n'); - sv_next(&scanner); - continue; - } - if (c == '\\' && sv_peek(&scanner) == '"') { - putchar('"'); - sv_next(&scanner); - continue; - } - putchar(c); - } - } else { - fprintf(stderr, "error: print requires a string argument\n"); - } - } - return NULL; -} - -// -// Type info procedures. -// - -Object * -proc_is_boolean(Object *args) { - if (args->type != OBJ_TYPE_PAIR) { - fprintf(stderr, "error: wrong number of arguments.\n"); - return NULL; - } - Object *obj = eval(args->car); - return (obj == obj_true || obj == obj_false) ? obj_true : obj_false; -} - -Object * -proc_is_null(Object *args) { - if (args->type != OBJ_TYPE_PAIR) { - fprintf(stderr, "error: wrong number of arguments.\n"); - return NULL; - } - Object *obj = eval(args->car); - return obj == obj_nil ? obj_true : obj_false; -} - -Object * -proc_is_symbol(Object *args) { - if (args->type != OBJ_TYPE_PAIR) { - fprintf(stderr, "error: wrong number of arguments.\n"); - return NULL; - } - Object *obj = eval(args->car); - return obj->type == OBJ_TYPE_SYMBOL ? obj_true : obj_false; -} - -Object * -proc_is_string(Object *args) { - if (args->type != OBJ_TYPE_PAIR) { - fprintf(stderr, "error: wrong number of arguments.\n"); - return NULL; - } - Object *obj = eval(args->car); - return obj->type == OBJ_TYPE_STRING ? obj_true : obj_false; -} - -Object * -proc_is_fixnum(Object *args) { - if (args->type != OBJ_TYPE_PAIR) { - fprintf(stderr, "error: wrong number of arguments.\n"); - return NULL; - } - Object *obj = eval(args->car); - return obj->type == OBJ_TYPE_FIXNUM ? obj_true : obj_false; -} - -Object * -proc_is_pair(Object *args) { - if (args->type != OBJ_TYPE_PAIR) { - fprintf(stderr, "error: wrong number of arguments.\n"); - return NULL; - } - Object *obj = eval(args->car); - return obj->type == OBJ_TYPE_PAIR ? obj_true : obj_false; -} - -Object * -proc_is_procedure(Object *args) { - if (args->type != OBJ_TYPE_PAIR) { - fprintf(stderr, "error: wrong number of arguments.\n"); - return NULL; - } - Object *obj = eval(args->car); - return obj->type == OBJ_TYPE_PROCEDURE ? obj_true : obj_false; -} - -// -// Boolean/conditional procedures. -// - -Object * -proc_not(Object *args) { - if (args->type == OBJ_TYPE_PAIR) { - return eval(args->car) == obj_false ? obj_true : obj_false; - } - return eval(args) == obj_false ? obj_true : obj_false; -} - -Object * -proc_and(Object *args) { - while (args != NULL && args != obj_nil) { - Object *obj = args->car; - if (args->car->type == OBJ_TYPE_PAIR) { - obj = eval(args->car); - } - if (proc_not(obj) == obj_true) { - return obj_false; - } - args = args->cdr; - } - return obj_true; -} - -Object * -proc_or(Object *args) { - if (args->type != OBJ_TYPE_PAIR) { - return obj_false; - } - - while (args != NULL && args != obj_nil) { - Object *obj = args->car; - if (args->car->type == OBJ_TYPE_PAIR) { - obj = eval(args->car); - } - if (proc_not(obj) == obj_false) { - return obj_true; - } - args = args->cdr; - } - return obj_false; -} - -Object * -proc_if(Object *args) { - if (args->type != OBJ_TYPE_PAIR || args->cdr->type != OBJ_TYPE_PAIR) { - fprintf(stderr, "error: wrong number of arguments.\n"); - return NULL; - } - - Object *condition = eval(args->car); - if (condition == obj_true) { - Object *ret = eval(args->cdr->car); - return ret; - } - if (args->cdr->cdr != obj_nil) { - Object *ret = eval(args->cdr->cdr->car); - return ret; - } - - return obj_nil; -} - -Object * -proc_cond(Object *args) { - if (args->type != OBJ_TYPE_PAIR) { - fprintf(stderr, "error: wrong number of arguments.\n"); - return NULL; - } - - if (args->car->type != OBJ_TYPE_PAIR) { - fprintf(stderr, "error: wrong argument type.\n"); - return NULL; - } - - while (args != obj_nil) { - Object *clause = args->car; - if (eval(clause->car) == obj_true) { - return eval(clause->cdr->car); - } - args = args->cdr; - } - - return obj_nil; -} - -Object * -proc_num_less_than(Object *args) { - if (args == obj_nil) { - fprintf(stderr, "error: wrong number of arguments type.\n"); - return NULL; - } - - Object *obj = eval(args->car); - if (obj->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: wrong argument type.\n"); - return NULL; - } - ssize_t prev = obj->fixnum; - args = args->cdr; - - if (args == obj_nil) { - fprintf(stderr, "error: wrong number of arguments type.\n"); - return NULL; - } - while (args != obj_nil) { - Object *obj = eval(args->car); - if (obj->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: wrong argument type.\n"); - return NULL; - } - if (prev >= obj->fixnum) { - return obj_false; - } - prev = obj->fixnum; - args = args->cdr; - } - return obj_true; -} - -Object * -proc_num_greater_than(Object *args) { - if (args == obj_nil) { - fprintf(stderr, "error: wrong number of arguments type.\n"); - return NULL; - } - - Object *obj = eval(args->car); - if (obj->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: wrong argument type.\n"); - return NULL; - } - ssize_t prev = obj->fixnum; - args = args->cdr; - - if (args == obj_nil) { - fprintf(stderr, "error: wrong number of arguments type.\n"); - return NULL; - } - while (args != obj_nil) { - Object *obj = eval(args->car); - if (obj->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: wrong argument type.\n"); - return NULL; - } - if (prev <= obj->fixnum) { - return obj_false; - } - prev = obj->fixnum; - args = args->cdr; - } - return obj_true; -} - -Object * -proc_num_lesseq_than(Object *args) { - if (args == obj_nil) { - fprintf(stderr, "error: wrong number of arguments type.\n"); - return NULL; - } - - Object *obj = eval(args->car); - if (obj->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: wrong argument type.\n"); - return NULL; - } - ssize_t prev = obj->fixnum; - args = args->cdr; - - if (args == obj_nil) { - fprintf(stderr, "error: wrong number of arguments type.\n"); - return NULL; - } - while (args != obj_nil) { - Object *obj = eval(args->car); - if (obj->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: wrong argument type.\n"); - return NULL; - } - if (prev > obj->fixnum) { - return obj_false; - } - prev = obj->fixnum; - args = args->cdr; - } - return obj_true; -} - -Object * -proc_num_greatereq_than(Object *args) { - if (args == obj_nil) { - fprintf(stderr, "error: wrong number of arguments type.\n"); - return NULL; - } - - Object *obj = eval(args->car); - if (obj->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: wrong argument type.\n"); - return NULL; - } - ssize_t prev = obj->fixnum; - args = args->cdr; - - if (args == obj_nil) { - fprintf(stderr, "error: wrong number of arguments type.\n"); - return NULL; - } - while (args != obj_nil) { - Object *obj = eval(args->car); - if (obj->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: wrong argument type.\n"); - return NULL; - } - if (prev < obj->fixnum) { - return obj_false; - } - prev = obj->fixnum; - args = args->cdr; - } - return obj_true; -} - -Object * -proc_num_equal(Object *args) { - if (args == obj_nil) { - fprintf(stderr, "error: wrong number of arguments type.\n"); - return NULL; - } - - Object *obj = eval(args->car); - if (obj->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: wrong argument type.\n"); - return NULL; - } - ssize_t prev = obj->fixnum; - args = args->cdr; - - if (args == obj_nil) { - fprintf(stderr, "error: wrong number of arguments type.\n"); - return NULL; - } - while (args != obj_nil) { - Object *obj = eval(args->car); - if (obj->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "error: wrong argument type.\n"); - return NULL; - } - if (prev != obj->fixnum) { - return obj_false; - } - prev = obj->fixnum; - args = args->cdr; - } - return obj_true; -} - -// -// List operation procedures. -// - -Object * -proc_car(Object *args) { - if (args == obj_nil) { - fprintf(stderr, "error: not enough arguments\n"); - return obj_nil; - } - Object *obj = eval(args->car); - if (obj->type != OBJ_TYPE_PAIR) { - fprintf(stderr, "error: wrong argument type\n"); - return obj_nil; - } - return obj->car; -} - -Object * -proc_cdr(Object *args) { - if (args == obj_nil) { - fprintf(stderr, "error: not enough arguments\n"); - return obj_nil; - } - Object *obj = eval(args->car); - if (obj->type != OBJ_TYPE_PAIR) { - fprintf(stderr, "error: wrong argument type\n"); - return obj_nil; - } - return obj->cdr; -} - -Object * -proc_cons(Object *args) { - if (args == obj_nil || args->cdr == obj_nil) { - fprintf(stderr, "error: not enough arguments\n"); - return obj_nil; - } - Object *a = eval(args->car); - Object *b = eval(args->cdr->car); - return make_pair(a, b); -} - -Object * -proc_list(Object *args) { - if (args == obj_nil) { - return obj_nil; - } - Object *head = make_pair(eval(args->car), obj_nil); - Object *curr = head; - args = args->cdr; - while (args != obj_nil) { - curr->cdr = make_pair(eval(args->car), obj_nil); - curr = curr->cdr; - args = args->cdr; - } - return head; -} - -// -// Polymorphic procedures. -// - -Object * -proc_equal(Object *args) { - // TODO: stub - (void) args; - return NULL; -} - -// TODO: fixnum left/right shift, mask, invert -// TODO: implement and test missing procedures -// TODO: add primitives for type transforms: string->symbol, symbol->string, etc -// TODO: properly implement nested environments -// TODO: implement support for quotes and semi-quotes -// TODO: LAMBDA -// TODO: let -// TODO: better error handling? -// TODO: Revise all instances where we are returning an object, since currently -// we may be returning a pointer to an object instead of a new one. Check also -// on eval function and everytime we do make_xxx(obj). diff --git a/src/bootstrap/readline.c b/src/bootstrap/readline.c deleted file mode 100644 index ae03e4a..0000000 --- a/src/bootstrap/readline.c +++ /dev/null @@ -1,28 +0,0 @@ -#define READLINE_VALID_CHAR(C) (((u8)(C) >= 0x20 && (u8)(C) < 0x7F) || (C) == '\n') - -StringView -read_line(FILE *fd, char delimiter) { - #define RL_BUF_SIZE KB(64) - static char readline_buf[RL_BUF_SIZE]; - - // Clear buffer. - for (size_t i = 0; i < RL_BUF_SIZE; i++) { - readline_buf[i] = 0; - } - - // Barebones readline implementation. - size_t n = 0; - char c; - while ((c = getc(fd)) != delimiter) { - if (c == '\b') { - readline_buf[n] = '\0'; - n--; - } else if (READLINE_VALID_CHAR(c) && n < RL_BUF_SIZE) { - readline_buf[n] = c; - n++; - } - } - - return (StringView){.start = (char *)&readline_buf, .n = n}; -} - diff --git a/src/bootstrap/shorthand.h b/src/bootstrap/shorthand.h deleted file mode 100755 index 6fcb82c..0000000 --- a/src/bootstrap/shorthand.h +++ /dev/null @@ -1,37 +0,0 @@ -#ifndef SHORTHAND_H -#define SHORTHAND_H - -#include -#include -#include -#include - -// -// This simple header just typedefs the basic C define types to a shorter name, -// loads the quality of life bool macro for _Bool and defines shorthand macros -// for byte sizes. -// - -typedef uint8_t u8; -typedef uint16_t u16; -typedef uint32_t u32; -typedef uint64_t u64; -typedef int8_t s8; -typedef int16_t s16; -typedef int32_t s32; -typedef int64_t s64; -typedef volatile u8 vu8; -typedef volatile u16 vu16; -typedef volatile u32 vu32; -typedef volatile u64 vu64; -typedef volatile s8 vs8; -typedef volatile s16 vs16; -typedef volatile s32 vs32; -typedef volatile s64 vs64; - -#define KB(N) ((u64)(N) * 1024) -#define MB(N) ((u64)KB(N) * 1024) -#define GB(N) ((u64)MB(N) * 1024) -#define TB(N) ((u64)GB(N) * 1024) - -#endif // SHORTHAND_H diff --git a/src/bootstrap/string_view.c b/src/bootstrap/string_view.c deleted file mode 100644 index e958a46..0000000 --- a/src/bootstrap/string_view.c +++ /dev/null @@ -1,43 +0,0 @@ -typedef struct StringView { - char *start; - size_t n; -} StringView; - -void -sv_write(StringView sv) { - for (size_t i = 0; i < sv.n; i++) { - putchar(sv.start[i]); - } -} - -bool -sv_equal(StringView a, StringView b) { - if (a.n == b.n) { - for (size_t i = 0; i < a.n; i++) { - if (a.start[i] != b.start[i]) { - return false; - } - } - return true; - } - return false; -} - -char -sv_next(StringView *sv) { - if (sv->n == 0) { - return '\0'; - } - char ret = sv->start[0]; - sv->start++; - sv->n--; - return ret; -} - -char -sv_peek(const StringView *sv) { - if (sv->n == 0) { - return '\0'; - } - return sv->start[0]; -} -- cgit v1.2.1