#include "pebblisp.h" #include "tokens.h" #include #include #include #ifndef STANDALONE #undef printf #define printf(...) APP_LOG(APP_LOG_LEVEL_DEBUG, __VA_ARGS__) #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 *argForms, struct Environment *env) { const Object *newSymbol = argForms; const Object *newValue = argForms->forward; const char *name = newSymbol->string; // Handles multi-definitions if(newSymbol->type == TYPE_LIST && newValue->type == TYPE_LIST && listLength(newSymbol) == listLength(newValue)) { FOR_POINTERS_IN_LISTS(newSymbol, newValue) { Object finalValue = eval(P2, env); addToEnv(env, P1->string, finalValue); cleanObject(&finalValue); } return cloneObject(*newSymbol); } Object finalValue = eval(newSymbol->forward, env); addToEnv(env, name, finalValue); cleanObject(&finalValue); return cloneObject(*newSymbol); } Object evalIfArgs(const Object *argForms, struct Environment *env) { return eval(argForms, env).number ? eval(argForms->forward, env) : eval(argForms->forward->forward, env); } Object evalLambdaArgs(const Object *argForms) { return constructLambda( argForms, // Params argForms ? argForms->forward : NULL // Body ); } 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; Object outputList = listObject(); if(lambda.type != TYPE_LAMBDA) return errorObject(BAD_TYPE); FOR_POINTER_IN_LIST(inputList) { // Create a new list for each element, // since lambda evaluation looks for a list Object tempList = startList(cloneObject(*POINTER)); Object *params = &lambda.lambda->params; struct Environment newEnv = envForLambda(params, &tempList, env); // Add the lambda evaluation to the list Object lambda_output = eval(&lambda.lambda->body, &newEnv); Object delisted = cloneObject(*lambda_output.list); nf_addToList(&outputList, delisted); deleteEnv(&newEnv); cleanObject(&tempList); cleanObject(&lambda_output); } cleanObject(&lambda); return outputList; } Object evalBuiltIns(const Object *first, const Object *rest, struct Environment *env) { if(first->type != TYPE_SYMBOL) { return errorObject(NOT_A_SYMBOL); } if(strcmp(first->string, "def") == 0) { return evalDefArgs(rest, env); } else if(strcmp(first->string, "if") == 0) { return evalIfArgs(rest, env); } else if(strcmp(first->string, "fn") == 0) { return evalLambdaArgs(rest); } else if(strcmp(first->string, "map") == 0) { return evalMapArgs(rest, env); } return errorObject(BUILT_IN_NOT_FOUND); } /** * Bulk evaluator of Objects in a given list. Puts the results in a given array * * Note that `destArr` is a raw array, not an Object list, and that `start` is * not itself a list, but the first element *in* a list to be evaluated. This * allows more speed and flexibility in what should be evaluated. * * @param destArr The raw array to put the results into. Not an Object list! * @param start The Object element to start with * @param env The environment to use while evaluating */ void evalForms(Object *destArr, const Object *start, struct Environment *env) { int i = 0; while(start) { destArr[i] = eval(start, env); start = start->forward; i++; } } /** * 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]; evalForms(rest, list->list->forward, env); Object func_result = rest[0]; if(length == 1) { func_result = function->func( func_result, errorObject(ONLY_ONE_ARGUMENT), env); // Return a partial function if more parameters are required // Otherwise, return the function result return isError(func_result, ONLY_ONE_ARGUMENT) ? cloneObject(*list) : func_result; } else { // With two args, will apply function once // With more than two args, apply the function repeatedly for(int i = 1; i < length; i++) { Object toClean = func_result; func_result = function->func(func_result, rest[i], env); cleanObject(&toClean); cleanObject(&rest[i]); } return func_result; } } /** * 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, struct Environment *env) { struct Environment newEnv = envForLambda( &lambda->lambda->params, remaining, 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); if(evalLength == 1) { if(listLength(obj->list) == 0) return cloneObject(*obj); return startList(cloneObject(eval(obj->list, env))); } Object *first_form = obj->list; { // Try to eval built-ins const Object builtIn = evalBuiltIns(first_form, first_form->forward, env); if(!isError(builtIn, BUILT_IN_NOT_FOUND) && !isError(builtIn, NOT_A_SYMBOL)) { return builtIn; } } // Evaluate the list based on the first element's type Object first_eval = eval(first_form, env); switch(first_eval.type) { case TYPE_FUNC: // Passes 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, env); default: { // Return list with each element evaluated Object list = listObject(); int i = 0; nf_addToList(&list, first_eval); FOR_POINTER_IN_LIST(obj) { if(i != 0) { nf_addToList(&list, eval(POINTER, env)); } i++; } return list; } } } Object eval(const Object *obj, struct Environment *env) { switch(obj->type) { case TYPE_ERROR: case TYPE_FUNC: return *obj; case TYPE_OTHER: case TYPE_NUMBER: case TYPE_BOOL: case TYPE_STRING: return cloneObject(*obj); case TYPE_SYMBOL: return fetchFromEnvironment(obj->string, env); case TYPE_LIST: return evalList(obj, env); case TYPE_LAMBDA: return eval(&obj->lambda->body, env); } return errorObject(BAD_TYPE); } Object catObjects(const Object obj1, const Object obj2, struct Environment *env) { Object evalObj1 = eval(&obj1, env); Object evalObj2 = eval(&obj2, env); char str1[100] = ""; char str2[100] = ""; stringObj(str1, &evalObj1); stringObj(str2, &evalObj2); cleanObject(&evalObj1); cleanObject(&evalObj2); int length = strlen(str1) + strlen(str2) + 1; Object o = newObject(TYPE_STRING); o.string = calloc(sizeof(char), length); strcat(o.string, str1); strcat(o.string, str2); return o; } Object listEquality(const Object *list1, const Object *list2) { FOR_POINTERS_IN_LISTS(list1, list2) { if(P1->type != P2->type || P1->number != P2->number) return boolObject(0); } return boolObject(1); } Object _basicOp(const Object *obj1, const Object *obj2, const char op, struct Environment *env) { const int n1 = obj1->number; const int n2 = obj2->number; switch(op){ case '+': if(obj1->type == TYPE_STRING || obj2->type == TYPE_STRING) return catObjects(*obj1, *obj2, env); return numberObject(n1 + n2); case '-': return numberObject(n1 - n2); case '*': return numberObject(n1 * n2); case '/': return numberObject(n1 / n2); case '%': return numberObject(n1 % n2); case '=': if(obj1->type == TYPE_STRING && obj2->type == TYPE_STRING) return boolObject(!strcmp(obj1->string, obj2->string)); if(obj1->type == TYPE_LIST && obj2->type == TYPE_LIST) return listEquality(obj1, obj2); return boolObject(n1 == n2 && obj1->type == obj2->type); case '>': return boolObject(n1 > n2); case '<': return boolObject(n1 < n2); } return *obj1; } Object basicOp(const Object *obj1, const Object *obj2, const char op, struct Environment *env) { if(isError(*obj2, ONLY_ONE_ARGUMENT)) return *obj2; int lists = (obj1->type == TYPE_LIST) + (obj2->type == TYPE_LIST); if(lists == 0) { return _basicOp(obj1, obj2, op, env); } else if(lists == 1) { // Single operand is applied to each element in list const Object *listObj = (obj1->type == TYPE_LIST)? obj1 : obj2; const Object *singleObj = (obj1->type == TYPE_LIST)? obj2 : obj1; Object newList = listObject(); FOR_POINTER_IN_LIST(listObj) { Object adding = eval(POINTER, env); nf_addToList(&newList, _basicOp(&adding, singleObj, op, env)); } return newList; } else { // 2 lists with the op applied to matching indices of both lists if(listLength(obj1) == listLength(obj2)) { Object newList = listObject(); FOR_POINTERS_IN_LISTS(obj1, obj2) { const Object ev1 = eval(P1, env); const Object ev2 = eval(P2, env); nf_addToList(&newList, _basicOp(&ev1, &ev2, op, env)); } return newList; } else { return errorObject(LISTS_NOT_SAME_SIZE); } } } #define BASIC_OP(_name, _char) \ Object _name(Object obj1, Object obj2, struct Environment *env) \ { return basicOp(&obj1, &obj2, _char, env); } BASIC_OP(add, '+'); BASIC_OP(sub, '-'); BASIC_OP(mul, '*'); BASIC_OP(dvi, '/'); BASIC_OP(mod, '%'); BASIC_OP(equ, '='); BASIC_OP(gth, '>'); BASIC_OP(lth, '<'); #undef BASIC_OP Object filter(Object obj1, Object obj2, struct Environment *env) { Object filteredList = listObject(); Object *filteringList = &obj2; FOR_POINTER_IN_LIST(filteringList) { Object conditional = cloneObject(obj1); nf_addToList(&conditional, *POINTER); // cloneObject()? Object result = eval(&conditional, env); cleanObject(&conditional); if(result.number == 1) { nf_addToList(&filteredList, *POINTER); } } return filteredList; } Object append(Object list, Object newElement, struct Environment *env) { Object newList = cloneObject(list); nf_addToList(&newList, cloneObject(newElement)); return newList; } Object prepend(Object list, Object newElement, struct Environment *env) { Object newList = listObject(); nf_addToList(&newList, cloneObject(newElement)); appendList(&newList, &list); return newList; } Object at(Object index, Object list, struct Environment *env) { return cloneObject(*itemAt(&list, index.number)); } Object rest(Object list, Object ignore, struct Environment *env) { Object ret = listObject(); Object *l = &list; FOR_POINTER_IN_LIST(l) { if(POINTER == l->list) continue; nf_addToList(&ret, cloneObject(*POINTER)); } return ret; } Object reverse(Object _list, Object ignore, struct Environment *ignore2) { const Object *list = &_list; Object rev = listObject(); Object *tail = NULL; FOR_POINTER_IN_LIST(list) { Object *oldTail = tail; allocObject(&tail, cloneObject(*POINTER)); if(oldTail) tail->forward = oldTail; } rev.list = tail; return rev; } Object isNum(Object test, Object ignore, struct Environment *ignore2) { return test.type == TYPE_NUMBER ? boolObject(1) : boolObject(0); } Object isString(Object test, Object ignore, struct Environment *ignore2) { return test.type == TYPE_STRING ? boolObject(1) : boolObject(0); } Object print(Object p, Object ignore, struct Environment *env) { p = cloneObject(p); p = eval(&p, env); _printObj(&p, 0); return numberObject(0); } Object pChar(Object c, Object i1, struct Environment *i2) { if(c.type != TYPE_NUMBER) { return errorObject(BAD_NUMBER); } printf("%c", c.number % 256); return numberObject(0); } Object printEnvO(Object i1, Object i2, struct Environment *env) { while(env->outer) { env = env-> outer; } printEnv(env); return numberObject(0); } Object parseEvalO(Object text, Object ignore, struct Environment *env) { if(text.type != TYPE_STRING) { return errorObject(CAN_ONLY_EVAL_STRINGS); } return parseEval(text.string, env); } #ifdef STANDALONE Object takeInput(Object i1, Object i2, struct Environment *i3) { char input[256] = ""; fgets(input, 256, stdin); return stringFromSlice(input, strlen(input) - 1); } #endif void copySlice(char * dest, struct Slice *src) { if(!dest || !src) return; strncpy(dest, src->text, src->length); dest[(int)src->length] = '\0'; } void debugSlice(struct Slice *s) { if(!s) { printf("NULL SLICE\n"); return; } printf("Debug Slice\n text:'"); for(int i = 0; i < s->length; i++) { printf("%c", s->text[i]); if(s->text[i] == '\0') printf("NULLCHAR\n"); } printf("'\n"); printf(" length: %d\n", s->length); } Result parse(struct Slice *slices) { struct Slice *token = slices; if(token && token->text) { struct Slice *rest = &slices[1]; if(token->text[0] == '(') { // todo check for null rest return readSeq(rest); } else { // todo error on missing close paren return (Result){parseAtom(token), rest}; } } else { return (Result){errorObject(NULL_PARSE), NULL}; } } Result readSeq(struct Slice *tokens) { Object res = listObject(); 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); if(r.obj.type == TYPE_ERROR) return r; nf_addToList(&res, cloneObject(r.obj)); tokens = r.slices; cleanObject(&r.obj); } } 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); } Object parseAtom(struct Slice *s) { const char c = s->text[0]; if(isDigit(c)) { if(c != '0' || s->length == 1) { return parseDecimal(s); } else if(c == '0' && s->text[1] == 'x') { return parseHex(s); } else if(c == '0' && s->text[1] == 'b') { return parseBin(s); } else { return errorObject(UNSUPPORTED_NUMBER_TYPE); } } else if (s->length == 1 && (c == 'T' || c == 't')) { return boolObject(1); } else if (s->length == 1 && (c == 'F' || c == 'f')) { return boolObject(0); } else if (c == '"' || c == '\'') { return objFromSlice(s->text, s->length); } else { return symFromSlice(s->text, s->length); } } Object parseEval(const char *input, struct Environment *env) { struct Slice *tokens = nf_tokenize(input); if(!tokens) return errorObject(MISMATCHED_PARENS); if(!tokens->text) return symFromSlice(" ", 1); #ifdef DEBUG struct Slice *debug = tokens; printd("start slice\n"); if(debug) { while(debug->text) { char tok[100]; copySlice(tok, debug); printd("slice: '%s'\n", tok); debug++; } } #endif int i = 0; int parens = 0; Object obj = numberObject(0); struct Slice *tok = tokens; while(tok[i].text != NULL) { if(tok[i].text[0] == '(') { parens++; } else if(tok[i].text[0] == ')') { parens--; } if(parens == 0) { cleanObject(&obj); Object parsed = parse(tok).obj; if(parsed.type == TYPE_ERROR) return parsed; if(tok[i].text[0] == ')') { tok = &tok[i + 1]; i = -1; } 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; } Object r = numberObject(0); char page[4096] = ""; const unsigned LINE_MAX = 256; char line[LINE_MAX]; if(fgets(line, LINE_MAX, input)){ if(line[0] != '#' || line[1] != '!') { strncat(page, line, strlen(line) - 1); } } 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 = 0; for(j = i; j < LINE_MAX; j++) { if(line[j] == ';' || line[j] == '\0') break; } strncat(page, line, j); strcat(page, " "); break; } } } } r = parseEval(page, env); cleanObject(&r); printf("\n"); fclose(input); return 0; } void repl(struct Environment *env) { char input[200] = ""; while(input[0] != 'q') { printf("pebblisp>> "); fgets(input, 100, stdin); Object obj = parseEval(input, env); printAndClean(&obj); } } int main(int argc, const char* argv[]) { struct Environment env = defaultEnv(); if(argc >= 2) { if(readFile(argv[1], &env) != 0) { Object r = numberObject(0); for(int i = 1; i < argc; i++) { r = parseEval(argv[i], &env); printAndClean(&r); } } } else { repl(&env); } deleteEnv(&env); } #endif