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.
This commit is contained in:
Sage Vaillancourt 2022-03-18 16:10:23 -04:00 committed by Sage Vaillancourt
parent ee8eaf2d28
commit 9da4649a27
5 changed files with 108 additions and 62 deletions

View File

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

View File

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

View File

@ -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 * 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* list = itemAt(&listInitial, 0);
Object total = cloneObject(*list->forward); // From given initial value 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) { 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; return total;
@ -1131,6 +1134,8 @@ int main(int argc, const char* argv[])
repl(&env); repl(&env);
} }
deleteEnv(&env); deleteEnv(&env);
// printf("TOTAL ALLOCATIONS: %d\n", getAllocations());
// printf("TOTAL BYTES: %d\n", getBytes());
} }
#endif #endif

View File

@ -13,6 +13,9 @@ CURRENT_BLOCK=""
if [ "$1" == "-val" ]; then if [ "$1" == "-val" ]; then
VALGRIND=true VALGRIND=true
filter="$2"
else
filter="$1"
fi fi
FIRST_TITLE=true FIRST_TITLE=true
@ -47,10 +50,13 @@ fail() {
((TOTAL_FAILS++)) ((TOTAL_FAILS++))
} }
regex="regex"
check() { check() {
if $DISABLED; then if $DISABLED || ! [[ "$1" =~ $filter ]]; then
return 1 return 1
fi fi
if $VALGRIND; then if $VALGRIND; then
echo -ne "\n $1\r " echo -ne "\n $1\r "
local output="$($VALCOM ./pl "(loadfile \"examples/lib.pbl\") $2")" local output="$($VALCOM ./pl "(loadfile \"examples/lib.pbl\") $2")"
@ -60,6 +66,8 @@ check() {
if [ "$output" == "$3" ]; then if [ "$output" == "$3" ]; then
pass "$1" pass "$1"
elif [ "$3" == "$regex" ] && [[ "$output" =~ $4 ]]; then
pass "$1"
else else
fail "$1" "$2" fail "$1" "$2"
FAIL_OUTPUT="${FAIL_OUTPUT}\n  expected '$3' but received '$output'\n" FAIL_OUTPUT="${FAIL_OUTPUT}\n  expected '$3' but received '$output'\n"
@ -70,8 +78,7 @@ echo "STARTING TESTS"
title "Plain returns" title "Plain returns"
check "PlainRet" "10" "10" check "PlainRet" "10" "10"
check "StrRetrn" "\"hey\"" "hey" check "StrRetrn" '"hey"' "hey"
check "SingleStrRetrn" "\"hey\"" "hey"
check "HexReturn" "0x0f0f0" "61680" check "HexReturn" "0x0f0f0" "61680"
check "BinaryReturn" "0b011010011010011" "13523" check "BinaryReturn" "0b011010011010011" "13523"
@ -90,17 +97,21 @@ title "Comparison"
check "GratrThn" "(> 23847123 19375933)" "T" check "GratrThn" "(> 23847123 19375933)" "T"
check "LessThan" "(< 23847123 19375933)" "F" check "LessThan" "(< 23847123 19375933)" "F"
check "Equality" "(= 987654321 987654321 )" "T" 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" title "TypeCheck"
check "IsNum" "(isnum 23847123)" "T" 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 "NumNotString" "(isstr 5)" "F"
check "ListNotString" "(isstr (\"hello\"))" "F" check "ListNotString" '(isstr ("hello"))' "F"
title "Ifs/Bools" title "Ifs/Bools"
check "IfReturn" "(if (T) 123456789 987654321)" "123456789" check "IfReturn" "(if (T) 123456789 987654321)" "123456789"
@ -110,7 +121,7 @@ check "EtyLstLt" "(if (()) T F)" "T"
title "Lists" title "Lists"
check "RegLists" "(1 2 3 4 5)" "( 1 2 3 4 5 )" 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 "EmptyLst" "()" "( )"
check "EmptLst2" "( )" "( )" check "EmptLst2" "( )" "( )"
check "ListIndex" "(at (+ 1 1) (1 2 1000 4 5))" "1000" 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 empty list" "(islist ())" "T"
check "Identifying not a list" "(islist 1)" "F" 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" title "Spacing"
check "DenseSpc" "(+1093 102852)" "103945" check "DenseSpc" "(+1093 102852)" "103945"
check "WideSpac" "( + 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 )" check "Duplicate" "(def dupe (fn (a) (() (a a a))));(dupe (*10 10))" "( 100 100 100 )"
title "Cat" 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: # 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" title "Filtering"
check "Filtering" "(fil (< 321) (30 300 90 1200 135 801))" "( 1200 801 )" check "Filtering" "(fil (< 321) (30 300 90 1200 135 801))" "( 1200 801 )"
@ -184,6 +199,7 @@ check "Accessing struct fields"\
title "HigherOrder" title "HigherOrder"
check "Simple reducing" '(reduce ((1 2 3) 0) +)' '6' 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))))\ check "FuncReturningAFunc" "(def plusser (fn (outer) (fn (inner) (+ outer inner))))\
(def plusFive (plusser 5))\ (def plusFive (plusser 5))\
(plusFive 10)" "15" (plusFive 10)" "15"
@ -195,31 +211,28 @@ check "UnevenLists" "(+ (1 2) (1 2 3))" "LISTS_NOT_SAME_SIZE"
check "BadNumber" "(5df)" "BAD_NUMBER" check "BadNumber" "(5df)" "BAD_NUMBER"
check "BadHex" "(0x0zf)" "BAD_NUMBER" check "BadHex" "(0x0zf)" "BAD_NUMBER"
check "BadBinary" "(0b01120)" "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" 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 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" 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" 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 "" echo ""

View File

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