#ifdef STANDALONE #define _GNU_SOURCE #include #include #endif #include "pebblisp.h" #include #include #include #include #include "tokens.h" #include "plfunc.h" #ifdef STANDALONE #include "web.h" #endif /** * Inserts a variable into the environment with a given name and value. * * If `argForms` (symbol) and `argForms->forward` (value) are lists of the same * length, define each symbol element with the corresponding value element. * I.e. `(def (a b) (5 20))` would store `a` as `5` and `b` as `20`. * * @param argForms The symbol(s) and value(s) to define in the environment * @param env The environment to add the new definition to * @return The symbol(s) defined */ Object evalDefArgs(const Object* symbol, const Object* value, struct Environment* env) { const char* name = symbol->string; Object finalValue = eval(value, env); addToEnv(env, name, finalValue); cleanObject(&finalValue); return cloneObject(*symbol); } /** * Add a struct to the environment with a given name and fields. * * (struct point (x y)) */ Object evalStructArgs(const Object* symbol, const Object* fields, struct Environment* env) { const char* name = symbol->string; if (!isListy(*fields)) { return errorObject(NOT_A_LIST); } struct StructDef def; def.name = malloc(sizeof(char) * (strlen(name) + 1)); strcpy(def.name, name); def.fieldCount = listLength(fields); def.names = malloc(sizeof(char*) * def.fieldCount); { int i = 0; FOR_POINTER_IN_LIST(fields) { def.names[i] = malloc(sizeof(char) * (strlen(POINTER->string) + 1)); strcpy(def.names[i], POINTER->string); i++; } } addStructDef(def); return boolObject(1); } Object evalIfArgs(const Object* argForms, struct Environment* env) { Object condition = eval(argForms, env); Object result = condition.number ? eval(argForms->forward, env) : eval(argForms->forward->forward, env); cleanObject(&condition); return result; } Object evalLambdaArgs(const Object* argForms, struct Environment* env) { return constructLambda(argForms, argForms ? argForms->forward : NULL, env); } Object evalMapArgs(const Object* argForms, struct Environment* env) { if (!argForms) { return errorObject(NULL_MAP_ARGS); } Object lambda = eval(argForms, env); const Object* inputList = argForms->forward; if (lambda.type != TYPE_LAMBDA) { return errorObject(BAD_TYPE); } Object outputList = listObject(); if (inputList) { FOR_POINTER_IN_LIST(inputList) { // Create a new list for each element, // since lambda evaluation looks for a list Object tempInput = cloneObject(*POINTER); Object* params = &lambda.lambda->params; struct Environment newEnv = envForLambda(params, &tempInput, listLength(params), env); // Add the lambda evaluation to the list Object lambda_output = eval(&lambda.lambda->body, &newEnv); nf_addToList(&outputList, lambda_output); deleteEnv(&newEnv); cleanObject(&tempInput); } } cleanObject(&lambda); return outputList; } Object evalBuiltIns(const Object* first, const Object* rest, struct Environment* env, int* found) { *found = 1; if (strcmp(first->string, "def") == 0) { return evalDefArgs(rest, rest->forward, env); #ifndef LOW_MEM } else if (strcmp(first->string, "defe") == 0) { Object symbol = eval(rest, env); Object e = evalDefArgs(&symbol, rest->forward, env); cleanObject(&symbol); return e; #endif } else if (strcmp(first->string, "if") == 0) { return evalIfArgs(rest, env); } else if (strcmp(first->string, "fn") == 0) { return evalLambdaArgs(rest, env); } else if (strcmp(first->string, "map") == 0) { return evalMapArgs(rest, env); } else if (strcmp(first->string, "struct") == 0) { return evalStructArgs(rest, rest->forward, env); } *found = 0; return *first; } /** * Evaluates a list whose first element is a function, applying that function * * Tries to either apply the function to its parameters, or create a partial * function, if not enough parameters were passed. * * @param list The list being evaluated * @param function First element of the list, already evaluated to be a function * @param length Length of `list` - 1, to exclude the already-evaluated element * @param env The environment to evaluate in */ Object listEvalFunc(const Object* list, const Object* function, const int length, struct Environment* env) { Object rest[length]; const Object* start = list->list->forward; for (int i = 0; i < length; i++) { rest[i] = eval(start, env); start = start->forward; } Object result = function->func(rest, length, env); for (int i = 0; i < length; i++) { cleanObject(&rest[i]); } return result; } Object simpleFuncEval(const Object func, Object arg1, Object arg2, struct Environment* env) { Object funcList = startList(func); nf_addToList(&funcList, arg1); Object current = cloneObject(arg2); nf_addToList(&funcList, current); Object first_eval = eval(funcList.list, env); arg1 = listEvalFunc(&funcList, &first_eval, 2, env); cleanObject(&funcList); return arg1; } /** * Evaluates a list whose first element is a lambda, applying that lambda * * Tries to apply the lambda to its parameters. Doesn't attempt partial * application. * * @param lambda First element of the list, already evaluated to be a lambda * @param remaining The first element after `lambda` * @param env The environment to evaluate in */ Object listEvalLambda(Object* lambda, const Object* remaining, int evalLength, struct Environment* env) { struct Environment newEnv = envForLambda(&lambda->lambda->params, remaining, evalLength - 1, env); Object ret = eval(&lambda->lambda->body, &newEnv); deleteEnv(&newEnv); cleanObject(lambda); Object* t = tail(&ret); if (t) { Object o = cloneObject(*t); cleanObject(&ret); return o; } return ret; } /** * Evaluates a given list, including the application of functions and lambdas * * Engages in several behaviors, depending on list contents: * - () => () * - (x y z) => (eval_x eval_y eval_z) * - (function x y) => evaluated function(x, y) * - (function ...) => evaluated function(...) applied to each arg * - (function x) => functionx() partial function * - (lambda x) => evaluated lambda(x) * * @param obj The list to be evaluated * @param env The environment to evaluate in */ Object evalList(const Object* obj, struct Environment* env) { const int evalLength = listLength(obj); if (evalLength == 0) { return cloneObject(*obj); } Object* first_form = obj->list; if (first_form->type == TYPE_SYMBOL) { int found; Object builtIn = evalBuiltIns(first_form, first_form->forward, env, &found); if (found) { return builtIn; } int i = getStructIndex(first_form->string); if (i >= 0) { Object structo = structObject(i); int s = 0; FOR_POINTER_IN_LIST(obj) { if (s != 0) { // Skip the field name structo.structObject->fields[s - 1] = eval(POINTER, env); } s++; } return structo; } } // Evaluate the list based on the first element's type Object first_eval = eval(first_form, env); switch (first_eval.type) { case TYPE_FUNC: // Uses evalLength - 1 because we skip the first form return listEvalFunc(obj, &first_eval, evalLength - 1, env); case TYPE_LAMBDA: return listEvalLambda(&first_eval, first_form->forward, evalLength, env); default: { // Return list with each element evaluated Object list = listObject(); int i = 0; Object* t = nf_addToList(&list, first_eval); FOR_POINTER_IN_LIST(obj) { if (i != 0) { allocObject(&t->forward, eval(POINTER, env)); t = t->forward; } i++; } return list; } } } Object eval(const Object* obj, struct Environment* env) { switch (obj->type) { case TYPE_LAMBDA: case TYPE_FUNC: case TYPE_ERROR: case TYPE_OTHER: case TYPE_NUMBER: case TYPE_BOOL: case TYPE_STRING: case TYPE_STRUCT: case TYPE_SLIST: return cloneObject(*obj); case TYPE_SYMBOL: return fetchFromEnvironment(obj->string, env); case TYPE_LIST: return evalList(obj, env); } return errorObject(BAD_TYPE); } Object possessive(Object* params, int length, struct Environment* env) { Object structo = params[0]; Object field = params[1]; if (structo.type != TYPE_STRUCT) { printf("`'s` must be used on a struct!\n"); return errorObject(NULL_PARSE); } if (!isStringy(field)) { printf("`'s` field name must be stringy! Received a "); printType(&field); printObj(&field); printf("\n"); return errorObject(NULL_PARSE); } struct StructDef* structDef = getStructAt(structo.structObject->definition); for (int i = 0; i < structDef->fieldCount; i++) { if (strcmp(field.string, structDef->names[i]) == 0) { return cloneObject(structo.structObject->fields[i]); } } printf("Could not find field name `%s`\n", field.string); return errorObject(NULL_PARSE); } Result parse(struct Slice* slices) { struct Slice* token = slices; if (token && token->text) { struct Slice* rest = &slices[1]; if (token->text[0] == '\'' && token->text[1] == '(') { Result r = readSeq(&slices[2]); if (r.obj.type == TYPE_LIST) { r.obj.type = TYPE_SLIST; } return r; } else if (token->text[0] == '(') { // todo check for null rest return readSeq(rest); } else { // todo error on missing close paren Result r = parseAtom(token); r.slices = &r.slices[1]; return r; } } else { return (Result) {errorObject(NULL_PARSE), NULL}; } } #ifdef SUGAR #define sugar(_desc, _code) ; #else #define sugar(_desc, _code) _code #endif Result readSeq(struct Slice* tokens) { Object res = listObject(); int isHelp = 0; for (;;) { struct Slice* next = tokens; struct Slice* rest = next->text ? &next[1] : NULL; if (next->text[0] == ')') { return (Result) {res, rest}; } Result r = parse(tokens); sugar("(? fil) => (? 'fil')", if (isHelp && r.obj.type == TYPE_SYMBOL) { r.obj.type = TYPE_STRING; } ) if (r.obj.type == TYPE_ERROR) { return r; } nf_addToList(&res, cloneObject(r.obj)); tokens = r.slices; cleanObject(&r.obj); isHelp = next->text[0] == '?'; } } Object parseDecimal(struct Slice* s) { int num = 0; for (int i = 0; i < s->length; i++) { if (!isDigit(s->text[i])) { return errorObject(BAD_NUMBER); } num *= 10; num += s->text[i] - '0'; } return numberObject(num); } Object parseHex(struct Slice* s) { int num = 0; for (int i = 2; i < s->length; i++) { const char c = s->text[i]; if (!isHex(c)) { return errorObject(BAD_NUMBER); } num *= 16; if (isDigit(c)) { num += c - '0'; } else /* is hex */ { num += c - 'a' + 10; } } return numberObject(num); } Object parseBin(struct Slice* s) { int num = 0; for (int i = 2; i < s->length; i++) { const char c = s->text[i]; if (c != '0' && c != '1') { return errorObject(BAD_NUMBER); } num *= 2; num += c - '0'; } return numberObject(num); } Result parseAtom(struct Slice* s) { const char c = s->text[0]; if (isDigit(c)) { if (c != '0' || s->length == 1) { return (Result) {parseDecimal(s), s}; #ifndef LOW_MEM } else if (s->text[1] == 'x') { return (Result) {parseHex(s), s}; } else if (s->text[1] == 'b') { return (Result) {parseBin(s), s}; #endif } else { return (Result) {errorObject(UNSUPPORTED_NUMBER_TYPE), s}; } } else if (s->length == 1 && (c == 'T' || c == 't')) { return (Result) {boolObject(1), s}; } else if (s->length == 1 && (c == 'F' || c == 'f')) { return (Result) {boolObject(0), s}; } else if (c == '"'/* || c == '\''*/) { return (Result) {objFromSlice(s->text, s->length), s}; } else { if (s->text[s->length] == '\'' && s->text[s->length + 1] == 's') { Object possessiveFunc = newObject(TYPE_FUNC); possessiveFunc.func = &possessive; Object list = startList(possessiveFunc); Object possesser = symFromSlice(s->text, s->length); nf_addToList(&list, possesser); struct Slice* next = s + 3; Object possessed = objFromSlice(&next->text[-1], next->length + 1); nf_addToList(&list, possessed); return (Result) {list, next}; } return (Result) {symFromSlice(s->text, s->length), s}; } } struct Slice* lastOpen = NULL; Object parseEval(const char* input, struct Environment* env) { struct Error err = noError(); struct Slice* tokens = nf_tokenize(input, &err); if (err.context != NULL) { Object o = errorWithContext(err.code, err.context); free(err.context); return o; } if (!tokens->text) { return symFromSlice(" ", 1); } int i = 0; int parens = 0; Object obj = numberObject(0); struct Slice* tok = tokens; while (tok[i].text != NULL) { if (tok[i].text[0] == '(') { lastOpen = &tok[i]; parens++; } else if (tok[i].text[0] == ')') { parens--; } if (parens == 0) { cleanObject(&obj); Object parsed = parse(tok).obj; if (parsed.type == TYPE_ERROR) { obj = parsed; // TODO Check necessity obj.error->plContext = malloc(sizeof(struct Slice)); *obj.error->plContext = *lastOpen; break; } if (tok[i].text[0] == ')') { // Skip `tok` past end of list that just closed tok = &tok[i + 1]; i = -1; } if (parsed.type == TYPE_SLIST) { obj = parsed; } else { obj = eval(&parsed, env); cleanObject(&parsed); } } i++; } free(tokens); return obj; } #ifdef STANDALONE int readFile(const char* filename, struct Environment* env) { FILE* input = fopen(filename, "r"); if (!input) { return 1; } _readFile(input, env); return 0; } int _readFile(FILE* input, struct Environment* env) { Object r = numberObject(0); char page[4096] = ""; const int LINE_MAX = 256; char line[LINE_MAX]; if (fgets(line, LINE_MAX, input)) { if (line[0] != '#' || line[1] != '!') { strcat(page, line); } } int isQuote = 0; while (fgets(line, LINE_MAX, input)) { int i; for (i = 0; i < LINE_MAX; i++) { if (line[i] != ' ') { if (line[i] == ';') { break; } else { int j; for (j = i; j < LINE_MAX; j++) { if (line[j] == '"') { isQuote = !isQuote; } else if (line[j] == '\0' || (!isQuote && line[j] == ';')) { break; } } strncat(page, line, j); strcat(page, " "); break; } } } } r = parseEval(page, env); cleanObject(&r); fclose(input); return 0; } void repl(struct Environment* env) { char* buf; using_history(); parseEval("(def prompt \"pebblisp::> \")", env); while ((buf = readline(readFromEnvironment("prompt", env).string)) != NULL) { if (strcmp("q", buf) == 0) { free(buf); break; } if (buf[0] != '\0') { add_history(buf); } if (buf[0] == '?' && (buf[1] == ' ' || buf[1] == '\0')) { char* oldBuf = buf; buf = malloc(sizeof(char) * strlen(buf + 3)); sprintf(buf, "(%s)", oldBuf); free(oldBuf); } Object o = parseEval(buf, env); size_t length; char *output = stringObj(&o, &length); printColored(output); free(output); printf("\n"); cleanObject(&o); free(buf); } } void loadArgsIntoEnv(int argc, const char* argv[], struct Environment* env) { Object args = listObject(); for (int i = 0; i < argc; i++) { nf_addToList(&args, nullTerminated(argv[i])); } addToEnv(env, "args", args); } int nestedSegfault = 0; void handler(int nSignum, siginfo_t* si, void* vcontext) { if (nestedSegfault) { printf("Nested segfault!!!\n"); exit(139); } nestedSegfault = 1; printf("Segfaulted!\n"); if (lastOpen) { printf("line: %d\n%s\n", lastOpen->lineNumber, lastOpen->text); } else { printf("Happened before token processing.\n"); } ucontext_t* context = vcontext; context->uc_mcontext.gregs[REG_RIP]++; exit(139); } int main(int argc, const char* argv[]) { struct Environment env = defaultEnv(); setGlobal(&env); int ret = -1; if (argc == 2) { if (strcmp(argv[1], "--run-tests") == 0) { ret = runTests(0); } else if (strcmp(argv[1], "--run-tests=detailed") == 0) { ret = runTests(1); } } if (ret != -1) { shredDictionary(); deleteEnv(global()); return ret; } struct sigaction action; memset(&action, 0, sizeof(struct sigaction)); action.sa_flags = SA_SIGINFO; action.sa_sigaction = handler; sigaction(SIGSEGV, &action, NULL); readFile(SCRIPTDIR "/lib.pbl", &env); if (argc >= 2) { FILE* file = fopen(argv[1], "r"); if (file) { // Executing a file loadArgsIntoEnv(argc, argv, &env); _readFile(file, &env); } else { // Running arguments directly as pl code Object r = numberObject(0); for (int i = 1; i < argc; i++) { r = parseEval(argv[i], &env); printAndClean(&r); } } } else { // Running a repl loadArgsIntoEnv(argc, argv, &env); repl(&env); } deleteEnv(&env); shredDictionary(); // fprintf(stderr, "\nHEAP-ALLOCATED OBJECTS: %d\n", getAllocations()); // fprintf(stderr, "TOTAL OBJECT.C ALLOC: %zu\n", getBytes()); } #endif