Archived
1
0
Fork 0

Implemented lambda functions

This commit is contained in:
Brandon Rozek 2018-06-10 11:58:29 -04:00
parent 762e41a1f7
commit e6924523cf
4 changed files with 132 additions and 41 deletions

View file

@ -6,6 +6,7 @@
lenv* lenv_new(void) { lenv* lenv_new(void) {
lenv* e = (lenv*) malloc(sizeof(lenv)); lenv* e = (lenv*) malloc(sizeof(lenv));
e->par = NULL;
e->count = 0; e->count = 0;
e->syms = NULL; e->syms = NULL;
e->vals = NULL; e->vals = NULL;
@ -23,12 +24,13 @@ void lenv_del(lenv* e) {
} }
lenv* lenv_copy(lenv* e) { lenv* lenv_copy(lenv* e) {
lenv* n = malloc(sizeof(lenv)); lenv* n = (lenv*) malloc(sizeof(lenv));
n->par = e->par;
n->count = e->count; n->count = e->count;
n->syms = malloc(sizeof(char*) * n->count); n->syms = (char**) malloc(sizeof(char*) * n->count);
n->vals = malloc(sizeof(lval*) * n->count); n->vals = (lval**) malloc(sizeof(lval*) * n->count);
for (int i = 0; i < e->count; i++) { for (int i = 0; i < e->count; i++) {
n->syms[i] = malloc(strlen(e->syms[i]) + 1); n->syms[i] = (char*) malloc(strlen(e->syms[i]) + 1);
strcpy(n->syms[i], e->syms[i]); strcpy(n->syms[i], e->syms[i]);
n->vals[i] = lval_copy(e->vals[i]); n->vals[i] = lval_copy(e->vals[i]);
} }
@ -45,7 +47,12 @@ lval* lenv_get(lenv* e, lval* k) {
} }
} }
// If no symbol found return error // If no symbol found so far, check in parent
if (e->par) {
return lenv_get(e->par, k);
}
// If no symbol found and no parent, return error
return lval_err("Unbounded symbol %s", k->sym); return lval_err("Unbounded symbol %s", k->sym);
} }
@ -73,7 +80,15 @@ void lenv_put(lenv* e, lval* k, lval* v) {
strcpy(e->syms[e->count - 1], k->sym); strcpy(e->syms[e->count - 1], k->sym);
} }
lval* lval_fun(lbuiltin func) { void lenv_def(lenv* e, lval* k, lval* v) {
// Iterate until e has no parent
while (e->par) { e = e->par; }
// Put the value in e
lenv_put(e, k, v);
}
lval* lval_builtin(lbuiltin func) {
lval* v = malloc(sizeof(lval)); lval* v = malloc(sizeof(lval));
v->type = LVAL_FUN; v->type = LVAL_FUN;
v->builtin = func; v->builtin = func;
@ -82,7 +97,7 @@ lval* lval_fun(lbuiltin func) {
void lenv_add_builtin(lenv* e, char* name, lbuiltin func) { void lenv_add_builtin(lenv* e, char* name, lbuiltin func) {
lval* k = lval_sym(name); lval* k = lval_sym(name);
lval* v = lval_fun(func); lval* v = lval_builtin(func);
lenv_put(e, k, v); lenv_put(e, k, v);
lval_del(k); lval_del(v); lval_del(k); lval_del(v);
} }
@ -108,35 +123,11 @@ void lenv_add_builtins(lenv* e) {
lenv_add_builtin(e, "max", builtin_max); lenv_add_builtin(e, "max", builtin_max);
lenv_add_builtin(e, "def", builtin_def); lenv_add_builtin(e, "def", builtin_def);
lenv_add_builtin(e, "=", builtin_put);
lenv_add_builtin(e, "ls", builtin_ls); lenv_add_builtin(e, "ls", builtin_ls);
lenv_add_builtin(e, "\\", builtin_lambda); lenv_add_builtin(e, "\\", builtin_lambda);
} }
lval* builtin_def(lenv* e, lval* a) {
LASSERT_TYPE("def", a, 0, LVAL_QEXPR)
// First argument is the symbol list
lval* syms = a->cell[0];
// Ensure all elements of the first list are symbols
for (int i = 0; i < syms->count; i++) {
LASSERT(a, syms->cell[i]->type == LVAL_SYM,
"Function 'def' cannot define non-symbol")
}
// Check correct number of symbols and values
LASSERT(a, syms->count == a->count - 1,
"Function 'def' cannot define incorrect number of values to symbols. Left side %i, right side %i", syms->count, a->count - 1)
// Assign copies of values to symbols
for (int i = 0; i < syms->count; i++) {
lenv_put(e, syms->cell[i], a->cell[i + 1]);
}
lval_del(a);
return lval_sexpr();
}
lval* builtin_ls(lenv* e, lval* a) { lval* builtin_ls(lenv* e, lval* a) {
LASSERT_NUM("ls", a, 0) LASSERT_NUM("ls", a, 0)
@ -185,3 +176,89 @@ lval* builtin_lambda(lenv* e, lval* a) {
return lval_lambda(formals, body); return lval_lambda(formals, body);
} }
lval* builtin_var(lenv* e, lval* a, char* func) {
LASSERT_TYPE(func, a, 0, LVAL_QEXPR)
lval* syms = a->cell[0];
for (int i = 0; i < syms->count; i++) {
LASSERT(a, (syms->cell[i]->type == LVAL_SYM),
"Function '%s' cannot define non-symbol. "
"Got %s, Expected %s.", func,
ltype_name(syms->cell[i]->type),
ltype_name(LVAL_SYM))
}
LASSERT(a, (syms->count == a->count-1),
"Function '%s' passed too many arguments for symbols. "
"Got %i, Expected %i.", func, syms->count, a->count-1)
for (int i = 0; i < syms->count; i++) {
// If 'def' define it globally
if (strcmp(func, "def") == 0) {
lenv_def(e, syms->cell[i], a->cell[i + 1]);
}
// If 'put' define it locally
if (strcmp(func, "=") == 0) {
lenv_put(e, syms->cell[i], a->cell[i + 1]);
}
}
lval_del(a);
return lval_sexpr();
}
lval* builtin_def(lenv* e, lval* a) {
return builtin_var(e, a, "def");
}
lval* builtin_put(lenv* e, lval* a) {
return builtin_var(e, a, "=");
}
lval* lval_call(lenv* e, lval* f, lval* a) {
// If builtin simply apply that
if (f->builtin) { return f->builtin(e, a); }
// Record argument counts
int given = a->count;
int total = f->formals->count;
// // While arguments still remain to be processed
while (a->count) {
// If we've run out of formal arguments..
if (f->formals->count == 0) {
lval_del(a);
return lval_err("Function passed too many arguments. "
"Got %i, Expected %i.", given, total);
}
// Pop the first symbol from the formals
lval* sym = lval_pop(f->formals, 0);
// Pop the next argument from the list
lval* val = lval_pop(a, 0);
// Bind a copy into the function's environment
lenv_put(f->env, sym, val);
// Delete the symbol and value
lval_del(sym); lval_del(val);
}
// The argument list is now bounded so we can clean up the given
lval_del(a);
// If all formals have been bounded evaluate
if (f->formals->count == 0) {
// Set environment parent to evaluation environment
f->env->par = e;
// Evaluate and return
return builtin_eval(
f->env, lval_add(lval_sexpr(), lval_copy(f->body)));
} else {
// Otherwise return partially evaluated function
return lval_copy(f);
}
return lval_sexpr();
}

View file

@ -3,6 +3,8 @@
#include "base.h" #include "base.h"
struct lenv { struct lenv {
// Represents the parent environment
lenv* par;
int count; int count;
char** syms; char** syms;
lval** vals; lval** vals;
@ -10,13 +12,16 @@ struct lenv {
lenv* lenv_new(void); lenv* lenv_new(void);
void lenv_del(lenv* e); void lenv_del(lenv* e);
lenv* lenv_copy(lenv* e);
// Obtain a variable from the environment // Obtain a variable from the environment
// e is the environment // e is the environment
// k is the symbol // k is the symbol
lval* lenv_get(lenv* e, lval* k); lval* lenv_get(lenv* e, lval* k);
void lenv_put(lenv* e, lval* k, lval* v); void lenv_put(lenv* e, lval* k, lval* v);
void lenv_def(lenv* e, lval* k, lval* v);
lval* lval_fun(lbuiltin func); lval* lval_builtin(lbuiltin func);
void lenv_add_builtin(lenv* e, char* name, lbuiltin func); void lenv_add_builtin(lenv* e, char* name, lbuiltin func);
void lenv_add_builtins(lenv* e); void lenv_add_builtins(lenv* e);
@ -24,6 +29,10 @@ void lenv_add_builtins(lenv* e);
lval* builtin_def(lenv* e, lval* a); lval* builtin_def(lenv* e, lval* a);
lval* builtin_ls(lenv* e, lval* a); lval* builtin_ls(lenv* e, lval* a);
lval* builtin_lambda(lenv* e, lval* a); lval* builtin_lambda(lenv* e, lval* a);
lval* builtin_def(lenv* e, lval* a);
lval* builtin_put(lenv* e, lval* a);
lval* builtin_var(lenv* e, lval* a, char* func);
lval* lval_call(lenv* e, lval* f, lval* a);
#endif #endif

View file

@ -3,6 +3,7 @@
#include <stdlib.h> #include <stdlib.h>
#include "expressions.h" #include "expressions.h"
#include "environment.h"
#include "numbers.h" #include "numbers.h"
#include "operations.h" #include "operations.h"
#include "error.h" #include "error.h"
@ -85,17 +86,20 @@ lval* lval_eval_sexpr(lenv* e, lval* v) {
if (v->count == 0) { return v; } if (v->count == 0) { return v; }
// Single expression // Single expression
if (v->count == 1) { return lval_take(v, 0); } if (v->count == 1) { return lval_eval(e, lval_take(v, 0)); }
// Ensure first element is a symbol otherwise // Ensure first element is a symbol otherwise
lval* f = lval_pop(v, 0); lval* f = lval_pop(v, 0);
if (f->type != LVAL_FUN) { if (f->type != LVAL_FUN) {
lval* err = lval_err(
"S-Experssion starts with incorrect type. "
"Got %s, Expected %s.",
ltype_name(f->type), ltype_name(LVAL_FUN));
lval_del(f); lval_del(v); lval_del(f); lval_del(v);
return lval_err("S-expression does not start with function"); return err;
} }
// If so call the function and return result // If so call the function and return result
lval* result = f->builtin(e, v); lval* result = lval_call(e, f, v);
lval_del(f); lval_del(f);
return result; return result;
} }

View file

@ -3,6 +3,7 @@
#include "numbers.h" #include "numbers.h"
#include "expressions.h" #include "expressions.h"
#include "operations.h" #include "operations.h"
#include "environment.h"
lval* builtin_op(lenv* e, lval* v, char* sym); lval* builtin_op(lenv* e, lval* v, char* sym);