felix/slime
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

added user types

Browse Source
This commit is contained in:
Felix Brendel
2019-02-24 12:07:06 +01:00
parent 2f0df71c50
commit 8c827029be
4 changed files with 127 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/built_ins.cpp
+33
View File
@@ -794,6 +794,35 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return evaluated_arguments->value.pair->first->value.pair->rest;
});
defun("set-type", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}
if (arguments_length != 2) {
report_error(Error_Type::Wrong_Number_Of_Arguments);
}
Lisp_Object* object = evaluated_arguments->value.pair->first;
Lisp_Object* type = evaluated_arguments->value.pair->rest->value.pair->first;
try {
assert_type(type, Lisp_Object_Type::Keyword);
}
evaluated_arguments->value.pair->first->userType = type;
return type;
});
defun("delete-type", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}
if (arguments_length != 1) {
report_error(Error_Type::Wrong_Number_Of_Arguments);
}
evaluated_arguments->value.pair->first->userType = nullptr;
return Memory::create_lisp_object_t();
});
defun("type", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
@@ -802,6 +831,10 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Wrong_Number_Of_Arguments);
}
if (evaluated_arguments->value.pair->first->userType) {
return evaluated_arguments->value.pair->first->userType;
}
Lisp_Object_Type type = evaluated_arguments->value.pair->first->type;
switch (type) {
case Lisp_Object_Type::CFunction: return Memory::create_lisp_object_keyword("cfunction");
src/structs.cpp
+8 -6
View File
@@ -15,6 +15,7 @@ enum struct Lisp_Object_Type {
Number,
String,
Pair,
// Pointer,
Function,
CFunction,
};
@@ -114,13 +115,14 @@ struct cFunction {
struct Lisp_Object {
Source_Code_Location* sourceCodeLocation;
Lisp_Object_Type type;
Lisp_Object* userType;
union {
Symbol* symbol;
Keyword* keyword;
Number* number;
String* string;
Pair* pair;
Function* function;
Symbol* symbol;
Keyword* keyword;
Number* number;
String* string;
Pair* pair;
Function* function;
cFunction* cFunction;
} value;
};
src/testing.cpp
+83 -23
View File
@@ -16,14 +16,6 @@
"\n\tgot anyways: " format "\n", \
__FILE__, __LINE__, (type)value, (type)variable)
#define assert_no_error(error) \
if (error) { \
printf("\nExpected no error to occur," \
" but an error occured anyways:\n"); \
log_error(); \
return fail; \
} \
#define assert_equal_int(variable, value) \
if (variable != value) { \
print_assert_equal_fail(variable, value, size_t, "%zd"); \
@@ -36,6 +28,23 @@
return fail; \
}
#define assert_no_error() \
if (error) { \
print_assert_equal_fail(error, 0, size_t, "%zd"); \
printf("\nExpected no error to occur," \
" but an error occured anyways:\n"); \
log_error(); \
return fail; \
} \
#define assert_error() \
if (!error) { \
print_assert_not_equal_fail(error, 0, size_t, "%zd"); \
printf("\nExpected an error to occur," \
" but no error occured:\n"); \
return fail; \
} \
#define assert_equal_double(variable, value) \
if (fabs((double)variable - (double)value) > epsilon) { \
print_assert_equal_fail(variable, value, double, "%f"); \
@@ -91,7 +100,7 @@ proc test_eval_operands() -> testresult {
int operands_length;
operands = eval_arguments(operands, Memory::create_built_ins_environment(), &operands_length);
assert_no_error(error);
assert_no_error();
assert_equal_int(list_length(operands), 4);
assert_equal_type(operands, Lisp_Object_Type::Pair);
@@ -180,7 +189,7 @@ proc test_parse_expression() -> testresult {
char string[] = "(fun + 12)";
Lisp_Object* result = Parser::parse_expression(string, &index_in_text);
assert_no_error(error);
assert_no_error();
assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair->first, Lisp_Object_Type::Symbol);
@@ -206,7 +215,7 @@ proc test_parse_expression() -> testresult {
index_in_text = 0;
result = Parser::parse_expression(string2, &index_in_text);
assert_no_error(error);
assert_no_error();
assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair->first, Lisp_Object_Type::Symbol);
@@ -235,7 +244,7 @@ proc test_built_in_add() -> testresult {
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
assert_no_error(error);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Number);
assert_equal_double(result->value.number->value, 14);
@@ -248,7 +257,7 @@ proc test_built_in_substract() -> testresult {
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
assert_no_error(error);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Number);
assert_equal_double(result->value.number->value, 6);
@@ -262,7 +271,7 @@ proc test_built_in_multiply() -> testresult {
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
assert_no_error(error);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Number);
assert_equal_double(result->value.number->value, 40);
@@ -276,7 +285,7 @@ proc test_built_in_divide() -> testresult {
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
assert_null(error);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Number);
assert_equal_double(result->value.number->value, 5);
@@ -290,7 +299,7 @@ proc test_built_in_if() -> testresult {
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
assert_no_error(error);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Number);
assert_equal_double(result->value.number->value, 4);
@@ -299,7 +308,7 @@ proc test_built_in_if() -> testresult {
expression = Parser::parse_single_expression(exp_string2);
result = eval_expr(expression, Memory::create_built_ins_environment());
assert_no_error(error);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Number);
assert_equal_double(result->value.number->value, 5);
@@ -312,7 +321,7 @@ proc test_built_in_and() -> testresult {
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
assert_no_error(error);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::T);
@@ -321,7 +330,7 @@ proc test_built_in_and() -> testresult {
expression = Parser::parse_single_expression(exp_string2);
result = eval_expr(expression, Memory::create_built_ins_environment());
assert_no_error(error);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Nil);
@@ -333,7 +342,7 @@ proc test_built_in_or() -> testresult {
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
assert_no_error(error);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::T);
@@ -342,7 +351,7 @@ proc test_built_in_or() -> testresult {
expression = Parser::parse_single_expression(exp_string2);
result = eval_expr(expression, Memory::create_built_ins_environment());
assert_no_error(error);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Nil);
@@ -356,7 +365,7 @@ proc test_built_in_not() -> testresult {
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
// a true case
assert_no_error(error);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::T);
@@ -365,13 +374,57 @@ proc test_built_in_not() -> testresult {
expression = Parser::parse_single_expression(exp_string2);
result = eval_expr(expression, Memory::create_built_ins_environment());
assert_no_error(error);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Nil);
return pass;
}
proc test_built_in_type() -> testresult {
Environment* env = Memory::create_built_ins_environment();
// normal type testing
char exp_string1[] = "(prog (define a 10)(type a))";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result = eval_expr(expression, env);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.keyword->identifier, "number");
// setting user type
char exp_string2[] = "(prog (set-type a :my-type)(type a))";
expression = Parser::parse_single_expression(exp_string2);
result = eval_expr(expression, env);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.keyword->identifier, "my-type");
// trying to set invalid user type
char exp_string3[] = "(prog (set-type a \"wrong tpye\")(type a))";
expression = Parser::parse_single_expression(exp_string3);
result = eval_expr(expression, env);
assert_error();
delete_error();
// deleting user type
char exp_string4[] = "(prog (delete-type a)(type a))";
expression = Parser::parse_single_expression(exp_string4);
result = eval_expr(expression, env);
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.keyword->identifier, "number");
return pass;
}
proc run_all_tests() -> void {
log_level = Log_Level::None;
Memory::init();
@@ -393,6 +446,13 @@ proc run_all_tests() -> void {
invoke_test(test_built_in_and);
invoke_test(test_built_in_or);
invoke_test(test_built_in_not);
invoke_test(test_built_in_type);
printf("\n-- Memory management --\n");
printf("\n-- Lexical scope --\n");
printf("\n-- Macros --\n");
}
#undef epsilon