Several changes.

Add `reduce` and `islist`. - Reduce is broken with lambdas for some reason. Remove `switch` from lib (breaks `penv`). More detailed lambda to-stringing. A bit of fixing for lambdas that return lambdas. Re-org Object fields for simpler visual debugging. Let `cat` work with one argument. Add prompt option for `inp`. Some more refinement of the webby.pl example.
2022-03-16 16:36:04 -04:00 · 2022-03-16 16:36:04 -04:00 · 711719289f
parent 7faf2ebbb3
commit 711719289f
8 changed files with 150 additions and 56 deletions
--- 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},
--- 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))
+;    ))
+;  )
+;))
--- 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 "<html>" text "</html>")))
-(def head (fn (text) (cat "<head>" text "</head>")))
-(def body (fn (text) (cat "<body>" text "</body>")))
-(def link (fn (text) (cat "<link " text ">")))
-(def h1 (fn (text) (cat "<h1>" text "</h1>
-")))
-(def h2 (fn (text) (cat "<h2>" text "</h2>")))
-(def p (fn (text) (cat "<p>" text "</p>
-")))
+(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))
+  (def input (inp "webby>> "))
+  (if (= input "q") () (
+    (eval input)
    (repl)
-    )))
+  ))
+)))
+
 (repl)
--- 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;
 }

--- 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 *);
--- 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(&current);
+    }
+
+    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);
--- 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);
--- 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)" "( )"