├── .gitignore ├── CMakeLists.txt ├── HEADER ├── LICENSE ├── README.md ├── include ├── builtins_base.h ├── builtins_interpreter.h ├── builtins_math.h ├── lisp.h └── lispint.h └── src ├── builtins_base.c ├── builtins_datetime.c ├── builtins_interpreter.c ├── builtins_math.c ├── eval.c ├── lisp.c ├── lispint.c ├── main.c ├── print.c └── reader.c /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | a.out 3 | build 4 | lisp 5 | *.o 6 | *#* 7 | CMakeCache.txt 8 | CMakeFiles 9 | basic_lisp 10 | .idea 11 | -------------------------------------------------------------------------------- /CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required (VERSION 2.6) 2 | project (basic_lisp) 3 | 4 | set (PROJECT_INCLUDE_DIR ${PROJECT_SOURCE_DIR}/include) 5 | set (PROJECT_SOURCE_DIR ${CMAKE_CURRENT_SOURCE_DIR}/src) 6 | 7 | set (Lisp_SRCS 8 | ${PROJECT_SOURCE_DIR}/builtins_base.c 9 | ${PROJECT_SOURCE_DIR}/eval.c 10 | ${PROJECT_SOURCE_DIR}/lisp.c 11 | ${PROJECT_SOURCE_DIR}/main.c 12 | ${PROJECT_SOURCE_DIR}/print.c 13 | ${PROJECT_SOURCE_DIR}/reader.c 14 | ${PROJECT_SOURCE_DIR}/builtins_math.c 15 | ${PROJECT_SOURCE_DIR}/builtins_interpreter.c) 16 | 17 | # Compiler options 18 | add_definitions (-g -Wall) 19 | 20 | include_directories ("${PROJECT_BINARY_DIR}") 21 | include_directories ("${PROJECT_INCLUDE_DIR}") 22 | 23 | add_executable (${PROJECT_NAME} ${Lisp_SRCS}) 24 | 25 | target_link_libraries(${PROJECT_NAME} m) -------------------------------------------------------------------------------- /HEADER: -------------------------------------------------------------------------------- 1 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 2 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 3 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 4 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 5 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 6 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 7 | THE SOFTWARE. -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2014 Jack McCracken 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 21 | THE SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # BasicLisp 2 | 3 | This is a Lisp interpreter I wrote as a learning exercise in the summer of 2014 4 | to learn more about parsing and interpreters. Note that it is pretty unstable 5 | and can't read files reliably, but the REPL works pretty well. To build and run: 6 | 7 | ``` 8 | mkdir build 9 | cmake ../ && make 10 | ./basic_lisp 11 | ``` 12 | 13 | This interpreter supports functions, basic arithmetic, conditional statements, 14 | loops, and builtin functions. See files beginning with builtins_ for 15 | implementations of these. 16 | 17 | ## TODO 18 | 19 | * Test and fix bugs in file loading 20 | * Better error messages for unexpected end of file 21 | -------------------------------------------------------------------------------- /include/builtins_base.h: -------------------------------------------------------------------------------- 1 | /* 2 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 3 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 4 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 5 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 6 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 7 | * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 8 | * THE SOFTWARE. 9 | */ 10 | 11 | #ifndef BUILTINS_BASE_H_ 12 | #define BUILTINS_BASE_H_ 13 | 14 | /* 15 | * Initializes the basic builtins 16 | */ 17 | void base_initialize(); 18 | 19 | 20 | #endif // BUILTINS_BASE_H_ 21 | -------------------------------------------------------------------------------- /include/builtins_interpreter.h: -------------------------------------------------------------------------------- 1 | #ifndef INTERPRETER_H_ 2 | #define INTERPRETER_H_ 3 | 4 | void interpreter_initialize(); 5 | 6 | #endif 7 | -------------------------------------------------------------------------------- /include/builtins_math.h: -------------------------------------------------------------------------------- 1 | /* 2 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 3 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 4 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 5 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 6 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 7 | * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 8 | * THE SOFTWARE. 9 | */ 10 | 11 | #ifndef BUILTINS_MATH_H_ 12 | #define BUILTINS_MATH_H_ 13 | 14 | void math_initialize(); 15 | 16 | #endif // BUILTINS_MATH_H_ 17 | -------------------------------------------------------------------------------- /include/lisp.h: -------------------------------------------------------------------------------- 1 | /* 2 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 3 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 4 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 5 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 6 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 7 | * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 8 | * THE SOFTWARE. 9 | */ 10 | 11 | #ifndef LISP_H_ 12 | #define LISP_H_ 13 | 14 | #include 15 | 16 | #include "builtins_interpreter.h" 17 | 18 | #define C_BOOL int 19 | #define C_TRUE 1 20 | #define C_FALSE 0 21 | 22 | #define CLAIM(obj) (obj->counter++) 23 | #define REMOVE(obj) (obj->counter--) 24 | 25 | enum type { 26 | INTEGER, /* LISPINT * */ 27 | STRING, /* char * */ 28 | SYMBOL, /* char * */ 29 | LIST, /* struct lisp_object * or NULL for empty list. */ 30 | FUNCTION, /* struct lisp_function * */ 31 | BUILTIN, /* struct lisp_object* (*func)(struct lisp_object*) */ 32 | T_TYPE /* NULL */ 33 | }; 34 | 35 | struct lisp_object { 36 | void *data; 37 | 38 | struct lisp_object *prev; 39 | struct lisp_object *next; 40 | 41 | enum type obj_type; 42 | 43 | C_BOOL quoted; 44 | int counter; 45 | }; 46 | 47 | /* Type conversion macros */ 48 | #define TOLINT(n) (*((LISPINT*)( (n) ->data))) 49 | #define TOSTR(n) ((char*)( (n) ->data)) 50 | #define SYM_NAME(n) ((char*)( (n) ->data)) 51 | #define TOBUILTIN(n) ((struct lisp_builtin*)( (n) ->data)) 52 | #define TOFUNC(n) ((struct lisp_function*)( (n) ->data)) 53 | 54 | extern struct lisp_object *t; 55 | extern struct lisp_object *nil; 56 | 57 | struct symbol { 58 | char *symbol_name; 59 | struct lisp_object *value; 60 | C_BOOL builtin; 61 | }; 62 | 63 | extern struct symbol *symbol_table; 64 | extern int symbol_table_counter; 65 | 66 | /* 67 | * Initialize the Lisp interpreter symbol table and builtins. 68 | */ 69 | void lisp_initialize(); 70 | 71 | /* 72 | * The C implementation of the Lisp `read` function. 73 | * Input: FILE *input - Where to read the text for the reader from. NULL means stdin. 74 | * Output: lisp_object* - The root of the unevaluated objects returned. 75 | */ 76 | struct lisp_object *c_read(FILE *input); 77 | 78 | /* 79 | * The C implementation of the Lisp `eval` function. 80 | * Input: lisp_object *root - The root of the Lisp object to be evaluated. Usually output from read() 81 | * Output: lisp_object* - The result of the Lisp object's evaluation. 82 | */ 83 | struct lisp_object *c_eval(struct lisp_object *root); 84 | 85 | 86 | /* 87 | * Gets a new symbol from the symbol table and registers it. 88 | * Note: This function may allocate more memory for the symbol object. 89 | */ 90 | struct symbol *get_new_symbol(); 91 | 92 | /* 93 | * The C implementation of the Lisp `print` function. 94 | * Input: lisp_object *obj - The object to print. 95 | * Output: nil. 96 | */ 97 | struct lisp_object *c_print(struct lisp_object *obj); 98 | 99 | int list_length(struct lisp_object *head); 100 | 101 | 102 | /* 103 | * Does a deep copy of a lisp_object structure. This should be avoided if possible. 104 | * Input: lisp_object *obj - An object to be deep copied 105 | * Output: lisp_object* - A deep copy of obj. 106 | */ 107 | struct lisp_object *lisp_object_deep_copy(struct lisp_object *obj); 108 | 109 | /* 110 | * Defines the way parameters are restricted. 111 | */ 112 | enum paramspec { 113 | EVAL_ARGS = 0, 114 | UNEVAL_ARGS = 0x1000 /* Do not evaluate the arguments to this function. */ 115 | }; 116 | 117 | /* 118 | * Defines a builtin function. Only called from C. 119 | * Input: 120 | * char *symbol_name - The name to be used to call this function in Lisp. 121 | * enum paramspec spec - Defines the way parameters are restricted. 122 | * int numparams - Number of parameters - Exact interpretation depends on spec. See above paramspec docs. 123 | * lisp_object* (*func)(lisp_object*) - The C function you are defining. Takes a lisp_object which is always a 124 | * LIST of the passed-in parameters. Returns a lisp_object which will be 125 | * returned back to the Lisp code. 126 | */ 127 | void define_builtin_function(char *symbol_name, enum paramspec spec, int min_params, 128 | int max_params, struct lisp_object* (*func)(struct lisp_object*), C_BOOL is_builtin); 129 | 130 | struct symbol *symbol_lookup(char *key); 131 | struct lisp_object *symbol_value(char *key); 132 | void set_local_symbols(struct symbol *symbols, size_t count); 133 | void unset_local_symbols(); 134 | C_BOOL symbol_reassign(struct symbol *sym, char *name, struct lisp_object *obj); 135 | 136 | /* 137 | * Set the error and the error flag 138 | */ 139 | void set_error(char *error, ...); 140 | 141 | /* 142 | * Gets the current error or NULL if no error has occurred. 143 | */ 144 | char *get_error(); 145 | 146 | /* Deals with a Lisp error in some unspecified manner (does not quit) */ 147 | void lisp_error(); 148 | 149 | /* 150 | * Returns C_TRUE if an error has occurred. 151 | */ 152 | C_BOOL has_error(); 153 | 154 | /* 155 | * Allocated by the functions generated by the DEFUN macro to represent a builtin. 156 | */ 157 | struct lisp_builtin { 158 | struct lisp_object* (*func)(struct lisp_object*); 159 | enum paramspec spec; 160 | int min_params; 161 | int max_params; 162 | }; 163 | 164 | /* 165 | * Defines a non-builtin Lisp function. 166 | */ 167 | struct lisp_function { 168 | /* A list of SYMBOLs defining parameter names. */ 169 | struct lisp_object *params; 170 | /* A cached value for the number of params (=list_length(params)) */ 171 | int numparams; 172 | /* The head of the list of forms defining this fn */ 173 | struct lisp_object *forms; 174 | }; 175 | 176 | /* Macro to define a function from C. This requires that this be called in register_builtins() in lisp.c */ 177 | #define DEFUN(lisp_name, func_name, spec, min, max) \ 178 | struct lisp_object * func_name (struct lisp_object*); \ 179 | void func_name ## _init () { \ 180 | define_builtin_function( lisp_name , spec , min , max , func_name, C_TRUE ); \ 181 | } \ 182 | DEFUN_NO_INIT(func_name) 183 | 184 | #define DEFUN_NO_INIT(func_name) \ 185 | struct lisp_object * func_name (struct lisp_object *args) 186 | 187 | C_BOOL true_p(struct lisp_object * obj); 188 | 189 | struct lisp_object *make_lisp_object(enum type obj_type, void *data); 190 | 191 | #define HEAD(list) ((struct lisp_object *)(list->data)) 192 | #define TRUEP(obj) true_p(obj) 193 | 194 | /* Possibly changing constants */ 195 | /* Not necessarily a max length for a symbol. It is more efficient if a 196 | * symbol's length is smaller than this. 197 | */ 198 | #define BASE_SYMBOL_LENGTH 35 199 | /* A scaling factor for when a symbol's length is > BASE_SYMBOL_LENGTH */ 200 | #define SYMBOL_SCALE_FACTOR 2 201 | 202 | /* Same definitions for string constants */ 203 | #define BASE_STRINGBUF_LENGTH 256 204 | #define STRINGBUF_SCALE_FACTOR 2 205 | 206 | #define SYMBOL_TABLE_INITIAL_SIZE 100 207 | #define SYMBOL_TABLE_SCALE_FACTOR 2 208 | 209 | #define LISPINT long long 210 | #define LISPINT_FORMAT "%lld" 211 | 212 | #define MAX_ERROR 1000 213 | 214 | #endif /* LISP_H_ */ 215 | -------------------------------------------------------------------------------- /include/lispint.h: -------------------------------------------------------------------------------- 1 | #ifndef LISP_INT_H_ 2 | #define LISP_INT_H_ 3 | 4 | #include 5 | 6 | // Measured in units of LONG_MAX 7 | #define DEFAULT_PRECISION 3 8 | 9 | struct lisp_int { 10 | long *rep; 11 | // Measured in units of LONG_MAX. Default DEFAULT_PRECISION 12 | int rep_len; 13 | }; 14 | 15 | struct lisp_int *lisp_int_initializef(FILE *f); 16 | 17 | struct lisp_int *lisp_int_initializes(char *s); 18 | 19 | char *lisp_int_to_str(struct lisp_int *i); 20 | 21 | #endif // LISP_INT_H_ 22 | -------------------------------------------------------------------------------- /src/builtins_base.c: -------------------------------------------------------------------------------- 1 | 2 | /* 3 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 4 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 5 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 6 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 7 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 8 | * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 9 | * THE SOFTWARE. 10 | */ 11 | 12 | #include "lisp.h" 13 | #include "builtins_base.h" 14 | 15 | #include 16 | #include 17 | 18 | DEFUN("<", lisp_lt, EVAL_ARGS, 2, -1) { 19 | struct lisp_object *first = HEAD(args); 20 | struct lisp_object *second = first->next; 21 | 22 | if (first->obj_type != INTEGER || second->obj_type != INTEGER) { 23 | set_error("Can only compare integers with <."); 24 | return NULL; 25 | } 26 | 27 | if (TOLINT(first) < TOLINT(second)) { 28 | return t; 29 | } 30 | else { 31 | return nil; 32 | } 33 | } 34 | 35 | DEFUN(">", lisp_gt, EVAL_ARGS, 2, -1) { 36 | struct lisp_object *first = HEAD(args); 37 | struct lisp_object *second = first->next; 38 | 39 | if (first->obj_type != INTEGER || second->obj_type != INTEGER) { 40 | set_error("Can only compare integers with >."); 41 | return NULL; 42 | } 43 | 44 | if (TOLINT(first) > TOLINT(second)) { 45 | return t; 46 | } 47 | else { 48 | return nil; 49 | } 50 | } 51 | 52 | DEFUN("=", lisp_eq, EVAL_ARGS, 2, -1) { 53 | struct lisp_object *first = HEAD(args); 54 | struct lisp_object *second = first->next; 55 | 56 | if (first->obj_type != INTEGER || second->obj_type != INTEGER) { 57 | set_error("= can only compare integers."); 58 | return NULL; 59 | } 60 | 61 | if (TOLINT(first) == TOLINT(second)) { 62 | return t; 63 | } 64 | else { 65 | return nil; 66 | } 67 | } 68 | 69 | /* 70 | * (IF CONDITION THEN-CLAUSE ELSE-CLAUSE) 71 | */ 72 | DEFUN("if", lisp_if, UNEVAL_ARGS, 2, 3) { 73 | int length = list_length(args); 74 | 75 | struct lisp_object *head = HEAD(args); 76 | 77 | struct lisp_object *condition = c_eval(head); 78 | struct lisp_object *then_clause = head->next; 79 | struct lisp_object *else_clause = NULL; 80 | 81 | if (!condition) { 82 | return NULL; 83 | } 84 | 85 | if (length == 3) { 86 | else_clause = then_clause->next; 87 | } 88 | 89 | if (TRUEP(condition)) { 90 | return c_eval(then_clause); 91 | } 92 | else { 93 | /* If it's nil, we're OK because nil evaluates to nil (elevator -- Elisa) */ 94 | return c_eval(else_clause); 95 | } 96 | } 97 | 98 | DEFUN("prints", lisp_prints, EVAL_ARGS, 1, 1) { 99 | if (HEAD(args)->obj_type != STRING) { 100 | set_error("Argument to prints must be a string."); 101 | return NULL; 102 | } 103 | 104 | char *to_print = TOSTR(HEAD(args)); 105 | 106 | printf("%s\n", to_print); 107 | 108 | return nil; 109 | } 110 | 111 | DEFUN("print", lisp_print, EVAL_ARGS, 1, 1) { 112 | struct lisp_object *current = HEAD(args); 113 | 114 | while (current) { 115 | c_print(current); 116 | 117 | current = current->next; 118 | } 119 | 120 | return nil; 121 | } 122 | 123 | DEFUN("setq", lisp_setq, UNEVAL_ARGS, 2, 2) { 124 | struct lisp_object *sym_obj = HEAD(args); 125 | 126 | if (sym_obj->obj_type != SYMBOL) { 127 | set_error("First argument to setq must be a symbol reference."); 128 | return NULL; 129 | } 130 | 131 | /* 132 | * We evaluate first so that the expression cannot try to access the symbol 133 | * if it doesn't exist. 134 | */ 135 | struct lisp_object *value = c_eval(sym_obj->next); 136 | 137 | struct symbol *sym = symbol_lookup(SYM_NAME(sym_obj)); 138 | 139 | if (!sym) { 140 | sym = get_new_symbol(); 141 | } 142 | 143 | if (!symbol_reassign(sym, SYM_NAME(sym_obj), value)) { 144 | // This function sets the lisp_error 145 | return NULL; 146 | } 147 | 148 | return nil; 149 | } 150 | 151 | DEFUN("while", lisp_while, UNEVAL_ARGS, 2, 2) { 152 | struct lisp_object *cond = HEAD(args); 153 | struct lisp_object *body = cond->next; 154 | 155 | struct lisp_object *body_evaled = nil; 156 | 157 | struct lisp_object *current = c_eval(cond); 158 | 159 | if (!current) { 160 | return NULL; 161 | } 162 | 163 | while (TRUEP(current)) { 164 | if (body) { 165 | body_evaled = c_eval(body); 166 | if (!body_evaled) { 167 | return NULL; 168 | } 169 | } 170 | 171 | current = c_eval(cond); 172 | if (!current) { 173 | return NULL; 174 | } 175 | } 176 | 177 | return body_evaled; 178 | } 179 | 180 | DEFUN("progn", lisp_progn, UNEVAL_ARGS, 1, -1) { 181 | struct lisp_object *current = HEAD(args); 182 | 183 | struct lisp_object *evaled = nil; 184 | 185 | while (current) { 186 | evaled = c_eval(current); 187 | 188 | current = current->next; 189 | } 190 | 191 | return evaled; 192 | } 193 | 194 | DEFUN("defun", lisp_defun, UNEVAL_ARGS, 3, -1) { 195 | /* To define a function, first we need the parameters list and the forms */ 196 | struct lisp_object *name = HEAD(args); 197 | struct lisp_object *params = name->next; 198 | struct lisp_object *forms = params->next; 199 | 200 | if (params->obj_type != LIST) { 201 | set_error("Params must be of type LIST"); 202 | return NULL; 203 | } 204 | 205 | /* Separate the params and forms */ 206 | params->next = NULL; 207 | forms->prev = NULL; 208 | 209 | struct lisp_function *func = malloc(sizeof(struct lisp_function)); 210 | func->params = params; 211 | func->forms = forms; 212 | 213 | func->numparams = list_length(params); 214 | 215 | struct symbol *sym = symbol_lookup(SYM_NAME(name)); 216 | 217 | if (!sym) { 218 | sym = get_new_symbol(); 219 | } 220 | 221 | if (!symbol_reassign(sym, SYM_NAME(name), make_lisp_object(FUNCTION, func))) { 222 | // This function sets the lisp_error 223 | return NULL; 224 | } 225 | 226 | return sym->value; 227 | } 228 | 229 | DEFUN("lambda", lisp_lambda, UNEVAL_ARGS, 2, -1) { 230 | /* To define a function, first we need the parameters list and the forms */ 231 | struct lisp_object *params = HEAD(args); 232 | struct lisp_object *forms = params->next; 233 | 234 | if (params->obj_type != LIST) { 235 | set_error("Params must be of type LIST."); 236 | return NULL; 237 | } 238 | 239 | /* Separate the params and forms */ 240 | params->next = NULL; 241 | forms->prev = NULL; 242 | 243 | struct lisp_function *func = malloc(sizeof(struct lisp_function)); 244 | func->params = params; 245 | func->forms = forms; 246 | func->numparams = list_length(params); 247 | return make_lisp_object(FUNCTION, func); 248 | } 249 | 250 | DEFUN("symbols", lisp_symbols, EVAL_ARGS, 0, 0) { 251 | int i; 252 | 253 | struct lisp_object *head = make_lisp_object(LIST, NULL); 254 | 255 | struct lisp_object *prev = NULL; 256 | struct lisp_object *current = NULL; 257 | 258 | for (i = 0; i < symbol_table_counter; i++) { 259 | struct symbol *sym = symbol_table + i; 260 | 261 | struct lisp_object *symref = make_lisp_object(SYMBOL, sym->symbol_name); 262 | struct lisp_object *value = lisp_object_deep_copy(sym->value); 263 | symref->next = value; 264 | value->prev = symref; 265 | if (i == 0) { 266 | current = head; 267 | current->data = symref; 268 | } 269 | else { 270 | current = make_lisp_object(LIST, symref); 271 | } 272 | 273 | current->prev = prev; 274 | if (prev) { 275 | prev->next = current; 276 | } 277 | prev = current; 278 | } 279 | 280 | return make_lisp_object(LIST, head); 281 | } 282 | 283 | /* Returns the CAR (the first element) of the given list. */ 284 | DEFUN("car", lisp_car, EVAL_ARGS, 1, 1) { 285 | struct lisp_object *list = HEAD(args); 286 | 287 | if (list->obj_type != LIST) { 288 | set_error("Cannot take car of non-list."); 289 | return NULL; 290 | } 291 | if (list->data == NULL) { 292 | set_error("Cannot take car of nil."); 293 | return NULL; 294 | } 295 | 296 | struct lisp_object *ret = lisp_object_deep_copy(HEAD(list)); 297 | 298 | ret->next = NULL; 299 | ret->prev = NULL; 300 | 301 | return ret; 302 | } 303 | 304 | DEFUN("cdr", lisp_cdr, EVAL_ARGS, 1, 1) { 305 | struct lisp_object *list = HEAD(args); 306 | 307 | if (list->obj_type != LIST) { 308 | set_error("Cannot take cdr of non-list."); 309 | return NULL; 310 | } 311 | if (list->data == NULL) { 312 | set_error("Cannot take cdr of nil."); 313 | return NULL; 314 | } 315 | 316 | struct lisp_object *old_head = HEAD(list); 317 | 318 | /* Temporarily screw up the old list to make deep copy work */ 319 | list->data = HEAD(list)->next; 320 | 321 | /* Makes a copy of the list without the first element */ 322 | struct lisp_object *cdr = lisp_object_deep_copy(list); 323 | 324 | list->data = old_head; 325 | 326 | return cdr; 327 | } 328 | 329 | void base_initialize() { 330 | lisp_if_init(); 331 | lisp_lt_init(); 332 | lisp_gt_init(); 333 | lisp_eq_init(); 334 | lisp_print_init(); 335 | lisp_prints_init(); 336 | lisp_setq_init(); 337 | lisp_progn_init(); 338 | lisp_while_init(); 339 | lisp_defun_init(); 340 | lisp_lambda_init(); 341 | lisp_symbols_init(); 342 | lisp_cdr_init(); 343 | lisp_car_init(); 344 | } 345 | -------------------------------------------------------------------------------- /src/builtins_datetime.c: -------------------------------------------------------------------------------- 1 | /* 2 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 3 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 4 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 5 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 6 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 7 | * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 8 | * THE SOFTWARE. 9 | */ 10 | 11 | -------------------------------------------------------------------------------- /src/builtins_interpreter.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Defines a set of functions which are only initialized when we are using the interactive interpreter 3 | */ 4 | 5 | #include "lisp.h" 6 | 7 | #include 8 | 9 | DEFUN("exit", lisp_exit, EVAL_ARGS, 0, 1) { 10 | exit(args->next ? (int)TOLINT(args->next) : 0); 11 | } 12 | 13 | void interpreter_initialize() { 14 | lisp_exit_init(); 15 | } 16 | -------------------------------------------------------------------------------- /src/builtins_math.c: -------------------------------------------------------------------------------- 1 | /* 2 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 3 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 4 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 5 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 6 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 7 | * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 8 | * THE SOFTWARE. 9 | */ 10 | 11 | #include "lisp.h" 12 | 13 | #include 14 | #include 15 | 16 | DEFUN("+", lisp_add, EVAL_ARGS, 2, -1) { 17 | LISPINT *sum = malloc(sizeof(LISPINT)); 18 | 19 | struct lisp_object *current = HEAD(args); 20 | 21 | while (current) { 22 | if (current->obj_type != INTEGER) { 23 | set_error("Incorrect argument types to '+'"); 24 | return NULL; 25 | } 26 | 27 | (*sum) += TOLINT(current); 28 | current = current->next; 29 | } 30 | 31 | return make_lisp_object(INTEGER, sum); 32 | } 33 | 34 | DEFUN("-", lisp_subtract, EVAL_ARGS, 2, -1) { 35 | LISPINT *sum = malloc(sizeof(LISPINT)); 36 | 37 | struct lisp_object *current = HEAD(args); 38 | 39 | (*sum) = TOLINT(current); 40 | 41 | current = current->next; 42 | 43 | while (current) { 44 | if (current->obj_type != INTEGER) { 45 | set_error("Incorrect argument types to '-'"); 46 | return NULL; 47 | } 48 | 49 | (*sum) -= TOLINT(current); 50 | current = current->next; 51 | } 52 | 53 | return make_lisp_object(INTEGER, sum); 54 | } 55 | 56 | DEFUN("*", lisp_multiply, EVAL_ARGS, 2, -1) { 57 | LISPINT *ret = malloc(sizeof(LISPINT)); 58 | 59 | struct lisp_object *current = HEAD(args); 60 | 61 | (*ret) = TOLINT(current); 62 | 63 | current = current->next; 64 | 65 | while (current) { 66 | if (current->obj_type != INTEGER) { 67 | set_error("Incorrect argument types to '*'"); 68 | return NULL; 69 | } 70 | 71 | (*ret) *= TOLINT(current); 72 | current = current->next; 73 | } 74 | 75 | return make_lisp_object(INTEGER, ret); 76 | } 77 | 78 | DEFUN("/", lisp_divide, EVAL_ARGS, 2, -1) { 79 | LISPINT *ret = malloc(sizeof(LISPINT)); 80 | 81 | struct lisp_object *current = HEAD(args); 82 | 83 | (*ret) = TOLINT(current); 84 | 85 | current = current->next; 86 | 87 | while (current) { 88 | if (current->obj_type != INTEGER) { 89 | set_error("Incorrect argument types to '/'"); 90 | return NULL; 91 | } 92 | 93 | (*ret) /= TOLINT(current); 94 | current = current->next; 95 | } 96 | 97 | return make_lisp_object(INTEGER, ret); 98 | } 99 | 100 | DEFUN("%", lisp_mod, EVAL_ARGS, 2, 2) { 101 | LISPINT *ret = malloc(sizeof(LISPINT)); 102 | 103 | struct lisp_object *first = HEAD(args); 104 | 105 | struct lisp_object *second = first->next; 106 | 107 | if (first->obj_type != INTEGER || second->obj_type != INTEGER) { 108 | set_error("Incorrect argument types to '%'"); 109 | return NULL; 110 | } 111 | 112 | (*ret) = TOLINT(first) % TOLINT(second); 113 | 114 | return make_lisp_object(INTEGER, ret); 115 | } 116 | 117 | DEFUN("^", lisp_power, EVAL_ARGS, 2, 2) { 118 | LISPINT * ret = malloc(sizeof(LISPINT)); 119 | 120 | struct lisp_object *first = HEAD(args); 121 | 122 | struct lisp_object *second = first->next; 123 | 124 | if (first->obj_type != INTEGER || second->obj_type != INTEGER) { 125 | set_error("Incorrect argument types to '^'"); 126 | return NULL; 127 | } 128 | 129 | (*ret) = pow(TOLINT(first), TOLINT(second)); 130 | 131 | return make_lisp_object(INTEGER, ret); 132 | } 133 | 134 | void math_initialize() { 135 | lisp_add_init(); 136 | lisp_subtract_init(); 137 | lisp_multiply_init(); 138 | lisp_divide_init(); 139 | lisp_mod_init(); 140 | lisp_power_init(); 141 | } 142 | -------------------------------------------------------------------------------- /src/eval.c: -------------------------------------------------------------------------------- 1 | /* 2 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 3 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 4 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 5 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 6 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 7 | * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 8 | * THE SOFTWARE. 9 | */ 10 | 11 | #include "lisp.h" 12 | 13 | #include 14 | #include 15 | 16 | struct lisp_object *c_eval(struct lisp_object *obj) { 17 | if (!obj) { 18 | lisp_error(); 19 | return NULL; 20 | } 21 | 22 | if (obj->quoted) { 23 | struct lisp_object *new_obj = lisp_object_deep_copy(obj); 24 | new_obj->quoted = C_FALSE; 25 | return new_obj; 26 | } 27 | 28 | switch (obj->obj_type) { 29 | case LIST: 30 | { 31 | struct lisp_object *ret = make_lisp_object(LIST, NULL); 32 | 33 | struct lisp_object *head = HEAD(obj); 34 | 35 | if (!head) { 36 | // It already is nil 37 | return ret; 38 | } 39 | 40 | struct lisp_object *func = c_eval(head); 41 | 42 | if (!func) { 43 | set_error("Function %s doesn't exist.", TOSTR(head)); 44 | return NULL; 45 | } 46 | 47 | if (func->obj_type != BUILTIN && func->obj_type != FUNCTION) { 48 | set_error("First object in list is not a function.", SYM_NAME(head)); 49 | return NULL; 50 | } 51 | 52 | /* Allocate an object to be used to store the copied arguments list */ 53 | struct lisp_object *args = make_lisp_object(LIST, NULL); 54 | 55 | if (head->next) { 56 | struct lisp_object *args_head; 57 | 58 | if (func->obj_type == BUILTIN && (TOBUILTIN(func)->spec & UNEVAL_ARGS)) { 59 | args_head = lisp_object_deep_copy(head->next); 60 | } 61 | else { 62 | args_head = c_eval(head->next); 63 | 64 | if (!args_head) { 65 | return NULL; 66 | } 67 | } 68 | 69 | args_head->next = NULL; 70 | args_head->prev = NULL; 71 | struct lisp_object *current = head->next->next; 72 | 73 | struct lisp_object *args_current = NULL; 74 | 75 | struct lisp_object *args_prev = args_head; 76 | 77 | while (current) { 78 | if (func->obj_type == BUILTIN && (TOBUILTIN(func)->spec & UNEVAL_ARGS)) { 79 | args_current = lisp_object_deep_copy(current); 80 | } 81 | else { 82 | args_current = c_eval(current); 83 | if (!args_current) { 84 | return NULL; 85 | } 86 | } 87 | 88 | args_current->prev = args_prev; 89 | args_current->next = NULL; 90 | args_prev->next = args_current; 91 | 92 | args_prev = args_current; 93 | current = current->next; 94 | } 95 | 96 | /* Finish constructing the arguments list */ 97 | args->data = args_head; 98 | } 99 | 100 | /* Perform the function call. */ 101 | if (func->obj_type == BUILTIN) { 102 | int count = list_length(args); 103 | 104 | struct lisp_builtin *builtin = TOBUILTIN(func); 105 | 106 | if (builtin->max_params != -1 && count > builtin->max_params) { 107 | set_error("Incorrect number of arguments (%d) to function %s!", count, TOSTR(head)); 108 | } 109 | 110 | if (builtin->min_params != -1 && count < builtin->min_params) { 111 | set_error("Incorrect number of arguments (%d) to function %s!", count, TOSTR(head)); 112 | } 113 | 114 | return builtin->func(args); 115 | } 116 | else if (func->obj_type == FUNCTION) { 117 | struct lisp_function *func_obj = TOFUNC(func); 118 | 119 | int count = list_length(args); 120 | 121 | char *func_name = head->obj_type == SYMBOL ? TOSTR(head) : ""; 122 | 123 | if (count != func_obj->numparams) { 124 | set_error("Incorrect number of arguments (%d) to function %s!", count, func_name); 125 | return NULL; 126 | } 127 | 128 | int i = 0; 129 | struct lisp_object *params_current = HEAD(func_obj->params); 130 | struct lisp_object *args_current = HEAD(args); 131 | struct symbol *syms = malloc(sizeof(struct symbol)*count); 132 | 133 | while (params_current) { 134 | syms[i].symbol_name = SYM_NAME(params_current); 135 | syms[i].value = args_current; 136 | 137 | i++; 138 | params_current = params_current->next; 139 | args_current = args_current->next; 140 | } 141 | 142 | set_local_symbols(syms, count); 143 | 144 | struct lisp_object *form_current = func_obj->forms; 145 | 146 | struct lisp_object *sub = nil; 147 | 148 | while (form_current) { 149 | sub = c_eval(form_current); 150 | 151 | if (!sub) { 152 | return NULL; 153 | } 154 | 155 | // Keep track of the return value 156 | ret = sub; 157 | 158 | form_current = form_current->next; 159 | } 160 | 161 | unset_local_symbols(); 162 | 163 | free(syms); 164 | 165 | return ret; 166 | } 167 | } 168 | case SYMBOL: 169 | { 170 | /* Do a lookup of the symbol and return the value. */ 171 | struct lisp_object *value = symbol_value(SYM_NAME(obj)); 172 | 173 | if (!value) { 174 | set_error("Symbol %s does not exist!", SYM_NAME(obj)); 175 | } 176 | 177 | return value; 178 | } 179 | default: 180 | { 181 | return lisp_object_deep_copy(obj); 182 | } 183 | } 184 | } 185 | -------------------------------------------------------------------------------- /src/lisp.c: -------------------------------------------------------------------------------- 1 | /* 2 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 3 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 4 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 5 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 6 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 7 | * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 8 | * THE SOFTWARE. 9 | */ 10 | 11 | #include "lisp.h" 12 | 13 | #include "builtins_base.h" 14 | #include "builtins_math.h" 15 | 16 | #include 17 | #include 18 | #include 19 | 20 | struct lisp_object *t; 21 | struct lisp_object *nil; 22 | 23 | struct symbol *symbol_table; 24 | int symbol_table_counter; 25 | static size_t symbol_table_size; 26 | 27 | struct symbol *local_symbols; 28 | size_t local_symbols_counter; 29 | 30 | char *glob_error; 31 | 32 | void register_builtins() { 33 | base_initialize(); 34 | math_initialize(); 35 | } 36 | 37 | void lisp_initialize() { 38 | /* We don't have a context, so the local symbol table is NULL */ 39 | local_symbols = NULL; 40 | local_symbols_counter = 0; 41 | 42 | /* Initialize the symbol table and add nil and t. */ 43 | symbol_table = malloc(sizeof(struct symbol)*SYMBOL_TABLE_INITIAL_SIZE); 44 | symbol_table_size = SYMBOL_TABLE_INITIAL_SIZE; 45 | symbol_table_counter = 0; 46 | 47 | /* Only object of type T_TYPE ever constructed. */ 48 | t = make_lisp_object(T_TYPE, NULL); 49 | 50 | struct symbol *t_symbol = get_new_symbol(); 51 | t_symbol->symbol_name = "t"; 52 | t_symbol->value = t; 53 | t_symbol->builtin = C_TRUE; 54 | 55 | /* Nil - The FALSE value in Lisp. Equivalent in value to an empty list. */ 56 | /* With a list, NULL data means an empty list. */ 57 | nil = make_lisp_object(LIST, NULL); 58 | 59 | struct symbol *nil_symbol = get_new_symbol(); 60 | nil_symbol->symbol_name = "nil"; 61 | nil_symbol->value = nil; 62 | nil_symbol->builtin = C_TRUE; 63 | 64 | glob_error = NULL; 65 | 66 | /* Register builtin functions */ 67 | register_builtins(); 68 | } 69 | 70 | struct lisp_object *lisp_object_deep_copy(struct lisp_object *obj) { 71 | struct lisp_object *ret = make_lisp_object(obj->obj_type, NULL); 72 | 73 | switch (obj->obj_type) { 74 | case LIST: 75 | { 76 | if (!(obj->data)) { 77 | ret->data = NULL; 78 | return ret; 79 | } 80 | 81 | struct lisp_object *current = (struct lisp_object*)(obj->data); 82 | struct lisp_object *new_head = lisp_object_deep_copy(current); 83 | /* Move the current pointer forward so the below loop only works on elements that need copies */ 84 | current = current->next; 85 | struct lisp_object *new_current = NULL; 86 | struct lisp_object *new_prev = new_head; 87 | 88 | while (current != NULL) { 89 | new_current = lisp_object_deep_copy(current); 90 | new_prev->next = new_current; 91 | new_current->prev = new_prev; 92 | 93 | new_prev = new_current; 94 | current = current->next; 95 | } 96 | 97 | ret->data = new_head; 98 | break; 99 | } 100 | case INTEGER: 101 | { 102 | LISPINT *data = malloc(sizeof(LISPINT)); 103 | *data = TOLINT(obj); 104 | 105 | ret->data = data; 106 | break; 107 | } 108 | /* String and symbol are the same data representation. */ 109 | case STRING: 110 | case SYMBOL: 111 | { 112 | char *old_data = (char*)(obj->data); 113 | /* Length of string plus one for a '\0' */ 114 | char *new_data = malloc((strlen(old_data)+1)*sizeof(char)); 115 | /* This copy is safe because we just made the buffers exactly equal in size ^^ */ 116 | strcpy(new_data, old_data); 117 | 118 | ret->data = new_data; 119 | 120 | break; 121 | } 122 | case T_TYPE: 123 | { 124 | return t; 125 | } 126 | default: 127 | break; 128 | } 129 | 130 | return ret; 131 | } 132 | 133 | struct symbol *get_new_symbol() { 134 | if (symbol_table_counter == symbol_table_size) { 135 | /* Extend the symbol table by the scale factor */ 136 | symbol_table_size *= SYMBOL_TABLE_SCALE_FACTOR; 137 | symbol_table = realloc(symbol_table, symbol_table_size); 138 | } 139 | 140 | struct symbol *sym = &(symbol_table[symbol_table_counter++]); 141 | 142 | sym->builtin = C_FALSE; 143 | 144 | return sym; 145 | } 146 | 147 | struct symbol *symbol_lookup(char *key) { 148 | int i; 149 | 150 | if (local_symbols) { 151 | for (i = 0; i < local_symbols_counter; i++) { 152 | if (strcmp(local_symbols[i].symbol_name, key) == 0) { 153 | /* Return a pointer. */ 154 | return local_symbols + i; 155 | } 156 | } 157 | } 158 | 159 | for (i = 0; i < symbol_table_counter; i++) { 160 | if (strcmp(symbol_table[i].symbol_name, key) == 0) { 161 | /* Return a pointer. */ 162 | return symbol_table + i; 163 | } 164 | } 165 | 166 | return NULL; 167 | } 168 | 169 | struct lisp_object *symbol_value(char *key) { 170 | struct symbol *sym = symbol_lookup(key); 171 | 172 | return sym ? sym->value : NULL; 173 | } 174 | 175 | void set_local_symbols(struct symbol *syms, size_t length) { 176 | local_symbols = syms; 177 | local_symbols_counter = length; 178 | } 179 | 180 | void unset_local_symbols() { 181 | local_symbols = NULL; 182 | local_symbols_counter = 0; 183 | } 184 | 185 | void define_builtin_function(char *symbol_name, enum paramspec spec, int min_params, int max_params, 186 | struct lisp_object* (*func)(struct lisp_object*), C_BOOL is_builtin) { 187 | /* Handles the allocation of the symbol from the pool */ 188 | struct symbol *sym = get_new_symbol(); 189 | 190 | struct lisp_builtin *builtin = malloc(sizeof(struct lisp_builtin)); 191 | builtin->func = func; 192 | builtin->spec = spec; 193 | builtin->min_params = min_params; 194 | builtin->max_params = max_params; 195 | 196 | sym->symbol_name = symbol_name; 197 | sym->value = make_lisp_object(BUILTIN, builtin); 198 | sym->builtin = is_builtin; 199 | } 200 | 201 | int list_length(struct lisp_object *list) { 202 | struct lisp_object *current = HEAD(list); 203 | 204 | int count = 0; 205 | 206 | while (current) { 207 | count++; 208 | 209 | current = current->next; 210 | } 211 | 212 | return count; 213 | } 214 | 215 | /* 216 | * Checks if object `obj` is 'true' by the conditions 217 | */ 218 | C_BOOL true_p(struct lisp_object *obj) { 219 | switch (obj->obj_type) { 220 | case INTEGER: 221 | if (!TOLINT(obj)) { 222 | return C_FALSE; 223 | } 224 | case STRING: 225 | if (!strlen(TOSTR(obj))) { 226 | return C_FALSE; 227 | } 228 | case LIST: 229 | if (!(obj->data)) { 230 | return C_FALSE; 231 | } 232 | default: 233 | return C_TRUE; 234 | } 235 | } 236 | 237 | struct lisp_object *make_lisp_object(enum type obj_type, void *data) { 238 | struct lisp_object *obj = malloc(sizeof(struct lisp_object)); 239 | 240 | obj->obj_type = obj_type; 241 | obj->data = data; 242 | obj->next = NULL; 243 | obj->prev = NULL; 244 | obj->quoted = C_FALSE; 245 | obj->counter = 0; 246 | 247 | CLAIM(obj); 248 | 249 | return obj; 250 | } 251 | 252 | void set_error(char *error, ...) { 253 | va_list va; 254 | va_start(va, error); 255 | 256 | /* The maximum length for an error message is MAX_ERROR. It will be cut off after that. */ 257 | char *buf = malloc(MAX_ERROR*sizeof(char)); 258 | 259 | vsnprintf(buf, MAX_ERROR, error, va); 260 | 261 | glob_error = buf; 262 | } 263 | 264 | char *get_error() { 265 | return glob_error; 266 | } 267 | 268 | C_BOOL has_error() { 269 | return glob_error != NULL; 270 | } 271 | 272 | void lisp_error() { 273 | if (has_error()) { 274 | fprintf(stderr, "%s", get_error()); 275 | } 276 | else { 277 | fprintf(stderr, "An unspecified error occurred."); 278 | } 279 | return; 280 | } 281 | 282 | C_BOOL symbol_reassign(struct symbol *sym, char *name, struct lisp_object *obj) { 283 | if (!obj) { 284 | // We are gonna rely on the fact that it was set in c_eval 285 | return C_FALSE; 286 | } 287 | else if (sym->builtin) { 288 | set_error("Symbol %s is a fundamental constant or builtin and cannot be modified.", sym->symbol_name); 289 | return C_FALSE; 290 | } 291 | 292 | sym->symbol_name = name; 293 | sym->value = obj; 294 | return C_TRUE; 295 | } 296 | -------------------------------------------------------------------------------- /src/lispint.c: -------------------------------------------------------------------------------- 1 | #include "lispint.h" 2 | 3 | static int num_long_digits; 4 | 5 | static void determine_long_digits() { 6 | num_long_digits = 0; 7 | long n = LONG_MAX; 8 | 9 | while (n) { 10 | num_long_digits++; 11 | n /= 10; 12 | } 13 | } 14 | 15 | struct lisp_int *lisp_int_initializef(FILE *f) { 16 | fpos_t pos; 17 | char c = 0; 18 | int digits = 0; 19 | 20 | // Determine the length of the int in digits 21 | fgetpos(f, &pos); 22 | while(isdigit(fgetc(f)) && ++digits); 23 | fsetpos(f, &pos); 24 | 25 | if (!num_long_digits) { 26 | determine_long_digits(); 27 | } 28 | 29 | // We only use the space up to long digits - 1 because we can work easier 30 | // in a system with a power of ten as the max rather than a power of 2 31 | if (digits < (num_long_digits - 1)) { 32 | // We can just store it in a single long! :D 33 | 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /src/main.c: -------------------------------------------------------------------------------- 1 | /* 2 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 3 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 4 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 5 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 6 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 7 | * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 8 | * THE SOFTWARE. 9 | */ 10 | 11 | #include "lisp.h" 12 | 13 | #include 14 | #include 15 | #include 16 | 17 | int main(int argc, char **argv) { 18 | FILE *read_from; 19 | 20 | switch (argc) { 21 | case 1: 22 | read_from = NULL; 23 | break; 24 | case 2: { 25 | read_from = fopen(argv[1], "r"); 26 | if (!read_from) { 27 | perror("Error while opening main file: "); 28 | return EXIT_FAILURE; 29 | } 30 | break; 31 | } 32 | default: 33 | printf("Too many arguments. Use like %s [file]", argv[0]); 34 | return EXIT_FAILURE; 35 | } 36 | 37 | lisp_initialize(); 38 | 39 | if (read_from == NULL) { 40 | interpreter_initialize(); 41 | } 42 | 43 | while (C_TRUE) { 44 | printf(">>> "); 45 | c_print(c_eval(c_read(read_from))); 46 | } 47 | } 48 | -------------------------------------------------------------------------------- /src/print.c: -------------------------------------------------------------------------------- 1 | /* 2 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 3 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 4 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 5 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 6 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 7 | * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 8 | * THE SOFTWARE. 9 | */ 10 | 11 | #include "lisp.h" 12 | 13 | static void c_print_internal(struct lisp_object *obj) { 14 | if (!obj) { 15 | lisp_error(); 16 | return; 17 | } 18 | 19 | switch (obj->obj_type) { 20 | case LIST: 21 | { 22 | if (obj->quoted) { 23 | printf("'"); 24 | } 25 | printf("("); 26 | struct lisp_object *current = (struct lisp_object *)(obj->data); 27 | while (current) { 28 | c_print_internal(current); 29 | 30 | if (current->next) { 31 | printf(" "); 32 | } 33 | 34 | current = current->next; 35 | } 36 | printf(")"); 37 | break; 38 | } 39 | case INTEGER: 40 | printf(LISPINT_FORMAT, TOLINT(obj)); 41 | break; 42 | case STRING: 43 | printf("\"%s\"", (char*)(obj->data)); 44 | break; 45 | case SYMBOL: 46 | if (obj->quoted) { 47 | printf("'"); 48 | } 49 | printf("%s", (char*)(obj->data)); 50 | break; 51 | case T_TYPE: 52 | printf("t"); 53 | break; 54 | case FUNCTION: 55 | printf("", obj); 56 | break; 57 | case BUILTIN: 58 | printf("", obj); 59 | break; 60 | default: 61 | printf("", obj); 62 | break; 63 | } 64 | } 65 | 66 | struct lisp_object *c_print(struct lisp_object *obj) { 67 | c_print_internal(obj); 68 | 69 | printf("\n"); 70 | 71 | return nil; 72 | } 73 | -------------------------------------------------------------------------------- /src/reader.c: -------------------------------------------------------------------------------- 1 | /* 2 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 3 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 4 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 5 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 6 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 7 | * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 8 | * THE SOFTWARE. 9 | */ 10 | 11 | #include "lisp.h" 12 | 13 | #include 14 | #include 15 | 16 | // Checks if there was an end of file while calling getc 17 | #define READ_FGETC(inp, c) do {\ 18 | c = fgetc(inp);\ 19 | if (feof(inp)) { \ 20 | set_error("Unexpected end-of-file while parsing."); \ 21 | return NULL; \ 22 | } \ 23 | } while(0) 24 | 25 | static struct lisp_object *mk_symbol(struct lisp_object *ret, FILE *input, char initial) { 26 | /* Make a base buffer with a reasonable estimate of how big the 27 | * symbol will be. 28 | */ 29 | ungetc(initial, input); 30 | char *text = malloc(BASE_SYMBOL_LENGTH*sizeof(char)); 31 | size_t text_size = BASE_SYMBOL_LENGTH; 32 | 33 | char in; 34 | int i = 0; 35 | READ_FGETC(input, in); 36 | 37 | while (!isspace(in) && in != ')') { 38 | if (i == text_size) { 39 | text_size *= SYMBOL_SCALE_FACTOR; 40 | text = realloc(text, text_size); 41 | } 42 | 43 | text[i] = in; 44 | i++; 45 | 46 | READ_FGETC(input, in); 47 | } 48 | 49 | ungetc(in, input); 50 | 51 | if (i == text_size) { 52 | text_size += 1; 53 | text = realloc(text, text_size); 54 | } 55 | text[i] = '\0'; 56 | 57 | /* Symbol name is now in text */ 58 | ret->obj_type = SYMBOL; 59 | ret->data = text; 60 | 61 | return ret; 62 | } 63 | 64 | struct lisp_object *c_read(FILE *input) { 65 | if (input == NULL) { 66 | input = stdin; 67 | } 68 | 69 | struct lisp_object *ret = malloc(sizeof(struct lisp_object)); 70 | 71 | char initial; 72 | READ_FGETC(input, initial); 73 | 74 | /* Skip any whitespace */ 75 | while (isspace(initial)) { 76 | READ_FGETC(input, initial); 77 | } 78 | 79 | /* Terminates the current list. */ 80 | if (initial == ')') { 81 | return NULL; 82 | } 83 | 84 | if (initial == '\'') { 85 | ret->quoted = C_TRUE; 86 | /* Read the next character */ 87 | READ_FGETC(input, initial); 88 | } 89 | 90 | /* List */ 91 | if (initial == '(') { 92 | ret->obj_type = LIST; 93 | 94 | /* Recursive calls to do another sub-read until we get a NULL 95 | * (')' character). 96 | */ 97 | struct lisp_object *head = c_read(input); 98 | 99 | ret->data = head; 100 | struct lisp_object *current = NULL; 101 | struct lisp_object *prev = head; 102 | 103 | /* Some special handling for if the list is empty ('()') */ 104 | if (head == NULL) { 105 | /* NULL data in a LIST type means () or nil. */ 106 | ret->data = NULL; 107 | return ret; 108 | } 109 | 110 | while ((current = c_read(input))) { 111 | current->prev = prev; 112 | current->prev->next = current; 113 | current->next = NULL; 114 | prev = current; 115 | } 116 | } 117 | 118 | /* Integers */ 119 | else if (initial == '-' || isdigit(initial)) { 120 | /* There is a special case in that "-" can be a symbol */ 121 | if (initial == '-') { 122 | char checker; 123 | 124 | READ_FGETC(input, checker); 125 | 126 | 127 | /* Therefore, we check if the - is immediately followed by whitespace */ 128 | if (isspace(checker)) { 129 | ungetc(checker, input); 130 | 131 | if (!mk_symbol(ret, input, initial)) { 132 | set_error("Unexpected end-of-file while parsing."); 133 | return NULL; 134 | } 135 | 136 | return ret; 137 | } 138 | 139 | ungetc(checker, input); 140 | } 141 | 142 | /* Return the character to the stream and read it as an int. */ 143 | ungetc(initial, input); 144 | LISPINT *data = malloc(sizeof(LISPINT)); 145 | fscanf(input, LISPINT_FORMAT, data); 146 | ret->obj_type = INTEGER; 147 | ret->data = data; 148 | } 149 | /* String */ 150 | else if (initial == '"') { 151 | char *text = malloc(BASE_STRINGBUF_LENGTH*sizeof(char)); 152 | size_t text_size = BASE_STRINGBUF_LENGTH; 153 | 154 | char in; 155 | int i = 0; 156 | READ_FGETC(input, in); 157 | 158 | while (in != '"') { 159 | if (i == text_size) { 160 | text_size *= STRINGBUF_SCALE_FACTOR; 161 | text = realloc(text, text_size); 162 | } 163 | 164 | text[i] = in; 165 | i++; 166 | 167 | READ_FGETC(input, in); 168 | } 169 | 170 | /* Terminate the string */ 171 | if (i == text_size) { 172 | text_size += 1; 173 | text = realloc(text, text_size); 174 | } 175 | text[i] = '\0'; 176 | 177 | ret->obj_type = STRING; 178 | ret->data = text; 179 | } 180 | /* Symbol */ 181 | else { 182 | if (!mk_symbol(ret, input, initial)) { 183 | set_error("Unexpected end-of-file while parsing."); 184 | return NULL; 185 | } 186 | } 187 | 188 | return ret; 189 | } 190 | --------------------------------------------------------------------------------