diff --git a/src/object.c b/src/object.c index 4ebfd0f..3296ad5 100644 --- a/src/object.c +++ b/src/object.c @@ -4,6 +4,28 @@ #include #include +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; } diff --git a/src/object.h b/src/object.h index 692c04a..53a84fb 100644 --- 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 diff --git a/src/pebblisp.c b/src/pebblisp.c index a05acc6..d43f57d 100644 --- 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(¤t); + 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 diff --git a/src/tests.sh b/src/tests.sh index 790239b..3fa1579 100755 --- 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,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 "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 "" diff --git a/src/tokens.c b/src/tokens.c index 2ed6284..da6d191 100644 --- 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;