felix
/
slime
1
0
Форкнуть 0
Код Задачи 0 Pull Request'ы 0 Релизы 0 Вики Активность
Просмотр исходного кода

some things

master
FelixBrendel 7 лет назад
Родитель
93e180a8f1
Сommit
fec24d11c7
14 измененных файлов: 452 добавлений и 186 удалений
Единый вид
Опции Diff
Показать статистику Скачать Patch файл Скачать Diff файл
  1. +16
    -5
      bin/pre.slime
  2. +73
    -76
      bin/test.slime
  3. +1
    -1
      build.bat
  4. Двоичные данные
     
  5. +11
    -34
      src/ast.cpp
  6. +161
    -19
      src/built_ins.cpp
  7. +1
    -1
      src/env.cpp
  8. +1
    -1
      src/error.cpp
  9. +15
    -16
      src/eval.cpp
  10. +13
    -6
      src/helpers.cpp
  11. +68
    -3
      src/io.cpp
  12. +3
    -2
      src/main.cpp
  13. +82
    -18
      src/parse.cpp
  14. +7
    -4
      vs/slime.vcxproj

+ 16
- 5
bin/pre.slime Просмотреть файл

@@ -1,18 +1,24 @@
(define-syntax when (condition :rest body) (define-syntax when (condition :rest body)
(list 'if condition (pair 'prog body) nil))
;; (break)
`(if ,condition ,(pair prog body) nil))
;; (list 'if condition (pair 'prog body) nil))


(define-syntax unless (condition :rest body) (define-syntax unless (condition :rest body)
(list 'if condition nil (pair 'prog body)))
`(if ,condition nil ,(pair prog body)))


(define-syntax defun (name arguments :rest body) (define-syntax defun (name arguments :rest body)
;; (type-assert arguments :pair) ;; (type-assert arguments :pair)
;; `(define ,name (lambda ,arguments ,body)) ;; `(define ,name (lambda ,arguments ,body))


;; TODO(Felix: I think we do not need to wrap the body of the lamba
;; in a prog

;; see if we have a docstring ;; see if we have a docstring
(if (and (= (type (first body)) :string) (not (= (type (rest body)) :nil))) (if (and (= (type (first body)) :string) (not (= (type (rest body)) :nil)))
(list 'define name (list 'lambda arguments (first body) (pair 'prog (rest body)))) (list 'define name (list 'lambda arguments (first body) (pair 'prog (rest body))))
(list 'define name (list 'lambda arguments (pair 'prog body))))) (list 'define name (list 'lambda arguments (pair 'prog body)))))



(define-syntax defspecial (name arguments :rest body) (define-syntax defspecial (name arguments :rest body)
;; (type-assert arguments :pair) ;; (type-assert arguments :pair)
;; `(define ,name (lambda ,arguments ,body)) ;; `(define ,name (lambda ,arguments ,body))
@@ -52,7 +58,7 @@


(defun pair? (x) (defun pair? (x)
"Checks if the argument is a pair." "Checks if the argument is a pair."
(or (= (type x) :pair) (= (type x) :nil)))
(= (type x) :pair))


(defun string? (x) (defun string? (x)
"Checks if the argument is a string." "Checks if the argument is a string."
@@ -191,6 +197,11 @@ added to a list, which in the end is returned."
(filter fun (rest seq))) (filter fun (rest seq)))
(filter fun (rest seq))))) (filter fun (rest seq)))))


(defun zip (l1 l2)
(if (and (nil? l1) (nil? l2))
nil
(pair (list (first l1) (first l2)) (zip (rest l1) (rest l2)))))

(defun printf (:keys sep :defaults-to " " end :defaults-to "\n" :rest args) (defun printf (:keys sep :defaults-to " " end :defaults-to "\n" :rest args)
"A wrapper for the built-in (print) that accepts a variable number "A wrapper for the built-in (print) that accepts a variable number
of arguments and also provides keywords for specifying the printed of arguments and also provides keywords for specifying the printed
@@ -208,5 +219,5 @@ las argument."


(eval (pair printf-quoted (extend (list :@sep (eval sep) :@end (eval end)) args)))) (eval (pair printf-quoted (extend (list :@sep (eval sep) :@end (eval end)) args))))


;; (defmacro pe (@expr)
;; (printf @expr "evaluates to" (eval @expr)))
(defspecial pe (@expr)
(printf @expr "evaluates to" (eval @expr)))

+ 73
- 76
bin/test.slime Просмотреть файл

@@ -1,80 +1,77 @@
;; (define-syntax defclass (name members :rest functions)
;; (list 'defun (string->symbol (concat-strings "make-" (symbol->string name)))


;; ))

;; (defclass vector3 (x y z)
;; ;; getters and setters will be auto generated

;; (defun ->length ()
;; (** (+ (* x x) (* y y) (* z z)) 0.5))

;; (defun ->scale (fac)
;; (mutate x (* fac x))
;; (mutate y (* fac y))
;; (mutate z (* fac z)))

;; )

(defun make-vector3 (x-coord y-coord z-coord)
(let ((x x-coord)
(y y-coord)
(z z-coord))

(defun ->get-x () x)
(defun ->get-y () y)
(defun ->get-z () z)
(defun ->set-x (new-x) (mutate x new-x))
(defun ->set-y (new-y) (mutate y new-y))
(defun ->set-z (new-z) (mutate z new-z))

(defun ->length ()
(** (+ (* x x) (* y y) (* z z)) 0.5))

(defun ->scale (fac)
(mutate x (* fac x))
(mutate y (* fac y))
(mutate z (* fac z)))

(defun ->print ()
(print "[vector3] (")
(print x)
(print " ")
(print y)
(print " ")
(print z)
(print ")\n"))

(defun ->+ (other)
(make-vector
(+ x ((other ->get-x)))
(+ y ((other ->get-y)))
(+ z ((other ->get-z)))))

(defun ->- (other)
(make-vector
(- x ((other ->get-x)))
(- y ((other ->get-y)))
(- z ((other ->get-z)))))

(defun ->scalar-product (other)
(+ (* x ((other ->get-x)))
(* y ((other ->get-y)))
(* z ((other ->get-z)))))

(defun ->cross-product (other)
(make-vector
(- (* y ((other ->get-z))) (* z ((other ->get-y))))
(- (* z ((other ->get-x))) (* x ((other ->get-z))))
(- (* x ((other ->get-y))) (* y ((other ->get-x))))))

(special-lambda (message) (eval message))))
(define-syntax defclass (name members :rest body)
"Macro for creatating classes."
(defun underscore (sym)
(string->symbol (concat-strings "_" (symbol->string sym))))

(define underscored-members (map underscore members))

;; the wrapping let environment
(define let-body (list 'let (zip members underscored-members)))

;; the body
(map (lambda (fun) (append let-body fun)) body)

;; the dispatch function
(append let-body (list 'special-lambda '(message :rest args)
"This is the docs for the handle"
'(eval (extend (list message) args))))


;; stuff it all in the constructor function
(eval (list 'defun (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members
"This is the handle to an object of the class "
let-body)))

;; (v1 print)
;; (v1 length)
;; (v1 get-x)
;; (v1 set-x 10)

(defclass vector3 (x y z)
(defun get-x () x)
(defun get-y () y)
(defun get-z () z)

(defun set-x (new-x) (mutate x new-x))
(defun set-y (new-y) (mutate y new-y))
(defun set-z (new-z) (mutate z new-z))

(defun length ()
(** (+ (* x x) (* y y) (* z z)) 0.5))

(defun scale (fac)
(mutate x (* fac x))
(mutate y (* fac y))
(mutate z (* fac z))
fac)

(defun add (other)
(make-vector3
(+ x (other get-x))
(+ y (other get-y))
(+ z (other get-z))))

(defun subtract (other)
(make-vector3
(- x (other get-x))
(- y (other get-y))
(- z (other get-z))))

(defun scalar-product (other)
(+ (* x (other get-x))
(* y (other get-y))
(* z (other get-z))))

(defun cross-product (other)
(make-vector3
(- (* y (other get-z)) (* z (other get-y)))
(- (* z (other get-x)) (* x (other get-z)))
(- (* x (other get-y)) (* y (other get-x)))))

(defun printout ()
(printf "[vector3] (" x y z ")"))
)


(define v1 (make-vector3 1 2 3)) (define v1 (make-vector3 1 2 3))
(define v2 (make-vector3 3 2 1)) (define v2 (make-vector3 3 2 1))


(print ((v1 ->length)))
(print ((v2 ->length)))

(read " ")

+ 1
- 1
build.bat Просмотреть файл

@@ -11,7 +11,7 @@ pushd build
taskkill /F /IM %exeName% > NUL 2> NUL taskkill /F /IM %exeName% > NUL 2> NUL


echo ---------- Compiling ---------- echo ---------- Compiling ----------
call timecmd cl ../src/main.cpp /Fe%exeName% /D_DEBUG /W3 /Zi /nologo /EHsc /link /NODEFAULTLIB:libucrt libucrtd.lib
call timecmd cl ../src/main.cpp /std:c++latest /Fe%exeName% /D_DEBUG /W3 /Zi /nologo /EHsc /link /NODEFAULTLIB:libucrt libucrtd.lib


if %errorlevel% == 0 ( if %errorlevel% == 0 (
echo. echo.


Двоичные данные
Просмотреть файл


+ 11
- 34
src/ast.cpp Просмотреть файл

@@ -1,31 +1,5 @@
struct Ast_Node; struct Ast_Node;


// #define define_array_list(type, name) \
// struct name##_Array_List { \
// type* data; \
// int length; \
// int next_index; \
// }; \
// \
// \
// void append_to_##name##_array_list(name##_Array_List* arraylist, type element) { \
// if (arraylist->next_index == arraylist->length) { \
// arraylist->length *= 2; \
// arraylist->data = \
// (type*)realloc(arraylist->data, arraylist->length * sizeof(type)); \
// } \
// arraylist->data[arraylist->next_index++] = element; \
// } \
// \
// \
// name##_Array_List* create_##name##_array_list(int initial_capacity) { \
// name##_Array_List* ret = new(name##_Array_List); \
// ret->data = (type*)malloc(initial_capacity * sizeof(type)); \
// ret->next_index = 0; \
// ret->length = initial_capacity; \
// return ret; \
// }

define_array_list(Ast_Node*, Ast_Node); define_array_list(Ast_Node*, Ast_Node);


enum struct Ast_Node_Type { enum struct Ast_Node_Type {
@@ -73,8 +47,8 @@ struct String {
}; };


struct Pair { struct Pair {
struct Ast_Node* first;
struct Ast_Node* rest;
Ast_Node* first;
Ast_Node* rest;
}; };


struct Positional_Arguments { struct Positional_Arguments {
@@ -87,17 +61,14 @@ struct Positional_Arguments {


struct Keyword_Arguments { struct Keyword_Arguments {
char** identifiers; char** identifiers;
// values[i] will be nullptr if no defalut value was declared for
// key identifiers[i]
// NOTE(Felix): values[i] will be nullptr if no defalut value was
// declared for key identifiers[i]
Ast_Node_Array_List* values; Ast_Node_Array_List* values;
int next_index; int next_index;
int length; int length;
}; };




/* Ast_Node_Array_List* create_Ast_Node_Array_List(int initial_length); */
/* void append_to_Ast_Node_Array_List(Ast_Node_Array_List* list, struct Ast_Node* node); */

Positional_Arguments* create_positional_argument_list(int initial_capacity) { Positional_Arguments* create_positional_argument_list(int initial_capacity) {
Positional_Arguments* ret = new(Positional_Arguments); Positional_Arguments* ret = new(Positional_Arguments);
ret->identifiers = (char**)malloc(initial_capacity * sizeof(char*)); ret->identifiers = (char**)malloc(initial_capacity * sizeof(char*));
@@ -138,8 +109,14 @@ void append_to_keyword_argument_list(Keyword_Arguments* args,


struct Environment; struct Environment;


enum struct Function_Type {
Lambda,
Special_Lambda,
Macro
};

struct Function { struct Function {
bool is_special_form;
Function_Type type;
char* docstring; char* docstring;
Positional_Arguments* positional_arguments; Positional_Arguments* positional_arguments;
Keyword_Arguments* keyword_arguments; Keyword_Arguments* keyword_arguments;


+ 161
- 19
src/built_ins.cpp Просмотреть файл

@@ -450,6 +450,67 @@ void load_built_ins_into_environment(Environment* env) {


return arguments->value.pair->first; return arguments->value.pair->first;
}); });
defun("quasiquote", cLambda {
try {
arguments_length = list_length(arguments);
}

if (arguments_length != 1) {
report_error(Error_Type::Wrong_Number_Of_Arguments);
}
// print(arguments);
// printf("\n");

// recursive lambdas in lambdas yay!!
std::function<Ast_Node*(Ast_Node*)> unquoteSomeExpressions;
unquoteSomeExpressions = [&unquoteSomeExpressions, &env] (Ast_Node* expr) -> Ast_Node* {
// if it is an atom, return it
if (expr->type != Ast_Node_Type::Pair)
return copy_ast_node(expr);

// it is a pair!
Ast_Node* originalPair = expr->value.pair->first;
if (originalPair->type == Ast_Node_Type::Symbol &&
string_equal(originalPair->value.symbol->identifier, "unquote"))
{
// eval replace the stuff
return eval_expr(expr->value.pair->rest->value.pair->first, env);
}

// it is a list but not starting with the symbol
// unquote, so search in there for stuff to unquote.
// While copying the list

//NOTE(Felix): Of fucking course we have to copy the
// list. The quasiquote will be part of the body of a
// funciton, we can't jsut modify it because otherwise
// we modify the body of the function and would bake
// in the result...
Ast_Node* newPair = create_ast_node_pair(nullptr, nullptr);
Ast_Node* newPairHead = newPair;
Ast_Node* head = expr;
while (head->type == Ast_Node_Type::Pair) {
newPairHead->value.pair->first = unquoteSomeExpressions(head->value.pair->first);

if (head->value.pair->rest->type != Ast_Node_Type::Pair)
break;

newPairHead->value.pair->rest = create_ast_node_pair(nullptr, nullptr);

newPairHead = newPairHead->value.pair->rest;
head = head->value.pair->rest;
}
newPairHead->value.pair->rest = create_ast_node_nil();

return newPair;
};

Ast_Node* ret = arguments->value.pair->first;
Ast_Node* head = ret;

ret = unquoteSomeExpressions(ret);
return ret;
});
defun("and", cLambda { defun("and", cLambda {
bool result = true; bool result = true;
while (arguments->type != Ast_Node_Type::Nil) { while (arguments->type != Ast_Node_Type::Nil) {
@@ -596,7 +657,7 @@ void load_built_ins_into_environment(Environment* env) {


Function* function = new(Function); Function* function = new(Function);
function->parent_environment = env; function->parent_environment = env;
function->is_special_form = false;
function->type = Function_Type::Lambda;


// if parameters were specified // if parameters were specified
if (arguments->value.pair->first->type != Ast_Node_Type::Nil) { if (arguments->value.pair->first->type != Ast_Node_Type::Nil) {
@@ -646,7 +707,7 @@ void load_built_ins_into_environment(Environment* env) {


Function* function = new(Function); Function* function = new(Function);
function->parent_environment = env; function->parent_environment = env;
function->is_special_form = true;
function->type = Function_Type::Special_Lambda;


// if parameters were specified // if parameters were specified
if (arguments->value.pair->first->type != Ast_Node_Type::Nil) { if (arguments->value.pair->first->type != Ast_Node_Type::Nil) {
@@ -726,11 +787,6 @@ void load_built_ins_into_environment(Environment* env) {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length); evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
} }


// BUG(Felix): Why is arguments_length for '(1 (2)) == 3 and not 2??
// BUG(Felix): Why is arguments_length for '(1 (2)) == 3 and not 2??
// BUG(Felix): Why is arguments_length for '(1 (2)) == 3 and not 2??

// if (list_length(evaluated_arguments) != 2) {
if (arguments_length != 2) { if (arguments_length != 2) {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }
@@ -776,9 +832,14 @@ void load_built_ins_into_environment(Environment* env) {
switch (type) { switch (type) {
case Ast_Node_Type::CFunction: return create_ast_node_keyword("cfunction"); case Ast_Node_Type::CFunction: return create_ast_node_keyword("cfunction");
case Ast_Node_Type::Function: { case Ast_Node_Type::Function: {
if (evaluated_arguments->value.pair->first->value.function->is_special_form)
return create_ast_node_keyword("dynamic-macro");
return create_ast_node_keyword("dynamic-function");
Function* fun = evaluated_arguments->value.pair->first->value.function;
if (fun->type == Function_Type::Lambda)
return create_ast_node_keyword("lambda");
else if (fun->type == Function_Type::Special_Lambda)
return create_ast_node_keyword("special-lambda");
else if (fun->type == Function_Type::Macro)
return create_ast_node_keyword("macro");
else return create_ast_node_keyword("unknown");
} }
case Ast_Node_Type::Keyword: return create_ast_node_keyword("keyword"); case Ast_Node_Type::Keyword: return create_ast_node_keyword("keyword");
case Ast_Node_Type::Nil: return create_ast_node_keyword("nil"); case Ast_Node_Type::Nil: return create_ast_node_keyword("nil");
@@ -810,15 +871,16 @@ void load_built_ins_into_environment(Environment* env) {
if (type) { if (type) {
printf(" is of type "); printf(" is of type ");
print(type); print(type);
printf("\n");
// just make sure type was not redefined and
// returns something that is not a keyword
printf("\n\n");
// TODO(Felix): Maybe don't compare strings here?? Wtf
if (type->type == Ast_Node_Type::Keyword && if (type->type == Ast_Node_Type::Keyword &&
(string_equal(type->value.keyword->identifier, "dynamic-function") ||
string_equal(type->value.keyword->identifier, "dynamic-macro")))
(string_equal(type->value.keyword->identifier, "lambda") ||
string_equal(type->value.keyword->identifier, "special-lambda") ||
string_equal(type->value.keyword->identifier, "macro")))
{ {
Ast_Node* fun = eval_expr(arguments->value.pair->first, env); Ast_Node* fun = eval_expr(arguments->value.pair->first, env);
printf("\nspecial-lambda? %s\n", (fun->value.function->is_special_form) ? "yes" : "no");
if (fun->value.function->docstring) if (fun->value.function->docstring)
printf("Docstring:\n==========\n%s\n\n", fun->value.function->docstring); printf("Docstring:\n==========\n%s\n\n", fun->value.function->docstring);
else else
@@ -914,9 +976,9 @@ void load_built_ins_into_environment(Environment* env) {
}); });
defun("break", cLambda { defun("break", cLambda {
print_environment(env); print_environment(env);
#ifdef _DEBUG
__debugbreak();
#endif
if_debug {
__debugbreak();
}
return create_ast_node_nil(); return create_ast_node_nil();
}); });
defun("try", cLambda { defun("try", cLambda {
@@ -961,6 +1023,9 @@ void load_built_ins_into_environment(Environment* env) {


}); });
defun("copy", cLambda { defun("copy", cLambda {

// TODO(Felix): if we are copying string nodes, then
// shouldn't the string itself also get copied??
try { try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length); evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
} }
@@ -990,6 +1055,83 @@ void load_built_ins_into_environment(Environment* env) {
report_error(Error_Type::Unknown_Error); report_error(Error_Type::Unknown_Error);
}); });


defun("string->symbol", cLambda {

// TODO(Felix): do some sanity checks on the string. For
// example, numbers are not valid symbols.

try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}

if (arguments_length != 1) {
report_error(Error_Type::Wrong_Number_Of_Arguments);
}

Ast_Node* source = evaluated_arguments->value.pair->first;

if (source->type != Ast_Node_Type::String) {
report_error(Error_Type::Type_Missmatch);
}

return create_ast_node_symbol(_strdup(source->value.string->value));
});
defun("symbol->string", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}

if (arguments_length != 1) {
report_error(Error_Type::Wrong_Number_Of_Arguments);
}

Ast_Node* source = evaluated_arguments->value.pair->first;

if (source->type != Ast_Node_Type::Symbol) {
report_error(Error_Type::Type_Missmatch);
}

// TODO(Felix): this is not really fast what we are doing here:
return create_ast_node_string(_strdup(source->value.symbol->identifier), (int)strlen(source->value.symbol->identifier));
});
defun("concat-strings", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}

if (arguments_length < 1) {
report_error(Error_Type::Wrong_Number_Of_Arguments);
}

int resulting_string_len = 0;

Ast_Node* head = evaluated_arguments;

while (head->type == Ast_Node_Type::Pair) {
try {
assert_type(head->value.pair->first, Ast_Node_Type::String);
}
resulting_string_len += head->value.pair->first->value.string->length;

head = head->value.pair->rest;
}

head = evaluated_arguments;

char* resulting_string = (char*)malloc(resulting_string_len * sizeof(char)) + 1;
int index_in_string = 0;

while (head->type == Ast_Node_Type::Pair) {
strcpy(resulting_string+index_in_string, head->value.pair->first->value.string->value);
index_in_string += head->value.pair->first->value.string->length;
head = head->value.pair->rest;
}

resulting_string[index_in_string] = '\0';

return create_ast_node_string(resulting_string, resulting_string_len);
});

#undef report_error #undef report_error
#undef cLambda #undef cLambda
} }


+ 1
- 1
src/env.cpp Просмотреть файл

@@ -75,7 +75,7 @@ Ast_Node* lookup_symbol(Ast_Node* node, Environment* env) {
} }


create_error(Error_Type::Symbol_Not_Defined, node->sourceCodeLocation); create_error(Error_Type::Symbol_Not_Defined, node->sourceCodeLocation);
/* printf("%s\n", sym->identifier); */
printf("%s\n", sym->identifier);
return nullptr; return nullptr;
} }
void print_indent(int indent) { void print_indent(int indent) {


+ 1
- 1
src/error.cpp Просмотреть файл

@@ -52,6 +52,6 @@ char* Error_Type_to_string(Error_Type type) {
case Error_Type::Unexpected_Eof: return "Parsing-error: Unexpected EOF"; case Error_Type::Unexpected_Eof: return "Parsing-error: Unexpected EOF";
case Error_Type::Unknown_Keyword_Argument: return "Evaluation-error: Unknown keyword argument"; case Error_Type::Unknown_Keyword_Argument: return "Evaluation-error: Unknown keyword argument";
case Error_Type::Wrong_Number_Of_Arguments: return "Evaluation-error: Wrong number of arguments"; case Error_Type::Wrong_Number_Of_Arguments: return "Evaluation-error: Wrong number of arguments";
default: return "Unknown Error";
default: return "Unknown Error";
} }
} }

+ 15
- 16
src/eval.cpp Просмотреть файл

@@ -13,17 +13,17 @@ Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function) {
create_ast_node_symbol(function->positional_arguments->identifiers[i]), create_ast_node_symbol(function->positional_arguments->identifiers[i]),
arguments->value.pair->first, new_env); arguments->value.pair->first, new_env);
} else { } else {
// not enough arguments given
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;
} }


if (arguments->type == Ast_Node_Type::Nil)
goto eval_time;

String_Array_List* read_in_keywords = create_String_array_list(16); String_Array_List* read_in_keywords = create_String_array_list(16);

if (arguments->type == Ast_Node_Type::Nil)
goto checks;
// keyword arguments: use all given ones and keep track of the // keyword arguments: use all given ones and keep track of the
// added ones (array list), if end of parameters in encountered or // added ones (array list), if end of parameters in encountered or
// something that is not a keyword is encountered or a keyword // something that is not a keyword is encountered or a keyword
@@ -85,7 +85,7 @@ Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function) {
} }
} }


checks:
// check if all necessary keywords have been read in // check if all necessary keywords have been read in
for (int i = 0; i < function->keyword_arguments->next_index; ++i) { for (int i = 0; i < function->keyword_arguments->next_index; ++i) {
char* defined_keyword = function->keyword_arguments->identifiers[i]; char* defined_keyword = function->keyword_arguments->identifiers[i];
@@ -135,14 +135,14 @@ Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function) {
} }
} }


eval_time: {
Ast_Node* result;
try {
result = eval_expr(function->body, new_env);
}


return result;
Ast_Node* result;
try {
result = eval_expr(function->body, new_env);
} }

return result;

} }


/* /*
@@ -397,9 +397,11 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) {
return result; return result;
} }


// check for list function
// check for lisp function
if (lispOperator->type == Ast_Node_Type::Function) { if (lispOperator->type == Ast_Node_Type::Function) {
if (!lispOperator->value.function->is_special_form) {
// only for lambdas we evaluate the arguments before
// apllying
if (lispOperator->value.function->type == Function_Type::Lambda) {
try { try {
arguments = eval_arguments(arguments, env, &arguments_length); arguments = eval_arguments(arguments, env, &arguments_length);
} }
@@ -413,9 +415,6 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) {
} }
} }
default: { default: {
#ifdef _DEBUG
__debugbreak();
#endif
report_error(Error_Type::Not_A_Function); report_error(Error_Type::Not_A_Function);
} }
} }


+ 13
- 6
src/helpers.cpp Просмотреть файл

@@ -1,14 +1,22 @@
#define new(type) new type #define new(type) new type
#define nullptr NULL


#ifdef _DEBUG #ifdef _DEBUG
#define assert(cond) \
if (!cond) \
__debugbreak();
constexpr bool is_debug_build = true;
#else #else
#define assert(cond)
constexpr bool is_debug_build = false;
#endif #endif


#define if_debug if constexpr (is_debug_build)

#define assert(cond) \
if_debug { \
if (!cond) { \
printf("Assertion failed: %s %d", __FILE__, __LINE__); \
__debugbreak(); \
} \
} else {} \


#define concat_( a, b) a##b #define concat_( a, b) a##b
#define label(prefix, lnum) concat_(prefix,lnum) #define label(prefix, lnum) concat_(prefix,lnum)
#define try \ #define try \
@@ -62,7 +70,6 @@


define_array_list(char*, String); define_array_list(char*, String);



// int string_equal(char* a, char* b) { // int string_equal(char* a, char* b) {
// return !strcmp(a, b); // return !strcmp(a, b);
// } // }


+ 68
- 3
src/io.cpp Просмотреть файл

@@ -50,7 +50,7 @@ void print(Ast_Node* node) {
printf("%f", node->value.number->value); printf("%f", node->value.number->value);
} break; } break;
case (Ast_Node_Type::String): { case (Ast_Node_Type::String): {
printf("%s", node->value.string->value);
printf("\"%s\"", node->value.string->value);
} break; } break;
case (Ast_Node_Type::Symbol): { case (Ast_Node_Type::Symbol): {
printf("%s", node->value.symbol->identifier); printf("%s", node->value.symbol->identifier);
@@ -59,10 +59,14 @@ void print(Ast_Node* node) {
printf(":%s", node->value.keyword->identifier); printf(":%s", node->value.keyword->identifier);
} break; } break;
case (Ast_Node_Type::Function): { case (Ast_Node_Type::Function): {
if (node->value.function->is_special_form)
if (node->value.function->type == Function_Type::Lambda)
printf("[lambda]");
else if (node->value.function->type == Function_Type::Special_Lambda)
printf("[special-lambda]"); printf("[special-lambda]");
else if (node->value.function->type == Function_Type::Macro)
printf("[macro]");
else else
printf("[lambda]");
assert(false);
} break; } break;
case (Ast_Node_Type::CFunction): { case (Ast_Node_Type::CFunction): {
printf("[C-function]"); printf("[C-function]");
@@ -94,6 +98,67 @@ void print(Ast_Node* node) {
} }
} }


// XXX(Felix): obv code dublicate
void fprint(FILE* f, Ast_Node* node) {
switch (node->type) {
case (Ast_Node_Type::Nil): {
fprintf(f, "nil");
} break;
case (Ast_Node_Type::T): {
fprintf(f, "t");
} break;
case (Ast_Node_Type::Number): {
fprintf(f, "%f", node->value.number->value);
} break;
case (Ast_Node_Type::String): {
fprintf(f, "\"%s\"", node->value.string->value);
} break;
case (Ast_Node_Type::Symbol): {
fprintf(f, "%s", node->value.symbol->identifier);
} break;
case (Ast_Node_Type::Keyword): {
fprintf(f, ":%s", node->value.keyword->identifier);
} break;
case (Ast_Node_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 (Ast_Node_Type::CFunction): {
fprintf(f, "[C-function]");
} break;
case (Ast_Node_Type::Pair): {
Ast_Node* 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 != Ast_Node_Type::Pair)
break;
fprintf(f, " ");
}

if (head->type != Ast_Node_Type::Nil) {
fprintf(f, " . ");
print(head);
}

fprintf(f, ")");
} break;
}
}

void print_error_location() { void print_error_location() {
if (error->location) { if (error->location) {
printf("%s (line %d, position %d)", printf("%s (line %d, position %d)",


+ 3
- 2
src/main.cpp Просмотреть файл

@@ -52,12 +52,13 @@ Ast_Node* interprete_file (char* file_name) {
int interprete_stdin () { int interprete_stdin () {
printf("Welcome to the lispy interpreter.\n"); printf("Welcome to the lispy interpreter.\n");
char* line; char* line;
Environment* env = create_empty_environment();
load_built_ins_into_environment(env);
Environment* env = create_built_ins_environment();


Parser::init(env); Parser::init(env);


built_in_load("pre.slime", env); built_in_load("pre.slime", env);
built_in_load("test.slime", env);

if (error) { if (error) {
log_error(); log_error();
delete_error(); delete_error();


+ 82
- 18
src/parse.cpp Просмотреть файл

@@ -1,8 +1,8 @@
// forward decls -- start // forward decls -- start
void load_built_ins_into_environment(Environment*); void load_built_ins_into_environment(Environment*);
int list_length(Ast_Node*);
void parse_argument_list(Ast_Node*, Function*);
Ast_Node* eval_expr(Ast_Node*, Environment*); Ast_Node* eval_expr(Ast_Node*, Environment*);
void parse_argument_list(Ast_Node*, Function*);
int list_length(Ast_Node*);
// forward decls -- end // forward decls -- end




@@ -18,16 +18,16 @@ namespace Parser {
int parser_line; int parser_line;
int parser_col; int parser_col;


// NOTE(Felix): In this environment, the build in vunctions will
// NOTE(Felix): In this environment, the build in functions will
// be loaded, and the macros will be stroed in form of // be loaded, and the macros will be stroed in form of
// special-lambdas, that get executed in this environment at // special-lambdas, that get executed in this environment at
// read-time
// read-time. This should always be the global environment.
Environment* environment_for_macros; Environment* environment_for_macros;


void init(Environment* env) { void init(Environment* env) {
// if we already initialized it, then skip
if (environment_for_macros)
return;
// NOTE(Felix): it is important to keep the parser environment
// up to date with the global environment. When donig tests,
// or running a programm we have to reaload it.


// NOTE(Felix): For now we just allow executing built-ins at // NOTE(Felix): For now we just allow executing built-ins at
// read-time (while creating macros). If later we want to // read-time (while creating macros). If later we want to
@@ -148,6 +148,10 @@ namespace Parser {
*str = '\0'; *str = '\0';
Ast_Node* ret = create_ast_node_string(str, 0); Ast_Node* ret = create_ast_node_string(str, 0);
inject_scl(ret); inject_scl(ret);

// plus one because we want to go after the quotes
*index_in_text += 1;

return ret; return ret;
} }


@@ -219,11 +223,19 @@ namespace Parser {
Ast_Node* parse_expression(char* text, int* index_in_text) { Ast_Node* parse_expression(char* text, int* index_in_text) {


// if it is quoted // if it is quoted
if (text[*index_in_text] == '\'') {
if (text[*index_in_text] == '\'' ||
text[*index_in_text] == '`' ||
text[*index_in_text] == ',')
{
char quoteType = text[*index_in_text];
++(*index_in_text); ++(*index_in_text);
++parser_col; ++parser_col;
Ast_Node* result; Ast_Node* result;
if (text[*index_in_text] == '(' || text[*index_in_text] == '\'' ) {
if (text[*index_in_text] == '(' ||
text[*index_in_text] == '\'' ||
text[*index_in_text] == '`' ||
text[*index_in_text] == ',')
{
try { try {
result = parse_expression(text, index_in_text); result = parse_expression(text, index_in_text);
} }
@@ -232,11 +244,22 @@ namespace Parser {
result = parse_atom(text, index_in_text); result = parse_atom(text, index_in_text);
} }
} }

if (quoteType == '\'')
return create_ast_node_pair(
create_ast_node_symbol("quote"),
create_ast_node_pair(result, create_ast_node_nil()));
else if (quoteType == '`')
return create_ast_node_pair(
create_ast_node_symbol("quasiquote"),
create_ast_node_pair(result, create_ast_node_nil()));
// it has to be an unquote
return create_ast_node_pair( return create_ast_node_pair(
create_ast_node_symbol("quote"),
create_ast_node_symbol("unquote"),
create_ast_node_pair(result, create_ast_node_nil())); create_ast_node_pair(result, create_ast_node_nil()));
} }



// if it is not quoted // if it is not quoted
++(*index_in_text); ++(*index_in_text);
++parser_col; ++parser_col;
@@ -258,7 +281,11 @@ namespace Parser {
Ast_Node* expression = head; Ast_Node* expression = head;


while (true) { while (true) {
if (text[(*index_in_text)] == '(' || text[(*index_in_text)] == '\'' ) {
if (text[*index_in_text] == '(' ||
text[*index_in_text] == '\''||
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);
} }
@@ -333,7 +360,7 @@ namespace Parser {


Function* function = new(Function); Function* function = new(Function);
function->parent_environment = environment_for_macros; function->parent_environment = environment_for_macros;
function->is_special_form = true;
function->type = Function_Type::Macro;


// if parameters were specified // if parameters were specified
if (arguments->value.pair->first->type != Ast_Node_Type::Nil) { if (arguments->value.pair->first->type != Ast_Node_Type::Nil) {
@@ -393,14 +420,20 @@ namespace Parser {


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.symbol->identifier, environment_for_macros->keys[i]) &&
environment_for_macros->values[i]->type == Ast_Node_Type::Function)
environment_for_macros->values[i]->type == Ast_Node_Type::Function &&
environment_for_macros->values[i]->value.function->type == Function_Type::Macro)
{ {
// every `Function` that is defined in this
// environment _has_ to be a macro because
// only built_ins are in there otherwise,
// which are `CFunction`s.
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");
// }
} }
} }
} }
@@ -421,10 +454,15 @@ namespace Parser {
eat_until_code(text, &index_in_text); eat_until_code(text, &index_in_text);
if (text[(index_in_text)] == '\0') if (text[(index_in_text)] == '\0')
return create_ast_node_nil(); return create_ast_node_nil();
if (text[(index_in_text)] == '(' || text[(index_in_text)] == '\'' )
if (text[index_in_text] == '(' ||
text[index_in_text] == '\'' ||
text[index_in_text] == '`' ||
text[index_in_text] == ',')
{
try { try {
result = parse_expression(text, &index_in_text); result = parse_expression(text, &index_in_text);
} }
}
else else
try { try {
result = parse_atom(text, &index_in_text); result = parse_atom(text, &index_in_text);
@@ -436,6 +474,29 @@ namespace Parser {
return nullptr; return nullptr;
} }


void write_expanded_file(char* file_name, Ast_Node_Array_List* program) {
char* ext = ".expanded";
char* newName = (char*)calloc(4 + strlen(file_name), sizeof(char));
strcpy(newName, file_name);
strcat(newName, ext);

FILE *f = fopen(newName, "w");
if (f == NULL) {
printf("Error opening file!\n");
exit(1);
}

for (int i = 0; i < program->next_index; ++i) {
// a macro will parse as nil for now, so we skip those
if (program->data[i]->type == Ast_Node_Type::Nil)
continue;
fprint(f, program->data[i]);
fprintf(f, "\n\n");
}

fclose(f);
}

Ast_Node_Array_List* parse_program(char* file_name, char* text) { Ast_Node_Array_List* parse_program(char* file_name, char* text) {
parser_file = (char*)malloc(strlen(file_name) * sizeof(char) + 1); parser_file = (char*)malloc(strlen(file_name) * sizeof(char) + 1);
strcpy(parser_file, file_name); strcpy(parser_file, file_name);
@@ -468,6 +529,9 @@ namespace Parser {
return nullptr; return nullptr;
} }
} }

write_expanded_file(file_name, program);

return program; return program;
} }




+ 7
- 4
vs/slime.vcxproj Просмотреть файл

@@ -122,7 +122,8 @@
<WarningLevel>Level3</WarningLevel> <WarningLevel>Level3</WarningLevel>
<Optimization>Disabled</Optimization> <Optimization>Disabled</Optimization>
<SDLCheck>true</SDLCheck> <SDLCheck>true</SDLCheck>
<CompileAs>CompileAsC</CompileAs>
<CompileAs>Default</CompileAs>
<LanguageStandard>stdcpplatest</LanguageStandard>
</ClCompile> </ClCompile>
<Link> <Link>
<Profile>true</Profile> <Profile>true</Profile>
@@ -134,6 +135,7 @@
<Optimization>Disabled</Optimization> <Optimization>Disabled</Optimization>
<SDLCheck>true</SDLCheck> <SDLCheck>true</SDLCheck>
<CompileAs>CompileAsC</CompileAs> <CompileAs>CompileAsC</CompileAs>
<LanguageStandard>stdcpplatest</LanguageStandard>
</ClCompile> </ClCompile>
<Link> <Link>
<Profile>true</Profile> <Profile>true</Profile>
@@ -159,12 +161,13 @@
<FunctionLevelLinking>true</FunctionLevelLinking> <FunctionLevelLinking>true</FunctionLevelLinking>
<IntrinsicFunctions>true</IntrinsicFunctions> <IntrinsicFunctions>true</IntrinsicFunctions>
<SDLCheck>true</SDLCheck> <SDLCheck>true</SDLCheck>
<CompileAs>CompileAsC</CompileAs>
<CompileAs>Default</CompileAs>
<LanguageStandard>stdcpplatest</LanguageStandard>
</ClCompile> </ClCompile>
<Link> <Link>
<EnableCOMDATFolding>true</EnableCOMDATFolding> <EnableCOMDATFolding>true</EnableCOMDATFolding>
<OptimizeReferences>true</OptimizeReferences> <OptimizeReferences>true</OptimizeReferences>
<SubSystem>Windows</SubSystem>
<SubSystem>NotSet</SubSystem>
</Link> </Link>
</ItemDefinitionGroup> </ItemDefinitionGroup>
<ItemGroup> <ItemGroup>
@@ -173,4 +176,4 @@
<Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" /> <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
<ImportGroup Label="ExtensionTargets"> <ImportGroup Label="ExtensionTargets">
</ImportGroup> </ImportGroup>
</Project>
</Project>

Редактирование Предпросмотр
Загрузка…
Отмена
Сохранить