diff options
Diffstat (limited to 'src_c/syntax.c')
| -rw-r--r-- | src_c/syntax.c | 192 |
1 files changed, 192 insertions, 0 deletions
diff --git a/src_c/syntax.c b/src_c/syntax.c new file mode 100644 index 0000000..5ec6c7e --- /dev/null +++ b/src_c/syntax.c @@ -0,0 +1,192 @@ +#include "syntax.h" +#include "ctx.h" +#include "eval.h" + + +lsp_builtin_entry_t lsp_syntaxes[] = { + {"lambda", lsp_syntax_lambda}, {"syntax", lsp_syntax_syntax}, + {"define", lsp_syntax_define}, {"set!", lsp_syntax_set}, + {"begin", lsp_syntax_begin}, {"quote", lsp_syntax_quote}, + {"if", lsp_syntax_if}, {NULL, NULL}}; + + +lsp_status_t lsp_syntax_lambda(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + if (args == e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_addr_t fn_args = lsp_mem_get_pair_first(e->m, args); + lsp_addr_t fn_body = lsp_mem_get_pair_second(e->m, args); + + if (!lsp_mem_is_symbol(e->m, fn_args) && !lsp_mem_is_pair(e->m, fn_args)) + return LSP_ERR_ARG_TYPE; + + if (fn_body == e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_addr_t ctx_copy; + lsp_status_t status = lsp_ctx_copy(e->m, ctx, &ctx_copy); + if (status != LSP_SUCCESS) + return status; + + lsp_addr_t result; + status = lsp_mem_create_function(e->m, ctx_copy, fn_args, fn_body, &result); + lsp_mem_dec_ref(e->m, ctx_copy); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + +lsp_status_t lsp_syntax_syntax(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + if (args == e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_addr_t syntax_args = lsp_mem_get_pair_first(e->m, args); + lsp_addr_t syntax_body = lsp_mem_get_pair_second(e->m, args); + + if (!lsp_mem_is_symbol(e->m, syntax_args) && + !lsp_mem_is_pair(e->m, syntax_args)) + return LSP_ERR_ARG_TYPE; + + if (syntax_body == e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_addr_t ctx_copy; + lsp_status_t status = lsp_ctx_copy(e->m, ctx, &ctx_copy); + if (status != LSP_SUCCESS) + return status; + + lsp_addr_t result; + status = lsp_mem_create_syntax(e->m, ctx_copy, syntax_args, syntax_body, + &result); + lsp_mem_dec_ref(e->m, ctx_copy); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + +lsp_status_t lsp_syntax_define(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t symbol; + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &symbol, &value); + if (status != LSP_SUCCESS) + return status; + + if (!lsp_mem_is_symbol(e->m, symbol)) + return LSP_ERR_ARG_TYPE; + + status = lsp_env_resolve(e, ctx, value, &value); + if (status != LSP_SUCCESS) + return status; + + status = lsp_ctx_add(e->m, ctx, symbol, value); + lsp_mem_dec_ref(e->m, value); + if (status != LSP_SUCCESS) + return status; + + return lsp_env_set_result_value(e, e->m->nil); +} + + +lsp_status_t lsp_syntax_set(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t symbol; + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &symbol, &value); + if (status != LSP_SUCCESS) + return status; + + if (!lsp_mem_is_symbol(e->m, symbol)) + return LSP_ERR_ARG_TYPE; + + status = lsp_env_resolve(e, ctx, value, &value); + if (status != LSP_SUCCESS) + return status; + + status = lsp_ctx_set(e->m, ctx, symbol, value); + lsp_mem_dec_ref(e->m, value); + if (status != LSP_SUCCESS) + return status; + + return lsp_env_set_result_value(e, e->m->nil); +} + + +lsp_status_t lsp_syntax_begin(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + if (args == e->m->nil) + return LSP_ERR_ARG_COUNT; + + while (true) { + lsp_addr_t value = lsp_mem_get_pair_first(e->m, args); + lsp_addr_t next_args = lsp_mem_get_pair_second(e->m, args); + + if (next_args == e->m->nil) + return lsp_env_set_result_eval(e, ctx, value); + + lsp_status_t status = lsp_env_resolve(e, ctx, value, &value); + if (status != LSP_SUCCESS) + return status; + + lsp_mem_dec_ref(e->m, value); + args = next_args; + } +} + + +lsp_status_t lsp_syntax_quote(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value); + if (status != LSP_SUCCESS) + return status; + + return lsp_env_set_result_value(e, value); +} + + +lsp_status_t lsp_syntax_if(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + if (args == e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_addr_t test = lsp_mem_get_pair_first(e->m, args); + + args = lsp_mem_get_pair_second(e->m, args); + if (args == e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_addr_t true_value = lsp_mem_get_pair_first(e->m, args); + + lsp_addr_t false_value; + args = lsp_mem_get_pair_second(e->m, args); + if (args == e->m->nil) { + false_value = e->m->nil; + + } else { + false_value = lsp_mem_get_pair_first(e->m, args); + args = lsp_mem_get_pair_second(e->m, args); + } + + if (args != e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_status_t status = lsp_env_resolve(e, ctx, test, &test); + if (status != LSP_SUCCESS) + return status; + + lsp_bool_t is_false = (lsp_mem_is_number(e->m, test) && + lsp_mem_get_number(e->m, test) == 0) || + (lsp_mem_is_pair(e->m, test) && test == e->m->nil) || + (lsp_mem_is_string(e->m, test) && + lsp_mem_get_string_len(e->m, test) == 0) || + (lsp_mem_is_symbol(e->m, test) && + lsp_mem_get_symbol_len(e->m, test) == 0); + lsp_mem_dec_ref(e->m, test); + + return lsp_env_set_result_eval(e, ctx, + (is_false ? false_value : true_value)); +} |