aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBad Diode <bd@badd10de.dev>2021-10-11 09:59:42 +0200
committerBad Diode <bd@badd10de.dev>2021-10-11 09:59:42 +0200
commitdc758810b463c1674991601edb0ba41d40831e7a (patch)
tree229b257883245adbfde2c056e6a0348e757ae130
parentc497aca556295479b1ed5632e125ff1d0658d8d8 (diff)
downloadbdl-dc758810b463c1674991601edb0ba41d40831e7a.tar.gz
bdl-dc758810b463c1674991601edb0ba41d40831e7a.zip
Remove most code for step-by-step guidev0.0
Diffstat
-rw-r--r--src/bootstrap/environment.c42
-rw-r--r--src/bootstrap/lexer.c207
-rwxr-xr-xsrc/bootstrap/main.c124
-rw-r--r--src/bootstrap/objects.c149
-rw-r--r--src/bootstrap/parser.c78
-rw-r--r--src/bootstrap/primitives.c710
-rw-r--r--src/bootstrap/readline.c28
-rwxr-xr-xsrc/bootstrap/shorthand.h37
-rw-r--r--src/bootstrap/string_view.c43
9 files changed, 17 insertions, 1401 deletions
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 @@
1//
2// Environment.
3//
4
5typedef struct EnvSymbol {
6 Object *symbol;
7 Object *value;
8} EnvSymbol;
9
10typedef struct Environment {
11 struct Environment *parent;
12 EnvSymbol *memory;
13 size_t size;
14 size_t capacity;
15} Environment;
16
17#define ENV_SIZE 256
18static EnvSymbol environment[ENV_SIZE];
19static size_t env_n = 0;
20
21Object *
22env_find_symbol(Object *symbol) {
23 for (size_t i = 0; i < env_n; i++) {
24 if (symbol_eq(environment[i].symbol, symbol)) {
25 return environment[i].value;
26 }
27 }
28 return obj_nil;
29}
30
31Environment *
32env_create(Environment *parent) {
33 // TODO: calloc env and assign parent.
34 return NULL;
35}
36
37void
38env_add_symbol(EnvSymbol symbol, Environment *env) {
39 // TODO: If empty allocate enough for one object.
40 // TODO: If full double the capacity and realloc.
41 // TODO: Put the symbol on the next slot available.
42}
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 @@
1typedef enum TokenType {
2 TOKEN_UNKNOWN = 0,
3 TOKEN_LPAREN,
4 TOKEN_RPAREN,
5 TOKEN_FIXNUM,
6 TOKEN_SYMBOL,
7 TOKEN_BOOL,
8 TOKEN_STRING,
9} TokenType;
10
11typedef struct Token {
12 TokenType type;
13 StringView value;
14} Token;
15
16typedef struct Tokens {
17 Token *start;
18 size_t n;
19} Tokens;
20
21#define TRUE_TOKEN (StringView){"true", 4}
22#define FALSE_TOKEN (StringView){"false", 5}
23#define LPAREN_TOKEN (StringView){"(", 1}
24#define RPAREN_TOKEN (StringView){")", 1}
25
26TokenType
27find_token_type(StringView value) {
28 bool is_fixnum = true;
29 for (size_t i = 0; i < value.n; i++) {
30 char c = value.start[i];
31 if (i == 0 && c == '-' && value.n > 1) {
32 continue;
33 }
34 if (!isdigit(c)) {
35 is_fixnum = false;
36 break;
37 }
38 }
39 if (is_fixnum) {
40 return TOKEN_FIXNUM;
41 }
42
43 if (sv_equal(value, TRUE_TOKEN) || sv_equal(value, FALSE_TOKEN)) {
44 return TOKEN_BOOL;
45 }
46
47 return TOKEN_SYMBOL;
48}
49
50Tokens
51tokenize(StringView sv) {
52 // NOTE: Not allocating any memory for now, but we are limited by a maximum
53 // number of tokens we can process.
54 #define TOKENS_BUF_SIZE KB(64)
55 static Token tokens_buf[TOKENS_BUF_SIZE];
56
57 // Clear buffer.
58 for (size_t i = 0; i < TOKENS_BUF_SIZE; i++) {
59 tokens_buf[i] = (Token){0};
60 }
61
62 size_t n = 0;
63 size_t token_n = 0;
64 for (size_t i = 0; i < sv.n; i++) {
65 switch (sv.start[i]) {
66 case ' ':
67 case '\f':
68 case '\n':
69 case '\r':
70 case '\t':
71 case '\v': {
72 if (token_n != 0) {
73 Token token = (Token){
74 .type = TOKEN_UNKNOWN,
75 .value = (StringView){
76 .start = &sv.start[i - token_n],
77 .n = token_n,
78 }
79 };
80 token.type = find_token_type(token.value);
81 tokens_buf[n++] = token;
82 token_n = 0;
83 }
84 } break;
85 case ';': {
86 if (token_n != 0) {
87 Token token = (Token){
88 .type = TOKEN_UNKNOWN,
89 .value = (StringView){
90 .start = &sv.start[i - token_n],
91 .n = token_n,
92 }
93 };
94 token.type = find_token_type(token.value);
95 tokens_buf[n++] = token;
96 token_n = 0;
97 }
98
99 // Advance until the next newline.
100 do {
101 i++;
102 } while (i < sv.n && sv.start[(i + 1)] != '\n');
103 } break;
104 case '"': {
105 if (token_n != 0) {
106 fprintf(stderr, "error: string started inside symbol\n");
107 return (Tokens){0};
108 }
109
110 // Find end delimiter.
111 size_t string_start = i + 1;
112 size_t string_end = i + 1;
113 while (true) {
114 if (sv.start[string_end] == '"' && sv.start[string_end - 1] != '\\') {
115 break;
116 }
117 if (string_end >= sv.n) {
118 fprintf(stderr, "error: string delimiter not found\n");
119 return (Tokens){0};
120 }
121 string_end++;
122 }
123
124 Token token = (Token){
125 .type = TOKEN_STRING,
126 .value = (StringView){
127 .start = &sv.start[string_start],
128 .n = string_end - string_start,
129 }
130 };
131 tokens_buf[n++] = token;
132 token_n = 0;
133 i += string_end - string_start + 1;
134 } break;
135 case '(': {
136 if ((i + 1) < sv.n) {
137 char next_c = sv.start[i + 1];
138 if (isspace(next_c)) {
139 fprintf(stderr, "error: lparen delimiter followed by space\n");
140 return (Tokens){0};
141 }
142 }
143
144 if (token_n != 0) {
145 fprintf(stderr, "error: lparen delimiter within symbol name\n");
146 return (Tokens){0};
147 }
148
149 Token token = (Token){
150 .type = TOKEN_LPAREN,
151 .value = LPAREN_TOKEN,
152 };
153 tokens_buf[n++] = token;
154 } break;
155 case ')': {
156 if ((i + 1) < sv.n) {
157 char next_c = sv.start[i + 1];
158 if ((next_c != ')' && !isspace(next_c))) {
159 fprintf(stderr, "error: rparen delimiter within symbol name\n");
160 return (Tokens){0};
161 }
162 }
163
164 if (token_n != 0) {
165 // Push previous token.
166 Token token = (Token){
167 .type = TOKEN_UNKNOWN,
168 .value = (StringView){
169 .start = &sv.start[i - token_n],
170 .n = token_n,
171 }
172 };
173 token.type = find_token_type(token.value);
174 tokens_buf[n++] = token;
175 token_n = 0;
176 }
177
178 Token token = (Token){
179 .type = TOKEN_RPAREN,
180 .value = RPAREN_TOKEN,
181 };
182 tokens_buf[n++] = token;
183 } break;
184 case EOF: {
185 break;
186 } break;
187 default: {
188 token_n++;
189 } break;
190 }
191 }
192 if (token_n != 0) {
193 // End of line encountered.
194 Token token = (Token){
195 .type = TOKEN_UNKNOWN,
196 .value = (StringView){
197 .start = &sv.start[sv.n - token_n],
198 .n = token_n,
199 }
200 };
201 token.type = find_token_type(token.value);
202 tokens_buf[n++] = token;
203 }
204
205 return (Tokens){.start = (Token *)&tokens_buf, .n = n};
206}
207
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 @@
1#include <ctype.h>
2#include <getopt.h> 1#include <getopt.h>
2#include <stdbool.h>
3#include <stdio.h> 3#include <stdio.h>
4#include <stdlib.h> 4#include <stdlib.h>
5#include <string.h>
6
7#include "shorthand.h"
8#include "string_view.c"
9#include "readline.c"
10#include "lexer.c"
11#include "objects.c"
12#include "parser.c"
13#include "environment.c"
14#include "primitives.c"
15
16// FIXME: We are not worried right now about freeing memory, but we should in
17// the future.
18// TODO: Better error messages.
19
20#define REPL_PROMPT "bdl> "
21 5
22void 6void
23init(void) { 7process_input(FILE *file) {
24 // Clear env. 8 // TODO: Implement.
25 for (size_t i = 0; i < ENV_SIZE; i++) { 9 getchar();
26 environment[i] = (EnvSymbol){0}; 10 (void)file;
27 }
28
29 // Initialize singletons.
30 obj_nil = make_empty_list();
31 obj_true = make_boolean(true);
32 obj_false = make_boolean(false);
33
34 // Add primitive functions.
35 environment[env_n++] = (EnvSymbol){MAKE_SYM("+"), make_procedure(proc_add)};
36 environment[env_n++] = (EnvSymbol){MAKE_SYM("-"), make_procedure(proc_sub)};
37 environment[env_n++] = (EnvSymbol){MAKE_SYM("*"), make_procedure(proc_mul)};
38 environment[env_n++] = (EnvSymbol){MAKE_SYM("/"), make_procedure(proc_div)};
39 environment[env_n++] = (EnvSymbol){MAKE_SYM("%"), make_procedure(proc_mod)};
40 environment[env_n++] = (EnvSymbol){MAKE_SYM("<"), make_procedure(proc_num_less_than)};
41 environment[env_n++] = (EnvSymbol){MAKE_SYM(">"), make_procedure(proc_num_greater_than)};
42 environment[env_n++] = (EnvSymbol){MAKE_SYM("="), make_procedure(proc_num_equal)};
43 environment[env_n++] = (EnvSymbol){MAKE_SYM("<="), make_procedure(proc_num_lesseq_than)};
44 environment[env_n++] = (EnvSymbol){MAKE_SYM(">="), make_procedure(proc_num_greatereq_than)};
45 environment[env_n++] = (EnvSymbol){MAKE_SYM("null?"), make_procedure(proc_is_null)};
46 environment[env_n++] = (EnvSymbol){MAKE_SYM("boolean?"), make_procedure(proc_is_boolean)};
47 environment[env_n++] = (EnvSymbol){MAKE_SYM("symbol?"), make_procedure(proc_is_symbol)};
48 environment[env_n++] = (EnvSymbol){MAKE_SYM("string?"), make_procedure(proc_is_string)};
49 environment[env_n++] = (EnvSymbol){MAKE_SYM("fixnum?"), make_procedure(proc_is_fixnum)};
50 environment[env_n++] = (EnvSymbol){MAKE_SYM("pair?"), make_procedure(proc_is_pair)};
51 environment[env_n++] = (EnvSymbol){MAKE_SYM("procedure?"), make_procedure(proc_is_procedure)};
52 environment[env_n++] = (EnvSymbol){MAKE_SYM("not"), make_procedure(proc_not)};
53 environment[env_n++] = (EnvSymbol){MAKE_SYM("and"), make_procedure(proc_and)};
54 environment[env_n++] = (EnvSymbol){MAKE_SYM("or"), make_procedure(proc_or)};
55 environment[env_n++] = (EnvSymbol){MAKE_SYM("if"), make_procedure(proc_if)};
56 environment[env_n++] = (EnvSymbol){MAKE_SYM("else"), obj_true};
57 environment[env_n++] = (EnvSymbol){MAKE_SYM("true"), obj_true};
58 environment[env_n++] = (EnvSymbol){MAKE_SYM("false"), obj_false};
59 environment[env_n++] = (EnvSymbol){MAKE_SYM("nil"), obj_nil};
60 environment[env_n++] = (EnvSymbol){MAKE_SYM("cond"), make_procedure(proc_cond)};
61 environment[env_n++] = (EnvSymbol){MAKE_SYM("car"), make_procedure(proc_car)};
62 environment[env_n++] = (EnvSymbol){MAKE_SYM("cdr"), make_procedure(proc_cdr)};
63 environment[env_n++] = (EnvSymbol){MAKE_SYM("cons"), make_procedure(proc_cons)};
64 environment[env_n++] = (EnvSymbol){MAKE_SYM("list"), make_procedure(proc_list)};
65 environment[env_n++] = (EnvSymbol){MAKE_SYM("eq?"), make_procedure(proc_equal)};
66 environment[env_n++] = (EnvSymbol){MAKE_SYM("display"), make_procedure(proc_display)};
67 environment[env_n++] = (EnvSymbol){MAKE_SYM("print"), make_procedure(proc_print)};
68} 11}
69 12
70void 13#define REPL_PROMPT "bdl> "
71eval_line(FILE *fd, char delimiter) {
72 StringView line = read_line(fd, delimiter);
73 Tokens tokens = tokenize(line);
74#if DEBUG
75 printf("N_TOKENS: %ld\n", tokens.n);
76 for (size_t i = 0; i < tokens.n; i++) {
77 printf("\tTYPE: %3d ", tokens.start[i].type);
78 printf("N: %3ld ", tokens.start[i].value.n);
79 printf("VALUE: ");
80 sv_write(tokens.start[i].value);
81 printf("\n");
82 }
83#endif
84 while (tokens.n > 0) {
85 Object *ast = parse(&tokens);
86 if (ast) {
87#if DEBUG
88 printf("AST: ");
89 display(ast);
90 printf("\n");
91 printf("EVAL: ");
92#endif
93 if (display(eval(ast))) {
94 printf("\n");
95 };
96 }
97 }
98}
99 14
100void 15void
101run_repl(void) { 16run_repl(void) {
102 printf("BDL REPL (Press Ctrl-C to exit)\n"); 17 printf("BDL REPL (Press Ctrl-C to exit)\n");
103 while (true) { 18 while (true) {
104 printf(REPL_PROMPT); 19 printf(REPL_PROMPT);
105 eval_line(stdin, '\n'); 20 process_input(stdin);
106 } 21 }
107} 22}
108 23
109void 24void
110run_file(char *file_name) { 25run_file(char *file_name) {
111#if DEBUG
112 printf("Executing file: %s\n", file_name);
113#endif
114 FILE *fd = fopen(file_name, "r"); 26 FILE *fd = fopen(file_name, "r");
115 if (!fd) { 27 if (!fd) {
116 fprintf(stderr, "couldn't open file: %s\n", file_name); 28 fprintf(stderr, "error: couldn't open input file: %s\n", file_name);
117 exit(EXIT_FAILURE); 29 exit(EXIT_FAILURE);
118 } 30 }
119 eval_line(fd, EOF); 31 process_input(fd);
120 fclose(fd); 32 fclose(fd);
121} 33}
122 34
35#ifndef BIN_NAME
36#define BIN_NAME "bdl"
37#endif
38
123void 39void
124print_usage(void) { 40print_usage(void) {
125 printf("Usage: %s [options] <filename>\n", BIN_NAME); 41 printf("Usage: %s [options] <filename filename ...>\n", BIN_NAME);
126 printf("\n"); 42 printf("\n");
127 printf("\t-i\tInteractive mode (REPL).\n"); 43 printf("\t-i\tInteractive mode (REPL).\n");
128 printf("\t-x\tExecute expression from stdin.\n");
129 printf("\n"); 44 printf("\n");
130} 45}
131 46
132int 47int
133main(int argc, char *argv[]) { 48main(int argc, char *argv[]) {
134 init();
135
136 int option; 49 int option;
137 while ((option = getopt(argc, argv, "ix")) != -1) { 50 while ((option = getopt(argc, argv, "i")) != -1) {
138 switch (option) { 51 switch (option) {
139 case 'i': { 52 case 'i': {
140 // Interactive mode. 53 // Interactive mode.
141 run_repl(); 54 run_repl();
142 return EXIT_SUCCESS; 55 return EXIT_SUCCESS;
143 } break; 56 } break;
144 case 'x': {
145 // Execute expression from stdin.
146 eval_line(stdin, EOF);
147 return EXIT_SUCCESS;
148 } break;
149 default: { 57 default: {
150 print_usage(); 58 print_usage();
151 return EXIT_FAILURE; 59 return EXIT_FAILURE;
@@ -153,6 +61,8 @@ main(int argc, char *argv[]) {
153 } 61 }
154 } 62 }
155 63
64 // TODO: Run from stdin if no file is given.
65
156 // Run from file. 66 // Run from file.
157 if (optind != argc - 1) { 67 if (optind != argc - 1) {
158 fprintf(stderr, "%s: No input file given.\n", BIN_NAME); 68 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 @@
1typedef enum ObjectType {
2 OBJ_TYPE_FIXNUM,
3 OBJ_TYPE_BOOL,
4 OBJ_TYPE_NIL,
5 OBJ_TYPE_SYMBOL,
6 OBJ_TYPE_STRING,
7 OBJ_TYPE_PAIR,
8 OBJ_TYPE_PROCEDURE,
9} ObjectType;
10
11typedef struct Object {
12 ObjectType type;
13 union {
14 // OBJ_TYPE_FIXNUM
15 ssize_t fixnum;
16
17 // OBJ_TYPE_BOOL
18 bool boolean;
19
20 // OBJ_TYPE_STRING
21 struct {
22 char *string;
23 size_t string_n;
24 };
25
26 // OBJ_TYPE_PAIR
27 struct {
28 struct Object *car;
29 struct Object *cdr;
30 };
31
32 // OBJ_TYPE_SYMBOL
33 struct {
34 char *symbol;
35 size_t symbol_n;
36 };
37
38 // OBJ_TYPE_PROCEDURE
39 struct Object *(*proc)(struct Object *args);
40 };
41} Object;
42
43//
44// Singletons.
45//
46
47Object *obj_nil;
48Object *obj_true;
49Object *obj_false;
50
51//
52// Constructors.
53//
54
55Object *
56make_fixnum(ssize_t num) {
57 Object *obj = malloc(sizeof(Object));
58 obj->type = OBJ_TYPE_FIXNUM;
59 obj->fixnum = num;
60 return obj;
61}
62
63Object *
64make_boolean(bool b) {
65 Object *obj = malloc(sizeof(Object));
66 obj->type = OBJ_TYPE_BOOL;
67 obj->boolean = b;
68 return obj;
69}
70
71Object *
72make_empty_string(void) {
73 Object *obj = malloc(sizeof(Object));
74 obj->type = OBJ_TYPE_STRING;
75 obj->string = NULL;
76 obj->string_n = 0;
77 return obj;
78}
79
80void
81append_string(Object *string, StringView sv) {
82 assert(string != NULL);
83 assert(string->type == OBJ_TYPE_STRING);
84
85 if (sv.n == 0) {
86 return;
87 }
88
89 string->string = realloc(string->string, (string->string_n + sv.n) * sizeof(char));
90 memcpy(string->string + string->string_n, sv.start, sv.n);
91 string->string_n += sv.n;
92}
93
94Object *
95make_symbol(const char *str, size_t n) {
96 Object *obj = malloc(sizeof(Object));
97 obj->type = OBJ_TYPE_SYMBOL;
98 obj->string = malloc(sizeof(char) * n);
99 memcpy(obj->string, str, n);
100 obj->string_n = n;
101 return obj;
102}
103
104Object *
105make_empty_list(void) {
106 Object *obj = malloc(sizeof(Object));
107 obj->type = OBJ_TYPE_NIL;
108 return obj;
109}
110
111Object *
112make_procedure(Object *(*proc)(struct Object *args)) {
113 Object *obj = malloc(sizeof(Object));
114 obj->type = OBJ_TYPE_PROCEDURE;
115 obj->proc = proc;
116 return obj;
117}
118
119Object *
120make_pair(Object *car, Object *cdr) {
121 Object *obj = malloc(sizeof(Object));
122 obj->type = OBJ_TYPE_PAIR;
123 obj->car = car;
124 obj->cdr = cdr;
125 return obj;
126}
127
128//
129// Comparative ops.
130//
131
132bool
133symbol_eq(Object *a, Object *b) {
134 if (a->type != b->type || a->type != OBJ_TYPE_SYMBOL || a->symbol_n != b->symbol_n) {
135 return false;
136 }
137 for (size_t i = 0; i < a->symbol_n; i++) {
138 if (a->symbol[i] != b->symbol[i]) {
139 return false;
140 }
141 }
142 return true;
143}
144
145//
146// Utility macros.
147//
148
149#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 @@
1Token *
2consume_token(Tokens *tokens) {
3 if (tokens->n == 0) {
4 return NULL;
5 }
6 Token *ret = tokens->start;
7 tokens->start = &tokens->start[1];
8 tokens->n--;
9 return ret;
10}
11
12Object *
13parse(Tokens *tokens) {
14 while (tokens->n > 0) {
15 Token *token = consume_token(tokens);
16 if (token == NULL) {
17 return NULL;
18 }
19
20 switch (token->type) {
21 case TOKEN_FIXNUM: {
22 ssize_t num = 0;
23 int sign = 1;
24 for (size_t i = 0; i < token->value.n; i++) {
25 char c = token->value.start[i];
26 if (c == '-') {
27 sign = -1;
28 continue;
29 }
30 num = num * 10 + (c - '0');
31 }
32 return make_fixnum(num * sign);
33 } break;
34 case TOKEN_BOOL: {
35 if (sv_equal(token->value, TRUE_TOKEN)) {
36 return obj_true;
37 }
38 if (sv_equal(token->value, FALSE_TOKEN)) {
39 return obj_false;
40 }
41 } break;
42 case TOKEN_RPAREN: {
43 return NULL;
44 } break;
45 case TOKEN_LPAREN: {
46 if (tokens->n > 0 && tokens->start[0].type == TOKEN_RPAREN) {
47 return obj_nil;
48 }
49
50 Object *next_obj = parse(tokens);
51 if (next_obj == NULL) {
52 return NULL;
53 }
54 Object *root = make_pair(next_obj, obj_nil);
55 Object *list = root;
56 while (tokens->n > 0 && (next_obj = parse(tokens)) != NULL) {
57 list->cdr = make_pair(next_obj, obj_nil);
58 list = list->cdr;
59 }
60 return root;
61 } break;
62 case TOKEN_STRING: {
63 Object *obj = make_empty_string();
64 append_string(obj, token->value);
65 return obj;
66 } break;
67 case TOKEN_SYMBOL: {
68 return make_symbol(token->value.start, token->value.n);
69 } break;
70 default: {
71 fprintf(stderr, "error: unknown token\n");
72 } break;
73 }
74 }
75
76 return NULL;
77}
78
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 @@
1bool display(Object *root);
2
3void
4display_pair(Object *root) {
5 display(root->car);
6 if (root->cdr->type == OBJ_TYPE_PAIR) {
7 printf(" ");
8 display_pair(root->cdr);
9 } else if (root->cdr == obj_nil) {
10 return;
11 } else {
12 printf(" . ");
13 display(root->cdr);
14 }
15}
16
17bool
18display(Object *root) {
19 if (root == NULL) {
20 return false;
21 }
22
23 switch (root->type) {
24 case OBJ_TYPE_FIXNUM: {
25 printf("%zd", root->fixnum);
26 } break;
27 case OBJ_TYPE_BOOL: {
28 if (root->boolean) {
29 printf("true");
30 } else {
31 printf("false");
32 }
33 } break;
34 case OBJ_TYPE_NIL: {
35 printf("()");
36 } break;
37 case OBJ_TYPE_STRING: {
38 printf("\"%.*s\"", (int)root->string_n, root->string);
39 } break;
40 case OBJ_TYPE_SYMBOL: {
41 printf(":%.*s", (int)root->symbol_n, root->symbol);
42 } break;
43 case OBJ_TYPE_PAIR: {
44 printf("(");
45 display_pair(root);
46 printf(")");
47 } break;
48 case OBJ_TYPE_PROCEDURE: {
49 printf("#{procedure}");
50 } break;
51 }
52 return true;
53}
54
55Object *
56eval(Object *root) {
57 switch (root->type) {
58 case OBJ_TYPE_FIXNUM:
59 case OBJ_TYPE_BOOL:
60 case OBJ_TYPE_NIL:
61 case OBJ_TYPE_STRING: {
62 return root;
63 } break;
64 case OBJ_TYPE_SYMBOL: {
65 Object *value = env_find_symbol(root);
66 if (value == NULL) {
67 printf("error: symbol not found: `");
68 display(root);
69 printf("`\n");
70 return obj_nil;
71 }
72 return value;
73 } break;
74 case OBJ_TYPE_PAIR: {
75 if (root->car->type == OBJ_TYPE_SYMBOL) {
76 Object *value = env_find_symbol(root->car);
77 if (value == NULL) {
78 printf("error: symbol not found: `");
79 display(root->car);
80 printf("`\n");
81 return obj_nil;
82 }
83 if (value->type == OBJ_TYPE_PROCEDURE) {
84 return value->proc(root->cdr);
85 }
86 }
87 } break;
88 default: {
89 printf("error: can't eval type %d.\n", root->type);
90 } break;
91 }
92 return obj_nil;
93}
94
95//
96// Arithmetic procedures.
97//
98
99Object *
100proc_add(Object *args) {
101 // Extract first parameter.
102 Object *car = eval(args->car);
103 if (car == NULL) {
104 fprintf(stderr, "error: not enough arguments\n");
105 return obj_nil;
106 }
107 if (car->type != OBJ_TYPE_FIXNUM) {
108 fprintf(stderr, "addition not supported for type %d\n", car->type);
109 return obj_nil;
110 }
111 args = args->cdr;
112 ssize_t tot = car->fixnum;
113
114 while (args->type == OBJ_TYPE_PAIR) {
115 Object *car = eval(args->car);
116 if (car == NULL) {
117 car = obj_nil;
118 }
119 if (car->type != OBJ_TYPE_FIXNUM) {
120 fprintf(stderr, "addition not supported for type %d\n", car->type);
121 return obj_nil;
122 }
123 tot += car->fixnum;
124 args = args->cdr;
125 }
126 return make_fixnum(tot);
127}
128
129Object *
130proc_sub(Object *args) {
131 // Extract first parameter.
132 Object *car = eval(args->car);
133 if (car == NULL) {
134 fprintf(stderr, "error: not enough arguments\n");
135 return obj_nil;
136 }
137 if (car->type != OBJ_TYPE_FIXNUM) {
138 fprintf(stderr, "error: sub not supported for type %d\n", car->type);
139 return obj_nil;
140 }
141 args = args->cdr;
142 ssize_t tot = car->fixnum;
143
144 while (args->type == OBJ_TYPE_PAIR) {
145 car = eval(args->car);
146 if (car == NULL) {
147 car = obj_nil;
148 }
149 if (car->type != OBJ_TYPE_FIXNUM) {
150 fprintf(stderr, "error: sub not supported for type %d\n", car->type);
151 return obj_nil;
152 }
153 tot -= car->fixnum;
154 args = args->cdr;
155 }
156 return make_fixnum(tot);
157}
158
159Object *
160proc_mul(Object *args) {
161 // Extract first parameter.
162 Object *car = eval(args->car);
163 if (car == NULL) {
164 fprintf(stderr, "error: not enough arguments\n");
165 return obj_nil;
166 }
167 if (car->type != OBJ_TYPE_FIXNUM) {
168 fprintf(stderr, "error: mult not supported for type %d\n", car->type);
169 return obj_nil;
170 }
171 args = args->cdr;
172 ssize_t tot = car->fixnum;
173
174 while (args->type == OBJ_TYPE_PAIR) {
175 Object *car = eval(args->car);
176 if (car == NULL) {
177 car = obj_nil;
178 }
179 if (car->type != OBJ_TYPE_FIXNUM) {
180 fprintf(stderr, "error: mult not supported for type %d\n", car->type);
181 return obj_nil;
182 }
183 tot *= car->fixnum;
184 args = args->cdr;
185 }
186 return make_fixnum(tot);
187}
188
189Object *
190proc_div(Object *args) {
191 // Extract first parameter.
192 Object *car = eval(args->car);
193 if (car == NULL) {
194 fprintf(stderr, "error: not enough arguments\n");
195 return obj_nil;
196 }
197 args = args->cdr;
198 ssize_t tot = car->fixnum;
199
200 while (args->type == OBJ_TYPE_PAIR) {
201 Object *car = eval(args->car);
202 if (car == NULL) {
203 car = obj_nil;
204 }
205 if (car->type != OBJ_TYPE_FIXNUM) {
206 fprintf(stderr, "error: div not supported for type %d\n", car->type);
207 return obj_nil;
208 }
209 if (car->fixnum == 0) {
210 fprintf(stderr, "error: division by zero\n");
211 return obj_nil;
212 }
213 tot /= car->fixnum;
214 args = args->cdr;
215 }
216 return make_fixnum(tot);
217}
218
219Object *
220proc_mod(Object *args) {
221 // Extract first parameter.
222 Object *car = eval(args->car);
223 if (car == NULL) {
224 fprintf(stderr, "error: not enough arguments\n");
225 return obj_nil;
226 }
227 args = args->cdr;
228 ssize_t tot = car->fixnum;
229
230 while (args->type == OBJ_TYPE_PAIR) {
231 Object *car = eval(args->car);
232 if (car == NULL) {
233 car = obj_nil;
234 }
235 if (car->type != OBJ_TYPE_FIXNUM) {
236 fprintf(stderr, "error: div not supported for type %d\n", car->type);
237 return obj_nil;
238 }
239 if (car->fixnum == 0) {
240 fprintf(stderr, "error: division by zero\n");
241 return obj_nil;
242 }
243 tot %= car->fixnum;
244 args = args->cdr;
245 }
246 return make_fixnum(tot);
247}
248
249//
250// Display/Evaluation procedues.
251//
252
253Object *
254proc_display(Object *args) {
255 if (args == NULL) {
256 return obj_nil;
257 }
258 if (args->type == OBJ_TYPE_PAIR) {
259 display(eval(args->car));
260 }
261 return obj_nil;
262}
263
264Object *
265proc_print(Object *args) {
266 if (args == NULL) {
267 return NULL;
268 }
269 if (args->type == OBJ_TYPE_PAIR) {
270 Object *obj = args->car;
271 if (obj->type == OBJ_TYPE_STRING) {
272 StringView scanner = (StringView) {
273 .start = obj->string,
274 .n = obj->string_n,
275 };
276 while (scanner.n != 0) {
277 char c = sv_next(&scanner);
278 if (c == '\\' && sv_peek(&scanner) == 'n') {
279 putchar('\n');
280 sv_next(&scanner);
281 continue;
282 }
283 if (c == '\\' && sv_peek(&scanner) == '"') {
284 putchar('"');
285 sv_next(&scanner);
286 continue;
287 }
288 putchar(c);
289 }
290 } else {
291 fprintf(stderr, "error: print requires a string argument\n");
292 }
293 }
294 return NULL;
295}
296
297//
298// Type info procedures.
299//
300
301Object *
302proc_is_boolean(Object *args) {
303 if (args->type != OBJ_TYPE_PAIR) {
304 fprintf(stderr, "error: wrong number of arguments.\n");
305 return NULL;
306 }
307 Object *obj = eval(args->car);
308 return (obj == obj_true || obj == obj_false) ? obj_true : obj_false;
309}
310
311Object *
312proc_is_null(Object *args) {
313 if (args->type != OBJ_TYPE_PAIR) {
314 fprintf(stderr, "error: wrong number of arguments.\n");
315 return NULL;
316 }
317 Object *obj = eval(args->car);
318 return obj == obj_nil ? obj_true : obj_false;
319}
320
321Object *
322proc_is_symbol(Object *args) {
323 if (args->type != OBJ_TYPE_PAIR) {
324 fprintf(stderr, "error: wrong number of arguments.\n");
325 return NULL;
326 }
327 Object *obj = eval(args->car);
328 return obj->type == OBJ_TYPE_SYMBOL ? obj_true : obj_false;
329}
330
331Object *
332proc_is_string(Object *args) {
333 if (args->type != OBJ_TYPE_PAIR) {
334 fprintf(stderr, "error: wrong number of arguments.\n");
335 return NULL;
336 }
337 Object *obj = eval(args->car);
338 return obj->type == OBJ_TYPE_STRING ? obj_true : obj_false;
339}
340
341Object *
342proc_is_fixnum(Object *args) {
343 if (args->type != OBJ_TYPE_PAIR) {
344 fprintf(stderr, "error: wrong number of arguments.\n");
345 return NULL;
346 }
347 Object *obj = eval(args->car);
348 return obj->type == OBJ_TYPE_FIXNUM ? obj_true : obj_false;
349}
350
351Object *
352proc_is_pair(Object *args) {
353 if (args->type != OBJ_TYPE_PAIR) {
354 fprintf(stderr, "error: wrong number of arguments.\n");
355 return NULL;
356 }
357 Object *obj = eval(args->car);
358 return obj->type == OBJ_TYPE_PAIR ? obj_true : obj_false;
359}
360
361Object *
362proc_is_procedure(Object *args) {
363 if (args->type != OBJ_TYPE_PAIR) {
364 fprintf(stderr, "error: wrong number of arguments.\n");
365 return NULL;
366 }
367 Object *obj = eval(args->car);
368 return obj->type == OBJ_TYPE_PROCEDURE ? obj_true : obj_false;
369}
370
371//
372// Boolean/conditional procedures.
373//
374
375Object *
376proc_not(Object *args) {
377 if (args->type == OBJ_TYPE_PAIR) {
378 return eval(args->car) == obj_false ? obj_true : obj_false;
379 }
380 return eval(args) == obj_false ? obj_true : obj_false;
381}
382
383Object *
384proc_and(Object *args) {
385 while (args != NULL && args != obj_nil) {
386 Object *obj = args->car;
387 if (args->car->type == OBJ_TYPE_PAIR) {
388 obj = eval(args->car);
389 }
390 if (proc_not(obj) == obj_true) {
391 return obj_false;
392 }
393 args = args->cdr;
394 }
395 return obj_true;
396}
397
398Object *
399proc_or(Object *args) {
400 if (args->type != OBJ_TYPE_PAIR) {
401 return obj_false;
402 }
403
404 while (args != NULL && args != obj_nil) {
405 Object *obj = args->car;
406 if (args->car->type == OBJ_TYPE_PAIR) {
407 obj = eval(args->car);
408 }
409 if (proc_not(obj) == obj_false) {
410 return obj_true;
411 }
412 args = args->cdr;
413 }
414 return obj_false;
415}
416
417Object *
418proc_if(Object *args) {
419 if (args->type != OBJ_TYPE_PAIR || args->cdr->type != OBJ_TYPE_PAIR) {
420 fprintf(stderr, "error: wrong number of arguments.\n");
421 return NULL;
422 }
423
424 Object *condition = eval(args->car);
425 if (condition == obj_true) {
426 Object *ret = eval(args->cdr->car);
427 return ret;
428 }
429 if (args->cdr->cdr != obj_nil) {
430 Object *ret = eval(args->cdr->cdr->car);
431 return ret;
432 }
433
434 return obj_nil;
435}
436
437Object *
438proc_cond(Object *args) {
439 if (args->type != OBJ_TYPE_PAIR) {
440 fprintf(stderr, "error: wrong number of arguments.\n");
441 return NULL;
442 }
443
444 if (args->car->type != OBJ_TYPE_PAIR) {
445 fprintf(stderr, "error: wrong argument type.\n");
446 return NULL;
447 }
448
449 while (args != obj_nil) {
450 Object *clause = args->car;
451 if (eval(clause->car) == obj_true) {
452 return eval(clause->cdr->car);
453 }
454 args = args->cdr;
455 }
456
457 return obj_nil;
458}
459
460Object *
461proc_num_less_than(Object *args) {
462 if (args == obj_nil) {
463 fprintf(stderr, "error: wrong number of arguments type.\n");
464 return NULL;
465 }
466
467 Object *obj = eval(args->car);
468 if (obj->type != OBJ_TYPE_FIXNUM) {
469 fprintf(stderr, "error: wrong argument type.\n");
470 return NULL;
471 }
472 ssize_t prev = obj->fixnum;
473 args = args->cdr;
474
475 if (args == obj_nil) {
476 fprintf(stderr, "error: wrong number of arguments type.\n");
477 return NULL;
478 }
479 while (args != obj_nil) {
480 Object *obj = eval(args->car);
481 if (obj->type != OBJ_TYPE_FIXNUM) {
482 fprintf(stderr, "error: wrong argument type.\n");
483 return NULL;
484 }
485 if (prev >= obj->fixnum) {
486 return obj_false;
487 }
488 prev = obj->fixnum;
489 args = args->cdr;
490 }
491 return obj_true;
492}
493
494Object *
495proc_num_greater_than(Object *args) {
496 if (args == obj_nil) {
497 fprintf(stderr, "error: wrong number of arguments type.\n");
498 return NULL;
499 }
500
501 Object *obj = eval(args->car);
502 if (obj->type != OBJ_TYPE_FIXNUM) {
503 fprintf(stderr, "error: wrong argument type.\n");
504 return NULL;
505 }
506 ssize_t prev = obj->fixnum;
507 args = args->cdr;
508
509 if (args == obj_nil) {
510 fprintf(stderr, "error: wrong number of arguments type.\n");
511 return NULL;
512 }
513 while (args != obj_nil) {
514 Object *obj = eval(args->car);
515 if (obj->type != OBJ_TYPE_FIXNUM) {
516 fprintf(stderr, "error: wrong argument type.\n");
517 return NULL;
518 }
519 if (prev <= obj->fixnum) {
520 return obj_false;
521 }
522 prev = obj->fixnum;
523 args = args->cdr;
524 }
525 return obj_true;
526}
527
528Object *
529proc_num_lesseq_than(Object *args) {
530 if (args == obj_nil) {
531 fprintf(stderr, "error: wrong number of arguments type.\n");
532 return NULL;
533 }
534
535 Object *obj = eval(args->car);
536 if (obj->type != OBJ_TYPE_FIXNUM) {
537 fprintf(stderr, "error: wrong argument type.\n");
538 return NULL;
539 }
540 ssize_t prev = obj->fixnum;
541 args = args->cdr;
542
543 if (args == obj_nil) {
544 fprintf(stderr, "error: wrong number of arguments type.\n");
545 return NULL;
546 }
547 while (args != obj_nil) {
548 Object *obj = eval(args->car);
549 if (obj->type != OBJ_TYPE_FIXNUM) {
550 fprintf(stderr, "error: wrong argument type.\n");
551 return NULL;
552 }
553 if (prev > obj->fixnum) {
554 return obj_false;
555 }
556 prev = obj->fixnum;
557 args = args->cdr;
558 }
559 return obj_true;
560}
561
562Object *
563proc_num_greatereq_than(Object *args) {
564 if (args == obj_nil) {
565 fprintf(stderr, "error: wrong number of arguments type.\n");
566 return NULL;
567 }
568
569 Object *obj = eval(args->car);
570 if (obj->type != OBJ_TYPE_FIXNUM) {
571 fprintf(stderr, "error: wrong argument type.\n");
572 return NULL;
573 }
574 ssize_t prev = obj->fixnum;
575 args = args->cdr;
576
577 if (args == obj_nil) {
578 fprintf(stderr, "error: wrong number of arguments type.\n");
579 return NULL;
580 }
581 while (args != obj_nil) {
582 Object *obj = eval(args->car);
583 if (obj->type != OBJ_TYPE_FIXNUM) {
584 fprintf(stderr, "error: wrong argument type.\n");
585 return NULL;
586 }
587 if (prev < obj->fixnum) {
588 return obj_false;
589 }
590 prev = obj->fixnum;
591 args = args->cdr;
592 }
593 return obj_true;
594}
595
596Object *
597proc_num_equal(Object *args) {
598 if (args == obj_nil) {
599 fprintf(stderr, "error: wrong number of arguments type.\n");
600 return NULL;
601 }
602
603 Object *obj = eval(args->car);
604 if (obj->type != OBJ_TYPE_FIXNUM) {
605 fprintf(stderr, "error: wrong argument type.\n");
606 return NULL;
607 }
608 ssize_t prev = obj->fixnum;
609 args = args->cdr;
610
611 if (args == obj_nil) {
612 fprintf(stderr, "error: wrong number of arguments type.\n");
613 return NULL;
614 }
615 while (args != obj_nil) {
616 Object *obj = eval(args->car);
617 if (obj->type != OBJ_TYPE_FIXNUM) {
618 fprintf(stderr, "error: wrong argument type.\n");
619 return NULL;
620 }
621 if (prev != obj->fixnum) {
622 return obj_false;
623 }
624 prev = obj->fixnum;
625 args = args->cdr;
626 }
627 return obj_true;
628}
629
630//
631// List operation procedures.
632//
633
634Object *
635proc_car(Object *args) {
636 if (args == obj_nil) {
637 fprintf(stderr, "error: not enough arguments\n");
638 return obj_nil;
639 }
640 Object *obj = eval(args->car);
641 if (obj->type != OBJ_TYPE_PAIR) {
642 fprintf(stderr, "error: wrong argument type\n");
643 return obj_nil;
644 }
645 return obj->car;
646}
647
648Object *
649proc_cdr(Object *args) {
650 if (args == obj_nil) {
651 fprintf(stderr, "error: not enough arguments\n");
652 return obj_nil;
653 }
654 Object *obj = eval(args->car);
655 if (obj->type != OBJ_TYPE_PAIR) {
656 fprintf(stderr, "error: wrong argument type\n");
657 return obj_nil;
658 }
659 return obj->cdr;
660}
661
662Object *
663proc_cons(Object *args) {
664 if (args == obj_nil || args->cdr == obj_nil) {
665 fprintf(stderr, "error: not enough arguments\n");
666 return obj_nil;
667 }
668 Object *a = eval(args->car);
669 Object *b = eval(args->cdr->car);
670 return make_pair(a, b);
671}
672
673Object *
674proc_list(Object *args) {
675 if (args == obj_nil) {
676 return obj_nil;
677 }
678 Object *head = make_pair(eval(args->car), obj_nil);
679 Object *curr = head;
680 args = args->cdr;
681 while (args != obj_nil) {
682 curr->cdr = make_pair(eval(args->car), obj_nil);
683 curr = curr->cdr;
684 args = args->cdr;
685 }
686 return head;
687}
688
689//
690// Polymorphic procedures.
691//
692
693Object *
694proc_equal(Object *args) {
695 // TODO: stub
696 (void) args;
697 return NULL;
698}
699
700// TODO: fixnum left/right shift, mask, invert
701// TODO: implement and test missing procedures
702// TODO: add primitives for type transforms: string->symbol, symbol->string, etc
703// TODO: properly implement nested environments
704// TODO: implement support for quotes and semi-quotes
705// TODO: LAMBDA
706// TODO: let
707// TODO: better error handling?
708// TODO: Revise all instances where we are returning an object, since currently
709// we may be returning a pointer to an object instead of a new one. Check also
710// 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 @@
1#define READLINE_VALID_CHAR(C) (((u8)(C) >= 0x20 && (u8)(C) < 0x7F) || (C) == '\n')
2
3StringView
4read_line(FILE *fd, char delimiter) {
5 #define RL_BUF_SIZE KB(64)
6 static char readline_buf[RL_BUF_SIZE];
7
8 // Clear buffer.
9 for (size_t i = 0; i < RL_BUF_SIZE; i++) {
10 readline_buf[i] = 0;
11 }
12
13 // Barebones readline implementation.
14 size_t n = 0;
15 char c;
16 while ((c = getc(fd)) != delimiter) {
17 if (c == '\b') {
18 readline_buf[n] = '\0';
19 n--;
20 } else if (READLINE_VALID_CHAR(c) && n < RL_BUF_SIZE) {
21 readline_buf[n] = c;
22 n++;
23 }
24 }
25
26 return (StringView){.start = (char *)&readline_buf, .n = n};
27}
28
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 @@
1#ifndef SHORTHAND_H
2#define SHORTHAND_H
3
4#include <assert.h>
5#include <stdbool.h>
6#include <stddef.h>
7#include <stdint.h>
8
9//
10// This simple header just typedefs the basic C define types to a shorter name,
11// loads the quality of life bool macro for _Bool and defines shorthand macros
12// for byte sizes.
13//
14
15typedef uint8_t u8;
16typedef uint16_t u16;
17typedef uint32_t u32;
18typedef uint64_t u64;
19typedef int8_t s8;
20typedef int16_t s16;
21typedef int32_t s32;
22typedef int64_t s64;
23typedef volatile u8 vu8;
24typedef volatile u16 vu16;
25typedef volatile u32 vu32;
26typedef volatile u64 vu64;
27typedef volatile s8 vs8;
28typedef volatile s16 vs16;
29typedef volatile s32 vs32;
30typedef volatile s64 vs64;
31
32#define KB(N) ((u64)(N) * 1024)
33#define MB(N) ((u64)KB(N) * 1024)
34#define GB(N) ((u64)MB(N) * 1024)
35#define TB(N) ((u64)GB(N) * 1024)
36
37#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 @@
1typedef struct StringView {
2 char *start;
3 size_t n;
4} StringView;
5
6void
7sv_write(StringView sv) {
8 for (size_t i = 0; i < sv.n; i++) {
9 putchar(sv.start[i]);
10 }
11}
12
13bool
14sv_equal(StringView a, StringView b) {
15 if (a.n == b.n) {
16 for (size_t i = 0; i < a.n; i++) {
17 if (a.start[i] != b.start[i]) {
18 return false;
19 }
20 }
21 return true;
22 }
23 return false;
24}
25
26char
27sv_next(StringView *sv) {
28 if (sv->n == 0) {
29 return '\0';
30 }
31 char ret = sv->start[0];
32 sv->start++;
33 sv->n--;
34 return ret;
35}
36
37char
38sv_peek(const StringView *sv) {
39 if (sv->n == 0) {
40 return '\0';
41 }
42 return sv->start[0];
43}
generated by cgit v1.2.1 (git 2.18.0) at 2024-05-02 02:15:23 +0000