diff --git a/src/env.c b/src/env.c index 83def53..f46432d 100644 --- a/src/env.c +++ b/src/env.c @@ -164,13 +164,14 @@ void printEnv(struct Environment* env) printf("NULL env\n"); return; } + printf("env->size = %d\n", env->size); for (int i = 0; i < env->size; i++) { if (env->strings[i] == NULL) { printf("env[%d]: NULL %p\n", i, env->strings[i]); break; } - printf("env[%d]: '%s' %p\n", i, env->strings[i], env->strings[i]); - printf("[1m "); + printf("env[%d]: `%s` %p :: ", i, env->strings[i], env->strings[i]); + printf("[1m"); printObj(&env->objects[i]); printf("[0m"); } @@ -259,6 +260,7 @@ struct Environment defaultEnv() {"len", &len}, {"ap", &append}, {"pre", &prepend}, + {"reduce", &reduce}, {"at", &at}, {"rest", &rest}, {"chat", &charAt}, @@ -266,6 +268,7 @@ struct Environment defaultEnv() {"rev", &reverse}, #endif {"isnum", &isNum}, + {"islist", &isList}, {"isstr", &isString}, {"iserr", &isErr}, {"char", &charVal}, diff --git a/src/examples/lib.pbl b/src/examples/lib.pbl index 1f04c77..d7ffd6e 100644 --- a/src/examples/lib.pbl +++ b/src/examples/lib.pbl @@ -27,10 +27,10 @@ ; Switch expression ; Doesn't yet work with lambdas -(def switch (fn (val pair_list) - (if (= 0 (len pair_list)) "no match" - (if (= val (at 0 (at 0 pair_list))) (at 1 (at 0 pair_list)) ( - (switch val (rest pair_list)) - )) - ) -)) +;(def switch (fn (val pair_list) +; (if (= 0 (len pair_list)) "no match" +; (if (= val (at 0 (at 0 pair_list))) (at 1 (at 0 pair_list)) ( +; (switch val (rest pair_list)) +; )) +; ) +;)) diff --git a/src/examples/webby.pl b/src/examples/webby.pl index dfd7875..b4f84b3 100755 --- a/src/examples/webby.pl +++ b/src/examples/webby.pl @@ -3,20 +3,27 @@ (struct Post (title body)) -;(def element (fn (type) (fn (text) (cat "<" type ">" text "" type ">")))) -;(def link (element "link")) -;(prnl (link "howdy")) +(def element (fn (type) + (fn (text) + (cat "<" type ">" + (if (islist text) (reduce (text "") cat) (reduce ((text) "") cat)) + "" type ">")))) -(def html (fn (text) (cat "" text ""))) -(def head (fn (text) (cat "
" text ""))) -(def body (fn (text) (cat "" text ""))) -(def link (fn (text) (cat ""))) -(def h1 (fn (text) (cat "" text "
-"))) +(def html (element "html")) +(def body (element "body")) +(def head (element "head")) +(def h1 (element "h1")) +(def h2 (element "h2")) +(def p (element "p")) +(def div (element "div")) +(def article (element "article")) +(def singleton (fn (type) (fn (text) (cat "<" type " " (reduce (text "") cat) ">")))) +(def link (singleton "link")) + +(def attribute (fn (type) (fn (value) (cat type "='" value "'")))) +(def rel (attribute "rel")) +(def href (attribute "href")) (def htmlize (fn (po) (cat (h2 po's title) @@ -29,12 +36,15 @@ and the interpreter won't even instantly crash over it! It's truly astounding stuff, when you think about it." )) -(def homepage (fn () (html (cat - (head (link "rel='stylesheet' href='styles.css'")) - (body (cat - (h1 "This is Sage's Blog") +(def homepage (fn () (html ( + (head ( + (link ((rel "stylesheet") (href "styles.css"))) + )) + (body ( + (h1 "This is a sweet PebbLisp blog") (htmlize p1) - (htmlize p2)))))) ) + (htmlize p2))) + )))) (get "/" homepage) @@ -54,9 +64,14 @@ body { (def PORT 9090) (serve PORT) -(prnl (cat "Hosting server on " PORT ". Press enter to exit.")) + +(prnl (cat "Hosting server on " PORT ". Entering simple REPL. q to quit")) (def repl (fn () ( - (eval (inp)) - (repl) - ))) + (def input (inp "webby>> ")) + (if (= input "q") () ( + (eval input) + (repl) + )) +))) + (repl) diff --git a/src/object.c b/src/object.c index 8facbe6..232a8ae 100644 --- a/src/object.c +++ b/src/object.c @@ -356,8 +356,21 @@ char* stringNObj(char* dest, const Object* obj, const size_t len) break; } case TYPE_FUNC: + stringf(dest, len, "F%d", obj->number); + break; case TYPE_LAMBDA: - stringf(dest, len, "X%d", obj->number); +#ifdef STANDALONE + dest += stringf(dest, len, "\\x%d", obj->number); + stringNObj(dest, &obj->lambda->params, len); + dest += strlen(dest); + strcat(dest, " -> "); + dest += 4; + stringNObj(dest, &obj->lambda->body, len); + dest += strlen(dest); + strcat(dest, ">"); +#else + stringf(dest, len, "\\x%d", obj->number); +#endif break; case TYPE_OTHER: stringf(dest, len, "%p", obj->other->data); @@ -396,6 +409,10 @@ void debugObj(const Object* obj) void printType(const Object* obj) { + if (!obj) { + printf("NULL OBJECT"); + return; + } switch (obj->type) { SIMPLE_TYPE(TYPE_NUMBER); SIMPLE_TYPE(TYPE_STRUCT); @@ -425,6 +442,10 @@ void _printObj(const Object* obj, int newline) printType(obj); #endif + if (!obj) { + printf(newline ? "\n" : ""); + return; + } if (obj->type == TYPE_LAMBDA) { printObj(&obj->lambda->params); printf("->"); @@ -710,7 +731,7 @@ inline int isValidType(const Object test) */ inline Object cloneLambda(const Object old) { - return constructLambda(&old.lambda->params, &old.lambda->body); + return constructLambda(&old.lambda->params, &old.lambda->body, NULL); } Object cloneString(Object obj) @@ -807,7 +828,7 @@ inline Object symFromSlice(const char* string, int len) return o; } -inline Object constructLambda(const Object* params, const Object* body) +inline Object constructLambda(const Object* params, const Object* body, struct Environment* env) { if (!params || !body) { return errorObject(NULL_LAMBDA_LIST); @@ -823,6 +844,23 @@ inline Object constructLambda(const Object* params, const Object* body) o.lambda->body = listObject(); copyList(&o.lambda->params, params); copyList(&o.lambda->body, body); + + if (env) { + Object *dest = &o.lambda->body; + FOR_POINTER_IN_LIST(dest) { + if (POINTER->type == TYPE_SYMBOL) { + Object fetched = fetchFromEnvironment(POINTER->string, env); + // TODO: Figure out why lambdas in particular break when doing this. + if (!isError(fetched, DID_NOT_FIND_SYMBOL) && fetched.type != TYPE_LAMBDA) { + fetched.forward = POINTER->forward; + cleanObject(POINTER); + *POINTER = fetched; + } else { + cleanObject(&fetched); + } + } + } + } return o; } diff --git a/src/object.h b/src/object.h index 3229ddd..692c04a 100644 --- a/src/object.h +++ b/src/object.h @@ -94,8 +94,6 @@ struct Error { struct Object { Type type; - Object *forward; - union { int number; Object *list; @@ -112,6 +110,8 @@ struct Object { struct Error *error; #endif }; + + Object *forward; }; struct StructDef { @@ -240,7 +240,7 @@ void errorAddContext(Object *o, const char *context); struct Error noError(); -Object constructLambda(const Object *params, const Object *body); +Object constructLambda(const Object *params, const Object *body, struct Environment* env); // Object version of listLength() Object len(Object obj1, Object, struct Environment *); diff --git a/src/pebblisp.c b/src/pebblisp.c index 3625c3e..4c0ae19 100644 --- a/src/pebblisp.c +++ b/src/pebblisp.c @@ -116,11 +116,9 @@ Object evalIfArgs(const Object* argForms, struct Environment* env) return result; } -Object evalLambdaArgs(const Object* argForms) +Object evalLambdaArgs(const Object* argForms, struct Environment* env) { - return constructLambda(argForms, // Params - argForms ? argForms->forward : NULL // Body - ); + return constructLambda(argForms, argForms ? argForms->forward : NULL, env); } Object evalMapArgs(const Object* argForms, struct Environment* env) @@ -179,7 +177,7 @@ Object evalBuiltIns(const Object* first, const Object* rest, } else if (strcmp(first->string, "if") == 0) { return evalIfArgs(rest, env); } else if (strcmp(first->string, "fn") == 0) { - return evalLambdaArgs(rest); + return evalLambdaArgs(rest, env); } else if (strcmp(first->string, "map") == 0) { return evalMapArgs(rest, env); } else if (strcmp(first->string, "struct") == 0) { @@ -276,7 +274,6 @@ Object listEvalLambda(Object* lambda, const Object* remaining, struct Environment newEnv = envForLambda(&lambda->lambda->params, remaining, env); Object ret = eval(&lambda->lambda->body, &newEnv); - deleteEnv(&newEnv); cleanObject(lambda); @@ -329,14 +326,9 @@ Object evalList(const Object* obj, struct Environment* env) while (outerEnv->outer) { outerEnv = outerEnv->outer; } - //printf("evalList firstElementName: %s\n", first_form->string); - //printf("checking for struct `%s`\n", first_form->string); - //printf("%d structs available\n", outerEnv->structCount); for (int i = 0; i < outerEnv->structCount; i++) { - //printf("struct[%d] - `%s`\n", i, outerEnv->structDefs[i].name); if (strcmp(first_form->string, outerEnv->structDefs[i].name) == 0) { def = i; - //printf("Found struct definition for %s!\n", first_form->string); break; } } @@ -409,11 +401,43 @@ Object eval(const Object* obj, struct Environment* env) return errorObject(BAD_TYPE); } +/** + * (reduce (list, initial) (fn (prev total) (+ prev total))) + */ +Object reduce(const Object listInitial, const Object func, struct Environment* env) +{ + Object* list = itemAt(&listInitial, 0); + Object total = cloneObject(*list->forward); // From given initial value + + // Object l; + // if (list->type != TYPE_LIST) { + // l = startList(*list); + // list = &l; + // } + + FOR_POINTER_IN_LIST(list) { + Object funcList = startList(func); + nf_addToList(&funcList, total); + Object current = cloneObject(*POINTER); + nf_addToList(&funcList, current); + //Object oldTotal = total; + total = eval(&funcList, env); + //cleanObject(&oldTotal); + //cleanObject(&funcList); + //cleanObject(¤t); + } + + return total; +} + #define CAT_MAX 1024 Object catObjects(const Object obj1, const Object obj2, struct Environment* env) { Object evalObj1 = eval(&obj1, env); Object evalObj2 = eval(&obj2, env); + if (isError(evalObj2, ONLY_ONE_ARGUMENT)) { + return evalObj1; + } char str1[CAT_MAX] = ""; char str2[CAT_MAX] = ""; @@ -627,6 +651,11 @@ Object isNum(Object test, Object ignore, struct Environment* ignore2) return test.type == TYPE_NUMBER ? boolObject(1) : boolObject(0); } +Object isList(Object test, Object ignore, struct Environment* ignore2) +{ + return test.type == TYPE_LIST ? boolObject(1) : boolObject(0); +} + Object isString(Object test, Object ignore, struct Environment* ignore2) { return test.type == TYPE_STRING ? boolObject(1) : boolObject(0); @@ -711,11 +740,7 @@ Object pChar(Object c, Object i1, struct Environment* i2) Object printEnvO(Object i1, Object i2, struct Environment* env) { - while (env->outer) { - env = env->outer; - } - - printEnv(env); + printEnv(global()); return numberObject(0); } @@ -736,8 +761,11 @@ Object parseEvalO(Object text, Object ignore, struct Environment* env) #ifdef STANDALONE -Object takeInput(Object i1, Object i2, struct Environment* i3) +Object takeInput(Object prompt, Object i2, struct Environment* i3) { + if (prompt.type == TYPE_STRING) { + printf("%s", prompt.string); + } char input[256] = ""; fgets(input, 256, stdin); return stringFromSlice(input, strlen(input) - 1); diff --git a/src/pebblisp.h b/src/pebblisp.h index 7bcdac8..4d42dbf 100644 --- a/src/pebblisp.h +++ b/src/pebblisp.h @@ -28,7 +28,7 @@ void evalForms(Object* destList, const Object* src, struct Environment* env); void copySlice(char* dest, struct Slice* src); -Object evalLambdaArgs(const Object* arg_forms); +Object evalLambdaArgs(const Object* arg_forms, struct Environment* env); Object listEvalLambda(Object* lambda, const Object* remaining, struct Environment* env); @@ -70,6 +70,8 @@ Object append(Object list, Object newElement, struct Environment* env); Object prepend(Object list, Object newElement, struct Environment* env); +Object reduce(Object listInitial, Object func, struct Environment* env); + Object at(Object index, Object list, struct Environment* env); Object rest(Object list, Object ignore, struct Environment* env); @@ -78,6 +80,8 @@ Object reverse(Object _list, Object ignore, struct Environment* ignore2); Object isNum(Object test, Object ignore, struct Environment* ignore2); +Object isList(Object test, Object ignore, struct Environment* ignore2); + Object isString(Object test, Object ignore, struct Environment* ignore2); Object isErr(Object test, Object ignore, struct Environment* ignore2); diff --git a/src/tests.sh b/src/tests.sh index de022de..9bb2b74 100755 --- a/src/tests.sh +++ b/src/tests.sh @@ -153,7 +153,7 @@ check "FbnciSeq" "\ a \ (+ (fib (- a 1)) (fib (- a 2))) \ )));\ - (fib 20)" "6765" + (fib 11)" "89" check "Factorial" "\ (def fac (fn (a) \ (if (= a 1) \ @@ -169,7 +169,7 @@ title "Cat" check "ExplicitCat" "(cat \"Big\" \" Kitty\")" "Big Kitty" check "CatNums" "(cat \"There are \" (+ 2 3) \" kitties\")" "There are 5 kitties" check "ImplicitCat" "(+ \"There are \" (* 5 4) \" bonks\")" "There are 20 bonks" -# Mixing of `+` and implicit cat not recommended: +# Mixing of `+` and implicit cat currently expected but not recommended: check "CatAssocLeft" "(+ 10 20 \" rascals\")" "30 rascals" endBlock @@ -179,6 +179,12 @@ check "FilterEval" "(fil (= 1000) ((+ 450 550) (* 20 50) (/ 30 3) (- 10000 100)) check "MapFilter" "(fil (< 50) (map sq (1 2 3 4 5 6 7 8 9 10 11 12)))" "( 64 81 100 121 144 )" endBlock +title "HigherOrder" +check "FuncReturningAFunc" "(def plusser (fn (outer) (fn (inner) (+ outer inner))))\ + (def plusFive (plusser 5))\ + (plusFive 10)" "15" +endBlock + title "ShouldError" check "LenOfNotList" "(len 5)" "NOT_A_LIST" check "NoMapList" "(map sq)" "( )"