Context#
Context (also known as environment in some of Lisp implementations) is association between symbols and their data values that apply to specific evaluation scope. This implementation provides single lexical context for evaluation of all names regarding of associated data type (also known as Lisp-1 namespaces).
Basic method of introducing new scope is function definition and application. During function definition, new function is associated with scope in which function itself is defined. Exact copy of current context as is in moment of definition is used as functions parent scope. During function application new context is created which inherit all associations that were available in parent scope.
Initial context, which is used as starting context, is initialized with associations to builtin functions and syntaxes.
Each context contains arbitrary number of mutable entries. Single entry defines association where any kind of data is referenced by symbol. Together with functions that add new entries (lsp_ctx_add) or obtain data associated with provided symbol (lsp_ctx_get), context enables modification of data referenced by provided symbol (lsp_ctx_set). During entry modification, previous data instance itself is not changed, only entry reference is modified to point to newly provided data instance. If child context modifies existing entry in parent context, this modifications will also be visible in parent context.
Because of support for tail call optimization, implementation of context hierarchy relies on lsp_ctx_copy operation instead of referencing parent context from child context. This method induces additional overhead in context operation. Never the less, additional memory allocation overhead is mostly neutralized by usage of immutable linked list as basis for entry storage.
Source code#
ctx.h#
#ifndef LISP16_CTX_H
#define LISP16_CTX_H
#include "mem.h"
lsp_status_t lsp_ctx_create(lsp_mem_t *m, lsp_addr_t *ctx);
lsp_status_t lsp_ctx_copy(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t *result);
lsp_status_t lsp_ctx_add(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol,
lsp_addr_t value);
lsp_status_t lsp_ctx_set(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol,
lsp_addr_t value);
lsp_status_t lsp_ctx_get(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol,
lsp_addr_t *value);
#endif
ctx.c#
#include "ctx.h"
#include "function.h"
#include "syntax.h"
static lsp_bool_t contains_symbol(lsp_mem_t *m, lsp_addr_t ctx,
lsp_addr_t symbol) {
while (ctx != m->nil) {
lsp_addr_t entry = lsp_mem_get_pair_first(m, ctx);
lsp_addr_t entry_symbol = lsp_mem_get_pair_first(m, entry);
if (lsp_mem_eq(m, entry_symbol, symbol))
return true;
ctx = lsp_mem_get_pair_second(m, ctx);
}
return false;
}
static lsp_status_t remove_symbol(lsp_mem_t *m, lsp_addr_t ctx,
lsp_addr_t symbol) {
lsp_addr_t list = lsp_mem_get_pair_first(m, ctx);
lsp_addr_t result = m->nil;
lsp_addr_t result_last = m->nil;
lsp_status_t status = LSP_SUCCESS;
while (list != m->nil) {
lsp_addr_t entry = lsp_mem_get_pair_first(m, list);
lsp_addr_t entry_symbol = lsp_mem_get_pair_first(m, entry);
list = lsp_mem_get_pair_second(m, list);
if (lsp_mem_eq(m, entry_symbol, symbol)) {
if (result == m->nil) {
result = list;
status = lsp_mem_inc_ref(m, list);
} else {
lsp_mem_set_pair_second(m, result_last, list);
}
break;
}
lsp_addr_t new_result_last;
status = lsp_mem_create_pair(m, entry, m->nil, &new_result_last);
if (status != LSP_SUCCESS)
break;
if (result == m->nil) {
result = new_result_last;
} else {
lsp_mem_set_pair_second(m, result_last, new_result_last);
lsp_mem_dec_ref(m, new_result_last);
}
result_last = new_result_last;
}
if (status == LSP_SUCCESS)
lsp_mem_set_pair_first(m, ctx, result);
lsp_mem_dec_ref(m, result);
return status;
}
lsp_status_t lsp_ctx_create(lsp_mem_t *m, lsp_addr_t *ctx) {
lsp_addr_t list = m->nil;
lsp_addr_t list_last = m->nil;
lsp_status_t status = LSP_SUCCESS;
for (uint8_t i = 0; status == LSP_SUCCESS && lsp_syntaxes[i].name; ++i) {
lsp_addr_t symbol;
status =
lsp_mem_create_symbol_from_char(m, lsp_syntaxes[i].name, &symbol);
if (status != LSP_SUCCESS)
break;
lsp_addr_t value;
status = lsp_mem_create_builtin_syntax(m, i, &value);
if (status != LSP_SUCCESS) {
lsp_mem_dec_ref(m, symbol);
break;
}
lsp_addr_t entry;
status = lsp_mem_create_pair(m, symbol, value, &entry);
lsp_mem_dec_ref(m, symbol);
lsp_mem_dec_ref(m, value);
if (status != LSP_SUCCESS)
break;
lsp_addr_t new_list_last;
status = lsp_mem_create_pair(m, entry, m->nil, &new_list_last);
lsp_mem_dec_ref(m, entry);
if (status != LSP_SUCCESS)
break;
if (list == m->nil) {
list = new_list_last;
} else {
lsp_mem_set_pair_second(m, list_last, new_list_last);
lsp_mem_dec_ref(m, new_list_last);
}
list_last = new_list_last;
}
for (uint8_t i = 0; status == LSP_SUCCESS && lsp_functions[i].name; ++i) {
lsp_addr_t symbol;
status =
lsp_mem_create_symbol_from_char(m, lsp_functions[i].name, &symbol);
if (status != LSP_SUCCESS)
break;
lsp_addr_t value;
status = lsp_mem_create_builtin_function(m, i, &value);
if (status != LSP_SUCCESS) {
lsp_mem_dec_ref(m, symbol);
break;
}
lsp_addr_t entry;
status = lsp_mem_create_pair(m, symbol, value, &entry);
lsp_mem_dec_ref(m, symbol);
lsp_mem_dec_ref(m, value);
if (status != LSP_SUCCESS)
break;
lsp_addr_t new_list_last;
status = lsp_mem_create_pair(m, entry, m->nil, &new_list_last);
lsp_mem_dec_ref(m, entry);
if (status != LSP_SUCCESS)
break;
if (list == m->nil) {
list = new_list_last;
} else {
lsp_mem_set_pair_second(m, list_last, new_list_last);
lsp_mem_dec_ref(m, new_list_last);
}
list_last = new_list_last;
}
if (status == LSP_SUCCESS)
status = lsp_mem_create_pair(m, list, m->nil, ctx);
lsp_mem_dec_ref(m, list);
return status;
}
lsp_status_t lsp_ctx_copy(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t *result) {
lsp_addr_t list = lsp_mem_get_pair_first(m, ctx);
return lsp_mem_create_pair(m, list, m->nil, result);
}
lsp_status_t lsp_ctx_add(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol,
lsp_addr_t value) {
lsp_status_t status;
if (contains_symbol(m, ctx, symbol)) {
status = remove_symbol(m, ctx, symbol);
if (status != LSP_SUCCESS)
return status;
}
lsp_addr_t list = lsp_mem_get_pair_first(m, ctx);
lsp_addr_t entry;
status = lsp_mem_create_pair(m, symbol, value, &entry);
if (status != LSP_SUCCESS)
return status;
status = lsp_mem_create_pair(m, entry, list, &list);
lsp_mem_dec_ref(m, entry);
if (status != LSP_SUCCESS)
return status;
lsp_mem_set_pair_first(m, ctx, list);
lsp_mem_dec_ref(m, list);
return LSP_SUCCESS;
}
lsp_status_t lsp_ctx_set(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol,
lsp_addr_t value) {
lsp_addr_t list = lsp_mem_get_pair_first(m, ctx);
while (list != m->nil) {
lsp_addr_t entry = lsp_mem_get_pair_first(m, list);
lsp_addr_t entry_symbol = lsp_mem_get_pair_first(m, entry);
if (lsp_mem_eq(m, symbol, entry_symbol)) {
lsp_mem_set_pair_second(m, entry, value);
return LSP_SUCCESS;
}
list = lsp_mem_get_pair_second(m, list);
}
return LSP_ERR_CTX;
}
lsp_status_t lsp_ctx_get(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol,
lsp_addr_t *value) {
lsp_addr_t list = lsp_mem_get_pair_first(m, ctx);
while (list != m->nil) {
lsp_addr_t entry = lsp_mem_get_pair_first(m, list);
lsp_addr_t entry_symbol = lsp_mem_get_pair_first(m, entry);
if (lsp_mem_eq(m, symbol, entry_symbol)) {
*value = lsp_mem_get_pair_second(m, entry);
return lsp_mem_inc_ref(m, *value);
}
list = lsp_mem_get_pair_second(m, list);
}
return LSP_ERR_CTX;
}