felix
/
slime
1
0
Çatalla 0
Kod Konular 0 Değişiklik İstekleri 0 Sürümler 0 Wiki Aktivite
Kaynağa Gözat

we have macros. OOOOOOFFF

master
FelixBrendel 7 yıl önce
ebeveyn
9b5692da9d
işleme
93e180a8f1
12 değiştirilmiş dosya ile 810 ekleme ve 648 silme
Görünümü Böl
Diff Seçenekleri
İstatistikleri Göster Yama Dosyasını İndir Diff Dosyasını İndir
  1. +187
    -172
      bin/pre.slime
  2. +72
    -21
      bin/test.slime
  3. BIN
     
  4. +29
    -2
      src/ast.cpp
  5. +41
    -45
      src/built_ins.cpp
  6. +0
    -62
      src/env.cpp
  7. +7
    -16
      src/eval.cpp
  8. +23
    -2
      src/helpers.cpp
  9. +2
    -2
      src/io.cpp
  10. +11
    -7
      src/main.cpp
  11. +415
    -297
      src/parse.cpp
  12. +23
    -22
      src/testing.cpp

+ 187
- 172
bin/pre.slime Dosyayı Görüntüle

@@ -1,102 +1,117 @@
(define defmacro
(macro (@name @params :rest @body)
"Macro for creating macros with a more concise syntax."
(eval (pair 'define-upwards (pair @name (pair (pair 'macro (pair @params @body)) nil))))))

(define defun
(macro (@name @params :rest @body)
"Macro for creating functions with a more concise syntax."
(eval (pair 'define-upwards (pair @name (pair (pair 'lambda (pair @params @body)) nil))))))

;; (defun nil? (x)
;; "Checks if the argument is nil."
;; (= x nil))

;; (defun number? (x)
;; "Checks if the argument is a number."
;; (= (type x) :number))

;; (defun symbol? (x)
;; "Checks if the argument is a symbol."
;; (= (type x) :symbol))

;; (defun keyword? (x)
;; "Checks if the argument is a keyword."
;; (= (type x) :keyword))

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

;; (defun string? (x)
;; "Checks if the argument is a string."
;; (= (type x) :string))

;; (defun dynamic-function? (x)
;; "Checks if the argument is a function."
;; (= (type x) :dynamic-function))

;; (defun dynamic-macro? (x)
;; "Checks if the argument is a macro."
;; (= (type x) :dynamic-macro))

;; (defun built-in-function? (x)
;; "Checks if the argument is a built-in function."
;; (= (type x) :built-in-function))

;; (defun apply (fun seq)
;; "Applies the funciton to the sequence, as in calls the function
;; with ithe sequence as arguemens."
;; (eval (pair fun seq)))

;; (defmacro when (@test :rest @body)
;; "Executes the code in :rest if test is true."
;; (if (eval @test)
;; (eval (pair prog @body))
;; nil))

;; (defmacro unless (@test :rest @body)
;; "Executes the code in :rest if test is false."
;; (if (eval @test)
;; nil
;; (eval (pair prog @body))))

;; (defun end (seq)
;; "Returns the last pair in the sqeuence."
;; (if (or (nil? seq) (not (pair? (rest seq))))
;; seq
;; (end (rest seq))))

;; (defun last (seq)
;; "Returns the (first) of the last (pair) of the given sequence."
;; (first (end seq)))

;; (defun extend (seq elem)
;; "Extends a list with the given element, by putting it in
;; the (rest) of the last element of the sequence."
;; (when (pair? seq)
;; (define e (end seq))
;; (mutate e (pair (first e) elem)))
;; seq)

;; (defun incr (val)
;; "Adds one to the argument."
;; (+ val 1))

;; (defun decr (val)
;; "Subtracts one from the argument."
;; (- val 1))

;; (defun append (seq elem)
;; "Appends an element to a sequence, by extendeing the list
;; with (pair elem nil)."
;; (extend seq (pair elem nil)))

;; (defun length (seq)
;; "Returns the length of the given sequence."
;; (if (nil? seq)
;; 0
;; (incr (length (rest seq)))))
(define-syntax when (condition :rest body)
(list 'if condition (pair 'prog body) nil))

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

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

;; 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))

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

;; (cond
;; (p1 v1)
;; (p2 v2))
(define-syntax cond (:rest clauses)
(defun rec (clauses)
(if (= nil clauses)
nil
(list 'if (first (first clauses))
(pair 'prog (rest (first clauses)))
(rec (rest clauses)))))
(rec clauses))

(defun nil? (x)
"Checks if the argument is nil."
(= x nil))

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

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

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

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

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

(defun lambda? (x)
"Checks if the argument is a function."
(= (type x) :dynamic-function))

(defun special-lambda? (x)
"Checks if the argument is a macro."
(= (type x) :dynamic-macro))

(defun built-in-function? (x)
"Checks if the argument is a built-in function."
(= (type x) :built-in-function))

(defun apply (fun seq)
"Applies the funciton to the sequence, as in calls the function
with ithe sequence as arguemens."
(eval (pair fun seq)))

(defun end (seq)
"Returns the last pair in the sqeuence."
(if (or (nil? seq) (not (pair? (rest seq))))
seq
(end (rest seq))))

(defun last (seq)
"Returns the (first) of the last (pair) of the given sequence."
(first (end seq)))

(defun extend (seq elem)
"Extends a list with the given element, by putting it in
the (rest) of the last element of the sequence."
(when (pair? seq)
(define e (end seq))
(mutate e (pair (first e) elem)))
seq)

(defun append (seq elem)
"Appends an element to a sequence, by extendeing the list
with (pair elem nil)."
(extend seq (pair elem nil)))

(defun length (seq)
"Returns the length of the given sequence."
(if (nil? seq)
0
(incr (length (rest seq)))))

(defun increment (val)
"Adds one to the argument."
(+ val 1))

(defun decrement (val)
"Subtracts one from the argument."
(- val 1))


;; (defmacro n-times (@times @action)
;; "Executes @action @times times."
@@ -119,79 +134,79 @@
;; (eval (pair prog @for-body))
;; (eval (extend (list for @symbol (@op @from) @to) @for-body))))

;; (defun range (:keys from :defaults-to 0 to)
;; "Returns a sequence of numbers starting with the number defined
;; by the key 'from' and ends with the number defined in 'to'."
;; (when (< from to)
;; (pair from (range :from (+ 1 from) :to to))))
;; (defun range-while (:keys from :defaults-to 0 to)
;; "Returns a sequence of numbers starting with the number defined
;; by the key 'from' and ends with the number defined in 'to'."
;; (define result (list (copy from)))
;; (define head result)
;; (mutate from (incr from))
;; (while (< from to)
;; (prog
;; (mutate head (pair (first head) (pair (copy from) nil)))
;; (define head (rest head))
;; (mutate from (incr from))))
;; result)
;; (defun map (fun seq)
;; "Takes a function and a sequence as arguments and returns a new
;; sequence which contains the results of using the first sequences
;; elemens as argument to that function."
;; (if (nil? seq)
;; seq
;; (pair (fun (first seq))
;; (map fun (rest seq)))))
;; (defun reduce (fun seq)
;; "Takes a function and a sequence as arguments and applies the
;; function to the argument sequence. This only works correctly if
;; the given function accepts a variable amount of parameters. If
;; your funciton is limited to two arguments, use `reduce-binary'
;; instead."
;; (apply fun seq))
;; (defun reduce-binary (fun seq)
;; "Takes a function and a sequence as arguments and applies the
;; function to the argument sequence. reduce-binary applies the
;; arguments `pair-wise' which means it works with binary functions
;; as compared to `reduce'."
;; (if (nil? (rest seq))
;; (first seq)
;; (fun (first seq)
;; (reduce-binary fun (rest seq)))))
;; (defun filter (fun seq)
;; "Takes a function and a sequence as arguments and applies the
;; function to every value in the sequence. If the result of that
;; funciton application returns a truthy value, the original value is
;; added to a list, which in the end is returned."
;; (when seq
;; (if (fun (first seq))
;; (pair (first seq)
;; (filter fun (rest seq)))
;; (filter fun (rest seq)))))
;; (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
;; separators between the arguments and what should be printed after the
;; las argument."
;; (defmacro printf-quoted (:keys @sep @end :rest @args)
;; (if (nil? @args)
;; (prog (print (eval @end)) nil)
;; (prog
;; (print (first @args))
;; (unless (nil? (rest @args))
;; (print (eval @sep)))
;; (eval (pair printf-quoted
;; (extend (list :@sep (eval @sep) :@end (eval @end)) (rest @args)))))))
;; (eval (pair printf-quoted (extend (list :@sep (eval sep) :@end (eval end)) args))))
(defun range (:keys from :defaults-to 0 to)
"Returns a sequence of numbers starting with the number defined
by the key 'from' and ends with the number defined in 'to'."
(when (< from to)
(pair from (range :from (+ 1 from) :to to))))
(defun range-while (:keys from :defaults-to 0 to)
"Returns a sequence of numbers starting with the number defined
by the key 'from' and ends with the number defined in 'to'."
(define result (list (copy from)))
(define head result)
(mutate from (increment from))
(while (< from to)
(prog
(mutate head (pair (first head) (pair (copy from) nil)))
(define head (rest head))
(mutate from (increment from))))
result)
(defun map (fun seq)
"Takes a function and a sequence as arguments and returns a new
sequence which contains the results of using the first sequences
elemens as argument to that function."
(if (nil? seq)
seq
(pair (fun (first seq))
(map fun (rest seq)))))
(defun reduce (fun seq)
"Takes a function and a sequence as arguments and applies the
function to the argument sequence. This only works correctly if
the given function accepts a variable amount of parameters. If
your funciton is limited to two arguments, use `reduce-binary'
instead."
(apply fun seq))
(defun reduce-binary (fun seq)
"Takes a function and a sequence as arguments and applies the
function to the argument sequence. reduce-binary applies the
arguments `pair-wise' which means it works with binary functions
as compared to `reduce'."
(if (nil? (rest seq))
(first seq)
(fun (first seq)
(reduce-binary fun (rest seq)))))
(defun filter (fun seq)
"Takes a function and a sequence as arguments and applies the
function to every value in the sequence. If the result of that
funciton application returns a truthy value, the original value is
added to a list, which in the end is returned."
(when seq
(if (fun (first seq))
(pair (first seq)
(filter fun (rest seq)))
(filter fun (rest seq)))))
(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
separators between the arguments and what should be printed after the
las argument."
(defspecial printf-quoted (:keys @sep @end :rest @args)
(if (nil? @args)
(prog (print (eval @end)) nil)
(prog
(print (first @args))
(unless (nil? (rest @args))
(print (eval @sep)))
(eval (pair printf-quoted
(extend (list :@sep (eval @sep) :@end (eval @end)) (rest @args)))))))
(eval (pair printf-quoted (extend (list :@sep (eval sep) :@end (eval end)) args))))

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

+ 72
- 21
bin/test.slime Dosyayı Görüntüle

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

(defun make-vector (x y z)
(let ((local-x x)
(local-y y)
(local-z z)
(defun (macro (@name @params :rest @body)
(eval (pair 'define-upwards (pair @name (pair (pair 'lambda (pair @params @body)) nil)))))))

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

(defun dispatch (message)
(if (= message ::get-x)
local-x
(if (= message ::set-x)
set-x
nil)))
;; (defclass vector3 (x y z)
;; ;; getters and setters will be auto generated

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

(define v (make-vector 1 2 3))
;; (defun ->scale (fac)
;; (mutate x (* fac x))
;; (mutate y (* fac y))
;; (mutate z (* fac z)))

(print (v ::get-x))
((v ::set-x) 19)
(print (v ::get-x))
;; )

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

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

(read " ")

BIN
Dosyayı Görüntüle


+ 29
- 2
src/ast.cpp Dosyayı Görüntüle

@@ -1,5 +1,32 @@
struct Ast_Node;
define_array_list(struct Ast_Node*, 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 {
Nil,
@@ -112,7 +139,7 @@ void append_to_keyword_argument_list(Keyword_Arguments* args,
struct Environment;

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


+ 41
- 45
src/built_ins.cpp Dosyayı Görüntüle

@@ -247,6 +247,34 @@ Ast_Node* built_in_divide(Ast_Node* arguments, Environment* env) {
return create_ast_node_number(quotient);
}

Ast_Node* built_in_exponentiate(Ast_Node* arguments, Environment* env) {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}

if (arguments_length != 2) {
create_error(Error_Type::Wrong_Number_Of_Arguments, arguments->sourceCodeLocation);
return nullptr;
}

try {
assert_type(arguments->value.pair->first, Ast_Node_Type::Number);
}

double base = arguments->value.pair->first->value.number->value;

arguments = arguments->value.pair->rest;

try {
assert_type(arguments->value.pair->first, Ast_Node_Type::Number);
}

double exponent = arguments->value.pair->first->value.number->value;

return create_ast_node_number(pow(base, exponent));
}


Ast_Node* built_in_load(char* file_name, Environment* env) {
char* file_content = read_entire_file(file_name);
@@ -254,7 +282,7 @@ Ast_Node* built_in_load(char* file_name, Environment* env) {
Ast_Node* result = create_ast_node_nil();
Ast_Node_Array_List* program;
try {
program = parse_program(file_name, file_content);
program = Parser::parse_program(file_name, file_content);
}
for (int i = 0; i < program->next_index; ++i) {
try {
@@ -294,6 +322,7 @@ void load_built_ins_into_environment(Environment* env) {
defun("-", built_in_substract);
defun("*", built_in_multiply);
defun("/", built_in_divide);
defun("**", built_in_exponentiate);
defun("define", cLambda {
try {
arguments_length = list_length(arguments);
@@ -359,36 +388,6 @@ void load_built_ins_into_environment(Environment* env) {

return value;
});
// defun("macro-define", cLambda {
// try {
// arguments_length = list_length(arguments);
// }

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

// Ast_Node* symbol = arguments->value.pair->first;

// if (symbol->type == Ast_Node_Type::Pair) {
// try {
// symbol = eval_expr(symbol, env);
// }
// }

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

// Ast_Node* value = arguments->value.pair->rest->value.pair->first;
// try {
// value = eval_expr(value, env);
// }

// define_macro_symbol(symbol, value, env);

// return value;
// });
defun("mutate", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
@@ -596,12 +595,8 @@ void load_built_ins_into_environment(Environment* env) {
report_error(Error_Type::Wrong_Number_Of_Arguments);

Function* function = new(Function);
/* if (lispOperator->value.built_in_function->type == Built_In_Macro) { */
/* function->is_macro = true; */
/* } else { */
function->parent_environment = env;
function->is_macro = false;
/* } */
function->is_special_form = false;

// if parameters were specified
if (arguments->value.pair->first->type != Ast_Node_Type::Nil) {
@@ -637,10 +632,10 @@ void load_built_ins_into_environment(Environment* env) {
ret->value.function = function;
return ret;
});
defun("macro", cLambda {
defun("special-lambda", cLambda {
/*
* (macro ())
* (macro (x d) (+ 1 2) (- 1 2) (* 1 2))
* (special-lambda ())
* (special-lambda (x d) (+ 1 2) (- 1 2) (* 1 2))
*/
try {
arguments_length = list_length(arguments);
@@ -651,7 +646,7 @@ void load_built_ins_into_environment(Environment* env) {

Function* function = new(Function);
function->parent_environment = env;
function->is_macro = true;
function->is_special_form = true;

// if parameters were specified
if (arguments->value.pair->first->type != Ast_Node_Type::Nil) {
@@ -734,8 +729,9 @@ void load_built_ins_into_environment(Environment* env) {
// 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 (arguments_length != 2) { */
if (list_length(evaluated_arguments) != 2) {

// if (list_length(evaluated_arguments) != 2) {
if (arguments_length != 2) {
report_error(Error_Type::Wrong_Number_Of_Arguments);
}
return create_ast_node_pair(evaluated_arguments->value.pair->first, evaluated_arguments->value.pair->rest->value.pair->first);
@@ -780,7 +776,7 @@ 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_macro)
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");
}
@@ -822,7 +818,7 @@ void load_built_ins_into_environment(Environment* env) {
string_equal(type->value.keyword->identifier, "dynamic-macro")))
{
Ast_Node* fun = eval_expr(arguments->value.pair->first, env);
printf("\nMacro? %s\n", (fun->value.function->is_macro) ? "yes" : "no");
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
@@ -876,7 +872,7 @@ void load_built_ins_into_environment(Environment* env) {
report_error(Error_Type::Wrong_Number_Of_Arguments);
}
print(evaluated_arguments->value.pair->first);
printf("\n");
// printf("\n");
return create_ast_node_nil();
});
defun("read", cLambda {


+ 0
- 62
src/env.cpp Dosyayı Görüntüle

@@ -27,15 +27,6 @@ Environment* create_empty_environment() {
}

void define_symbol(Ast_Node* symbol, Ast_Node* value, Environment* env) {
// if (env->type == Environment_Type::Macro) {
// // NOTE(Felix): we know we have a parent because every
// // environment has a parent except the top level environment.
// // However the top level environment is not a let-environment,
// // so we would not land here
// define_symbol(symbol, value, env->parent);
// return;
// }

// NOTE(Felix): right now we are simply adding the symol at the
// back of the list without checking if it already exists but are
// also searching for thesymbol from the back, so we will find the
@@ -52,17 +43,6 @@ void define_symbol(Ast_Node* symbol, Ast_Node* value, Environment* env) {
++env->next_index;
}

// void define_macro_symbol(Ast_Node* symbol, Ast_Node* value, Environment* env) {
// if (env->type != Environment_Type::Macro) {
// create_error(Error_Type::Unknown_Error, symbol->sourceCodeLocation);
// return;
// }

// env->type = Environment_Type::Lambda;
// define_symbol(symbol, value, env);
// env->type = Environment_Type::Macro;
// }

void print_environment(Environment* env);

Ast_Node* lookup_symbol_in_this_envt(Symbol* sym, Environment* env) {
@@ -72,42 +52,6 @@ Ast_Node* lookup_symbol_in_this_envt(Symbol* sym, Environment* env) {
return nullptr;
}

// Ast_Node* lookup_symbol_from_lambda_env(Symbol* sym, Environment* env) {
// Ast_Node* result;
// do {
// if (env->type != Environment_Type::Lambda) {
// result = lookup_symbol_in_this_envt(sym, env);
// if (result) return result;
// }
// env = env->parent;
// } while (env);
// return nullptr;
// }

// Ast_Node* lookup_symbol_from_let_or_macro_env(Symbol* sym, Environment* env) {
// Ast_Node* result;
// do {
// result = lookup_symbol_in_this_envt(sym, env);
// if (result) return result;
// if (env->type == Environment_Type::Lambda)
// break;

// env = env->parent;
// } while (env);

// if (env) {
// do {
// if (env->type != Environment_Type::Lambda) {
// result = lookup_symbol_in_this_envt(sym, env);
// if (result) return result;
// }
// env = env->parent;
// } while (env);
// }

// return nullptr;
// }

Ast_Node* lookup_symbol(Ast_Node* node, Environment* env) {
// first check current environment
Symbol* sym = node->value.symbol;
@@ -150,12 +94,6 @@ void print_environment_indent(Environment* env, int indent) {
if (env->parent) {
print_indent(indent);
printf("parent");
// if (env->parent->type == Environment_Type::Lambda)
// printf(" (lambda)");
// else if (env->parent->type == Environment_Type::Macro)
// printf(" (macro)");
// else if (env->parent->type == Environment_Type::Let)
// printf(" (let)");
printf(":\n");
print_environment_indent(env->parent, indent+4);
}


+ 7
- 16
src/eval.cpp Dosyayı Görüntüle

@@ -1,12 +1,6 @@
Ast_Node* eval_expr(Ast_Node* node, Environment* env);
Ast_Node* eval_expr(Ast_Node*, Environment*);

Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function, Environment* parent) {
// NOTE(Felix): if it is a macro, we will set it later, so we can
// use the default "define_symbol" method here instead of
// switching between "define_symbol" and "define_macro_symbol" all
// the time

// Environment* new_env = create_child_environment(parent, Environment_Type::Lambda);
Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function) {
Environment* new_env = create_child_environment(function->parent_environment);

// positional arguments
@@ -143,10 +137,6 @@ Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function, E

eval_time: {
Ast_Node* result;

// don't have to check every time if it is macro environment or
// not

try {
result = eval_expr(function->body, new_env);
}
@@ -331,7 +321,7 @@ Ast_Node* extract_keyword_value(char* keyword, Parsed_Arguments* args) {
}

Ast_Node* eval_arguments(Ast_Node* arguments, Environment* env, int *out_arguments_length) {
*out_arguments_length = 0;
int my_out_arguments_length = 0;
if (arguments->type == Ast_Node_Type::Nil) {
return arguments;
}
@@ -355,8 +345,9 @@ Ast_Node* eval_arguments(Ast_Node* arguments, Environment* env, int *out_argumen
create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation);
return nullptr;
}
++(*out_arguments_length);
++my_out_arguments_length;
}
*(out_arguments_length) = my_out_arguments_length;
return evaluated_arguments;
}

@@ -408,7 +399,7 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) {

// check for list function
if (lispOperator->type == Ast_Node_Type::Function) {
if (!lispOperator->value.function->is_macro) {
if (!lispOperator->value.function->is_special_form) {
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}
@@ -416,7 +407,7 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) {

Ast_Node* result;
try {
result = apply_arguments_to_function(arguments, lispOperator->value.function, env);
result = apply_arguments_to_function(arguments, lispOperator->value.function);
}
return result;
}


+ 23
- 2
src/helpers.cpp Dosyayı Görüntüle

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

#ifdef _DEBUG
#define assert(cond) \
if (!cond) \
__debugbreak();
#else
#define assert(cond)
#endif

#define concat_( a, b) a##b
#define label(prefix, lnum) concat_(prefix,lnum)
#define try \
@@ -55,10 +63,23 @@
define_array_list(char*, String);


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

int string_equal(char input[],char check[])
{
int i,result=1;
for(i=0; input[i]!='\0' || check[i]!='\0'; i++) {
if(input[i] != check[i]) {
result=0;
break;
}
}
return result;
}


// asprintf implementation
int _vscprintf_so(const char * format, va_list pargs) {
int retval;


+ 2
- 2
src/io.cpp Dosyayı Görüntüle

@@ -59,8 +59,8 @@ void print(Ast_Node* node) {
printf(":%s", node->value.keyword->identifier);
} break;
case (Ast_Node_Type::Function): {
if (node->value.function->is_macro)
printf("[macro]");
if (node->value.function->is_special_form)
printf("[special-lambda]");
else
printf("[lambda]");
} break;


+ 11
- 7
src/main.cpp Dosyayı Görüntüle

@@ -13,8 +13,8 @@
#include "./error.cpp"
#include "./io.cpp"
#include "./assert.cpp"
#include "./parse.cpp"
#include "./env.cpp"
#include "./parse.cpp"
#include "./built_ins.cpp"
#include "./eval.cpp"
#include "./testing.cpp"
@@ -25,18 +25,20 @@ Ast_Node* interprete_file (char* file_name) {
create_error(Error_Type::Unknown_Error, nullptr);
}

Ast_Node_Array_List* program;
try {
program = parse_program(file_name, file_content);
}

Environment* env = create_empty_environment();
load_built_ins_into_environment(env);

Parser::init(env);

try {
built_in_load("pre.slime", env);
}

Ast_Node_Array_List* program;
try {
program = Parser::parse_program(file_name, file_content);
}

Ast_Node* result = create_ast_node_nil();
for (int i = 0; i < program->next_index; ++i) {
try {
@@ -53,6 +55,8 @@ int interprete_stdin () {
Environment* env = create_empty_environment();
load_built_ins_into_environment(env);

Parser::init(env);

built_in_load("pre.slime", env);
if (error) {
log_error();
@@ -63,7 +67,7 @@ int interprete_stdin () {
while (true) {
printf(">");
line = read_expression();
parsed = parse_single_expression(line);
parsed = Parser::parse_single_expression(line);
if (error) {
log_error();
delete_error();


+ 415
- 297
src/parse.cpp Dosyayı Görüntüle

@@ -1,358 +1,476 @@
char* parser_file;
int parser_line;
int parser_col;

#define inject_scl(_ret) \
ret->sourceCodeLocation = new(Source_Code_Location); \
ret->sourceCodeLocation->file = parser_file; \
ret->sourceCodeLocation->line = parser_line; \
ret->sourceCodeLocation->column = parser_col

// 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*);
// forward decls -- end

// TODO(Felix): use the array list macro here?
Ast_Node_Array_List* create_Ast_Node_Array_List(int initial_length) {
Ast_Node_Array_List* ret = new (Ast_Node_Array_List);

// create one with 16 entries first
ret->length = initial_length;
ret->data = (struct Ast_Node**)malloc(initial_length * sizeof(struct Ast_Node));
ret->next_index = 0;
namespace Parser {

return ret;
}
#define inject_scl(_ret) \
ret->sourceCodeLocation = new(Source_Code_Location); \
ret->sourceCodeLocation->file = parser_file; \
ret->sourceCodeLocation->line = parser_line; \
ret->sourceCodeLocation->column = parser_col

void append_to_Ast_Node_Array_List(Ast_Node_Array_List* list, struct Ast_Node* node) {
if (list->next_index == list->length) {
list->length *= 2;
list->data = (struct Ast_Node**)realloc(list->data, list->length * sizeof(struct Ast_Node));
char* parser_file;
int parser_line;
int parser_col;

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

void init(Environment* env) {
// if we already initialized it, then skip
if (environment_for_macros)
return;

// NOTE(Felix): For now we just allow executing built-ins at
// read-time (while creating macros). If later we want to
// change that, we have to define some funcions in this
// environment.
environment_for_macros = env;
}
list->data[list->next_index++] = node;
}


void eat_comment_line(char* text, int* index_in_text) {
// safety check if we are actually starting a comment here
if (text[*index_in_text] != ';')
return;
void eat_comment_line(char* text, int* index_in_text) {
// safety check if we are actually starting a comment here
if (text[*index_in_text] != ';')
return;

// eat the comment line
do {
++(*index_in_text);
++parser_col;
} while (text[(*index_in_text)] != '\n' &&
text[(*index_in_text)] != '\r' &&
text[(*index_in_text)] != '\0');
}

void eat_whitespace(char* text, int* index_in_text) {
// skip whitespaces
while (text[(*index_in_text)] == ' ' ||
text[(*index_in_text)] == '\t' ||
text[(*index_in_text)] == '\n' ||
text[(*index_in_text)] == '\r')
{
if (text[(*index_in_text)] == '\n') {
++parser_line;
parser_col = 0;
}
++parser_col;
++(*index_in_text);
// eat the comment line
do {
++(*index_in_text);
++parser_col;
} while (text[(*index_in_text)] != '\n' &&
text[(*index_in_text)] != '\r' &&
text[(*index_in_text)] != '\0');
}

}
void eat_whitespace(char* text, int* index_in_text) {
// skip whitespaces
while (text[(*index_in_text)] == ' ' ||
text[(*index_in_text)] == '\t' ||
text[(*index_in_text)] == '\n' ||
text[(*index_in_text)] == '\r')
{
if (text[(*index_in_text)] == '\n') {
++parser_line;
parser_col = 0;
}
++parser_col;
++(*index_in_text);
}

void eat_until_code(char* text, int* index_in_text) {
int position_before;
do {
position_before = *index_in_text;
eat_comment_line(text, index_in_text);
eat_whitespace(text, index_in_text);
} while (position_before != *index_in_text);
}
}

char* read_atom(char* text, int* index_in_text) {
int atom_length = 0;
while (text[*index_in_text+atom_length] != ' ' &&
text[*index_in_text+atom_length] != ')' &&
text[*index_in_text+atom_length] != '(' &&
text[*index_in_text+atom_length] != '\0' &&
text[*index_in_text+atom_length] != '\n' &&
text[*index_in_text+atom_length] != '\r' &&
text[*index_in_text+atom_length] != '\t')
{
++atom_length;
void eat_until_code(char* text, int* index_in_text) {
int position_before;
do {
position_before = *index_in_text;
eat_comment_line(text, index_in_text);
eat_whitespace(text, index_in_text);
} while (position_before != *index_in_text);
}

// let's mark the end of the atom there quickly, so the string can
// be copied from there easily and then put the char that was
// before there back
char before = text[*index_in_text+atom_length];
text[*index_in_text+atom_length] = '\0';
char* read_atom(char* text, int* index_in_text) {
int atom_length = 0;
while (text[*index_in_text+atom_length] != ' ' &&
text[*index_in_text+atom_length] != ')' &&
text[*index_in_text+atom_length] != '(' &&
text[*index_in_text+atom_length] != '\0' &&
text[*index_in_text+atom_length] != '\n' &&
text[*index_in_text+atom_length] != '\r' &&
text[*index_in_text+atom_length] != '\t')
{
++atom_length;
}

// get the atom
char* atom = (char*)malloc(atom_length*sizeof(char)+1); // plus null char
strcpy(atom, text+(*index_in_text));
// let's mark the end of the atom there quickly, so the string can
// be copied from there easily and then put the char that was
// before there back
char before = text[*index_in_text+atom_length];
text[*index_in_text+atom_length] = '\0';

// restore the original string
text[*index_in_text+atom_length] = before;
// get the atom
char* atom = (char*)malloc(atom_length*sizeof(char)+1); // plus null char
strcpy(atom, text+(*index_in_text));

// update the index to point to the character after the atom
// ended
*index_in_text += atom_length;
// restore the original string
text[*index_in_text+atom_length] = before;

return atom;
}
// update the index to point to the character after the atom
// ended
*index_in_text += atom_length;

Ast_Node* parse_number(char* text, int* index_in_text) {
double number;
char* str_number = read_atom(text, index_in_text);
sscanf(str_number, "%lf", &number);
Ast_Node* ret = create_ast_node_number(number);
inject_scl(ret);
return ret;
}


Ast_Node* parse_keyword(char* text, int* index_in_text) {
// we are now on the colon
++(*index_in_text);
++parser_col;
char* str_keyword = read_atom(text, index_in_text);
Ast_Node* ret = create_ast_node_keyword(str_keyword);
inject_scl(ret);
return ret;
}
return atom;
}

Ast_Node* parse_symbol(char* text, int* index_in_text) {
// we are now at the first char of the symbol
char* str_symbol = read_atom(text, index_in_text);
Ast_Node* ret = create_ast_node_symbol(str_symbol);
inject_scl(ret);
return ret;
}
Ast_Node* parse_number(char* text, int* index_in_text) {
double number;
char* str_number = read_atom(text, index_in_text);
sscanf(str_number, "%lf", &number);
Ast_Node* ret = create_ast_node_number(number);
inject_scl(ret);
return ret;
}

Ast_Node* parse_string(char* text, int* index_in_text) {
// the first character is the '"'
++(*index_in_text);
++parser_col;

// now we are at the first letter, if this is the closing '"' then
// it's easy
if (text[*index_in_text] == '"') {
char* str = new(char);
*str = '\0';
Ast_Node* ret = create_ast_node_string(str, 0);
Ast_Node* parse_keyword(char* text, int* index_in_text) {
// we are now on the colon
++(*index_in_text);
++parser_col;
char* str_keyword = read_atom(text, index_in_text);
Ast_Node* ret = create_ast_node_keyword(str_keyword);
inject_scl(ret);
return ret;
}

// okay so the first letter was not actually closing the string...
int string_length = 0;
while (text[*index_in_text+string_length] != '"' ||
text[*index_in_text+string_length] == '\\')
{
++string_length;
Ast_Node* parse_symbol(char* text, int* index_in_text) {
// we are now at the first char of the symbol
char* str_symbol = read_atom(text, index_in_text);
Ast_Node* ret = create_ast_node_symbol(str_symbol);
inject_scl(ret);
return ret;
}

// we found the end of the string
text[*index_in_text+string_length] = '\0';
Ast_Node* parse_string(char* text, int* index_in_text) {
// the first character is the '"'
++(*index_in_text);
++parser_col;

char* string = (char*)malloc(string_length*sizeof(char)+1); // plus null char
// now we are at the first letter, if this is the closing '"' then
// it's easy
if (text[*index_in_text] == '"') {
char* str = new(char);
*str = '\0';
Ast_Node* ret = create_ast_node_string(str, 0);
inject_scl(ret);
return ret;
}

if (!unescape_string(text+(*index_in_text))) {
create_error(
Error_Type::Unknown_Error,
create_source_code_location(parser_file, parser_line, parser_col));
return nullptr;
}
strcpy(string, text+(*index_in_text));
/* manually copy to parse control sequences correctly */
/* int temp_index = 0; */
/* while (text+(temp_index+(*index_in_text)) != '\0') { */
/* string[temp_index++] = text[temp_index+(*index_in_text)]; */
/* } */
/* string[temp_index++] = '\0'; */

text[*index_in_text+string_length] = '"';

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

Ast_Node* ret = create_ast_node_string(string, string_length);
inject_scl(ret);
return ret;
}
// okay so the first letter was not actually closing the string...
int string_length = 0;
while (text[*index_in_text+string_length] != '"' ||
text[*index_in_text+string_length] == '\\')
{
++string_length;
}

Ast_Node* parse_atom(char* text, int* index_in_text) {
// numbers
if ((text[*index_in_text] <= 57 && // if number
text[*index_in_text] >= 48)
||
((text[*index_in_text] == '+' || // or if sign and then number
text[*index_in_text] == '-')
&&
(text[*index_in_text +1] <= 57 &&
text[*index_in_text +1] >= 48))
||
((text[*index_in_text] == '.') // or if . and then number
&&
(text[*index_in_text +1] <= 57 &&
text[*index_in_text +1] >= 48)))
return parse_number(text, index_in_text);

// keywords
if (text[*index_in_text] == ':')
return parse_keyword(text, index_in_text);

// strings
if (text[*index_in_text] == '"')
return parse_string(text, index_in_text);

return parse_symbol(text, index_in_text);
}
// we found the end of the string
text[*index_in_text+string_length] = '\0';

Ast_Node* parse_expression(char* text, int* index_in_text) {
if (text[*index_in_text] == '\'') {
++(*index_in_text);
++parser_col;
Ast_Node* result;
if (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);
}
char* string = (char*)malloc(string_length*sizeof(char)+1); // plus null char

if (!unescape_string(text+(*index_in_text))) {
create_error(
Error_Type::Unknown_Error,
create_source_code_location(parser_file, parser_line, parser_col));
return nullptr;
}
return create_ast_node_pair(
create_ast_node_symbol("quote"),
create_ast_node_pair(result, create_ast_node_nil()));
}
++(*index_in_text);
++parser_col;
strcpy(string, text+(*index_in_text));
/* manually copy to parse control sequences correctly */
/* int temp_index = 0; */
/* while (text+(temp_index+(*index_in_text)) != '\0') { */
/* string[temp_index++] = text[temp_index+(*index_in_text)]; */
/* } */
/* string[temp_index++] = '\0'; */

eat_whitespace(text, index_in_text);
text[*index_in_text+string_length] = '"';

// if there was actually nothing in the list, return nil
if (text[(*index_in_text)] == ')') {
++(*index_in_text);
++parser_col;
return create_ast_node_nil();
*index_in_text += string_length +1; // plus one because we want to
// go after the quotes

Ast_Node* ret = create_ast_node_string(string, string_length);
inject_scl(ret);
return ret;
}

// okay there is something
Ast_Node* head = new(Ast_Node);
head->type = Ast_Node_Type::Pair;
head->value.pair = new(Pair);
Ast_Node* expression = head;
Ast_Node* parse_atom(char* text, int* index_in_text) {
// numbers
if ((text[*index_in_text] <= 57 && // if number
text[*index_in_text] >= 48)
||
((text[*index_in_text] == '+' || // or if sign and then number
text[*index_in_text] == '-')
&&
(text[*index_in_text +1] <= 57 &&
text[*index_in_text +1] >= 48))
||
((text[*index_in_text] == '.') // or if . and then number
&&
(text[*index_in_text +1] <= 57 &&
text[*index_in_text +1] >= 48)))
return parse_number(text, index_in_text);

// keywords
if (text[*index_in_text] == ':')
return parse_keyword(text, index_in_text);

// strings
if (text[*index_in_text] == '"')
return parse_string(text, index_in_text);

return parse_symbol(text, index_in_text);
}

while (true) {
if (text[(*index_in_text)] == '(' || text[(*index_in_text)] == '\'' ) {
try {
head->value.pair->first = parse_expression(text, index_in_text);
}
} else {
try {
head->value.pair->first = parse_atom(text, index_in_text);
Ast_Node* parse_expression(char* text, int* index_in_text) {

// if it is quoted
if (text[*index_in_text] == '\'') {
++(*index_in_text);
++parser_col;
Ast_Node* result;
if (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);
}
}
return create_ast_node_pair(
create_ast_node_symbol("quote"),
create_ast_node_pair(result, create_ast_node_nil()));
}

eat_until_code(text, index_in_text);
if (text[(*index_in_text)] == '\0') {
create_error(Error_Type::Unexpected_Eof, create_source_code_location(parser_file, parser_line, parser_col));
return nullptr;
}
// if it is not quoted
++(*index_in_text);
++parser_col;

eat_whitespace(text, index_in_text);

// if there was actually nothing in the list, we define here,
// that that means nil
if (text[(*index_in_text)] == ')') {
head->value.pair->rest = create_ast_node_nil();
++parser_col;
++(*index_in_text);
break;
} else if (text[(*index_in_text)] == '.') {
++parser_col;
++(*index_in_text);
eat_until_code(text, index_in_text);
return create_ast_node_nil();
}

if (text[(*index_in_text)] == '(')
head->value.pair->rest = parse_expression(text, index_in_text);
else
head->value.pair->rest = parse_atom(text, index_in_text);
// okay there is something
Ast_Node* head = new(Ast_Node);
head->type = Ast_Node_Type::Pair;
head->value.pair = new(Pair);
Ast_Node* expression = head;

while (true) {
if (text[(*index_in_text)] == '(' || text[(*index_in_text)] == '\'' ) {
try {
head->value.pair->first = parse_expression(text, index_in_text);
}
} else {
try {
head->value.pair->first = parse_atom(text, index_in_text);
}
}

eat_until_code(text, index_in_text);
if (text[(*index_in_text)] == '\0') {
create_error(Error_Type::Unexpected_Eof, create_source_code_location(parser_file, parser_line, parser_col));
return nullptr;
}

if (text[(*index_in_text)] != ')')
create_error(Error_Type::Syntax_Error, create_source_code_location(parser_file, parser_line, parser_col));
++parser_col;
++(*index_in_text);
break;
} else {
head->value.pair->rest = create_ast_node_pair(nullptr, nullptr);
head = head->value.pair->rest;
}
}
return expression;
}

Ast_Node* parse_single_expression(char* text) {
parser_file = "stdin";
parser_line = 1;
parser_col = 1;

int index_in_text = 0;
Ast_Node* result;
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)] == '\'' )
try {
result = parse_expression(text, &index_in_text);
if (text[(*index_in_text)] == ')') {
head->value.pair->rest = create_ast_node_nil();
++parser_col;
++(*index_in_text);
break;
} else if (text[(*index_in_text)] == '.') {
++parser_col;
++(*index_in_text);
eat_until_code(text, index_in_text);

if (text[(*index_in_text)] == '(')
head->value.pair->rest = parse_expression(text, index_in_text);
else
head->value.pair->rest = parse_atom(text, index_in_text);

eat_until_code(text, index_in_text);

if (text[(*index_in_text)] != ')')
create_error(Error_Type::Syntax_Error, create_source_code_location(parser_file, parser_line, parser_col));
++parser_col;
++(*index_in_text);
break;
} else {
head->value.pair->rest = create_ast_node_pair(nullptr, nullptr);
head = head->value.pair->rest;
}
}
else
try {
result = parse_atom(text, &index_in_text);

// check if we have to create or delete or run macros
if (expression->value.pair->first->type == Ast_Node_Type::Symbol) {
if (string_equal("define-syntax", expression->value.pair->first->value.symbol->identifier)) {
// create a new macro
Ast_Node* arguments = expression->value.pair->rest;
int arguments_length;

// HACK(Felix): almost code duplicate from
// `built_ins.cpp`: special-lambda
try {
arguments_length = list_length(arguments);
}

// (define-syntax defun (name args :rest body) (...))
if (arguments_length < 2) {
create_error(Error_Type::Wrong_Number_Of_Arguments, expression->sourceCodeLocation);
return nullptr;
}

if (arguments->value.pair->first->type != Ast_Node_Type::Symbol) {
create_error(Error_Type::Type_Missmatch, expression->sourceCodeLocation);
return nullptr;
}

// extract the name
Ast_Node* symbol_for_macro = arguments->value.pair->first;
arguments = arguments->value.pair->rest;

Function* function = new(Function);
function->parent_environment = environment_for_macros;
function->is_special_form = true;

// if parameters were specified
if (arguments->value.pair->first->type != Ast_Node_Type::Nil) {
try {
assert_type(arguments->value.pair->first, Ast_Node_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;
// if there is a docstring, use it
if (arguments->value.pair->first->type == Ast_Node_Type::String) {
function->docstring = arguments->value.pair->first->value.string->value;
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 = create_ast_node_pair(
create_ast_node_symbol("prog"),
arguments);

Ast_Node* macro = new(Ast_Node);
macro->type = Ast_Node_Type::Function;
macro->value.function = function;
define_symbol(symbol_for_macro, macro, environment_for_macros);

// print_environment(environment_for_macros);
return create_ast_node_nil();

} else if (string_equal("delete-syntax", expression->value.pair->first->value.symbol->identifier)) {
/* --- deleting an existing macro --- */
// TODO(Felix): this is a hard one because when
// environments will be made from hashmaps, how can we
// delete stuff from hashmaps? If we do probing on
// collision and then delte the first colliding entry,
// how can we find the second one? How many probes do
// we have to do to know for sure that an elemenet is
// not in the hashmap? It would be much easier if we
// never deleted any elements from the hashmap, so
// that, when an entry is not found immidiately, we
// know for sure that it does not exist in the table.

create_error(Error_Type::Not_Yet_Implemented, expression->sourceCodeLocation);
return nullptr;
} else {
// if threre is a macro named like this, then macroexpand
// if not it is regular code, dont touch.

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)
{
// 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 {
expression = eval_expr(expression, environment_for_macros);
}
}
}
}
}
eat_until_code(text, &index_in_text);
if (text[(index_in_text)] == '\0')
return result;
create_error(Error_Type::Trailing_Garbage, create_source_code_location(parser_file, parser_line, parser_col));
return nullptr;
}

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);
parser_line = 1;
parser_col = 0;

Ast_Node_Array_List* program = create_Ast_Node_Array_List(16);
return expression;
}

int index_in_text = 0;
Ast_Node* parse_single_expression(char* text) {
parser_file = "stdin";
parser_line = 1;
parser_col = 1;

while (text[index_in_text] != '\0') {
switch (text[index_in_text]) {
case '(': {
Ast_Node* parsed;
int index_in_text = 0;
Ast_Node* result;
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)] == '\'' )
try {
parsed = parse_expression(text, &index_in_text);
result = parse_expression(text, &index_in_text);
}
else
try {
result = parse_atom(text, &index_in_text);
}
eat_until_code(text, &index_in_text);
if (text[(index_in_text)] == '\0')
return result;
create_error(Error_Type::Trailing_Garbage, create_source_code_location(parser_file, parser_line, parser_col));
return nullptr;
}

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);
parser_line = 1;
parser_col = 0;

Ast_Node_Array_List* program = create_Ast_Node_array_list(16);

int index_in_text = 0;

while (text[index_in_text] != '\0') {
switch (text[index_in_text]) {
case '(': {
Ast_Node* parsed;
try {
parsed = parse_expression(text, &index_in_text);
}
append_to_Ast_Node_array_list(program, parsed);
} break;
case ';':
case ' ':
case '\t':
case '\n':
case '\r': {
eat_until_code(text, &index_in_text);
} break;
default:
/* syntax error */
create_error(Error_Type::Syntax_Error, create_source_code_location(parser_file, parser_line, parser_col));
return nullptr;
}
append_to_Ast_Node_Array_List(program, parsed);
} break;
case ';':
case ' ':
case '\t':
case '\n':
case '\r': {
eat_until_code(text, &index_in_text);
} break;
default:
/* syntax error */
create_error(Error_Type::Syntax_Error, create_source_code_location(parser_file, parser_line, parser_col));
return nullptr;
}
return program;
}
return program;
}

#undef inject_scl

}

+ 23
- 22
src/testing.cpp Dosyayı Görüntüle

@@ -87,7 +87,7 @@

testresult test_eval_operands() {
char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))";
Ast_Node* operands = parse_single_expression(operands_string);
Ast_Node* operands = Parser::parse_single_expression(operands_string);
int operands_length;
operands = eval_arguments(operands, create_built_ins_environment(), &operands_length);

@@ -128,47 +128,47 @@ testresult test_parse_atom() {
"sym +"; // symbols

// test numbers
Ast_Node* result = parse_atom(string, &index_in_text);
Ast_Node* result = Parser::parse_atom(string, &index_in_text);

assert_equal_type(result, Ast_Node_Type::Number);
assert_equal_double(result->value.number->value, 123);

++index_in_text;

result = parse_atom(string, &index_in_text);
result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Ast_Node_Type::Number);
assert_equal_double(result->value.number->value, -1.23e-2);

// test strings
++index_in_text;

result = parse_atom(string, &index_in_text);
result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Ast_Node_Type::String);
assert_equal_string(result->value.string->value, "asd");

// test keywords
++index_in_text;

result = parse_atom(string, &index_in_text);
result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Ast_Node_Type::Keyword);
assert_equal_string(result->value.keyword->identifier, "key1");

++index_in_text;

result = parse_atom(string, &index_in_text);
result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Ast_Node_Type::Keyword);
assert_equal_string(result->value.keyword->identifier, "key:2");

// test symbols
++index_in_text;

result = parse_atom(string, &index_in_text);
result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Ast_Node_Type::Symbol);
assert_equal_string(result->value.symbol->identifier, "sym");

++index_in_text;

result = parse_atom(string, &index_in_text);
result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Ast_Node_Type::Symbol);
assert_equal_string(result->value.symbol->identifier, "+");

@@ -179,7 +179,7 @@ testresult test_parse_expression() {
int index_in_text = 0;
char string[] = "(fun + 12)";

Ast_Node* result = parse_expression(string, &index_in_text);
Ast_Node* result = Parser::parse_expression(string, &index_in_text);
assert_no_error(error);

assert_equal_type(result, Ast_Node_Type::Pair);
@@ -205,7 +205,7 @@ testresult test_parse_expression() {
char string2[] = "(define fun (lambda (x) (+ 5 (* x x ))))";
index_in_text = 0;

result = parse_expression(string2, &index_in_text);
result = Parser::parse_expression(string2, &index_in_text);
assert_no_error(error);

assert_equal_type(result, Ast_Node_Type::Pair);
@@ -232,7 +232,7 @@ testresult test_parse_expression() {

testresult test_built_in_add() {
char exp_string[] = "(+ 10 4)";
Ast_Node* expression = parse_single_expression(exp_string);
Ast_Node* expression = Parser::parse_single_expression(exp_string);
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
@@ -245,7 +245,7 @@ testresult test_built_in_add() {

testresult test_built_in_substract() {
char exp_string[] = "(- 10 4)";
Ast_Node* expression = parse_single_expression(exp_string);
Ast_Node* expression = Parser::parse_single_expression(exp_string);
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
@@ -259,7 +259,7 @@ testresult test_built_in_substract() {

testresult test_built_in_multiply() {
char exp_string[] = "(* 10 4)";
Ast_Node* expression = parse_single_expression(exp_string);
Ast_Node* expression = Parser::parse_single_expression(exp_string);
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
@@ -273,7 +273,7 @@ testresult test_built_in_multiply() {

testresult test_built_in_divide() {
char exp_string[] = "(/ 20 4)";
Ast_Node* expression = parse_single_expression(exp_string);
Ast_Node* expression = Parser::parse_single_expression(exp_string);
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

assert_null(error);
@@ -287,7 +287,7 @@ testresult test_built_in_divide() {

testresult test_built_in_if() {
char exp_string1[] = "(if 1 4 5)";
Ast_Node* expression = parse_single_expression(exp_string1);
Ast_Node* expression = Parser::parse_single_expression(exp_string1);
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
@@ -296,7 +296,7 @@ testresult test_built_in_if() {
assert_equal_double(result->value.number->value, 4);

char exp_string2[] = "(if () 4 5)";
expression = parse_single_expression(exp_string2);
expression = Parser::parse_single_expression(exp_string2);
result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
@@ -309,7 +309,7 @@ testresult test_built_in_if() {

testresult test_built_in_and() {
char exp_string1[] = "(and 1 \"asd\" 4)";
Ast_Node* expression = parse_single_expression(exp_string1);
Ast_Node* expression = Parser::parse_single_expression(exp_string1);
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
@@ -318,7 +318,7 @@ testresult test_built_in_and() {

// a false case
char exp_string2[] = "(and () \"asd\" 4)";
expression = parse_single_expression(exp_string2);
expression = Parser::parse_single_expression(exp_string2);
result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
@@ -330,7 +330,7 @@ testresult test_built_in_and() {

testresult test_built_in_or() {
char exp_string1[] = "(or \"asd\" nil)";
Ast_Node* expression = parse_single_expression(exp_string1);
Ast_Node* expression = Parser::parse_single_expression(exp_string1);
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
@@ -339,7 +339,7 @@ testresult test_built_in_or() {

// a false case
char exp_string2[] = "(or () ())";
expression = parse_single_expression(exp_string2);
expression = Parser::parse_single_expression(exp_string2);
result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
@@ -352,7 +352,7 @@ testresult test_built_in_or() {

testresult test_built_in_not() {
char exp_string1[] = "(not ())";
Ast_Node* expression = parse_single_expression(exp_string1);
Ast_Node* expression = Parser::parse_single_expression(exp_string1);
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

// a true case
@@ -362,7 +362,7 @@ testresult test_built_in_not() {

// a false case
char exp_string2[] = "(not \"asd xD\")";
expression = parse_single_expression(exp_string2);
expression = Parser::parse_single_expression(exp_string2);
result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
@@ -374,6 +374,7 @@ testresult test_built_in_not() {

void run_all_tests() {
log_level = Log_Level::None;
Parser::init(create_built_ins_environment());

printf("-- Parsing --\n");
invoke_test(test_parse_atom);


Yaz Önizleme
Yükleniyor…
İptal
Kaydet