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

I think I did Lisp_Object SSO

Browse Source
This commit is contained in:
FelixBrendel
2019-03-15 15:37:35 +01:00
parent 9f2b25486c
commit d6ecda99f6
10 changed files with 386 additions and 501 deletions
Download Patch File Download Diff File Expand all files Collapse all files
bin/tests/lexical_scope.slime.expanded
+1 -1
View File
@@ -1,4 +1,4 @@
(define (make-counter) (let ((var 0.000000)) (lambda nil (mutate var (+ 1.000000 var)) var))) (define (make-counter) (let ((var 0.000000)) (lambda () (mutate var (+ 1.000000 var)) var)))
(define counter1 (make-counter)) (define counter1 (make-counter))
src/built_ins.cpp
+189 -219
View File
@@ -16,24 +16,20 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
return false; return false;
case Lisp_Object_Type::Keyword: case Lisp_Object_Type::Keyword:
return string_equal( return string_equal(
n1->value.keyword->identifier, n1->value.identifier,
n2->value.keyword->identifier); n2->value.identifier);
case Lisp_Object_Type::T: case Lisp_Object_Type::T:
case Lisp_Object_Type::Nil: case Lisp_Object_Type::Nil:
return true; return true;
case Lisp_Object_Type::Number: case Lisp_Object_Type::Number:
return return n1->value.number == n2->value.number;
n1->value.number->value ==
n2->value.number->value;
case Lisp_Object_Type::Pair: case Lisp_Object_Type::Pair:
create_error(Error_Type::Not_Yet_Implemented, n1->sourceCodeLocation); create_error(Error_Type::Not_Yet_Implemented, n1->sourceCodeLocation);
return false; return false;
case Lisp_Object_Type::String: case Lisp_Object_Type::String:
return string_equal(n1->value.string, n2->value.string); return string_equal(n1->value.string, n2->value.string);
case Lisp_Object_Type::Symbol: case Lisp_Object_Type::Symbol:
return string_equal( return string_equal(n1->value.identifier, n2->value.identifier);
n1->value.symbol->identifier,
n2->value.symbol->identifier);
} }
// we should never reach here // we should never reach here
@@ -80,43 +76,49 @@ proc load_built_ins_into_environment(Environment* env) -> void {
env); env);
}; };
proc parse_lambda_starting_from_args = [&](Lisp_Object* arguments, Environment* env) -> Lisp_Object* { proc parse_lambda_starting_from_args = [&](Lisp_Object* arguments, Environment* env, bool is_special = false) -> Lisp_Object* {
Function* function = new(Function); // Function* function = new(Function);
function->parent_environment = env; Lisp_Object* ret = Memory::create_lisp_object();
function->type = Function_Type::Lambda; ret->type = Lisp_Object_Type::Function;
ret->value.function.parent_environment = env;
if (is_special)
ret->value.function.type = Function_Type::Special_Lambda;
else
ret->value.function.type = Function_Type::Lambda;
// if parameters were specified // if parameters were specified
if (arguments->value.pair->first->type != Lisp_Object_Type::Nil) { if (arguments->value.pair.first->type != Lisp_Object_Type::Nil) {
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Pair); assert_type(arguments->value.pair.first, Lisp_Object_Type::Pair);
} }
try { try {
parse_argument_list(arguments->value.pair->first, function); parse_argument_list(arguments->value.pair.first, &ret->value.function);
} }
} else { } else {
function->positional_arguments = create_positional_argument_list(1); ret->value.function.positional_arguments = create_positional_argument_list(1);
function->keyword_arguments = create_keyword_argument_list(1); ret->value.function.keyword_arguments = create_keyword_argument_list(1);
function->rest_argument = nullptr; ret->value.function.rest_argument = nullptr;
} }
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
// if there is a docstring, use it // if there is a docstring, use it
if (arguments->value.pair->first->type == Lisp_Object_Type::String) { if (arguments->value.pair.first->type == Lisp_Object_Type::String) {
function->docstring = arguments->value.pair->first->value.string; ret->value.function.docstring = arguments->value.pair.first->value.string;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
} else { } else {
function->docstring = nullptr; ret->value.function.docstring = nullptr;
} }
// we are now in the function body, just wrap it in an // we are now in the function body, just wrap it in an
// implicit prog // implicit prog
function->body = Memory::create_lisp_object_pair( ret->value.function.body = Memory::create_lisp_object_pair(
Memory::get_or_create_lisp_object_symbol("prog"), Memory::get_or_create_lisp_object_symbol("prog"),
arguments); arguments);
Lisp_Object* ret = Memory::create_lisp_object();
ret->type = Lisp_Object_Type::Function; // ret->value.function = function;
ret->value.function = function;
return ret; return ret;
}; };
@@ -129,12 +131,12 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (arguments->type == Lisp_Object_Type::Nil) if (arguments->type == Lisp_Object_Type::Nil)
return Memory::t; return Memory::t;
Lisp_Object* first = arguments->value.pair->first; Lisp_Object* first = arguments->value.pair.first;
while (arguments->type == Lisp_Object_Type::Pair) { while (arguments->type == Lisp_Object_Type::Pair) {
if (!lisp_object_equal(arguments->value.pair->first, first)) if (!lisp_object_equal(arguments->value.pair.first, first))
return Memory::nil; return Memory::nil;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
} }
return Memory::t; return Memory::t;
@@ -149,14 +151,14 @@ proc load_built_ins_into_environment(Environment* env) -> void {
while (arguments->type == Lisp_Object_Type::Pair) { while (arguments->type == Lisp_Object_Type::Pair) {
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number); assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
} }
if (arguments->value.pair->first->value.number->value >= last_number) if (arguments->value.pair.first->value.number >= last_number)
return Memory::nil; return Memory::nil;
last_number = arguments->value.pair->first->value.number->value; last_number = arguments->value.pair.first->value.number;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
} }
return Memory::t; return Memory::t;
@@ -171,14 +173,14 @@ proc load_built_ins_into_environment(Environment* env) -> void {
while (arguments->type == Lisp_Object_Type::Pair) { while (arguments->type == Lisp_Object_Type::Pair) {
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number); assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
} }
if (arguments->value.pair->first->value.number->value > last_number) if (arguments->value.pair.first->value.number > last_number)
return Memory::nil; return Memory::nil;
last_number = arguments->value.pair->first->value.number->value; last_number = arguments->value.pair.first->value.number;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
} }
return Memory::t; return Memory::t;
@@ -193,14 +195,14 @@ proc load_built_ins_into_environment(Environment* env) -> void {
while (arguments->type == Lisp_Object_Type::Pair) { while (arguments->type == Lisp_Object_Type::Pair) {
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number); assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
} }
if (arguments->value.pair->first->value.number->value <= last_number) if (arguments->value.pair.first->value.number <= last_number)
return Memory::nil; return Memory::nil;
last_number = arguments->value.pair->first->value.number->value; last_number = arguments->value.pair.first->value.number;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
} }
return Memory::t; return Memory::t;
@@ -215,14 +217,14 @@ proc load_built_ins_into_environment(Environment* env) -> void {
while (arguments->type == Lisp_Object_Type::Pair) { while (arguments->type == Lisp_Object_Type::Pair) {
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number); assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
} }
if (arguments->value.pair->first->value.number->value < last_number) if (arguments->value.pair.first->value.number < last_number)
return Memory::nil; return Memory::nil;
last_number = arguments->value.pair->first->value.number->value; last_number = arguments->value.pair.first->value.number;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
} }
return Memory::t; return Memory::t;
@@ -236,10 +238,10 @@ proc load_built_ins_into_environment(Environment* env) -> void {
double sum = 0; double sum = 0;
while (arguments->type == Lisp_Object_Type::Pair) { while (arguments->type == Lisp_Object_Type::Pair) {
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number); assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
} }
sum += arguments->value.pair->first->value.number->value; sum += arguments->value.pair.first->value.number;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
} }
return Memory::create_lisp_object_number(sum); return Memory::create_lisp_object_number(sum);
@@ -251,18 +253,18 @@ proc load_built_ins_into_environment(Environment* env) -> void {
} }
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number); assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
} }
double difference = arguments->value.pair->first->value.number->value; double difference = arguments->value.pair.first->value.number;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
while (arguments->type == Lisp_Object_Type::Pair) { while (arguments->type == Lisp_Object_Type::Pair) {
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number); assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
} }
difference -= arguments->value.pair->first->value.number->value; difference -= arguments->value.pair.first->value.number;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
} }
return Memory::create_lisp_object_number(difference); return Memory::create_lisp_object_number(difference);
}); });
@@ -273,18 +275,18 @@ proc load_built_ins_into_environment(Environment* env) -> void {
} }
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number); assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
} }
double product = arguments->value.pair->first->value.number->value; double product = arguments->value.pair.first->value.number;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
while (arguments->type == Lisp_Object_Type::Pair) { while (arguments->type == Lisp_Object_Type::Pair) {
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number); assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
} }
product *= arguments->value.pair->first->value.number->value; product *= arguments->value.pair.first->value.number;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
} }
return Memory::create_lisp_object_number(product); return Memory::create_lisp_object_number(product);
}); });
@@ -295,18 +297,18 @@ proc load_built_ins_into_environment(Environment* env) -> void {
} }
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number); assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
} }
double quotient = arguments->value.pair->first->value.number->value; double quotient = arguments->value.pair.first->value.number;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
while (arguments->type == Lisp_Object_Type::Pair) { while (arguments->type == Lisp_Object_Type::Pair) {
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number); assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
} }
quotient /= arguments->value.pair->first->value.number->value; quotient /= arguments->value.pair.first->value.number;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
} }
return Memory::create_lisp_object_number(quotient); return Memory::create_lisp_object_number(quotient);
}); });
@@ -322,18 +324,18 @@ proc load_built_ins_into_environment(Environment* env) -> void {
} }
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number); assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
} }
double base = arguments->value.pair->first->value.number->value; double base = arguments->value.pair.first->value.number;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number); assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
} }
double exponent = arguments->value.pair->first->value.number->value; double exponent = arguments->value.pair.first->value.number;
return Memory::create_lisp_object_number(pow(base, exponent)); return Memory::create_lisp_object_number(pow(base, exponent));
}); });
@@ -348,7 +350,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
if (is_truthy(arguments->value.pair->first, env)) if (is_truthy(arguments->value.pair.first, env))
return Memory::t; return Memory::t;
report_error(Error_Type::Assertion_Error); report_error(Error_Type::Assertion_Error);
@@ -363,7 +365,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
Lisp_Object* symbol = arguments->value.pair->first; Lisp_Object* symbol = arguments->value.pair.first;
Lisp_Object* value; Lisp_Object* value;
if (symbol->type == Lisp_Object_Type::Pair) { if (symbol->type == Lisp_Object_Type::Pair) {
@@ -386,15 +388,15 @@ proc load_built_ins_into_environment(Environment* env) -> void {
f(3) x f(3) x
*/ */
Lisp_Object* real_symbol = symbol->value.pair->first; Lisp_Object* real_symbol = symbol->value.pair.first;
try { try {
assert_type(real_symbol, Lisp_Object_Type::Symbol); assert_type(real_symbol, Lisp_Object_Type::Symbol);
} }
Lisp_Object* fake_lambda = Memory::create_lisp_object_pair( Lisp_Object* fake_lambda = Memory::create_lisp_object_pair(
symbol ->value.pair->rest, symbol ->value.pair.rest,
arguments->value.pair->rest); arguments->value.pair.rest);
value = parse_lambda_starting_from_args(fake_lambda, env); value = parse_lambda_starting_from_args(fake_lambda, env);
symbol = real_symbol; symbol = real_symbol;
@@ -406,7 +408,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Type_Missmatch); report_error(Error_Type::Type_Missmatch);
} }
value = arguments->value.pair->rest->value.pair->first; value = arguments->value.pair.rest->value.pair.first;
try { try {
value = eval_expr(value, env); value = eval_expr(value, env);
} }
@@ -425,7 +427,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
// report_error(Error_Type::Wrong_Number_Of_Arguments); // report_error(Error_Type::Wrong_Number_Of_Arguments);
// } // }
// Lisp_Object* symbol = arguments->value.pair->first; // Lisp_Object* symbol = arguments->value.pair.first;
// if (symbol->type == Lisp_Object_Type::Pair) { // if (symbol->type == Lisp_Object_Type::Pair) {
// try { // try {
@@ -442,7 +444,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
// } // }
// Lisp_Object* value = arguments->value.pair->rest->value.pair->first; // Lisp_Object* value = arguments->value.pair.rest->value.pair.first;
// try { // try {
// value = eval_expr(value, env); // value = eval_expr(value, env);
// } // }
@@ -459,14 +461,14 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (arguments_length != 2) if (arguments_length != 2)
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
if (evaluated_arguments->value.pair->first->type == Lisp_Object_Type::Nil || if (evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Nil ||
evaluated_arguments->value.pair->first->type == Lisp_Object_Type::Keyword) evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Keyword)
{ {
report_error(Error_Type::Type_Missmatch); report_error(Error_Type::Type_Missmatch);
} }
Lisp_Object* target = evaluated_arguments->value.pair->first; Lisp_Object* target = evaluated_arguments->value.pair.first;
Lisp_Object* source = evaluated_arguments->value.pair->rest->value.pair->first; Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first;
*target = *source; *target = *source;
return target; return target;
@@ -480,9 +482,9 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
Lisp_Object* condition = arguments->value.pair->first; Lisp_Object* condition = arguments->value.pair.first;
Lisp_Object* then_part = arguments->value.pair->rest; Lisp_Object* then_part = arguments->value.pair.rest;
Lisp_Object* else_part = then_part->value.pair->rest; Lisp_Object* else_part = then_part->value.pair.rest;
bool truthy; bool truthy;
try { try {
@@ -493,11 +495,11 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (truthy) if (truthy)
try{ try{
result = eval_expr(then_part->value.pair->first, env); result = eval_expr(then_part->value.pair.first, env);
} }
else if (arguments_length == 3) else if (arguments_length == 3)
try { try {
result = eval_expr(else_part->value.pair->first, env); result = eval_expr(else_part->value.pair.first, env);
} }
else return Memory::nil; else return Memory::nil;
return result; return result;
@@ -511,7 +513,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
return arguments->value.pair->first; return arguments->value.pair.first;
}); });
defun("quasiquote", cLambda { defun("quasiquote", cLambda {
try { try {
@@ -535,12 +537,12 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::copy_lisp_object(expr); return Memory::copy_lisp_object(expr);
// it is a pair! // it is a pair!
Lisp_Object* originalPair = expr->value.pair->first; Lisp_Object* originalPair = expr->value.pair.first;
if (originalPair->type == Lisp_Object_Type::Symbol && if (originalPair->type == Lisp_Object_Type::Symbol &&
string_equal(originalPair->value.symbol->identifier, "unquote")) string_equal(originalPair->value.identifier, "unquote"))
{ {
// eval replace the stuff // eval replace the stuff
return eval_expr(expr->value.pair->rest->value.pair->first, env); return eval_expr(expr->value.pair.rest->value.pair.first, env);
} }
// it is a list but not starting with the symbol // it is a list but not starting with the symbol
@@ -556,22 +558,22 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Lisp_Object* newPairHead = newPair; Lisp_Object* newPairHead = newPair;
Lisp_Object* head = expr; Lisp_Object* head = expr;
while (head->type == Lisp_Object_Type::Pair) { while (head->type == Lisp_Object_Type::Pair) {
newPairHead->value.pair->first = unquoteSomeExpressions(head->value.pair->first); newPairHead->value.pair.first = unquoteSomeExpressions(head->value.pair.first);
if (head->value.pair->rest->type != Lisp_Object_Type::Pair) if (head->value.pair.rest->type != Lisp_Object_Type::Pair)
break; break;
newPairHead->value.pair->rest = Memory::create_lisp_object_pair(nullptr, nullptr); newPairHead->value.pair.rest = Memory::create_lisp_object_pair(nullptr, nullptr);
newPairHead = newPairHead->value.pair->rest; newPairHead = newPairHead->value.pair.rest;
head = head->value.pair->rest; head = head->value.pair.rest;
} }
newPairHead->value.pair->rest = Memory::nil; newPairHead->value.pair.rest = Memory::nil;
return newPair; return newPair;
}; };
Lisp_Object* ret = arguments->value.pair->first; Lisp_Object* ret = arguments->value.pair.first;
Lisp_Object* head = ret; Lisp_Object* head = ret;
ret = unquoteSomeExpressions(ret); ret = unquoteSomeExpressions(ret);
@@ -584,9 +586,9 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Ill_Formed_List); report_error(Error_Type::Ill_Formed_List);
} }
try { try {
result &= is_truthy(arguments->value.pair->first, env); result &= is_truthy(arguments->value.pair.first, env);
} }
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
if (!result) return Memory::nil; if (!result) return Memory::nil;
} }
@@ -600,9 +602,9 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Ill_Formed_List); report_error(Error_Type::Ill_Formed_List);
} }
try { try {
result |= is_truthy(arguments->value.pair->first, env); result |= is_truthy(arguments->value.pair.first, env);
} }
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
if (result) return Memory::t; if (result) return Memory::t;
} }
@@ -619,7 +621,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
} }
bool truthy; bool truthy;
try { try {
truthy = is_truthy(arguments->value.pair->first, env); truthy = is_truthy(arguments->value.pair.first, env);
} }
if (truthy) if (truthy)
return Memory::nil; return Memory::nil;
@@ -633,9 +635,9 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (arguments_length < 2) { if (arguments_length < 2) {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
Lisp_Object* condition_part = arguments->value.pair->first; Lisp_Object* condition_part = arguments->value.pair.first;
Lisp_Object* condition; Lisp_Object* condition;
Lisp_Object* then_part = arguments->value.pair->rest; Lisp_Object* then_part = arguments->value.pair.rest;
Lisp_Object* result = Memory::nil; Lisp_Object* result = Memory::nil;
while (true) { while (true) {
@@ -646,7 +648,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
break; break;
} }
try { try {
result = eval_expr(then_part->value.pair->first, env); result = eval_expr(then_part->value.pair.first, env);
} }
} }
return result; return result;
@@ -662,7 +664,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
Environment* let_env = Memory::create_child_environment(env); Environment* let_env = Memory::create_child_environment(env);
Lisp_Object* bindings = arguments->value.pair->first; Lisp_Object* bindings = arguments->value.pair.first;
while (true) { while (true) {
if (bindings->type == Lisp_Object_Type::Nil) { if (bindings->type == Lisp_Object_Type::Nil) {
break; break;
@@ -670,29 +672,29 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Ill_Formed_Arguments); report_error(Error_Type::Ill_Formed_Arguments);
} }
Lisp_Object* sym = bindings->value.pair->first->value.pair->first; Lisp_Object* sym = bindings->value.pair.first->value.pair.first;
if(sym->type != Lisp_Object_Type::Symbol) { if(sym->type != Lisp_Object_Type::Symbol) {
report_error(Error_Type::Ill_Formed_Arguments); report_error(Error_Type::Ill_Formed_Arguments);
} }
Lisp_Object* rest_sym = bindings->value.pair->first->value.pair->rest; Lisp_Object* rest_sym = bindings->value.pair.first->value.pair.rest;
if (rest_sym->type != Lisp_Object_Type::Pair) { if (rest_sym->type != Lisp_Object_Type::Pair) {
report_error(Error_Type::Ill_Formed_Arguments); report_error(Error_Type::Ill_Formed_Arguments);
} }
if (rest_sym->value.pair->rest->type != Lisp_Object_Type::Nil) { if (rest_sym->value.pair.rest->type != Lisp_Object_Type::Nil) {
report_error(Error_Type::Ill_Formed_Arguments); report_error(Error_Type::Ill_Formed_Arguments);
} }
Lisp_Object* value = eval_expr(rest_sym->value.pair->first, env); Lisp_Object* value = eval_expr(rest_sym->value.pair.first, env);
// NOTE(Felix): We have to copy the value here because // NOTE(Felix): We have to copy the value here because
// if the let body modifies the value, it would bake // if the let body modifies the value, it would bake
// in... bad bad... // in... bad bad...
define_symbol(sym, Memory::copy_lisp_object(value), let_env); define_symbol(sym, Memory::copy_lisp_object(value), let_env);
bindings = bindings->value.pair->rest; bindings = bindings->value.pair.rest;
} }
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
Lisp_Object* evaluated_arguments; Lisp_Object* evaluated_arguments;
try { try {
@@ -707,10 +709,10 @@ proc load_built_ins_into_environment(Environment* env) -> void {
// manually, because we want to increase code reuse, // manually, because we want to increase code reuse,
// but at the cost that we have to find the end of the // but at the cost that we have to find the end of the
// list again // list again
while (evaluated_arguments->value.pair->rest->type == Lisp_Object_Type::Pair) { while (evaluated_arguments->value.pair.rest->type == Lisp_Object_Type::Pair) {
evaluated_arguments = evaluated_arguments->value.pair->rest; evaluated_arguments = evaluated_arguments->value.pair.rest;
} }
return evaluated_arguments->value.pair->first; return evaluated_arguments->value.pair.first;
}); });
defun("lambda", cLambda { defun("lambda", cLambda {
/* TODO(Felix): first one crashes /* TODO(Felix): first one crashes
@@ -742,43 +744,11 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (arguments_length == 0) if (arguments_length == 0)
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
Function* function = new(Function); Lisp_Object* function = parse_lambda_starting_from_args(arguments, env, true);
function->parent_environment = env; // parse lambda starting from arguments
function->type = Function_Type::Special_Lambda;
// if parameters were specified
if (arguments->value.pair->first->type != Lisp_Object_Type::Nil) {
try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Pair);
}
try {
parse_argument_list(arguments->value.pair->first, function);
}
} else {
function->positional_arguments = create_positional_argument_list(1);
function->keyword_arguments = create_keyword_argument_list(1);
function->rest_argument = nullptr;
}
arguments = arguments->value.pair->rest; return function;
// if there is a docstring, use it
if (arguments->value.pair->first->type == Lisp_Object_Type::String) {
function->docstring = arguments->value.pair->first->value.string;
arguments = arguments->value.pair->rest;
} else {
function->docstring = nullptr;
}
// we are now in the function body, just wrap it in an
// implicit prog
function->body = Memory::create_lisp_object_pair(
Memory::get_or_create_lisp_object_symbol("prog"),
arguments);
Lisp_Object* ret = Memory::create_lisp_object();
ret->type = Lisp_Object_Type::Function;
ret->value.function = function;
return ret;
}); });
defun("eval", cLambda { defun("eval", cLambda {
try { try {
@@ -789,7 +759,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
} }
Lisp_Object* result; Lisp_Object* result;
try { try {
result = eval_expr(evaluated_arguments->value.pair->first, env); result = eval_expr(evaluated_arguments->value.pair.first, env);
} }
return result; return result;
}); });
@@ -808,10 +778,10 @@ proc load_built_ins_into_environment(Environment* env) -> void {
// manually, because we want to increase code reuse, // manually, because we want to increase code reuse,
// but at the cost that we have to find the end of the // but at the cost that we have to find the end of the
// list again // list again
while (evaluated_arguments->value.pair->rest->type == Lisp_Object_Type::Pair) { while (evaluated_arguments->value.pair.rest->type == Lisp_Object_Type::Pair) {
evaluated_arguments = evaluated_arguments->value.pair->rest; evaluated_arguments = evaluated_arguments->value.pair.rest;
} }
return evaluated_arguments->value.pair->first; return evaluated_arguments->value.pair.first;
}); });
defun("list", cLambda { defun("list", cLambda {
try { try {
@@ -827,7 +797,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (arguments_length != 2) { if (arguments_length != 2) {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
return Memory::create_lisp_object_pair(evaluated_arguments->value.pair->first, evaluated_arguments->value.pair->rest->value.pair->first); return Memory::create_lisp_object_pair(evaluated_arguments->value.pair.first, evaluated_arguments->value.pair.rest->value.pair.first);
}); });
defun("first", cLambda { defun("first", cLambda {
try { try {
@@ -836,12 +806,12 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (arguments_length != 1) { if (arguments_length != 1) {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
if (evaluated_arguments->value.pair->first->type == Lisp_Object_Type::Nil) if (evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Nil)
return Memory::nil; return Memory::nil;
if (evaluated_arguments->value.pair->first->type != Lisp_Object_Type::Pair) if (evaluated_arguments->value.pair.first->type != Lisp_Object_Type::Pair)
report_error(Error_Type::Type_Missmatch); report_error(Error_Type::Type_Missmatch);
return evaluated_arguments->value.pair->first->value.pair->first; return evaluated_arguments->value.pair.first->value.pair.first;
}); });
defun("rest", cLambda { defun("rest", cLambda {
try { try {
@@ -850,12 +820,12 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (arguments_length != 1) { if (arguments_length != 1) {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
if (evaluated_arguments->value.pair->first->type == Lisp_Object_Type::Nil) if (evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Nil)
return Memory::nil; return Memory::nil;
if (evaluated_arguments->value.pair->first->type != Lisp_Object_Type::Pair) if (evaluated_arguments->value.pair.first->type != Lisp_Object_Type::Pair)
report_error(Error_Type::Type_Missmatch); report_error(Error_Type::Type_Missmatch);
return evaluated_arguments->value.pair->first->value.pair->rest; return evaluated_arguments->value.pair.first->value.pair.rest;
}); });
defun("set-type", cLambda { defun("set-type", cLambda {
try { try {
@@ -865,14 +835,14 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
Lisp_Object* object = evaluated_arguments->value.pair->first; Lisp_Object* object = evaluated_arguments->value.pair.first;
Lisp_Object* type = evaluated_arguments->value.pair->rest->value.pair->first; Lisp_Object* type = evaluated_arguments->value.pair.rest->value.pair.first;
try { try {
assert_type(type, Lisp_Object_Type::Keyword); assert_type(type, Lisp_Object_Type::Keyword);
} }
evaluated_arguments->value.pair->first->userType = type; evaluated_arguments->value.pair.first->userType = type;
return type; return type;
}); });
defun("delete-type", cLambda { defun("delete-type", cLambda {
@@ -882,7 +852,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (arguments_length != 1) { if (arguments_length != 1) {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
evaluated_arguments->value.pair->first->userType = nullptr; evaluated_arguments->value.pair.first->userType = nullptr;
return Memory::t; return Memory::t;
}); });
defun("type", cLambda { defun("type", cLambda {
@@ -893,15 +863,15 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
if (evaluated_arguments->value.pair->first->userType) { if (evaluated_arguments->value.pair.first->userType) {
return evaluated_arguments->value.pair->first->userType; return evaluated_arguments->value.pair.first->userType;
} }
Lisp_Object_Type type = evaluated_arguments->value.pair->first->type; Lisp_Object_Type type = evaluated_arguments->value.pair.first->type;
switch (type) { switch (type) {
case Lisp_Object_Type::CFunction: return Memory::get_or_create_lisp_object_keyword("cfunction"); case Lisp_Object_Type::CFunction: return Memory::get_or_create_lisp_object_keyword("cfunction");
case Lisp_Object_Type::Function: { case Lisp_Object_Type::Function: {
Function* fun = evaluated_arguments->value.pair->first->value.function; Function* fun = &evaluated_arguments->value.pair.first->value.function;
if (fun->type == Function_Type::Lambda) if (fun->type == Function_Type::Lambda)
return Memory::get_or_create_lisp_object_keyword("lambda"); return Memory::get_or_create_lisp_object_keyword("lambda");
else if (fun->type == Function_Type::Special_Lambda) else if (fun->type == Function_Type::Special_Lambda)
@@ -929,12 +899,12 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
print(arguments->value.pair->first); print(arguments->value.pair.first);
Lisp_Object* type = eval_expr( Lisp_Object* type = eval_expr(
Memory::create_lisp_object_pair( Memory::create_lisp_object_pair(
Memory::get_or_create_lisp_object_symbol("type"), Memory::get_or_create_lisp_object_symbol("type"),
Memory::create_lisp_object_pair(arguments->value.pair->first, Memory::nil)), Memory::create_lisp_object_pair(arguments->value.pair.first, Memory::nil)),
env); env);
if (type) { if (type) {
@@ -944,52 +914,52 @@ proc load_built_ins_into_environment(Environment* env) -> void {
// TODO(Felix): Maybe don't compare strings here?? Wtf // TODO(Felix): Maybe don't compare strings here?? Wtf
if (type->type == Lisp_Object_Type::Keyword && if (type->type == Lisp_Object_Type::Keyword &&
(string_equal(type->value.keyword->identifier, "lambda") || (string_equal(type->value.identifier, "lambda") ||
string_equal(type->value.keyword->identifier, "special-lambda") || string_equal(type->value.identifier, "special-lambda") ||
string_equal(type->value.keyword->identifier, "macro"))) string_equal(type->value.identifier, "macro")))
{ {
Lisp_Object* fun = eval_expr(arguments->value.pair->first, env); Lisp_Object* fun = eval_expr(arguments->value.pair.first, env);
if (fun->value.function->docstring) if (fun->value.function.docstring)
printf("Docstring:\n==========\n%s\n\n", Memory::get_c_str(fun->value.function->docstring)); printf("Docstring:\n==========\n%s\n\n", Memory::get_c_str(fun->value.function.docstring));
else else
printf("No docstring avaliable\n"); printf("No docstring avaliable\n");
printf("Arguments:\n==========\n"); printf("Arguments:\n==========\n");
printf("Postitional: {"); printf("Postitional: {");
if (fun->value.function->positional_arguments->next_index != 0) { if (fun->value.function.positional_arguments->next_index != 0) {
printf("%s", printf("%s",
Memory::get_c_str(fun->value.function->positional_arguments->identifiers[0])); Memory::get_c_str(fun->value.function.positional_arguments->identifiers[0]));
for (int i = 1; i < fun->value.function->positional_arguments->next_index; ++i) { for (int i = 1; i < fun->value.function.positional_arguments->next_index; ++i) {
printf(", %s", printf(", %s",
Memory::get_c_str(fun->value.function->positional_arguments->identifiers[i])); Memory::get_c_str(fun->value.function.positional_arguments->identifiers[i]));
} }
} }
printf("}\n"); printf("}\n");
printf("Keyword: {"); printf("Keyword: {");
if (fun->value.function->keyword_arguments->next_index != 0) { if (fun->value.function.keyword_arguments->next_index != 0) {
printf("%s", printf("%s",
Memory::get_c_str(fun->value.function->keyword_arguments->identifiers[0])); Memory::get_c_str(fun->value.function.keyword_arguments->identifiers[0]));
if (fun->value.function->keyword_arguments->values->data[0]) { if (fun->value.function.keyword_arguments->values->data[0]) {
printf(" ("); printf(" (");
print(fun->value.function->keyword_arguments->values->data[0]); print(fun->value.function.keyword_arguments->values->data[0]);
printf(")"); printf(")");
} }
for (int i = 1; i < fun->value.function->keyword_arguments->next_index; ++i) { for (int i = 1; i < fun->value.function.keyword_arguments->next_index; ++i) {
printf(", %s", printf(", %s",
Memory::get_c_str(fun->value.function->keyword_arguments->identifiers[i])); Memory::get_c_str(fun->value.function.keyword_arguments->identifiers[i]));
if (fun->value.function->keyword_arguments->values->data[i]) { if (fun->value.function.keyword_arguments->values->data[i]) {
printf(" ("); printf(" (");
print(fun->value.function->keyword_arguments->values->data[i]); print(fun->value.function.keyword_arguments->values->data[i]);
printf(")"); printf(")");
} }
} }
} }
printf("}\n"); printf("}\n");
printf("Rest: {"); printf("Rest: {");
if (fun->value.function->rest_argument) if (fun->value.function.rest_argument)
printf("%s", printf("%s",
Memory::get_c_str(fun->value.function->rest_argument)); Memory::get_c_str(fun->value.function.rest_argument));
printf("}\n"); printf("}\n");
} }
@@ -1007,12 +977,12 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (arguments_length != 1) { if (arguments_length != 1) {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
if (evaluated_arguments->value.pair->first->type != Lisp_Object_Type::Function) { if (evaluated_arguments->value.pair.first->type != Lisp_Object_Type::Function) {
report_error(Error_Type::Type_Missmatch); report_error(Error_Type::Type_Missmatch);
} }
puts("body:\n"); puts("body:\n");
print(evaluated_arguments->value.pair->first->value.function->body); print(evaluated_arguments->value.pair.first->value.function.body);
puts("\n"); puts("\n");
return Memory::nil; return Memory::nil;
@@ -1024,7 +994,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (arguments_length != 1) { if (arguments_length != 1) {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
print(evaluated_arguments->value.pair->first); print(evaluated_arguments->value.pair.first);
// printf("\n"); // printf("\n");
return Memory::nil; return Memory::nil;
}); });
@@ -1038,11 +1008,11 @@ proc load_built_ins_into_environment(Environment* env) -> void {
} }
if (arguments_length == 1) { if (arguments_length == 1) {
Lisp_Object* prompt = evaluated_arguments->value.pair->first; Lisp_Object* prompt = evaluated_arguments->value.pair.first;
/* if (prompt->type == Lisp_Object_Type::String) */ /* if (prompt->type == Lisp_Object_Type::String) */
/* printf("%s", prompt->value.string->value); */ /* printf("%s", prompt->value.string->value); */
/* else */ /* else */
print(evaluated_arguments->value.pair->first); print(evaluated_arguments->value.pair.first);
} }
char* line = read_line(); char* line = read_line();
String* strLine = Memory::create_string(line); String* strLine = Memory::create_string(line);
@@ -1059,11 +1029,11 @@ proc load_built_ins_into_environment(Environment* env) -> void {
} }
if (arguments_length == 1) { if (arguments_length == 1) {
Lisp_Object* error_code = evaluated_arguments->value.pair->first; Lisp_Object* error_code = evaluated_arguments->value.pair.first;
if (error_code->type != Lisp_Object_Type::Number) if (error_code->type != Lisp_Object_Type::Number)
report_error(Error_Type::Type_Missmatch); report_error(Error_Type::Type_Missmatch);
exit((int)error_code->value.number->value); exit((int)error_code->value.number);
} }
exit(0); exit(0);
}); });
@@ -1085,8 +1055,8 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
Lisp_Object* try_part = arguments->value.pair->first; Lisp_Object* try_part = arguments->value.pair.first;
Lisp_Object* catch_part = arguments->value.pair->rest->value.pair->first; Lisp_Object* catch_part = arguments->value.pair.rest->value.pair.first;
Lisp_Object* result; Lisp_Object* result;
result = eval_expr(try_part, env); result = eval_expr(try_part, env);
@@ -1106,12 +1076,12 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (arguments_length != 1) if (arguments_length != 1)
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
if (evaluated_arguments->value.pair->first->type != Lisp_Object_Type::String) if (evaluated_arguments->value.pair.first->type != Lisp_Object_Type::String)
report_error(Error_Type::Type_Missmatch); report_error(Error_Type::Type_Missmatch);
Lisp_Object* result; Lisp_Object* result;
try { try {
result = built_in_load(evaluated_arguments->value.pair->first->value.string, env); result = built_in_load(evaluated_arguments->value.pair.first->value.string, env);
} }
return result; return result;
@@ -1127,14 +1097,14 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (arguments_length != 1) if (arguments_length != 1)
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
if (evaluated_arguments->value.pair->first->type == Lisp_Object_Type::Nil || if (evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Nil ||
evaluated_arguments->value.pair->first->type == Lisp_Object_Type::Keyword) evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Keyword)
{ {
report_error(Error_Type::Type_Missmatch); report_error(Error_Type::Type_Missmatch);
} }
Lisp_Object* target = Memory::create_lisp_object(); Lisp_Object* target = Memory::create_lisp_object();
Lisp_Object* source = evaluated_arguments->value.pair->first; Lisp_Object* source = evaluated_arguments->value.pair.first;
*target = *source; *target = *source;
return target; return target;
@@ -1157,13 +1127,13 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
Lisp_Object* source = evaluated_arguments->value.pair->first; Lisp_Object* source = evaluated_arguments->value.pair.first;
if (source->type != Lisp_Object_Type::Symbol) { if (source->type != Lisp_Object_Type::Symbol) {
report_error(Error_Type::Type_Missmatch); report_error(Error_Type::Type_Missmatch);
} }
return Memory::get_or_create_lisp_object_keyword(source->value.symbol->identifier); return Memory::get_or_create_lisp_object_keyword(source->value.identifier);
}); });
defun("string->symbol", cLambda { defun("string->symbol", cLambda {
@@ -1178,7 +1148,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
Lisp_Object* source = evaluated_arguments->value.pair->first; Lisp_Object* source = evaluated_arguments->value.pair.first;
if (source->type != Lisp_Object_Type::String) { if (source->type != Lisp_Object_Type::String) {
report_error(Error_Type::Type_Missmatch); report_error(Error_Type::Type_Missmatch);
@@ -1195,12 +1165,12 @@ proc load_built_ins_into_environment(Environment* env) -> void {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
Lisp_Object* source = evaluated_arguments->value.pair->first; Lisp_Object* source = evaluated_arguments->value.pair.first;
if (source->type != Lisp_Object_Type::Symbol) { if (source->type != Lisp_Object_Type::Symbol) {
report_error(Error_Type::Type_Missmatch); report_error(Error_Type::Type_Missmatch);
} }
return Memory::create_lisp_object_string(Memory::duplicate_string(source->value.symbol->identifier)); return Memory::create_lisp_object_string(Memory::duplicate_string(source->value.identifier));
}); });
defun("concat-strings", cLambda { defun("concat-strings", cLambda {
try { try {
@@ -1217,11 +1187,11 @@ proc load_built_ins_into_environment(Environment* env) -> void {
while (head->type == Lisp_Object_Type::Pair) { while (head->type == Lisp_Object_Type::Pair) {
try { try {
assert_type(head->value.pair->first, Lisp_Object_Type::String); assert_type(head->value.pair.first, Lisp_Object_Type::String);
} }
resulting_string_len += head->value.pair->first->value.string->length; resulting_string_len += head->value.pair.first->value.string->length;
head = head->value.pair->rest; head = head->value.pair.rest;
} }
head = evaluated_arguments; head = evaluated_arguments;
@@ -1231,9 +1201,9 @@ proc load_built_ins_into_environment(Environment* env) -> void {
while (head->type == Lisp_Object_Type::Pair) { while (head->type == Lisp_Object_Type::Pair) {
strcpy((&resulting_string->data)+index_in_string, strcpy((&resulting_string->data)+index_in_string,
Memory::get_c_str(head->value.pair->first->value.string)); Memory::get_c_str(head->value.pair.first->value.string));
index_in_string += head->value.pair->first->value.string->length; index_in_string += head->value.pair.first->value.string->length;
head = head->value.pair->rest; head = head->value.pair.rest;
} }
return Memory::create_lisp_object_string(resulting_string); return Memory::create_lisp_object_string(resulting_string);
src/env.cpp
+8 -8
View File
@@ -11,23 +11,23 @@ proc define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env) ->
env->values = (Lisp_Object**)realloc(env->values, env->capacity * sizeof(Lisp_Object*)); env->values = (Lisp_Object**)realloc(env->values, env->capacity * sizeof(Lisp_Object*));
} }
env->keys [env->next_index] = Memory::get_c_str(symbol->value.symbol->identifier); env->keys [env->next_index] = Memory::get_c_str(symbol->value.identifier);
env->values[env->next_index] = value; env->values[env->next_index] = value;
++env->next_index; ++env->next_index;
} }
proc lookup_symbol_in_this_envt(Symbol* sym, Environment* env) -> Lisp_Object* { proc lookup_symbol_in_this_envt(String* identifier, Environment* env) -> Lisp_Object* {
for (int i = env->next_index - 1; i >= 0; --i) for (int i = env->next_index - 1; i >= 0; --i)
if (string_equal(env->keys[i], Memory::get_c_str(sym->identifier))) if (string_equal(env->keys[i], Memory::get_c_str(identifier)))
return env->values[i]; return env->values[i];
return nullptr; return nullptr;
} }
proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
// first check current environment // first check current environment
Symbol* sym = node->value.symbol; String* identifier = node->value.identifier;
Lisp_Object* result; Lisp_Object* result;
result = lookup_symbol_in_this_envt(sym, env); result = lookup_symbol_in_this_envt(identifier, env);
if (result) if (result)
return result; return result;
@@ -38,15 +38,15 @@ proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
return result; return result;
} }
if (string_equal(Memory::get_c_str(sym->identifier), "nil")) { if (string_equal(Memory::get_c_str(identifier), "nil")) {
return Memory::nil; return Memory::nil;
} }
if (string_equal(Memory::get_c_str(sym->identifier), "t")) { if (string_equal(Memory::get_c_str(identifier), "t")) {
return Memory::t; return Memory::t;
} }
printf("%s\n", Memory::get_c_str(identifier));
create_error(Error_Type::Symbol_Not_Defined, node->sourceCodeLocation); create_error(Error_Type::Symbol_Not_Defined, node->sourceCodeLocation);
printf("%s\n", Memory::get_c_str(sym->identifier));
return nullptr; return nullptr;
} }
src/eval.cpp
+53 -53
View File
@@ -11,13 +11,13 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
// strings from symbols... Wo maybe just use the symbols? // strings from symbols... Wo maybe just use the symbols?
define_symbol( define_symbol(
Memory::get_or_create_lisp_object_symbol(function->positional_arguments->identifiers[i]), Memory::get_or_create_lisp_object_symbol(function->positional_arguments->identifiers[i]),
arguments->value.pair->first, new_env); arguments->value.pair.first, new_env);
} else { } else {
create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation); create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation);
return nullptr; return nullptr;
} }
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
} }
String_Array_List* read_in_keywords = create_String_array_list(); String_Array_List* read_in_keywords = create_String_array_list();
@@ -29,12 +29,12 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
// something that is not a keyword is encountered or a keyword // something that is not a keyword is encountered or a keyword
// that is not recognized is encoutered, jump out of the loop. // that is not recognized is encoutered, jump out of the loop.
while (arguments->value.pair->first->type == Lisp_Object_Type::Keyword) { while (arguments->value.pair.first->type == Lisp_Object_Type::Keyword) {
// check if this one is even an accepted keyword // check if this one is even an accepted keyword
bool accepted = false; bool accepted = false;
for (int i = 0; i < function->keyword_arguments->next_index; ++i) { for (int i = 0; i < function->keyword_arguments->next_index; ++i) {
if (string_equal( if (string_equal(
arguments->value.pair->first->value.keyword->identifier, arguments->value.pair.first->value.identifier,
function->keyword_arguments->identifiers[i])) function->keyword_arguments->identifiers[i]))
{ {
accepted = true; accepted = true;
@@ -54,7 +54,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
// check if it was already read in // check if it was already read in
for (int i = 0; i < read_in_keywords->next_index; ++i) { for (int i = 0; i < read_in_keywords->next_index; ++i) {
if (string_equal( if (string_equal(
arguments->value.pair->first->value.keyword->identifier, arguments->value.pair.first->value.identifier,
read_in_keywords->data[i])) read_in_keywords->data[i]))
{ {
// TODO(Felix): if we are actually done with all the // TODO(Felix): if we are actually done with all the
@@ -69,21 +69,21 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
// okay so we found a keyword that has to be read in and was // okay so we found a keyword that has to be read in and was
// not already read in, is there a next element to actually // not already read in, is there a next element to actually
// set it to? // set it to?
if (arguments->value.pair->rest->type != Lisp_Object_Type::Pair) { if (arguments->value.pair.rest->type != Lisp_Object_Type::Pair) {
create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation); create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation);
return nullptr; return nullptr;
} }
// if not set it and then add it to the array list // if not set it and then add it to the array list
define_symbol( define_symbol(
Memory::get_or_create_lisp_object_symbol(arguments->value.pair->first->value.keyword->identifier), Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.identifier),
arguments->value.pair->rest->value.pair->first, arguments->value.pair.rest->value.pair.first,
new_env); new_env);
append_to_array_list(read_in_keywords, arguments->value.pair->first->value.keyword->identifier); append_to_array_list(read_in_keywords, arguments->value.pair.first->value.identifier);
// overstep both for next one // overstep both for next one
arguments = arguments->value.pair->rest->value.pair->rest; arguments = arguments->value.pair.rest->value.pair.rest;
if (arguments->type == Lisp_Object_Type::Nil) { if (arguments->type == Lisp_Object_Type::Nil) {
break; break;
@@ -175,9 +175,9 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
// okay let's try to read some positional arguments // okay let's try to read some positional arguments
while (arguments->type == Lisp_Object_Type::Pair) { while (arguments->type == Lisp_Object_Type::Pair) {
if (arguments->value.pair->first->type == Lisp_Object_Type::Keyword) { if (arguments->value.pair.first->type == Lisp_Object_Type::Keyword) {
if (string_equal(arguments->value.pair->first->value.keyword->identifier, "keys") || if (string_equal(arguments->value.pair.first->value.identifier, "keys") ||
string_equal(arguments->value.pair->first->value.keyword->identifier, "rest")) string_equal(arguments->value.pair.first->value.identifier, "rest"))
break; break;
else { else {
create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation); create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
@@ -185,7 +185,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
} }
} }
if (arguments->value.pair->first->type != Lisp_Object_Type::Symbol) { if (arguments->value.pair.first->type != Lisp_Object_Type::Symbol) {
create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation); create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
return; return;
} }
@@ -193,9 +193,9 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
// okay wow we found an actual symbol // okay wow we found an actual symbol
append_to_positional_argument_list( append_to_positional_argument_list(
function->positional_arguments, function->positional_arguments,
arguments->value.pair->first->value.symbol->identifier); arguments->value.pair.first->value.identifier);
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
} }
// okay we are done with positional arguments, lets check for // okay we are done with positional arguments, lets check for
@@ -206,20 +206,20 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
return; return;
} }
if (arguments->value.pair->first->type == Lisp_Object_Type::Keyword && if (arguments->value.pair.first->type == Lisp_Object_Type::Keyword &&
string_equal(arguments->value.pair->first->value.keyword->identifier, "keys")) string_equal(arguments->value.pair.first->value.identifier, "keys"))
{ {
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
if (arguments->type != Lisp_Object_Type::Pair || if (arguments->type != Lisp_Object_Type::Pair ||
arguments->value.pair->first->type != Lisp_Object_Type::Symbol) arguments->value.pair.first->type != Lisp_Object_Type::Symbol)
{ {
create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation); create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
return; return;
} }
while (arguments->type == Lisp_Object_Type::Pair) { while (arguments->type == Lisp_Object_Type::Pair) {
if (arguments->value.pair->first->type == Lisp_Object_Type::Keyword) { if (arguments->value.pair.first->type == Lisp_Object_Type::Keyword) {
if (string_equal(arguments->value.pair->first->value.keyword->identifier, "rest")) if (string_equal(arguments->value.pair.first->value.identifier, "rest"))
break; break;
else { else {
create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation); create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
@@ -227,7 +227,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
} }
} }
if (arguments->value.pair->first->type != Lisp_Object_Type::Symbol) { if (arguments->value.pair.first->type != Lisp_Object_Type::Symbol) {
create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation); create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
return; return;
} }
@@ -235,20 +235,20 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
// we found a symbol (arguments->value.pair->first) for // we found a symbol (arguments->value.pair->first) for
// the keyword args! Let's check if the next arguement is // the keyword args! Let's check if the next arguement is
// :defaults-to // :defaults-to
Lisp_Object* next = arguments->value.pair->rest; Lisp_Object* next = arguments->value.pair.rest;
if (next->type == Lisp_Object_Type::Pair && if (next->type == Lisp_Object_Type::Pair &&
next->value.pair->first->type == Lisp_Object_Type::Keyword && next->value.pair.first->type == Lisp_Object_Type::Keyword &&
string_equal(next->value.pair->first->value.keyword->identifier, string_equal(next->value.pair.first->value.identifier,
"defaults-to")) "defaults-to"))
{ {
// check if there is a next argument too, otherwise it // check if there is a next argument too, otherwise it
// would be an error // would be an error
next = next->value.pair->rest; next = next->value.pair.rest;
if (next->type == Lisp_Object_Type::Pair) { if (next->type == Lisp_Object_Type::Pair) {
append_to_keyword_argument_list(function->keyword_arguments, append_to_keyword_argument_list(function->keyword_arguments,
arguments->value.pair->first->value.symbol->identifier, arguments->value.pair.first->value.identifier,
next->value.pair->first); next->value.pair.first);
arguments = next->value.pair->rest; arguments = next->value.pair.rest;
} else { } else {
create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation); create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
return; return;
@@ -256,7 +256,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
} else { } else {
// No :defaults-to, so just add it to the list // No :defaults-to, so just add it to the list
append_to_keyword_argument_list(function->keyword_arguments, append_to_keyword_argument_list(function->keyword_arguments,
arguments->value.pair->first->value.symbol->identifier, arguments->value.pair.first->value.identifier,
nullptr); nullptr);
arguments = next; arguments = next;
} }
@@ -272,18 +272,18 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
return; return;
} }
if (arguments->value.pair->first->type == Lisp_Object_Type::Keyword && if (arguments->value.pair.first->type == Lisp_Object_Type::Keyword &&
string_equal(arguments->value.pair->first->value.keyword->identifier, "rest")) string_equal(arguments->value.pair.first->value.identifier, "rest"))
{ {
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
if (arguments->type != Lisp_Object_Type::Pair || if (arguments->type != Lisp_Object_Type::Pair ||
arguments->value.pair->first->type != Lisp_Object_Type::Symbol) arguments->value.pair.first->type != Lisp_Object_Type::Symbol)
{ {
create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation); create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
return; return;
} }
function->rest_argument = arguments->value.pair->first->value.symbol->identifier; function->rest_argument = arguments->value.pair.first->value.identifier;
if (arguments->value.pair->rest->type != Lisp_Object_Type::Nil) { if (arguments->value.pair.rest->type != Lisp_Object_Type::Nil) {
create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation); create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
} }
} else { } else {
@@ -305,7 +305,7 @@ proc list_length(Lisp_Object* node) -> int {
int len = 0; int len = 0;
while (node->type == Lisp_Object_Type::Pair) { while (node->type == Lisp_Object_Type::Pair) {
++len; ++len;
node = node->value.pair->rest; node = node->value.pair.rest;
if (node->type == Lisp_Object_Type::Nil) if (node->type == Lisp_Object_Type::Nil)
return len; return len;
} }
@@ -317,7 +317,7 @@ proc list_length(Lisp_Object* node) -> int {
proc extract_keyword_value(char* keyword, Parsed_Arguments* args) -> Lisp_Object* { proc extract_keyword_value(char* keyword, Parsed_Arguments* args) -> Lisp_Object* {
// NOTE(Felix): This will be a hashmap lookup later // NOTE(Felix): This will be a hashmap lookup later
for (int i = 0; i < args->keyword_keys->next_index; ++i) { for (int i = 0; i < args->keyword_keys->next_index; ++i) {
if (string_equal(args->keyword_keys->data[i]->value.keyword->identifier, keyword)) if (string_equal(args->keyword_keys->data[i]->value.identifier, keyword))
return args->keyword_values->data[i]; return args->keyword_values->data[i];
} }
return nullptr; return nullptr;
@@ -335,17 +335,17 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments
Lisp_Object* current_head = arguments; Lisp_Object* current_head = arguments;
while (current_head->type == Lisp_Object_Type::Pair) { while (current_head->type == Lisp_Object_Type::Pair) {
try { try {
evaluated_arguments_head->value.pair->first = evaluated_arguments_head->value.pair.first =
eval_expr(current_head->value.pair->first, env); eval_expr(current_head->value.pair.first, env);
} }
evaluated_arguments_head->value.pair->first->sourceCodeLocation = current_head->value.pair->first->sourceCodeLocation; evaluated_arguments_head->value.pair.first->sourceCodeLocation = current_head->value.pair.first->sourceCodeLocation;
current_head = current_head->value.pair->rest; current_head = current_head->value.pair.rest;
if (current_head->type == Lisp_Object_Type::Pair) { if (current_head->type == Lisp_Object_Type::Pair) {
evaluated_arguments_head->value.pair->rest = Memory::create_lisp_object_pair(nullptr, nullptr); evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(nullptr, nullptr);
evaluated_arguments_head = evaluated_arguments_head->value.pair->rest; evaluated_arguments_head = evaluated_arguments_head->value.pair.rest;
} else if (current_head->type == Lisp_Object_Type::Nil) { } else if (current_head->type == Lisp_Object_Type::Nil) {
evaluated_arguments_head->value.pair->rest = current_head; evaluated_arguments_head->value.pair.rest = current_head;
} else { } else {
create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation); create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation);
return nullptr; return nullptr;
@@ -375,17 +375,17 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
current_source_code_location = node->sourceCodeLocation; current_source_code_location = node->sourceCodeLocation;
Lisp_Object* lispOperator; Lisp_Object* lispOperator;
if (node->value.pair->first->type != Lisp_Object_Type::CFunction && if (node->value.pair.first->type != Lisp_Object_Type::CFunction &&
node->value.pair->first->type != Lisp_Object_Type::Function) node->value.pair.first->type != Lisp_Object_Type::Function)
{ {
try { try {
lispOperator = eval_expr(node->value.pair->first, env); lispOperator = eval_expr(node->value.pair.first, env);
} }
} else { } else {
lispOperator = node->value.pair->first; lispOperator = node->value.pair.first;
} }
Lisp_Object* arguments = node->value.pair->rest; Lisp_Object* arguments = node->value.pair.rest;
int arguments_length; int arguments_length;
// check for c function // check for c function
@@ -398,7 +398,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
if (lispOperator->type == Lisp_Object_Type::Function) { if (lispOperator->type == Lisp_Object_Type::Function) {
// only for lambdas we evaluate the arguments before // only for lambdas we evaluate the arguments before
// apllying // apllying
if (lispOperator->value.function->type == Function_Type::Lambda) { if (lispOperator->value.function.type == Function_Type::Lambda) {
try { try {
arguments = eval_arguments(arguments, env, &arguments_length); arguments = eval_arguments(arguments, env, &arguments_length);
} }
@@ -406,7 +406,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
Lisp_Object* result; Lisp_Object* result;
try { try {
result = apply_arguments_to_function(arguments, lispOperator->value.function); result = apply_arguments_to_function(arguments, &lispOperator->value.function);
} }
return result; return result;
} }
src/io.cpp
+22 -93
View File
@@ -227,129 +227,58 @@ proc panic(char* message) -> void {
exit(1); exit(1);
} }
proc print(Lisp_Object* node, bool print_quotes = false) -> void { proc print(Lisp_Object* node, bool print_quotes = false, FILE* file = stdout) -> void {
switch (node->type) { switch (node->type) {
case (Lisp_Object_Type::Nil): { case (Lisp_Object_Type::Nil): fprintf(file, "()"); break;
printf("()"); case (Lisp_Object_Type::T): fprintf(file, "t"); break;
} break; case (Lisp_Object_Type::Number): fprintf(file, "%f", node->value.number); break;
case (Lisp_Object_Type::T): { case (Lisp_Object_Type::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.identifier)); break;
printf("t"); case (Lisp_Object_Type::Keyword): fprintf(file, ":%s", Memory::get_c_str(node->value.identifier)); break;
} break; case (Lisp_Object_Type::CFunction): fprintf(file, "[C-function]"); break;
case (Lisp_Object_Type::Number): {
printf("%f", node->value.number->value);
} break;
case (Lisp_Object_Type::String): { case (Lisp_Object_Type::String): {
if (print_quotes) if (print_quotes)
printf("\"%s\"", Memory::get_c_str(node->value.string)); fprintf(file, "\"%s\"", Memory::get_c_str(node->value.string));
else else
printf("%s", Memory::get_c_str(node->value.string)); fprintf(file, "%s", Memory::get_c_str(node->value.string));
} break;
case (Lisp_Object_Type::Symbol): {
printf("%s", Memory::get_c_str(node->value.symbol->identifier));
} break;
case (Lisp_Object_Type::Keyword): {
printf(":%s", Memory::get_c_str(node->value.keyword->identifier));
} break; } break;
case (Lisp_Object_Type::Function): { case (Lisp_Object_Type::Function): {
if (node->value.function->type == Function_Type::Lambda) if (node->value.function.type == Function_Type::Lambda)
printf("[lambda]"); fprintf(file, "[lambda]");
else if (node->value.function->type == Function_Type::Special_Lambda) else if (node->value.function.type == Function_Type::Special_Lambda)
printf("[special-lambda]"); fprintf(file, "[special-lambda]");
else if (node->value.function->type == Function_Type::Macro) else if (node->value.function.type == Function_Type::Macro)
printf("[macro]"); fprintf(file, "[macro]");
else else
assert(false); assert(false);
} break; } break;
case (Lisp_Object_Type::CFunction): {
printf("[C-function]");
} break;
case (Lisp_Object_Type::Pair): { case (Lisp_Object_Type::Pair): {
Lisp_Object* head = node; Lisp_Object* head = node;
printf("("); fprintf(file, "(");
// NOTE(Felix): We cold do a while true here, however in case // NOTE(Felix): We cold do a while true here, however in case
// we want to print a broken list (for logging the error) we // we want to print a broken list (for logging the error) we
// should do mo checks. // should do mo checks.
while (head) { while (head) {
print(head->value.pair->first); print(head->value.pair.first, print_quotes, file);
head = head->value.pair->rest; head = head->value.pair.rest;
if (!head) if (!head)
return; return;
if (head->type != Lisp_Object_Type::Pair) if (head->type != Lisp_Object_Type::Pair)
break; break;
printf(" "); fprintf(file, " ");
} }
if (head->type != Lisp_Object_Type::Nil) { if (head->type != Lisp_Object_Type::Nil) {
printf(" . "); fprintf(file, " . ");
print(head); print(head);
} }
printf(")"); fprintf(file, ")");
} break; } break;
} }
} }
// XXX(Felix): obv code dublicate
proc fprint(FILE* f, Lisp_Object* node) -> void {
switch (node->type) {
case (Lisp_Object_Type::Nil): {
fprintf(f, "nil");
} break;
case (Lisp_Object_Type::T): {
fprintf(f, "t");
} break;
case (Lisp_Object_Type::Number): {
fprintf(f, "%f", node->value.number->value);
} break;
case (Lisp_Object_Type::String): {
fprintf(f, "\"%s\"", Memory::get_c_str(node->value.string));
} break;
case (Lisp_Object_Type::Symbol): {
fprintf(f, "%s", Memory::get_c_str(node->value.symbol->identifier));
} break;
case (Lisp_Object_Type::Keyword): {
fprintf(f, ":%s", Memory::get_c_str(node->value.keyword->identifier));
} break;
case (Lisp_Object_Type::Function): {
if (node->value.function->type == Function_Type::Lambda)
fprintf(f, "[lambda]");
else if (node->value.function->type == Function_Type::Special_Lambda)
fprintf(f, "[special-lambda]");
else if (node->value.function->type == Function_Type::Macro)
fprintf(f, "[macro]");
else
assert(false);
} break;
case (Lisp_Object_Type::CFunction): {
fprintf(f, "[C-function]");
} break;
case (Lisp_Object_Type::Pair): {
Lisp_Object* head = node;
fprintf(f, "(");
// NOTE(Felix): We cold do a while true here, however in case
// we want to print a broken list (for logging the error) we
// should do mo checks.
while (head) {
fprint(f, head->value.pair->first);
head = head->value.pair->rest;
if (!head)
return;
if (head->type != Lisp_Object_Type::Pair)
break;
fprintf(f, " ");
}
if (head->type != Lisp_Object_Type::Nil) {
fprintf(f, " . ");
print(head);
}
fprintf(f, ")");
} break;
}
}
proc print_error_location() -> void { proc print_error_location() -> void {
if (error->location) { if (error->location) {
src/memory.cpp
+8 -25
View File
@@ -114,33 +114,16 @@ namespace Memory {
// init nil // init nil
nil = create_lisp_object(); nil = create_lisp_object();
nil->type = Lisp_Object_Type::Nil; nil->type = Lisp_Object_Type::Nil;
nil->value.pair = nullptr;
// init t // init t
t = create_lisp_object(); t = create_lisp_object();
t->type = Lisp_Object_Type::T; t->type = Lisp_Object_Type::T;
t->value.pair = nullptr;
} }
// proc get_lisp_object_nil() -> Lisp_Object* {
// Lisp_Object* node = create_lisp_object();
// node->type = Lisp_Object_Type::Nil;
// node->value.pair = nullptr;
// return node;
// }
// proc get_lisp_object_t() -> Lisp_Object* {
// Lisp_Object* node = create_lisp_object();
// node->type = Lisp_Object_Type::T;
// node->value.pair = nullptr;
// return node;
// }
proc create_lisp_object_number(double number) -> Lisp_Object* { proc create_lisp_object_number(double number) -> Lisp_Object* {
Lisp_Object* node = create_lisp_object(); Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::Number; node->type = Lisp_Object_Type::Number;
node->value.number = new(Number); node->value.number = number;
node->value.number->value = number;
return node; return node;
} }
@@ -163,8 +146,8 @@ namespace Memory {
// reuse it and dont create new one // reuse it and dont create new one
Lisp_Object* node = create_lisp_object(); Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::Symbol; node->type = Lisp_Object_Type::Symbol;
node->value.symbol = new(Symbol); // node->value.symbol = new(Symbol);
node->value.symbol->identifier = identifier; node->value.identifier = identifier;
return node; return node;
} }
@@ -178,8 +161,8 @@ namespace Memory {
// reuse it and dont create new one // reuse it and dont create new one
Lisp_Object* node = create_lisp_object(); Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::Keyword; node->type = Lisp_Object_Type::Keyword;
node->value.keyword = new(Keyword); // node->value.keyword = new(Keyword);
node->value.keyword->identifier = keyword; node->value.identifier = keyword;
return node; return node;
} }
@@ -200,9 +183,9 @@ namespace Memory {
proc create_lisp_object_pair(Lisp_Object* first, Lisp_Object* rest) -> Lisp_Object* { proc create_lisp_object_pair(Lisp_Object* first, Lisp_Object* rest) -> Lisp_Object* {
Lisp_Object* node = create_lisp_object(); Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::Pair; node->type = Lisp_Object_Type::Pair;
node->value.pair = new(Pair); // node->value.pair = new(Pair);
node->value.pair->first = first; node->value.pair.first = first;
node->value.pair->rest = rest; node->value.pair.rest = rest;
return node; return node;
} }
src/parse.cpp
+41 -48
View File
@@ -293,7 +293,7 @@ namespace Parser {
// okay there is something // okay there is something
Lisp_Object* head = Memory::create_lisp_object(); Lisp_Object* head = Memory::create_lisp_object();
head->type = Lisp_Object_Type::Pair; head->type = Lisp_Object_Type::Pair;
head->value.pair = new(Pair); // head->value.pair = new(Pair);
Lisp_Object* expression = head; Lisp_Object* expression = head;
while (true) { while (true) {
@@ -304,11 +304,11 @@ namespace Parser {
text[*index_in_text] == ',') text[*index_in_text] == ',')
{ {
try { try {
head->value.pair->first = parse_expression(text, index_in_text); head->value.pair.first = parse_expression(text, index_in_text);
} }
} else { } else {
try { try {
head->value.pair->first = parse_atom(text, index_in_text); head->value.pair.first = parse_atom(text, index_in_text);
} }
} }
@@ -320,7 +320,7 @@ namespace Parser {
if (text[(*index_in_text)] == ')') { if (text[(*index_in_text)] == ')') {
head->value.pair->rest = Memory::nil; head->value.pair.rest = Memory::nil;
++parser_col; ++parser_col;
++(*index_in_text); ++(*index_in_text);
break; break;
@@ -330,9 +330,9 @@ namespace Parser {
eat_until_code(text, index_in_text); eat_until_code(text, index_in_text);
if (text[(*index_in_text)] == '(') if (text[(*index_in_text)] == '(')
head->value.pair->rest = parse_expression(text, index_in_text); head->value.pair.rest = parse_expression(text, index_in_text);
else else
head->value.pair->rest = parse_atom(text, index_in_text); head->value.pair.rest = parse_atom(text, index_in_text);
eat_until_code(text, index_in_text); eat_until_code(text, index_in_text);
@@ -342,16 +342,16 @@ namespace Parser {
++(*index_in_text); ++(*index_in_text);
break; break;
} else { } else {
head->value.pair->rest = Memory::create_lisp_object_pair(nullptr, nullptr); head->value.pair.rest = Memory::create_lisp_object_pair(nullptr, nullptr);
head = head->value.pair->rest; head = head->value.pair.rest;
} }
} }
// check if we have to create or delete or run macros // check if we have to create or delete or run macros
if (expression->value.pair->first->type == Lisp_Object_Type::Symbol) { if (expression->value.pair.first->type == Lisp_Object_Type::Symbol) {
if (string_equal("define-syntax", expression->value.pair->first->value.symbol->identifier)) { if (string_equal("define-syntax", expression->value.pair.first->value.identifier)) {
// create a new macro // create a new macro
Lisp_Object* arguments = expression->value.pair->rest; Lisp_Object* arguments = expression->value.pair.rest;
int arguments_length; int arguments_length;
// HACK(Felix): almost code duplicate from // HACK(Felix): almost code duplicate from
@@ -366,57 +366,57 @@ namespace Parser {
return nullptr; return nullptr;
} }
if (arguments->value.pair->first->type != Lisp_Object_Type::Symbol) { if (arguments->value.pair.first->type != Lisp_Object_Type::Symbol) {
create_error(Error_Type::Type_Missmatch, expression->sourceCodeLocation); create_error(Error_Type::Type_Missmatch, expression->sourceCodeLocation);
return nullptr; return nullptr;
} }
// extract the name // extract the name
Lisp_Object* symbol_for_macro = arguments->value.pair->first; Lisp_Object* symbol_for_macro = arguments->value.pair.first;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
Function* function = new(Function); // Function* function = new(Function);
function->parent_environment = environment_for_macros; Lisp_Object* macro = Memory::create_lisp_object();
function->type = Function_Type::Macro; macro->type = Lisp_Object_Type::Function;
macro->value.function.parent_environment = environment_for_macros;
macro->value.function.type = Function_Type::Macro;
// if parameters were specified // if parameters were specified
if (arguments->value.pair->first->type != Lisp_Object_Type::Nil) { if (arguments->value.pair.first->type != Lisp_Object_Type::Nil) {
try { try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Pair); assert_type(arguments->value.pair.first, Lisp_Object_Type::Pair);
} }
try { try {
parse_argument_list(arguments->value.pair->first, function); parse_argument_list(arguments->value.pair.first, &macro->value.function);
} }
} else { } else {
function->positional_arguments = create_positional_argument_list(1); macro->value.function.positional_arguments = create_positional_argument_list(1);
function->keyword_arguments = create_keyword_argument_list(1); macro->value.function.keyword_arguments = create_keyword_argument_list(1);
function->rest_argument = nullptr; macro->value.function.rest_argument = nullptr;
} }
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
// if there is a docstring, use it // if there is a docstring, use it
if (arguments->value.pair->first->type == Lisp_Object_Type::String) { if (arguments->value.pair.first->type == Lisp_Object_Type::String) {
function->docstring = arguments->value.pair->first->value.string; macro->value.function.docstring = arguments->value.pair.first->value.string;
arguments = arguments->value.pair->rest; arguments = arguments->value.pair.rest;
} else { } else {
function->docstring = nullptr; macro->value.function.docstring = nullptr;
} }
// we are now in the function body, just wrap it in an // we are now in the function body, just wrap it in an
// implicit prog // implicit prog
function->body = Memory::create_lisp_object_pair( macro->value.function.body = Memory::create_lisp_object_pair(
Memory::get_or_create_lisp_object_symbol("prog"), Memory::get_or_create_lisp_object_symbol("prog"),
arguments); arguments);
Lisp_Object* macro = Memory::create_lisp_object(); // macro->value.function = function;
macro->type = Lisp_Object_Type::Function;
macro->value.function = function;
define_symbol(symbol_for_macro, macro, environment_for_macros); define_symbol(symbol_for_macro, macro, environment_for_macros);
// print_environment(environment_for_macros); // print_environment(environment_for_macros);
return Memory::nil; return Memory::nil;
} else if (string_equal("delete-syntax", expression->value.pair->first->value.symbol->identifier)) { } else if (string_equal("delete-syntax", expression->value.pair.first->value.identifier)) {
/* --- deleting an existing macro --- */ /* --- deleting an existing macro --- */
// TODO(Felix): this is a hard one because when // TODO(Felix): this is a hard one because when
// environments will be made from hashmaps, how can we // environments will be made from hashmaps, how can we
@@ -436,21 +436,12 @@ namespace Parser {
// if not it is regular code, dont touch. // if not it is regular code, dont touch.
for (int i = 0; i < environment_for_macros->next_index; ++i) { for (int i = 0; i < environment_for_macros->next_index; ++i) {
if (string_equal(expression->value.pair->first->value.symbol->identifier, environment_for_macros->keys[i]) && if (string_equal(expression->value.pair.first->value.identifier, environment_for_macros->keys[i]) &&
environment_for_macros->values[i]->type == Lisp_Object_Type::Function && environment_for_macros->values[i]->type == Lisp_Object_Type::Function &&
environment_for_macros->values[i]->value.function->type == Function_Type::Macro) environment_for_macros->values[i]->value.function.type == Function_Type::Macro)
{ {
try { try {
// if (string_equal(environment_for_macros->keys[i], "when")) {
// printf("invoking macro for %s in %s:%d to:\n\t", environment_for_macros->keys[i], parser_file, parser_line);
// print(environment_for_macros->values[i]->value.function->body);
// }
expression = eval_expr(expression, environment_for_macros); expression = eval_expr(expression, environment_for_macros);
// if (string_equal(environment_for_macros->keys[i], "when")) {
// printf("\nresult: \n\t");
// print(expression);
// printf("\n\n");
// }
} }
} }
} }
@@ -536,6 +527,11 @@ namespace Parser {
strcat(newName, ext); strcat(newName, ext);
FILE *f = fopen(newName, "w"); FILE *f = fopen(newName, "w");
defer {
fclose(f);
free(newName);
};
if (f == NULL) { if (f == NULL) {
printf("Error opening file!\n"); printf("Error opening file!\n");
exit(1); exit(1);
@@ -545,12 +541,9 @@ namespace Parser {
// a macro will parse as nil for now, so we skip those // a macro will parse as nil for now, so we skip those
if (program->data[i]->type == Lisp_Object_Type::Nil) if (program->data[i]->type == Lisp_Object_Type::Nil)
continue; continue;
fprint(f, program->data[i]); print(program->data[i], true, f);
fprintf(f, "\n\n"); fprintf(f, "\n\n");
} }
fclose(f);
free(newName);
} }
proc parse_program(String* file_name, char* text) -> Lisp_Object_Array_List* { proc parse_program(String* file_name, char* text) -> Lisp_Object_Array_List* {
src/structs.cpp
+8 -9
View File
@@ -73,9 +73,9 @@ struct Keyword {
String* identifier; String* identifier;
}; };
struct Number { // struct Number {
double value; // double value;
}; // };
struct Pair { struct Pair {
Lisp_Object* first; Lisp_Object* first;
@@ -119,12 +119,11 @@ struct Lisp_Object {
Lisp_Object_Type type; Lisp_Object_Type type;
Lisp_Object* userType; Lisp_Object* userType;
union { union {
Symbol* symbol; String* identifier; // used for symbols and keywords
Keyword* keyword; double number;
Number* number; String* string;
String* string; Pair pair;
Pair* pair; Function function;
Function* function;
cFunction* cFunction; cFunction* cFunction;
} value; } value;
}; };
src/testing.cpp
+45 -45
View File
@@ -105,26 +105,26 @@ proc test_eval_operands() -> testresult {
assert_equal_int(list_length(operands), 4); assert_equal_int(list_length(operands), 4);
assert_equal_type(operands, Lisp_Object_Type::Pair); assert_equal_type(operands, Lisp_Object_Type::Pair);
assert_equal_type(operands->value.pair->first, Lisp_Object_Type::Number); assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Number);
assert_equal_double(operands->value.pair->first->value.number->value, 1); assert_equal_double(operands->value.pair.first->value.number, 1);
operands = operands->value.pair->rest; operands = operands->value.pair.rest;
assert_equal_type(operands, Lisp_Object_Type::Pair); assert_equal_type(operands, Lisp_Object_Type::Pair);
assert_equal_type(operands->value.pair->first, Lisp_Object_Type::Number); assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Number);
assert_equal_double(operands->value.pair->first->value.number->value, 3); assert_equal_double(operands->value.pair.first->value.number, 3);
operands = operands->value.pair->rest; operands = operands->value.pair.rest;
assert_equal_type(operands, Lisp_Object_Type::Pair); assert_equal_type(operands, Lisp_Object_Type::Pair);
assert_equal_type(operands->value.pair->first, Lisp_Object_Type::String); assert_equal_type(operands->value.pair.first, Lisp_Object_Type::String);
assert_equal_string(operands->value.pair->first->value.string, "okay"); assert_equal_string(operands->value.pair.first->value.string, "okay");
operands = operands->value.pair->rest; operands = operands->value.pair.rest;
assert_equal_type(operands, Lisp_Object_Type::Pair); assert_equal_type(operands, Lisp_Object_Type::Pair);
assert_equal_type(operands->value.pair->first, Lisp_Object_Type::Keyword); assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Keyword);
assert_equal_string(operands->value.pair->first->value.keyword->identifier, "haha"); assert_equal_string(operands->value.pair.first->value.identifier, "haha");
return pass; return pass;
} }
@@ -141,13 +141,13 @@ proc test_parse_atom() -> testresult {
Lisp_Object* result = Parser::parse_atom(string, &index_in_text); Lisp_Object* result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_type(result, Lisp_Object_Type::Number);
assert_equal_double(result->value.number->value, 123); assert_equal_double(result->value.number, 123);
++index_in_text; ++index_in_text;
result = Parser::parse_atom(string, &index_in_text); result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_type(result, Lisp_Object_Type::Number);
assert_equal_double(result->value.number->value, -1.23e-2); assert_equal_double(result->value.number, -1.23e-2);
// test strings // test strings
++index_in_text; ++index_in_text;
@@ -161,26 +161,26 @@ proc test_parse_atom() -> testresult {
result = Parser::parse_atom(string, &index_in_text); result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.keyword->identifier, "key1"); assert_equal_string(result->value.identifier, "key1");
++index_in_text; ++index_in_text;
result = Parser::parse_atom(string, &index_in_text); result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.keyword->identifier, "key:2"); assert_equal_string(result->value.identifier, "key:2");
// test symbols // test symbols
++index_in_text; ++index_in_text;
result = Parser::parse_atom(string, &index_in_text); result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Symbol); assert_equal_type(result, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.symbol->identifier, "sym"); assert_equal_string(result->value.identifier, "sym");
++index_in_text; ++index_in_text;
result = Parser::parse_atom(string, &index_in_text); result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Symbol); assert_equal_type(result, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.symbol->identifier, "+"); assert_equal_string(result->value.identifier, "+");
return pass; return pass;
} }
@@ -193,22 +193,22 @@ proc test_parse_expression() -> testresult {
assert_no_error(); assert_no_error();
assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair->first, Lisp_Object_Type::Symbol); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair->first->value.symbol->identifier, "fun"); assert_equal_string(result->value.pair.first->value.identifier, "fun");
result = result->value.pair->rest; result = result->value.pair.rest;
assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair->first, Lisp_Object_Type::Symbol); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair->first->value.symbol->identifier, "+"); assert_equal_string(result->value.pair.first->value.identifier, "+");
result = result->value.pair->rest; result = result->value.pair.rest;
assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair->first, Lisp_Object_Type::Number); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Number);
assert_equal_double(result->value.pair->first->value.number->value, 12); assert_equal_double(result->value.pair.first->value.number, 12);
result = result->value.pair->rest; result = result->value.pair.rest;
assert_equal_type(result, Lisp_Object_Type::Nil); assert_equal_type(result, Lisp_Object_Type::Nil);
@@ -219,23 +219,23 @@ proc test_parse_expression() -> testresult {
assert_no_error(); assert_no_error();
assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair->first, Lisp_Object_Type::Symbol); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair->first->value.symbol->identifier, "define"); assert_equal_string(result->value.pair.first->value.identifier, "define");
result = result->value.pair->rest; result = result->value.pair.rest;
assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair->first, Lisp_Object_Type::Symbol); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair->first->value.symbol->identifier, "fun"); assert_equal_string(result->value.pair.first->value.identifier, "fun");
result = result->value.pair->rest; result = result->value.pair.rest;
assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair->first, Lisp_Object_Type::Pair); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair->first->value.pair->first, Lisp_Object_Type::Symbol); assert_equal_type(result->value.pair.first->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair->first->value.pair->first->value.symbol->identifier, "lambda"); assert_equal_string(result->value.pair.first->value.pair.first->value.identifier, "lambda");
result = result->value.pair->rest; result = result->value.pair.rest;
return pass; return pass;
} }
@@ -248,7 +248,7 @@ proc test_built_in_add() -> testresult {
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_type(result, Lisp_Object_Type::Number);
assert_equal_double(result->value.number->value, 14); assert_equal_double(result->value.number, 14);
return pass; return pass;
} }
@@ -261,7 +261,7 @@ proc test_built_in_substract() -> testresult {
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_type(result, Lisp_Object_Type::Number);
assert_equal_double(result->value.number->value, 6); assert_equal_double(result->value.number, 6);
return pass; return pass;
} }
@@ -275,7 +275,7 @@ proc test_built_in_multiply() -> testresult {
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_type(result, Lisp_Object_Type::Number);
assert_equal_double(result->value.number->value, 40); assert_equal_double(result->value.number, 40);
return pass; return pass;
} }
@@ -289,7 +289,7 @@ proc test_built_in_divide() -> testresult {
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_type(result, Lisp_Object_Type::Number);
assert_equal_double(result->value.number->value, 5); assert_equal_double(result->value.number, 5);
return pass; return pass;
} }
@@ -303,7 +303,7 @@ proc test_built_in_if() -> testresult {
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_type(result, Lisp_Object_Type::Number);
assert_equal_double(result->value.number->value, 4); assert_equal_double(result->value.number, 4);
char exp_string2[] = "(if () 4 5)"; char exp_string2[] = "(if () 4 5)";
expression = Parser::parse_single_expression(exp_string2); expression = Parser::parse_single_expression(exp_string2);
@@ -312,7 +312,7 @@ proc test_built_in_if() -> testresult {
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_type(result, Lisp_Object_Type::Number);
assert_equal_double(result->value.number->value, 5); assert_equal_double(result->value.number, 5);
return pass; return pass;
} }
@@ -393,7 +393,7 @@ proc test_built_in_type() -> testresult {
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.keyword->identifier, "number"); assert_equal_string(result->value.identifier, "number");
// setting user type // setting user type
char exp_string2[] = "(prog (set-type a :my-type)(type a))"; char exp_string2[] = "(prog (set-type a :my-type)(type a))";
@@ -403,7 +403,7 @@ proc test_built_in_type() -> testresult {
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.keyword->identifier, "my-type"); assert_equal_string(result->value.identifier, "my-type");
// trying to set invalid user type // trying to set invalid user type
char exp_string3[] = "(prog (set-type a \"wrong tpye\")(type a))"; char exp_string3[] = "(prog (set-type a \"wrong tpye\")(type a))";
@@ -421,7 +421,7 @@ proc test_built_in_type() -> testresult {
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.keyword->identifier, "number"); assert_equal_string(result->value.identifier, "number");
return pass; return pass;
} }
todo.org
+11
View File
@@ -13,3 +13,14 @@
;; should output 6 ;; should output 6
;; outputs 0 ;; outputs 0
#+END_SRC #+END_SRC
* SSO
#+begin_src c
Symbol* symbol; // { String* identifier }
Keyword* keyword; // { String* identifier }
Number* number; // { double value }
String* string; // has to stay a pointer
Pair* pair; // { Lisp_Object* first; Lisp_Object* rest }
Function* function; //
cFunction* cFunction; // has to stay a pointer
#+end_src