Several small additions.

Add basic allocation tracking.
Add extra error context
  - more useful for debugging the language than programs written in it
Let reduce work on a single non-list item. May be removed.
Add more testing.
Add test filtering.
Fix triple-quotes.

src/object.c

@@ -4,6 +4,28 @@
 #include <stdio.h>
 #include <string.h>
 
+size_t bytes = 0;
+int getBytes()
+{
+    return bytes;
+}
+
+void* smalloc(size_t size)
+{
+    bytes += size;
+    return malloc(size);
+}
+
+void* scalloc(size_t size, size_t count)
+{
+    bytes += (size * count);
+    return calloc(size, count);
+
+}
+
+#define malloc(x) smalloc(x)
+#define calloc(x, y) scalloc(x, y)
+
 /**
  * Returns the length of a given list Object
  * @param listObj The list to get the length of
@@ -113,6 +135,11 @@ inline int isEmpty(const Object* obj)
 }
 
 int allocations = 0;
+int getAllocations()
+{
+    return allocations;
+}
+
 /**
  * Allocate a copy of a given object into the given pointer.
  * Does nothing if `spot` is NULL
@@ -916,20 +943,20 @@ inline enum errorCode getErrorCode(const Object obj)
 
 #ifndef SIMPLE_ERRORS
 
-inline void errorAddContext(Object* o, const char* context)
+inline void errorAddContext(Object* o, const char* context, int lineNo, const char* fileName)
 {
     // printf("o: %p\n", o);
     // printf("o->error: %s\n", o->error);
     o->error->context = calloc(sizeof(char), RESULT_LENGTH);
     // printf("context: %p\n", context);
-    strncpy(o->error->context, context, RESULT_LENGTH);
+    sprintf(o->error->context, "%s %s:%d", context, fileName, lineNo);
 }
 
-inline Object errorWithContext(enum errorCode code, const char* context)
+inline Object errorWithContextLineNo(enum errorCode code, const char* context, int lineNo, const char* fileName)
 {
     Object o = errorObject(code);
     if (context) {
-        errorAddContext(&o, context);
+        errorAddContext(&o, context, lineNo, fileName);
     }
     return o;
 }

src/object.h

@@ -227,15 +227,14 @@ Object errorObject(enum errorCode err);
 
 enum errorCode getErrorCode(const Object obj);
 
+Object errorWithContextLineNo(enum errorCode code, const char* context, int lineNo, const char* fileName);
+
 #ifdef SIMPLE_ERRORS
 #define errorWithContext(code, context) errorObject(code)
-#define errorAddContext(x, y) ;
+#define errorAddContext(x, y, z, a) ;
 #else
-
+#define errorWithContext(_code, _context) errorWithContextLineNo(_code, _context, __LINE__, __FILE__)
-Object errorWithContext(enum errorCode err, const char *context);
+void errorAddContext(Object* o, const char* context, int lineNo, const char* fileName);
-
-void errorAddContext(Object *o, const char *context);
-
 #endif
 
 struct Error noError();
@@ -245,4 +244,7 @@ Object constructLambda(const Object *params, const Object *body, struct Environm
 // Object version of listLength()
 Object len(Object obj1, Object, struct Environment *);
 
+int getAllocations();
+int getBytes();
+
 #endif

src/pebblisp.c

@@ -207,6 +207,19 @@ void evalForms(Object* destArr, const Object* start, struct Environment* env)
     }
 }
 
+Object listEvalFunc(const Object* list, const Object* function,
+                    const int length, struct Environment* env);
+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 function, applying that function
  *
@@ -404,22 +417,12 @@ Object reduce(const Object listInitial, const Object func, struct Environment* e
     Object* list = itemAt(&listInitial, 0);
     Object total = cloneObject(*list->forward); // From given initial value
 
-    // Object l;
+    if (list->type != TYPE_LIST) {
-    // if (list->type != TYPE_LIST) {
+        return simpleFuncEval(func, total, *list, env);
-    //     l = startList(*list);
+    }
-    //     list = &l;
-    // }
 
     FOR_POINTER_IN_LIST(list) {
-        Object funcList = startList(func);
+        total = simpleFuncEval(func, total, *POINTER, env);
-        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;
@@ -1131,6 +1134,8 @@ int main(int argc, const char* argv[])
         repl(&env);
     }
     deleteEnv(&env);
+    // printf("TOTAL ALLOCATIONS: %d\n", getAllocations());
+    // printf("TOTAL BYTES: %d\n", getBytes());
 }
 
 #endif

src/tests.sh

@@ -13,6 +13,9 @@ CURRENT_BLOCK=""
 
 if [ "$1" == "-val" ]; then
     VALGRIND=true
+    filter="$2"
+else
+    filter="$1"
 fi
 
 FIRST_TITLE=true
@@ -47,12 +50,15 @@ fail() {
     ((TOTAL_FAILS++))
 }
 
+
+regex="regex"
 check() {
-    if $DISABLED; then
+    if $DISABLED || ! [[ "$1" =~ $filter ]]; then
         return 1
     fi
+
     if $VALGRIND; then
-        echo -ne "\n  $1\r"
+        echo -ne "\n   $1\r "
         local output="$($VALCOM ./pl "(loadfile \"examples/lib.pbl\") $2")"
     else
         local output="$(./pl "(loadfile \"examples/lib.pbl\") $2")"
@@ -60,6 +66,8 @@ check() {
 
     if [ "$output" == "$3" ]; then
         pass "$1"
+    elif [ "$3" == "$regex" ] && [[ "$output" =~ $4 ]]; then
+        pass "$1"
     else
         fail "$1" "$2"
         FAIL_OUTPUT="${FAIL_OUTPUT}\n    expected '$3' but received '$output'\n"
@@ -70,8 +78,7 @@ echo "STARTING TESTS"
 
 title "Plain returns"
 check "PlainRet" "10" "10"
-check "StrRetrn" "\"hey\"" "hey"
+check "StrRetrn" '"hey"' "hey"
-check "SingleStrRetrn" "\"hey\"" "hey"
 check "HexReturn" "0x0f0f0" "61680"
 check "BinaryReturn" "0b011010011010011" "13523"
 
@@ -90,17 +97,21 @@ title "Comparison"
 check "GratrThn" "(> 23847123 19375933)" "T"
 check "LessThan" "(< 23847123 19375933)" "F"
 check "Equality" "(= 987654321 987654321 )" "T"
-check "StringEquality" "(= \"Bean\" \"Bean\" )" "T"
+check "StringEquality" '(= "Bean" "Bean" )' "T"
-check "StringInequality" "(= \"Beans\" \"Bean\" )" "F"
+check "StringInequality" '(= "Beans" "Bean" )' "F"
-check "NullInequality" "(= \"Beans\" \"\" )" "F"
+check "NullInequality" '(= "Beans" "" )' "F"
+
+title "ComplexStrings"
+check "TripleQuoting" '"""Hello"""' 'Hello'
+check "TripleQuotingWithQuotes" '"""My name is "yoink"."""' 'My name is "yoink".'
 
 title "TypeCheck"
 check "IsNum" "(isnum 23847123)" "T"
-check "IsntNum" "(isnum \"WORDS\")" "F"
+check "IsntNum" '(isnum "WORDS")' "F"
-check "IsString" "(isstr \"words\")" "T"
+check "IsString" '(isstr "words")' "T"
-check "IsStringEmpty" "(isstr \"\")" "T"
+check "IsStringEmpty" '(isstr "")' "T"
 check "NumNotString" "(isstr 5)" "F"
-check "ListNotString" "(isstr (\"hello\"))" "F"
+check "ListNotString" '(isstr ("hello"))' "F"
 
 title "Ifs/Bools"
 check "IfReturn" "(if (T) 123456789 987654321)" "123456789"
@@ -110,7 +121,7 @@ check "EtyLstLt" "(if (()) T F)" "T"
 
 title "Lists"
 check "RegLists" "(1 2 3 4 5)" "( 1 2 3 4 5 )"
-check "MultiTypeList" "(10 20 \"rascals\")" "( 10 20 rascals )"
+check "MultiTypeList" '(10 20 "rascals")' "( 10 20 rascals )"
 check "EmptyLst" "()" "( )"
 check "EmptLst2" "(                     )" "( )"
 check "ListIndex" "(at (+ 1 1) (1 2 1000 4 5))" "1000"
@@ -125,6 +136,10 @@ check "Identifying list" "(islist (1 2 3))" "T"
 check "Identifying empty list" "(islist ())" "T"
 check "Identifying not a list" "(islist 1)" "F"
 
+deep_nesting="10"
+for i in {0..25}; do deep_nesting="( $deep_nesting )"; done
+check "DeepNesting" "$deep_nesting" "$deep_nesting" # Above 25 it starts to stack-smash
+
 title "Spacing"
 check "DenseSpc" "(+1093 102852)" "103945"
 check "WideSpac" "(     +     1093      102852       )" "103945"
@@ -162,11 +177,11 @@ check "LambdaClone" "(def y (fn (a) (* 10 a))) (def b y) (def y 12345) ((b 5) y)
 check "Duplicate" "(def dupe (fn (a) (() (a a a))));(dupe (*10 10))" "( 100 100 100 )"
 
 title "Cat"
-check "ExplicitCat" "(cat \"Big\" \" Kitty\")" "Big Kitty"
+check "ExplicitCat" '(cat "Big" " Kitty")' "Big Kitty"
-check "CatNums" "(cat \"There are \" (+ 2 3) \" kitties\")" "There are 5 kitties"
+check "CatNums" '(cat "There are " (+ 2 3) " kitties")' "There are 5 kitties"
-check "ImplicitCat" "(+ \"There are \" (* 5 4) \" bonks\")" "There are 20 bonks"
+check "ImplicitCat" '(+ "There are " (* 5 4) " bonks")' "There are 20 bonks"
 # Mixing of `+` and implicit cat currently expected but not recommended:
-check "CatAssocLeft" "(+ 10 20 \" rascals\")" "30 rascals"
+check "CatAssocLeft" '(+ 10 20 " rascals")' "30 rascals"
 
 title "Filtering"
 check "Filtering" "(fil (< 321) (30 300 90 1200 135 801))" "( 1200 801 )"
@@ -184,6 +199,7 @@ check "Accessing struct fields"\
 
 title "HigherOrder"
 check "Simple reducing" '(reduce ((1 2 3) 0) +)' '6'
+check "NonListReducing" '(reduce (1 0) +)' '1'
 check "FuncReturningAFunc" "(def plusser (fn (outer) (fn (inner) (+ outer inner))))\
     (def plusFive (plusser 5))\
     (plusFive 10)" "15"
@@ -195,31 +211,28 @@ check "UnevenLists" "(+ (1 2) (1 2 3))" "LISTS_NOT_SAME_SIZE"
 check "BadNumber" "(5df)" "BAD_NUMBER"
 check "BadHex" "(0x0zf)" "BAD_NUMBER"
 check "BadBinary" "(0b01120)" "BAD_NUMBER"
-check "BadParens" "(hey()" \
+check "BadParens1" "(hey()" regex "'MISMATCHED_PARENS.*"
-      "'MISMATCHED_PARENS': (loadfile \"examples/lib.pbl\") (hey()"
+check "BadParens2" "(hey)(" regex "'MISMATCHED_PARENS.*"
-check "BadParens2" "(hey)(" \
+check "BadParens3" "((hey(" regex "'MISMATCHED_PARENS.*"
-      "'MISMATCHED_PARENS': (loadfile \"examples/lib.pbl\") (hey)("
+check "BadParens4" ")))hey" regex "'MISMATCHED_PARENS.*"
-check "BadParens3" "((hey(" \
+check "BadParens5" "hey))(" regex "'MISMATCHED_PARENS.*"
-      "'MISMATCHED_PARENS': (loadfile \"examples/lib.pbl\") ((hey("
-check "BadParens4" ")))hey" \
-      "'MISMATCHED_PARENS': (loadfile \"examples/lib.pbl\") )))hey"
-check "BadParens5" "hey))(" \
-      "'MISMATCHED_PARENS': (loadfile \"examples/lib.pbl\") hey))("
 
 title "Eval"
-check "BasicNumberEval" "(eval \"5\")" "5"
+check "BasicNumberEval" '(eval "5")' "5"
-check "BasicOpEval" "(eval \"(+ 5 10)\")" "15"
+check "BasicOpEval" '(eval "(+ 5 10)")' "15"
-check "MapFilter" "(eval \"(fil (< 50) (map sq (1 2 3 4 5 6 7 8 9 10 11 12)))\")" "( 64 81 100 121 144 )"
+check "MapFilter" '(eval "(fil (< 50) (map sq (1 2 3 4 5 6 7 8 9 10 11 12)))")' "( 64 81 100 121 144 )"
 
 title "Forbble" disable
-check "BasicForbbleOp" "(loadfile \"examples/forbble.pbl\") (feval (10 10 * .)) \"\"" "100"
+check "BasicForbbleOp" '(loadfile "examples/forbble.pbl") (feval (10 10 * .)) ""' "100"
-check "FibForbble" "(loadfile \"examples/forbble.pbl\") (feval (1 1 _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f .)) \"\"" "28657"
+check "FibForbble" '(loadfile "examples/forbble.pbl") (feval (1 1 _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f _f .)) ""' "28657"
-check "ForbbleDefine" "(loadfile \"examples/forbble.pbl\") (feval ( : \"cubed\" dup dup * * $ )) (feval (4 cubed .)) \"\"" "64"
+check "ForbbleDefine" '(loadfile "examples/forbble.pbl") (feval ( : "cubed" dup dup * * $ )) (feval (4 cubed .)) ""' "64"
 
 title "Environment"
-check "EnvStressTestEarly" "(def a 1)(def b 20)(def c \"yee\")(def d \"yeehunnid\")(def e 3) (a)" "( 1 )"
+check "EnvStressTestEarly" '(def a 1)(def b 20)(def c "yee")(def d "yeehunnid")(def e 3) (a)' "( 1 )"
 check "EnvStressTestLate" "(def a 1)(def b 2)(def c 3)(def d 4)(def e 5)(def g 6)(def n 40) n" "40"
-
+hard_test_string="(def n 1000)"
+for c in {0..200}; do hard_test_string="(def a$c 1)$hard_test_string"; done
+check "HardEnvStressTest" "$hard_test_string n" "1000"
 
 echo ""
 

src/tokens.c

@@ -102,12 +102,11 @@ struct Slice* nf_tokenize(const char* input, struct Error* err)
                 slices[slice].text += 2;
                 for (;;) {
                     i++;
-                    if (input[i] == '"' && input[i + 1] == '"' &&
+                    if (input[i] == '"' && input[i + 1] == '"' && input[i + 2] == '"') {
-                        input[i + 2] == '"') {
                         break;
                     }
-                    if (input[i] == '\0' || input[i + 1] == '\0' ||
+                    l++;
-                        input[i + 2] == '\0') {
+                    if (input[i] == '\0' || input[i + 1] == '\0' || input[i + 2] == '\0') {
                         err->context = malloc(sizeof(char) * ERR_LEN + 1);
                         err->code = UNEXPECTED_EOF;
                         int start = i > ERR_LEN ? i - ERR_LEN : 0;