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

Macros actually working

Browse Source
This commit is contained in:
FelixBrendel
2018-10-27 15:57:45 +02:00
parent 65b97fe535
commit 5aa92062c3
15 changed files with 693 additions and 192 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.dir-locals.el
+1
View File
@@ -31,6 +31,7 @@
("r" save-and-find-run-script-and-compile "run" :color blue)
("d" save-and-find-debug-script-and-compile "debug" :color blue)
("t" save-and-find-test-script-and-compile "test" :color blue)
("o" browse-file-directory "open" :color blue)
("q" nil "quit" :color blue))
(define-key context-mode-map (kbd "<f2>") 'hydra-context/body))))))
.gitignore
+1
View File
@@ -7,3 +7,4 @@
/bin/slime
*.psess
*.vspx
todo.html
bin/pre.slime
+136 -109
View File
@@ -1,128 +1,155 @@
(define nil ())
(define pe
(macro (expr)
(print expr)
(print " evaluates to -> ")
(print (eval expr))
(print "
")
(define defun
(macro (@name @params :rest @body)
(eval (pair 'define (pair @name (pair (pair 'lambda (pair @params @body)) nil))))))
(define defmacro
(macro (@name @params :rest @body)
(eval (pair 'define (pair @name (pair (pair 'macro (pair @params @body)) nil))))))
(defmacro pe (@expr)
(printf @expr "evaluates to" (eval @expr)))
(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 funciton 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))))
(define apply
(lambda (fun seq)
(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))))
(define defun
(macro (name params :rest body)
(printf "name" params "params" params "body" body)
(define name
(lambda (params) body))))
(defun last (seq)
"Returns the (first) of the last (pair) of the given sequence."
(first (end seq)))
(define when
(macro (test :rest body)
(if (eval test)
(apply prog body)
nil)))
(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)
(define unless
(macro (test :rest body)
(if (eval test)
nil
(apply prog body))))
(defun append (seq elem)
(extend seq (pair elem nil)))
(define nil?
(lambda (x)
"Checks if the argument is nil."
(= x nil)))
(defmacro n-times (@times @action)
(unless (<= (eval @times) 0)
(eval @action)
(macro-define @args (pair (pair - (pair (eval @times) (pair 1 nil))) (pair @action nil)))
;; [o|o] --------------------------> [o|o] -> nil
;; | |
;; V V
;; [o|o] -> [o|o] -> [o|o]-> nil action
;; | | |
;; V V V
;; - times 1
(eval (pair n-times @args))))
(define append
(lambda (seq elem)
(if (nil? seq)
nil
(if (not (= (type (rest seq)) :pair))
;; we are on the last element
(mutate seq (pair (first seq) elem))
(append (rest seq) elem)))))
(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'."
(if (<= from to)
(pair from (range :from (+ 1 from) :to to))
nil))
(define last
(lambda (seq)
"Returns the last element of the given sequence."
(if (nil? seq)
seq
(if (not (= (type (rest seq)) :pair))
(first seq)
(last (rest seq))))))
(defun map (fun seq)
"Takes a sequence and a function 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)))))
(define n-times
(lambda (times action)
(if (<= times 0)
nil
(prog
(eval action)
(n-times (- 1 times) action)))))
(defun reduce (fun seq)
"Takes a sequence and a function 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."
(eval (pair fun seq)))
(define range
(lambda (: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'."
(if (<= from to)
(pair from (range :from (+ 1 from) :to to))
nil)))
(define map
(lambda (fun seq)
"Takes a sequence and a function 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))))))
(define reduce
(lambda (function sequence)
"Takes a sequence and a function 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 function sequence)))
(define reduce-binary
(lambda (function sequence)
"Takes a sequence and a function as arguments and applies the
(defun reduce-binary (fun seq)
"Takes a sequence and a function 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 sequence))
(first sequence)
(function (first sequence)
(reduce-binary (rest sequence) function)))))
(if (nil? (rest seq))
(first seq)
(fun (first seq)
(reduce-binary fun (rest seq)))))
(define filter
(lambda (function sequence)
(if (nil? sequence)
nil
(if (function (first sequence))
(pair (first sequence)
(filter (rest sequence) function))
(filter (rest sequence) function)))))
(defun filter (fun seq)
(if (nil? seq)
nil
(if (fun (first seq))
(pair (first seq)
(filter fun (rest seq)))
(filter fun (rest seq)))))
(define printf-quoted
(macro (:keys sep :defaults-to " " end :defaults-to "\n" :rest args)
(if (nil? args)
(prog (print (eval end)) nil)
(prog
(print (first args))
(when (not (nil? (rest args))) (print (eval sep)))
(define command-args (list :sep (eval sep) :end (eval end)))
(append command-args (rest args))
(apply printf-quoted command-args)))))
(defmacro printf-quoted (:keys @sep :defaults-to " " @end :defaults-to "\n" :rest @args)
(if (nil? @args)
(prog (print (eval @end)) nil)
(prog
(print (first @args))
(when (not (nil? (rest @args))) (print (eval @sep)))
(eval
(pair printf-quoted
(extend (list :@sep (eval @sep) :@end (eval @end)) (rest @args)))))))
(define printf
(lambda (:keys sep :defaults-to " " end :defaults-to "\n" :rest args)
(define command-args (list :sep (eval sep) :end (eval end)))
(append command-args args)
(apply printf-quoted command-args)))
(defun printf (:keys sep :defaults-to " " end :defaults-to "\n" :rest args)
(define command-args (extend (list :@sep (eval sep) :@end (eval end)) args))
(eval (pair printf-quoted command-args)))
bin/test.slime
+9 -4
View File
@@ -1,4 +1,9 @@
(define l '(1 2 3 4))
(define r (rest l))
(mutate r (list 100 200))
(print l)
(when 1 (breakpoint))
;; (if (eval 1)
;; (apply prog ((breakpoint)))
;; nil))
;; (if (eval 1)
;; (eval (pair prog ((breakpoint)))))
;; nil))
src/ast.c
+39 -30
View File
@@ -125,6 +125,9 @@ typedef enum {
Built_In_Rest,
Built_In_Load,
Built_In_Define,
Built_In_Let,
Built_In_Macro_Define,
Built_In_Breakpoint,
Built_In_Mutate,
Built_In_Lambda,
Built_In_Macro,
@@ -147,6 +150,8 @@ char* Built_In_Name_to_string(Built_In_Name name) {
case Built_In_Addition: return "+";
case Built_In_And: return "and";
case Built_In_Define: return "define";
case Built_In_Macro_Define: return "macro-define";
case Built_In_Breakpoint: return "breakpoint";
case Built_In_Division: return "/";
case Built_In_Equal: return "=";
case Built_In_Eval: return "eval";
@@ -157,6 +162,7 @@ char* Built_In_Name_to_string(Built_In_Name name) {
case Built_In_If: return "if";
case Built_In_Info: return "info";
case Built_In_Lambda: return "lambda";
case Built_In_Let: return "let";
case Built_In_Less: return "<";
case Built_In_Less_Equal: return "<=";
case Built_In_List: return "list";
@@ -248,36 +254,39 @@ Ast_Node* create_ast_node_keyword(char* keyword) {
Ast_Node* create_ast_node_built_in_function(char* name) {
Built_In_Name type;
if (string_equal(name, "+")) type = Built_In_Addition;
else if (string_equal(name, "-")) type = Built_In_Subtraction;
else if (string_equal(name, "*")) type = Built_In_Multiplication;
else if (string_equal(name, "/")) type = Built_In_Division;
else if (string_equal(name, "=")) type = Built_In_Equal;
else if (string_equal(name, ">")) type = Built_In_Greater;
else if (string_equal(name, ">=")) type = Built_In_Greater_Equal;
else if (string_equal(name, "<")) type = Built_In_Less;
else if (string_equal(name, "<=")) type = Built_In_Less_Equal;
else if (string_equal(name, "if")) type = Built_In_If;
else if (string_equal(name, "and")) type = Built_In_And;
else if (string_equal(name, "or")) type = Built_In_Or;
else if (string_equal(name, "not")) type = Built_In_Not;
else if (string_equal(name, "pair")) type = Built_In_Pair;
else if (string_equal(name, "first")) type = Built_In_First;
else if (string_equal(name, "rest")) type = Built_In_Rest;
else if (string_equal(name, "load")) type = Built_In_Load;
else if (string_equal(name, "define")) type = Built_In_Define;
else if (string_equal(name, "mutate")) type = Built_In_Mutate;
else if (string_equal(name, "lambda")) type = Built_In_Lambda;
else if (string_equal(name, "macro")) type = Built_In_Macro;
else if (string_equal(name, "eval")) type = Built_In_Eval;
else if (string_equal(name, "quote")) type = Built_In_Quote;
else if (string_equal(name, "prog")) type = Built_In_Prog;
else if (string_equal(name, "list")) type = Built_In_List;
else if (string_equal(name, "print")) type = Built_In_Print;
else if (string_equal(name, "read")) type = Built_In_Read;
else if (string_equal(name, "info")) type = Built_In_Info;
else if (string_equal(name, "type")) type = Built_In_Type;
else if (string_equal(name, "exit")) type = Built_In_Exit;
if (string_equal(name, "+")) type = Built_In_Addition;
else if (string_equal(name, "-")) type = Built_In_Subtraction;
else if (string_equal(name, "*")) type = Built_In_Multiplication;
else if (string_equal(name, "/")) type = Built_In_Division;
else if (string_equal(name, "=")) type = Built_In_Equal;
else if (string_equal(name, ">")) type = Built_In_Greater;
else if (string_equal(name, ">=")) type = Built_In_Greater_Equal;
else if (string_equal(name, "<")) type = Built_In_Less;
else if (string_equal(name, "<=")) type = Built_In_Less_Equal;
else if (string_equal(name, "if")) type = Built_In_If;
else if (string_equal(name, "and")) type = Built_In_And;
else if (string_equal(name, "or")) type = Built_In_Or;
else if (string_equal(name, "not")) type = Built_In_Not;
else if (string_equal(name, "pair")) type = Built_In_Pair;
else if (string_equal(name, "first")) type = Built_In_First;
else if (string_equal(name, "rest")) type = Built_In_Rest;
else if (string_equal(name, "load")) type = Built_In_Load;
else if (string_equal(name, "let")) type = Built_In_Let;
else if (string_equal(name, "define")) type = Built_In_Define;
else if (string_equal(name, "macro-define")) type = Built_In_Macro_Define;
else if (string_equal(name, "breakpoint")) type = Built_In_Breakpoint;
else if (string_equal(name, "mutate")) type = Built_In_Mutate;
else if (string_equal(name, "lambda")) type = Built_In_Lambda;
else if (string_equal(name, "macro")) type = Built_In_Macro;
else if (string_equal(name, "eval")) type = Built_In_Eval;
else if (string_equal(name, "quote")) type = Built_In_Quote;
else if (string_equal(name, "prog")) type = Built_In_Prog;
else if (string_equal(name, "list")) type = Built_In_List;
else if (string_equal(name, "print")) type = Built_In_Print;
else if (string_equal(name, "read")) type = Built_In_Read;
else if (string_equal(name, "info")) type = Built_In_Info;
else if (string_equal(name, "type")) type = Built_In_Type;
else if (string_equal(name, "exit")) type = Built_In_Exit;
else return nullptr;
Ast_Node* node = new(Ast_Node);
src/built_ins.c
+72
View File
@@ -56,6 +56,78 @@ Ast_Node* built_in_equals(Ast_Node* operands) {
return create_ast_node_number(1);
}
Ast_Node* built_in_greater(Ast_Node* operands) {
double last_number = strtod("Inf", NULL);
while (operands->type == Ast_Node_Type_Pair) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}
if (operands->value.pair->first->value.number->value >= last_number)
return create_ast_node_nil();
last_number = operands->value.pair->first->value.number->value;
operands = operands->value.pair->rest;
}
return create_ast_node_number(1);
}
Ast_Node* built_in_greater_equal(Ast_Node* operands) {
double last_number = strtod("Inf", NULL);
while (operands->type == Ast_Node_Type_Pair) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}
if (operands->value.pair->first->value.number->value > last_number)
return create_ast_node_nil();
last_number = operands->value.pair->first->value.number->value;
operands = operands->value.pair->rest;
}
return create_ast_node_number(1);
}
Ast_Node* built_in_less(Ast_Node* operands) {
double last_number = strtod("-Inf", NULL);
while (operands->type == Ast_Node_Type_Pair) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}
if (operands->value.pair->first->value.number->value <= last_number)
return create_ast_node_nil();
last_number = operands->value.pair->first->value.number->value;
operands = operands->value.pair->rest;
}
return create_ast_node_number(1);
}
Ast_Node* built_in_less_equal(Ast_Node* operands) {
double last_number = strtod("-Inf", NULL);
while (operands->type == Ast_Node_Type_Pair) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}
if (operands->value.pair->first->value.number->value < last_number)
return create_ast_node_nil();
last_number = operands->value.pair->first->value.number->value;
operands = operands->value.pair->rest;
}
return create_ast_node_number(1);
}
Ast_Node* built_in_add(Ast_Node* operands) {
double sum = 0;
while (operands->type == Ast_Node_Type_Pair) {
src/env.c
+123 -10
View File
@@ -1,6 +1,13 @@
typedef enum {
Environment_Type_Let,
Environment_Type_Lambda,
Environment_Type_Macro,
} Environment_Type;
struct Environment {
struct Environment* parent;
Environment_Type type;
int capacity;
int next_index;
// TODO(Felix): Use a hashmap here.
@@ -10,12 +17,12 @@ struct Environment {
typedef struct Environment Environment;
Environment* create_child_environment(Environment* parent) {
Environment* create_child_environment(Environment* parent, Environment_Type type) {
Environment* env = new(Environment);
int start_capacity = 16;
env->type = type;
env->parent = parent;
env->capacity = start_capacity;
env->next_index = 0;
@@ -25,11 +32,20 @@ Environment* create_child_environment(Environment* parent) {
return env;
}
Environment* create_empty_environment() {
return create_child_environment(nullptr);
Environment* create_empty_environment(Environment_Type type) {
return create_child_environment(nullptr, type);
}
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
@@ -47,19 +63,116 @@ void define_symbol(Ast_Node* symbol, Ast_Node* value, Environment* env) {
++env->next_index;
}
Ast_Node* lookup_symbol(Symbol* sym, Environment* env) {
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);
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) {
for (int i = env->next_index - 1; i >= 0; --i)
if (string_equal(env->keys[i], sym->identifier))
return env->values[i];
return nullptr;
}
if (env->parent)
return lookup_symbol(sym, env->parent);
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* built_in = create_ast_node_built_in_function(sym->identifier);
if (built_in)
return built_in;
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(Symbol* sym, Environment* env) {
// first check current environment
Ast_Node* result;
result = lookup_symbol_in_this_envt(sym, env);
if (result)
return result;
if (env->parent) {
if (env->type == Environment_Type_Lambda) {
result = lookup_symbol_from_lambda_env(sym, env->parent);
} else {
result = lookup_symbol_from_let_or_macro_env(sym, env->parent);
}
if (result)
return result;
}
result = create_ast_node_built_in_function(sym->identifier);
if (result)
return result;
create_error(Error_Type_Symbol_Not_Defined, create_ast_node_nil());
printf("%s\n", sym->identifier);
return nullptr;
}
void print_indent(int indent) {
for (int i = 0; i < indent; ++i) {
printf(" ");
}
}
void print_environment_indent(Environment* env, int indent) {
for (int i = 0; i < env->next_index; ++i) {
print_indent(indent);
printf("%s -> ", env->keys[i]);
print(env->values[i]);
printf("\n");
}
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);
}
}
void print_environment(Environment* env) {
printf("\n=== Environment ===\n");
print_environment_indent(env, 0);
}
src/eval.c
+120 -6
View File
@@ -1,7 +1,12 @@
Ast_Node* eval_expr(Ast_Node* node, Environment* env);
Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function, Environment* parent) {
Environment* new_env = create_child_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);
// positional arguments
for (int i = 0; i < function->positional_arguments->next_index; ++i) {
@@ -137,10 +142,16 @@ 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
if (function->is_macro)
new_env->type = Environment_Type_Macro;
try {
result = eval_expr(function->body, new_env);
}
free(new_env);
return result;
}
@@ -392,6 +403,13 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) {
// check for special form
if (operator->type == Ast_Node_Type_Built_In_Function) {
switch (operator->value.built_in_function->type) {
case Built_In_Breakpoint: {
print_environment(env);
#ifdef _DEBUG
__debugbreak();
#endif
return create_ast_node_nil();
}
case Built_In_Macro:
case Built_In_Lambda: {
/*
@@ -420,6 +438,10 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) {
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;
@@ -440,6 +462,63 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) {
ret->value.function = function;
return ret;
}
case Built_In_Let: {
// (let ((a 10)(b 20)) (body1) (body2))
try {
arguments_length = list_length(arguments);
}
if (arguments_length < 1)
report_error(Error_Type_Wrong_Number_Of_Arguments);
Environment* let_env = create_child_environment(env, Environment_Type_Let);
Ast_Node* bindings = arguments->value.pair->first;
while (true) {
if (bindings->type == Ast_Node_Type_Nil) {
break;
} else if (bindings->type != Ast_Node_Type_Pair) {
report_error(Error_Type_Ill_Formed_Arguments);
}
Ast_Node* sym = bindings->value.pair->first->value.pair->first;
if(sym->type != Ast_Node_Type_Symbol) {
report_error(Error_Type_Ill_Formed_Arguments);
}
Ast_Node* rest_sym = bindings->value.pair->first->value.pair->rest;
if (rest_sym->type != Ast_Node_Type_Pair) {
report_error(Error_Type_Ill_Formed_Arguments);
}
if (rest_sym->value.pair->rest->type != Ast_Node_Type_Nil) {
report_error(Error_Type_Ill_Formed_Arguments);
}
Ast_Node* value = rest_sym->value.pair->first;
define_symbol(sym, value, let_env);
bindings = bindings->value.pair->rest;
}
arguments = arguments->value.pair->rest;
Ast_Node* evaluated_arguments;
try {
evaluated_arguments = eval_arguments(arguments, let_env, &arguments_length);
}
if (evaluated_arguments->type == Ast_Node_Type_Nil)
return evaluated_arguments;
// skip to the last evaluated operand and return it,
// we use eval_arguments here instead of doing it
// manually, because we want to increase code reuse,
// but at the cost that we have to find the end of the
// list again
while (evaluated_arguments->value.pair->rest->type == Ast_Node_Type_Pair) {
evaluated_arguments = evaluated_arguments->value.pair->rest;
}
return evaluated_arguments->value.pair->first;
}
case Built_In_And: {
bool result = true;
while (arguments->type != Ast_Node_Type_Nil) {
@@ -522,6 +601,7 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) {
}
return arguments->value.pair->first;
}
case Built_In_Macro_Define:
case Built_In_Define: {
try {
arguments_length = list_length(arguments);
@@ -531,15 +611,32 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) {
}
Ast_Node* symbol = arguments->value.pair->first;
if (symbol->type != Ast_Node_Type_Symbol)
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;
/* print(value); */
try {
value = eval_expr(value, env);
}
/* print(value); */
define_symbol(symbol, value, env);
if (operator->value.built_in_function->type == Built_In_Macro_Define) {
/* printf("Defining %s in the macro env to be ", symbol->value.symbol->identifier); */
/* print(value); */
define_macro_symbol(symbol, value, env);
}
else
define_symbol(symbol, value, env);
return value;
}
@@ -569,6 +666,18 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) {
case Built_In_Equal: {
return built_in_equals(evaluated_arguments);
}
case Built_In_Greater: {
return built_in_greater(evaluated_arguments);
}
case Built_In_Greater_Equal: {
return built_in_greater_equal(evaluated_arguments);
}
case Built_In_Less: {
return built_in_less(evaluated_arguments);
}
case Built_In_Less_Equal: {
return built_in_less_equal(evaluated_arguments);
}
case Built_In_Mutate: {
if (arguments_length != 2)
report_error(Error_Type_Wrong_Number_Of_Arguments);
@@ -685,7 +794,11 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) {
Ast_Node_Type type = evaluated_arguments->value.pair->first->type;
switch (type) {
case Ast_Node_Type_Built_In_Function: return create_ast_node_keyword("built-in-function");
case Ast_Node_Type_Function: return create_ast_node_keyword("dynamic-function");
case Ast_Node_Type_Function: {
if (evaluated_arguments->value.pair->first->value.function->is_macro)
return create_ast_node_keyword("dynamic-macro");
return create_ast_node_keyword("dynamic-function");
}
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_Number: return create_ast_node_keyword("number");
@@ -715,8 +828,6 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) {
}
// assume it's lambda function and evaluate the arguments
if (operator->type == Ast_Node_Type_Function) {
if (!operator->value.function->is_macro) {
try {
@@ -732,6 +843,9 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) {
}
}
default: {
#ifdef _DEBUG
__debugbreak();
#endif
report_error(Error_Type_Not_A_Function);
}
}
src/helpers.c
+2 -1
View File
@@ -103,7 +103,8 @@ char* read_entire_file (char* filename) {
/* Read the entire file into memory. */
size_t newLen = fread(fileContent, sizeof(char), bufsize, fp);
/* fileContent[bufsize-5] = '\0'; */
fileContent[newLen] = '\0';
if ( ferror( fp ) != 0 ) {
fputs("Error reading file", stderr);
}
src/io.c
+4 -2
View File
@@ -68,8 +68,10 @@ void print(Ast_Node* node) {
printf(":%s", node->value.keyword->identifier);
} break;
case (Ast_Node_Type_Function): {
printf("[lambda]");
/* print(node->value.function->body); */
if (node->value.function->is_macro)
printf("[macro]");
else
printf("[lambda]");
} break;
case (Ast_Node_Type_Built_In_Function): {
printf("[built-in-function %s]", Built_In_Name_to_string(node->value.built_in_function->type));
src/main.c
+2 -2
View File
@@ -23,7 +23,7 @@ int interprete_file (char* file_content) {
log_error();
return 1;
}
Environment* env = create_empty_environment();
Environment* env = create_empty_environment(Environment_Type_Let);
built_in_load("pre.slime", env);
if (error) {
@@ -46,7 +46,7 @@ int interprete_file (char* file_content) {
int interprete_stdin () {
printf("Welcome to the lispy interpreter.\n");
char* line;
Environment* env = create_empty_environment();
Environment* env = create_empty_environment(Environment_Type_Let);
built_in_load("pre.slime", env);
if (error) {
src/parse.c
+6 -2
View File
@@ -27,6 +27,7 @@ void eat_comment_line(char* text, int* index_in_text) {
do {
++(*index_in_text);
} while (text[(*index_in_text)] != '\n' &&
text[(*index_in_text)] != '\r' &&
text[(*index_in_text)] != '\0');
}
@@ -34,7 +35,8 @@ 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)] == '\n' ||
text[(*index_in_text)] == '\r') {
++(*index_in_text);
}
}
@@ -55,6 +57,7 @@ char* read_atom(char* text, int* index_in_text) {
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;
@@ -269,7 +272,8 @@ Ast_Node_Array_List* parse_program(char* text) {
case ';':
case ' ':
case '\t':
case '\n': {
case '\n':
case '\r': {
eat_until_code(text, &index_in_text);
} break;
default:
src/testing.c
+13 -13
View File
@@ -83,7 +83,7 @@ testresult test_eval_operands() {
char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))";
Ast_Node* operands = parse_single_expression(operands_string);
int operands_length;
operands = eval_arguments(operands, create_empty_environment(), &operands_length);
operands = eval_arguments(operands, create_empty_environment(Environment_Type_Let), &operands_length);
assert_no_error(error);
assert_equal_int(list_length(operands), 4);
@@ -227,7 +227,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* result = eval_expr(expression, create_empty_environment());
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
assert_no_error(error);
assert_not_null(result);
@@ -240,7 +240,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* result = eval_expr(expression, create_empty_environment());
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
assert_no_error(error);
assert_not_null(result);
@@ -254,7 +254,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* result = eval_expr(expression, create_empty_environment());
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
assert_no_error(error);
assert_not_null(result);
@@ -268,7 +268,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* result = eval_expr(expression, create_empty_environment());
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
assert_null(error);
assert_not_null(result);
@@ -282,7 +282,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* result = eval_expr(expression, create_empty_environment());
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
assert_no_error(error);
assert_not_null(result);
@@ -291,7 +291,7 @@ testresult test_built_in_if() {
char exp_string2[] = "(if () 4 5)";
expression = parse_single_expression(exp_string2);
result = eval_expr(expression, create_empty_environment());
result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
assert_no_error(error);
assert_not_null(result);
@@ -304,7 +304,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* result = eval_expr(expression, create_empty_environment());
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
assert_no_error(error);
assert_not_null(result);
@@ -314,7 +314,7 @@ testresult test_built_in_and() {
// a false case
char exp_string2[] = "(and () \"asd\" 4)";
expression = parse_single_expression(exp_string2);
result = eval_expr(expression, create_empty_environment());
result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
assert_no_error(error);
assert_not_null(result);
@@ -326,7 +326,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* result = eval_expr(expression, create_empty_environment());
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
assert_no_error(error);
assert_not_null(result);
@@ -336,7 +336,7 @@ testresult test_built_in_or() {
// a false case
char exp_string2[] = "(or () ())";
expression = parse_single_expression(exp_string2);
result = eval_expr(expression, create_empty_environment());
result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
assert_no_error(error);
assert_not_null(result);
@@ -349,7 +349,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* result = eval_expr(expression, create_empty_environment());
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
// a true case
assert_no_error(error);
@@ -360,7 +360,7 @@ testresult test_built_in_not() {
// a false case
char exp_string2[] = "(not \"asd xD\")";
expression = parse_single_expression(exp_string2);
result = eval_expr(expression, create_empty_environment());
result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
assert_no_error(error);
assert_not_null(result);
todo.org
+162 -10
View File
@@ -1,3 +1,139 @@
* Issues
** DONE #001
CLOSED: [2018-10-26 Fr 22:36]
#+begin_src lisp
(define seq (list 1 2 3))
(when 1 (printf seq))
#+end_src
The problem is, that =when= calls =apply= and the params of =apply= are named =fun= and =seq=. So
when we refer to seq in =printf= then we are refering to the =apply='s argument names. Maybe a good
solution to that is, that a child environment can never look up something in a parent macro
environment, but will always pass through
| stack depth | is macro environment | defined symbols | scope |
|-------------+----------------------+--------------------------+---------------------|
| 0 | no | seq nil printf apply etc | |
| 1 | yes | test body | (when 1 printf seq) |
| 2 | yes | fun seq | (apply prog body) |
| 3 | no | | (printf seq) |
** DONE #002
CLOSED: [2018-10-27 Sa 13:50]
#+begin_src lisp
(define l (list 1 2 3))
(extend l 4)
;; === Environment ===
;; current: in (apply)
;; fun -> prog
;; seq -> body
;; parent (hidden): in (when)
;; test -> (pair? seq)
;; body -> ((define e (end seq)) (mutate e (pair (first e) elem)))
;; parent: in (extend)
;; seq -> (1.000000 2.000000 3.000000)
;; elem -> 4.000000
;; parent: (top level)
;; nil -> nil
;; defun -> [macro]
;; defmacro -> [macro]
;; pe -> [macro]
;; nil? -> [lambda]
;; number? -> [lambda]
;; symbol? -> [lambda]
;; keyword? -> [lambda]
;; pair? -> [lambda]
;; string? -> [lambda]
;; dynamic-function? -> [lambda]
;; dynamic-macro? -> [lambda]
;; built-in-function? -> [lambda]
;; apply -> [macro]
;; when -> [macro]
;; unless -> [macro]
;; end -> [lambda]
;; last -> [lambda]
;; extend -> [lambda]
;; append -> [lambda]
;; n-times -> [macro]
;; range -> [lambda]
;; map -> [lambda]
;; reduce -> [lambda]
;; reduce-binary -> [lambda]
;; filter -> [lambda]
;; printf-quoted -> [macro]
;; printf -> [lambda]
;; l -> (1.000000 2.000000 3.000000)
;; M (apply fun -> prog seq -> body)
;; M (when test -> (pair? seq) body -> ((define e (end seq)) (mutate e (pair (first e) elem))))
;; (extend seq -> (1.000000 2.000000 3.000000) elem -> 4.000000)
#+end_src
The problem is that a funciton g called by a function f has access to the environment of f. This is
a real problem.
#+begin_src lisp
(defun f () 1)
(defun g () (f))
(defun h (f) (g))
(h 4)
#+end_src
What *should* happen:
- (h 1) calls (g)
- (g) calls (f)
- (f) retunrs 1
What *actually* happens:
- (h 1) calls (g)
- (g) tries to call (f) but f is not a funciton but =4=
** DONE #003
CLOSED: [2018-10-27 Sa 15:22]
#+begin_src lisp
(defmacro n-times (times action)
(unless (<= (eval times) 0)
(breakpoint)
(eval action)
(macro-define args (pair (pair - (pair (eval times) (pair 1 nil))) (pair action nil)))
;; [o|o] --------------------------> [o|o] -> nil
;; | |
;; V V
;; [o|o] -> [o|o] -> [o|o]-> nil action
;; | | |
;; V V V
;; - times 1
(eval (pair n-times args))))
#+end_src
- *let* should never have access to parenting macro because =(while 2 test) -> 2.00000=
- Should it have access to the grandad macro?
- no, =(when 2 (when 3 test)) -> 2=
- in the example, =n-times= is a macro, that calls =unless=, that itself is a macro that calls the
content of =n-times= in a let. So of course the contents of =n-times= wont have acess to the
parameters to =n-times=, which is bad.
So right now the only way I see to fix this is to make maco environments accessable again, but pay
attention on how to name macro parameters, to avoid collision, maybe a naming convention would help,
maybe prefix with =@=
*** Solutions:
First instinct to prevent that, is that if a parent environment is a function then just pass it and
go for their parent etc. Then we need =let= of a way to create environments that are neither macro-
nor funciton environmetns. They will be still different though.
*** Defining
In a macro environment define will still behave differently than in a function environment. If you
use =define= in a macro environment, it will actually be defined in the closest non-macro
environment. If you actually want to define something in a macro environment, then use
=macro-define=. However =define= will do the same if you are in a function or let environment.
*** Looking up
If the symbol is found on the active environment then use it. If not: Go up the environments untily
ou find a let-environment and recurse on that.
* Arguments
In Emacs lisp, keyword arguments must be passed in the same order as they were
@@ -191,13 +327,23 @@ set to see if we are in an errornious state.
Ast_Node_array_list body;
} lambda;
#+end_src
* TODO =assert_equal_type= macro in testing
* DONE use an enum for builtin identifiers
CLOSED: [2018-10-11 Do 17:15]
* TODO dont create new nils or builtins, but store one of each globally
* TODO source code locations for errors
* Build-in forms
* TODO =assert_equal_type= macro in testing
* TODO =t= ast node type, universal source of truth
* TODO backquoting
* TODO dont create new nils or builtins, but store one of each globally
* TODO make keywords unique (binary tree)
* TODO store all ast nodes in a huge arena
* TODO source code locations for errors
* TODO String error messages
* TODO Rename macro to =special= or something
* Build-in forms [29/30]
** TODO info
** DONE let
CLOSED: [2018-10-27 Sa 15:30]
** DONE +
CLOSED: [2018-09-18 Di 12:14]
** DONE -
@@ -206,8 +352,14 @@ set to see if we are in an errornious state.
CLOSED: [2018-09-18 Di 12:14]
** DONE /
CLOSED: [2018-09-18 Di 12:14]
** TODO >
** TODO <
** DONE >
CLOSED: [2018-10-26 Fr 23:30]
** DONE >=
CLOSED: [2018-10-26 Fr 23:30]
** DONE <
CLOSED: [2018-10-26 Fr 23:30]
** DONE >=
CLOSED: [2018-10-26 Fr 23:30]
** DONE =
CLOSED: [2018-10-21 So 00:25]
** DONE if
@@ -239,10 +391,12 @@ set to see if we are in an errornious state.
CLOSED: [2018-10-21 So 00:25]
** DONE define
CLOSED: [2018-10-08 Mo 20:28]
** TODO mutateW
** DONE mutate
CLOSED: [2018-10-25 Do 19:40]
** DONE lambda
CLOSED: [2018-10-21 So 00:25]
** TODO macro
** DONE macro
CLOSED: [2018-10-25 Do 19:40]
** DONE prog
CLOSED: [2018-10-21 So 00:25]
** DONE eval
@@ -279,5 +433,3 @@ set to see if we are in an errornious state.
CLOSED: [2018-10-08 Mo 20:28]
** DONE type
CLOSED: [2018-10-08 Mo 21:30]
** TODO info