felix
/
slime
1
0
Forka 0
Codice Problemi 0 Pull Requests 0 Rilasci 0 Wiki Attività
Sfoglia il codice sorgente

some things

master
FelixBrendel 7 anni fa
parent
93e180a8f1
commit
fec24d11c7
14 ha cambiato i file con 452 aggiunte e 186 eliminazioni
Visualizzazione separata
Opzioni Diff
Mostra statistiche Scarica il file Patch Scarica il file Diff
  1. +16
    -5
      bin/pre.slime
  2. +73
    -76
      bin/test.slime
  3. +1
    -1
      build.bat
  4. BIN
     
  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 Vedi File

@@ -1,18 +1,24 @@
(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)
(list 'if condition nil (pair 'prog body)))
`(if ,condition nil ,(pair prog body)))

(define-syntax defun (name arguments :rest body)
;; (type-assert arguments :pair)
;; `(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
(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 (pair 'prog body)))))


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

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

(defun string? (x)
"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)))))

(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)
"A wrapper for the built-in (print) that accepts a variable number
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))))

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

+ 73
- 76
bin/test.slime Vedi File

@@ -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 v2 (make-vector3 3 2 1))

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

(read " ")

+ 1
- 1
build.bat Vedi File

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

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 (
echo.


BIN
Vedi File


+ 11
- 34
src/ast.cpp Vedi File

@@ -1,31 +1,5 @@
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);

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

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

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

struct Keyword_Arguments {
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;
int next_index;
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* ret = new(Positional_Arguments);
ret->identifiers = (char**)malloc(initial_capacity * sizeof(char*));
@@ -138,8 +109,14 @@ void append_to_keyword_argument_list(Keyword_Arguments* args,

struct Environment;

enum struct Function_Type {
Lambda,
Special_Lambda,
Macro
};

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


+ 161
- 19
src/built_ins.cpp Vedi File

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

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 {
bool result = true;
while (arguments->type != Ast_Node_Type::Nil) {
@@ -596,7 +657,7 @@ void load_built_ins_into_environment(Environment* env) {

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

// if parameters were specified
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->parent_environment = env;
function->is_special_form = true;
function->type = Function_Type::Special_Lambda;

// if parameters were specified
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);
}

// 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) {
report_error(Error_Type::Wrong_Number_Of_Arguments);
}
@@ -776,9 +832,14 @@ void load_built_ins_into_environment(Environment* env) {
switch (type) {
case Ast_Node_Type::CFunction: return create_ast_node_keyword("cfunction");
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::Nil: return create_ast_node_keyword("nil");
@@ -810,15 +871,16 @@ void load_built_ins_into_environment(Environment* env) {
if (type) {
printf(" is of 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 &&
(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);
printf("\nspecial-lambda? %s\n", (fun->value.function->is_special_form) ? "yes" : "no");
if (fun->value.function->docstring)
printf("Docstring:\n==========\n%s\n\n", fun->value.function->docstring);
else
@@ -914,9 +976,9 @@ void load_built_ins_into_environment(Environment* env) {
});
defun("break", cLambda {
print_environment(env);
#ifdef _DEBUG
__debugbreak();
#endif
if_debug {
__debugbreak();
}
return create_ast_node_nil();
});
defun("try", cLambda {
@@ -961,6 +1023,9 @@ void load_built_ins_into_environment(Environment* env) {

});
defun("copy", cLambda {

// TODO(Felix): if we are copying string nodes, then
// shouldn't the string itself also get copied??
try {
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);
});

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 cLambda
}


+ 1
- 1
src/env.cpp Vedi File

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

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


+ 1
- 1
src/error.cpp Vedi File

@@ -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::Unknown_Keyword_Argument: return "Evaluation-error: Unknown keyword argument";
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 Vedi File

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

if (arguments->type == Ast_Node_Type::Nil)
goto checks;
// keyword arguments: use all given ones and keep track of the
// added ones (array list), if end of parameters in encountered or
// 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
for (int i = 0; i < function->keyword_arguments->next_index; ++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;
}

// check for list function
// check for lisp 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 {
arguments = eval_arguments(arguments, env, &arguments_length);
}
@@ -413,9 +415,6 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) {
}
}
default: {
#ifdef _DEBUG
__debugbreak();
#endif
report_error(Error_Type::Not_A_Function);
}
}


+ 13
- 6
src/helpers.cpp Vedi File

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

#ifdef _DEBUG
#define assert(cond) \
if (!cond) \
__debugbreak();
constexpr bool is_debug_build = true;
#else
#define assert(cond)
constexpr bool is_debug_build = false;
#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 label(prefix, lnum) concat_(prefix,lnum)
#define try \
@@ -62,7 +70,6 @@

define_array_list(char*, String);


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


+ 68
- 3
src/io.cpp Vedi File

@@ -50,7 +50,7 @@ void print(Ast_Node* node) {
printf("%f", node->value.number->value);
} break;
case (Ast_Node_Type::String): {
printf("%s", node->value.string->value);
printf("\"%s\"", node->value.string->value);
} break;
case (Ast_Node_Type::Symbol): {
printf("%s", node->value.symbol->identifier);
@@ -59,10 +59,14 @@ void print(Ast_Node* node) {
printf(":%s", node->value.keyword->identifier);
} break;
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]");
else if (node->value.function->type == Function_Type::Macro)
printf("[macro]");
else
printf("[lambda]");
assert(false);
} break;
case (Ast_Node_Type::CFunction): {
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() {
if (error->location) {
printf("%s (line %d, position %d)",


+ 3
- 2
src/main.cpp Vedi File

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

Parser::init(env);

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

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


+ 82
- 18
src/parse.cpp Vedi File

@@ -1,8 +1,8 @@
// forward decls -- start
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*);
void parse_argument_list(Ast_Node*, Function*);
int list_length(Ast_Node*);
// forward decls -- end


@@ -18,16 +18,16 @@ namespace Parser {
int parser_line;
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
// special-lambdas, that get executed in this environment at
// read-time
// read-time. This should always be the global environment.
Environment* environment_for_macros;

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
// read-time (while creating macros). If later we want to
@@ -148,6 +148,10 @@ namespace Parser {
*str = '\0';
Ast_Node* ret = create_ast_node_string(str, 0);
inject_scl(ret);

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

return ret;
}

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

// 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);
++parser_col;
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 {
result = parse_expression(text, index_in_text);
}
@@ -232,11 +244,22 @@ namespace Parser {
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(
create_ast_node_symbol("quote"),
create_ast_node_symbol("unquote"),
create_ast_node_pair(result, create_ast_node_nil()));
}


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

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 {
head->value.pair->first = parse_expression(text, index_in_text);
}
@@ -333,7 +360,7 @@ namespace Parser {

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

// if parameters were specified
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) {
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 {
// 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);
// 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);
if (text[(index_in_text)] == '\0')
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 {
result = parse_expression(text, &index_in_text);
}
}
else
try {
result = parse_atom(text, &index_in_text);
@@ -436,6 +474,29 @@ namespace Parser {
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) {
parser_file = (char*)malloc(strlen(file_name) * sizeof(char) + 1);
strcpy(parser_file, file_name);
@@ -468,6 +529,9 @@ namespace Parser {
return nullptr;
}
}

write_expanded_file(file_name, program);

return program;
}



+ 7
- 4
vs/slime.vcxproj Vedi File

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

Scrivi Anteprima
Caricamento…
Annulla
Salva