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.
2022-03-18 16:10:23 -04:00 · 2022-03-18 16:10:23 -04:00 · 9da4649a27
parent ee8eaf2d28
commit 9da4649a27
5 changed files with 108 additions and 62 deletions
--- a/src/object.c
+++ b/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 [33m%s:%d[0m", 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;
 }
--- a/src/object.h
+++ b/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
-
-Object errorWithContext(enum errorCode err, const char *context);
-
-void errorAddContext(Object *o, const char *context);
-
+#define errorWithContext(_code, _context) errorWithContextLineNo(_code, _context, __LINE__, __FILE__)
+void errorAddContext(Object* o, const char* context, int lineNo, const char* fileName);
 #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
--- a/src/pebblisp.c
+++ b/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) {
-    //     l = startList(*list);
-    //     list = &l;
-    // }
+    if (list->type != TYPE_LIST) {
+        return simpleFuncEval(func, total, *list, env);
+    }

    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);
+        total = simpleFuncEval(func, total, *POINTER, env);
    }

    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
--- a/src/tests.sh
+++ b/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,10 +50,13 @@ 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 "
        local output="$($VALCOM ./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  [31m  expected '$3' but received '$output'\n"
@ -70,8 +78,7 @@ echo "[1;33mSTARTING TESTS[0;m"

 title "Plain returns"
 check "PlainRet" "10" "10"
-check "StrRetrn" "\"hey\"" "hey"
-check "SingleStrRetrn" "\"hey\"" "hey"
+check "StrRetrn" '"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 "StringInequality" "(= \"Beans\" \"Bean\" )" "F"
-check "NullInequality" "(= \"Beans\" \"\" )" "F"
+check "StringEquality" '(= "Bean" "Bean" )' "T"
+check "StringInequality" '(= "Beans" "Bean" )' "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 "IsString" "(isstr \"words\")" "T"
-check "IsStringEmpty" "(isstr \"\")" "T"
+check "IsntNum" '(isnum "WORDS")' "F"
+check "IsString" '(isstr "words")' "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 "CatNums" "(cat \"There are \" (+ 2 3) \" kitties\")" "There are 5 kitties"
-check "ImplicitCat" "(+ \"There are \" (* 5 4) \" bonks\")" "There are 20 bonks"
+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 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()" \
-      "'MISMATCHED_PARENS': (loadfile \"examples/lib.pbl\") (hey()"
-check "BadParens2" "(hey)(" \
-      "'MISMATCHED_PARENS': (loadfile \"examples/lib.pbl\") (hey)("
-check "BadParens3" "((hey(" \
-      "'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))("
+check "BadParens1" "(hey()" regex "'MISMATCHED_PARENS.*"
+check "BadParens2" "(hey)(" regex "'MISMATCHED_PARENS.*"
+check "BadParens3" "((hey(" regex "'MISMATCHED_PARENS.*"
+check "BadParens4" ")))hey" regex "'MISMATCHED_PARENS.*"
+check "BadParens5" "hey))(" regex "'MISMATCHED_PARENS.*"

 title "Eval"
-check "BasicNumberEval" "(eval \"5\")" "5"
-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 "BasicNumberEval" '(eval "5")' "5"
+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 )"

 title "Forbble" disable
-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 "ForbbleDefine" "(loadfile \"examples/forbble.pbl\") (feval ( : \"cubed\" dup dup * * $ )) (feval (4 cubed .)) \"\"" "64"
+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 "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 ""

--- a/src/tokens.c
+++ b/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] == '"' &&
-                        input[i + 2] == '"') {
+                    if (input[i] == '"' && input[i + 1] == '"' && input[i + 2] == '"') {
                        break;
                    }
-                    if (input[i] == '\0' || input[i + 1] == '\0' ||
-                        input[i + 2] == '\0') {
+                    l++;
+                    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;