#ifdef STANDALONE #define _GNU_SOURCE #endif #include "pebblisp.h" #include #include #include "tokens.h" #ifdef STANDALONE #include #include #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 def(Object* params, unused int length, unused struct Environment* env) { const char* name = params[0].string; Object finalValue = eval(¶ms[1], env); addToEnv(env, name, finalValue); cleanObject(&finalValue); return cloneObject(params[0]); } /** * Add a struct to the environment with a given name and fields. * * Not a typical pl function because I don't feel like adding more syntactic sugar right now. * * (struct point (x y)) */ Object evalStructArgs(const Object* symbol, const Object* fields, unused 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 trueObject(); } /** * Not a typical pl function because delayed evaluation is annoying in those right now. */ 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; } /** * Not a typical pl function because it relies almost exclusively on symbols */ Object evalLambdaArgs(const Object* argForms, struct Environment* env) { return constructLambda(argForms, argForms ? argForms->forward : NULL, env); } Object mapO(Object* params, int length, struct Environment* env) { if (length < 2) { return errorObject(NULL_MAP_ARGS); } Object lambda = eval(¶ms[0], env); const Object* inputList = ¶ms[1]; 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* lambdaParams = &lambda.lambda->params; struct Environment newEnv = envForLambda(lambdaParams, &tempInput, listLength(lambdaParams), 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, "if") == 0) { return evalIfArgs(rest, env); } else if (strcmp(first->string, "fn") == 0) { return evalLambdaArgs(rest, env); } else if (strcmp(first->string, "struct") == 0) { return evalStructArgs(rest, rest->forward, env); } *found = 0; return *first; } /** * Evaluates a paramList 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 function First element of the paramList, already evaluated to be a function * @param paramList The parameters to the function * @param length Length of `paramList` - 1, to exclude the already-evaluated element * @param env The environment to evaluate in */ Object listEvalFunc(const Object* function, const Object* paramList, const int length, struct Environment* env) { Object rest[length]; for (int i = 0; i < length; i++) { rest[i] = eval(paramList, env); paramList = paramList->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) { arg2 = cloneObject(arg2); arg1.forward = &arg2; Object first_eval = eval(&func, env); Object ret = listEvalFunc(&first_eval, &arg1, 2, env); cleanObject(&first_eval); cleanObject(&arg2); return ret; } /** * 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 (the function itself) return listEvalFunc(&first_eval, obj->list->forward, 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 structAccess(Object* params, unused int length, unused struct Environment* env) { checkTypes(structAccess) Object structo = params[0]; Object field = params[1]; 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 forceString = 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')" // or, "(def yee 10) => (def 'yee' 10)", if (forceString && 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); forceString = next->text[0] == '?' || (strncmp(next->text, "def", 3) == 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) { errorWithContext(UNSUPPORTED_NUMBER_TYPE, s->text), s }; } } else if (s->length == 1 && c == 'T') { return (Result) { trueObject(), s }; } else if (s->length == 1 && c == 'F') { return (Result) { falseObject(), s }; } else if (c == '"'/* || c == '\''*/) { return (Result) { objFromSlice(s->text, s->length), s }; } else if (s->text[s->length] == '.') { Object structAccessFunc = newObject(TYPE_FUNC); structAccessFunc.func = &structAccess; Object list = startList(structAccessFunc); Object theStruct = symFromSlice(s->text, s->length); nf_addToList(&list, theStruct); struct Slice* next = s + 2; Object structField = objFromSlice(&next->text[-1], next->length + 1); nf_addToList(&list, structField); 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 #ifdef STANDALONE obj.error->plContext = malloc(sizeof(struct Slice)); *obj.error->plContext = *lastOpen; #endif 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; } Object typeCheck(const char* funcName, Object* params, int length, int (* typeChecks[])(Object), int typeLength, int* failed) { *failed = 1; if ((typeLength - 1) > length) { return errorWithContext(NOT_ENOUGH_ARGUMENTS, funcName); } for (int i = 0; i < typeLength - 1; i++) { if (typeChecks[i] && !typeChecks[i](params[i])) { // TODO: Use pl func name instead of C function name. return /*errorObject(BAD_TYPE); */ errorWithContextLineNo(BAD_PARAMS_ON, funcName, 0, NULL); } } *failed = 0; return numberObject(0); } #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; } char* getPrompt(struct Environment* env) { Object prompt = fetchFromEnvironment("prompt", env); prompt = cloneObject(prompt); if (prompt.type == TYPE_STRING) { char* ret = readline(prompt.string); cleanObject(&prompt); return ret; } Object param = stringFromSlice("", 1); Object e = listEvalLambda(&prompt, ¶m, 2, env); cleanObject(&prompt); cleanObject(¶m); char* ret = readline(e.string); cleanObject(&e); return ret; } char* preprocess(char* buf, struct Environment* env) { Object lambda = fetchFromEnvironment("preprocess", env); Object buffer = nullTerminated(buf); Object s = listEvalLambda(&lambda, &buffer, 2, env); size_t length; return stringObj(&s, &length); } void repl(struct Environment* env) { char* buf; using_history(); while ((buf = getPrompt(env)) != NULL) { if (strcmp("q", buf) == 0) { free(buf); break; } buf = preprocess(buf, env); if (buf[0] == '\0') { free(buf); continue; } add_history(buf); if ((buf[0] == 'c' && buf[1] == 'd')) { char* oldBuf = buf; buf = malloc(sizeof(char) * strlen(buf + 6)); sprintf(buf, "(cd \"%s\")", oldBuf + 3); free(oldBuf); } 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); if (isFuncy(o) || isError(o, DID_NOT_FIND_SYMBOL)) { cleanObject(&o); system(buf); free(buf); continue; } free(buf); size_t length; char* output = stringObj(&o, &length); cleanObject(&o); printColored(output); free(output); printf("\n"); } } 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); } #ifdef __x86_64__ #include #include 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); } void setupSegfaultHandler() { struct sigaction action; memset(&action, 0, sizeof(struct sigaction)); action.sa_flags = SA_SIGINFO; action.sa_sigaction = handler; sigaction(SIGSEGV, &action, NULL); } #else void setupSegfaultHandler() { } #endif // TODO: add --no-lib and --no-config and/or --config= int main(int argc, const char* argv[]) { setupSegfaultHandler(); const char* const home = getenv("HOME"); char config[strlen(home) + 15]; struct Environment env = defaultEnv(); setGlobal(&env); if (argc == 2) { const char* runTestsArg = "--run-tests"; if (strncmp(argv[1], runTestsArg, strlen(runTestsArg)) == 0) { int ret = runTests(strcmp(argv[1] + strlen(runTestsArg), "=detailed") == 0); shredDictionary(); deleteEnv(global()); return ret; } } readFile(SCRIPTDIR "/lib.pbl", &env); Object o = parseEval("(def prompt \"pebblisp::> \")", &env); cleanObject(&o); o = parseEval("(def preprocess (fn (text) (text)))", &env); cleanObject(&o); sprintf(config, "%s/.pebblisp.pbl", home); readFile(config, &env); if (argc >= 2) { FILE* file = fopen(argv[1], "r"); if (file) { // Execute a file loadArgsIntoEnv(argc, argv, &env); _readFile(file, &env); } else { // Run arguments directly as pl code Object r = numberObject(0); for (int i = 1; i < argc; i++) { r = parseEval(argv[i], &env); printAndClean(&r); } } } else { // Run a repl loadArgsIntoEnv(argc, argv, &env); repl(&env); } deleteEnv(&env); shredDictionary(); // eprintf("totalSearchDepth: %d of %d searches\n", getTotalSearchDepth(), getTotalSearches()); // eprintf("\nHEAP-ALLOCATED OBJECTS: %d\n", getAllocations()); // eprintf("TOTAL OBJECT.C ALLOC: %zu\n", getBytes()); } #endif