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:
parent
ee8eaf2d28
commit
9da4649a27
35
src/object.c
35
src/object.c
|
@ -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 [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);
|
Object o = errorObject(code);
|
||||||
if (context) {
|
if (context) {
|
||||||
errorAddContext(&o, context);
|
errorAddContext(&o, context, lineNo, fileName);
|
||||||
}
|
}
|
||||||
return o;
|
return o;
|
||||||
}
|
}
|
||||||
|
|
14
src/object.h
14
src/object.h
|
@ -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
|
||||||
|
|
|
@ -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(¤t);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
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
|
||||||
|
|
79
src/tests.sh
79
src/tests.sh
|
@ -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 [31m expected '$3' but received '$output'\n"
|
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"
|
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 ""
|
||||||
|
|
||||||
|
|
|
@ -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;
|
||||||
|
|
Loading…
Reference in New Issue