Make AM registers into an array
This commit is contained in:
8
lib/am.c
8
lib/am.c
@@ -17,22 +17,22 @@ void am_init(am_t *am)
|
||||
void am_push(am_t *am)
|
||||
{
|
||||
assert(am->sp >= am->stack);
|
||||
*am->sp-- = am->expr;
|
||||
*am->sp-- = AM_EXPR(am);
|
||||
}
|
||||
|
||||
void am_pop(am_t *am)
|
||||
{
|
||||
assert(am->sp < am->stack + AM_STACK_SIZE - 1);
|
||||
am->expr = *++am->sp;
|
||||
AM_EXPR(am) = *++am->sp;
|
||||
}
|
||||
|
||||
void am_append_arg(am_t *am)
|
||||
{
|
||||
expr_t *list = am->argl;
|
||||
expr_t *list = AM_ARGL(am);
|
||||
while (!list->is_atom)
|
||||
list = list->pair.cdr;
|
||||
|
||||
list->is_atom = false;
|
||||
list->pair.car = am->val;
|
||||
list->pair.car = AM_VAL(am);
|
||||
list->pair.cdr = expr_empty_list(am);
|
||||
}
|
||||
|
||||
24
lib/env.c
24
lib/env.c
@@ -12,18 +12,18 @@ static bool symbol_eq(symbol_t *s, symbol_t *t)
|
||||
|
||||
static expr_t **lookup(am_t *am, bool *found)
|
||||
{
|
||||
assert(am->expr != NULL);
|
||||
assert(am->expr->is_atom);
|
||||
assert(am->expr->atom.type == ATOM_TYPE_SYMBOL);
|
||||
assert(AM_EXPR(am) != NULL);
|
||||
assert(AM_EXPR(am)->is_atom);
|
||||
assert(AM_EXPR(am)->atom.type == ATOM_TYPE_SYMBOL);
|
||||
|
||||
if (am->env->is_atom) {
|
||||
assert(am->env->atom.type == ATOM_TYPE_EMPTY_LIST);
|
||||
if (AM_ENV(am)->is_atom) {
|
||||
assert(AM_ENV(am)->atom.type == ATOM_TYPE_EMPTY_LIST);
|
||||
*found = false;
|
||||
return &am->env;
|
||||
return &AM_ENV(am);
|
||||
}
|
||||
|
||||
expr_t *prev;
|
||||
for (expr_t *list = am->env; !list->is_atom; list = list->pair.cdr) {
|
||||
for (expr_t *list = AM_ENV(am); !list->is_atom; list = list->pair.cdr) {
|
||||
assert(list != NULL);
|
||||
|
||||
expr_t *entry = list->pair.car;
|
||||
@@ -34,7 +34,7 @@ static expr_t **lookup(am_t *am, bool *found)
|
||||
assert(key->is_atom);
|
||||
assert(key->atom.type == ATOM_TYPE_SYMBOL);
|
||||
|
||||
if (symbol_eq(&am->expr->atom.symbol, &key->atom.symbol)) {
|
||||
if (symbol_eq(&AM_EXPR(am)->atom.symbol, &key->atom.symbol)) {
|
||||
*found = true;
|
||||
return &entry->pair.cdr;
|
||||
}
|
||||
@@ -51,7 +51,7 @@ static expr_t **lookup(am_t *am, bool *found)
|
||||
|
||||
void env_init(am_t *am)
|
||||
{
|
||||
am->env = expr_empty_list(am);
|
||||
AM_ENV(am) = expr_empty_list(am);
|
||||
prim_load(am);
|
||||
}
|
||||
|
||||
@@ -59,7 +59,7 @@ void env_fetch(am_t *am)
|
||||
{
|
||||
bool found;
|
||||
expr_t *val = *lookup(am, &found);
|
||||
am->val = found ? val : NULL;
|
||||
AM_VAL(am) = found ? val : NULL;
|
||||
}
|
||||
|
||||
void env_set(am_t *am)
|
||||
@@ -67,10 +67,10 @@ void env_set(am_t *am)
|
||||
bool found;
|
||||
expr_t **loc = lookup(am, &found);
|
||||
if (found) {
|
||||
*loc = am->val;
|
||||
*loc = AM_VAL(am);
|
||||
} else {
|
||||
(*loc)->is_atom = false;
|
||||
(*loc)->pair.cdr = expr_empty_list(am);
|
||||
(*loc)->pair.car = expr_pair(am, am->expr, am->val);
|
||||
(*loc)->pair.car = expr_pair(am, AM_EXPR(am), AM_VAL(am));
|
||||
}
|
||||
}
|
||||
|
||||
36
lib/eval.c
36
lib/eval.c
@@ -6,11 +6,11 @@
|
||||
|
||||
static void eval_atom(am_t *am)
|
||||
{
|
||||
switch (am->expr->atom.type) {
|
||||
switch (AM_EXPR(am)->atom.type) {
|
||||
case ATOM_TYPE_EMPTY_LIST:
|
||||
case ATOM_TYPE_INTEGER:
|
||||
case ATOM_TYPE_PRIM_PROC:
|
||||
am->val = am->expr;
|
||||
AM_VAL(am) = AM_EXPR(am);
|
||||
break;
|
||||
case ATOM_TYPE_SYMBOL:
|
||||
env_fetch(am);
|
||||
@@ -20,42 +20,42 @@ static void eval_atom(am_t *am)
|
||||
|
||||
static void eval_list(am_t *am)
|
||||
{
|
||||
am->argl = expr_empty_list(am);
|
||||
am->unev = am->expr->pair.cdr;
|
||||
am->expr = am->expr->pair.car;
|
||||
AM_ARGL(am) = expr_empty_list(am);
|
||||
AM_UNEV(am) = AM_EXPR(am)->pair.cdr;
|
||||
AM_EXPR(am) = AM_EXPR(am)->pair.car;
|
||||
|
||||
while (!am->unev->is_atom) {
|
||||
while (!AM_UNEV(am)->is_atom) {
|
||||
am_push(am);
|
||||
am->expr = am->unev->pair.cdr;
|
||||
AM_EXPR(am) = AM_UNEV(am)->pair.cdr;
|
||||
am_push(am);
|
||||
am->expr = am->argl;
|
||||
AM_EXPR(am) = AM_ARGL(am);
|
||||
am_push(am);
|
||||
|
||||
am->expr = am->unev->pair.car;
|
||||
AM_EXPR(am) = AM_UNEV(am)->pair.car;
|
||||
eval(am);
|
||||
|
||||
am_pop(am);
|
||||
am->argl = am->expr;
|
||||
AM_ARGL(am) = AM_EXPR(am);
|
||||
am_append_arg(am);
|
||||
|
||||
am_pop(am);
|
||||
am->unev = am->expr;
|
||||
AM_UNEV(am) = AM_EXPR(am);
|
||||
am_pop(am);
|
||||
}
|
||||
|
||||
assert(am->expr->is_atom);
|
||||
assert(am->expr->atom.type == ATOM_TYPE_SYMBOL);
|
||||
assert(AM_EXPR(am)->is_atom);
|
||||
assert(AM_EXPR(am)->atom.type == ATOM_TYPE_SYMBOL);
|
||||
env_fetch(am);
|
||||
|
||||
assert(am->val->is_atom);
|
||||
assert(am->val->atom.type == ATOM_TYPE_PRIM_PROC);
|
||||
assert(am->val->atom.prim_proc != NULL);
|
||||
am->val->atom.prim_proc(am);
|
||||
assert(AM_VAL(am)->is_atom);
|
||||
assert(AM_VAL(am)->atom.type == ATOM_TYPE_PRIM_PROC);
|
||||
assert(AM_VAL(am)->atom.prim_proc != NULL);
|
||||
AM_VAL(am)->atom.prim_proc(am);
|
||||
}
|
||||
|
||||
void eval(am_t *am)
|
||||
{
|
||||
if (am->expr->is_atom)
|
||||
if (AM_EXPR(am)->is_atom)
|
||||
eval_atom(am);
|
||||
else
|
||||
eval_list(am);
|
||||
|
||||
@@ -6,8 +6,24 @@
|
||||
|
||||
#define AM_STACK_SIZE 128U
|
||||
|
||||
#define AM_ARGL(am) am->regs[ARGL]
|
||||
#define AM_ENV(am) am->regs[ENV]
|
||||
#define AM_EXPR(am) am->regs[EXPR]
|
||||
#define AM_UNEV(am) am->regs[UNEV]
|
||||
#define AM_VAL(am) am->regs[VAL]
|
||||
|
||||
typedef enum {
|
||||
ARGL,
|
||||
ENV,
|
||||
EXPR,
|
||||
UNEV,
|
||||
VAL,
|
||||
|
||||
AM_REG_COUNT,
|
||||
} am_reg_t;
|
||||
|
||||
typedef struct am {
|
||||
expr_t *argl, *env, *expr, *unev, *val;
|
||||
expr_t *regs[AM_REG_COUNT];
|
||||
expr_t **sp, *stack[AM_STACK_SIZE];
|
||||
store_t store;
|
||||
} am_t;
|
||||
|
||||
12
lib/parse.c
12
lib/parse.c
@@ -24,7 +24,7 @@ static parse_state_t pop_state(parse_ctx_t *ctx)
|
||||
|
||||
static void append(parse_ctx_t *ctx, expr_t *expr)
|
||||
{
|
||||
expr_t *list = ctx->am->expr;
|
||||
expr_t *list = AM_EXPR(ctx->am);
|
||||
while (!list->is_atom)
|
||||
list = list->pair.cdr;
|
||||
assert(list->atom.type == ATOM_TYPE_EMPTY_LIST);
|
||||
@@ -40,16 +40,16 @@ parse_state_t parse_proc(parse_ctx_t *ctx, const token_t *token)
|
||||
case PARSE_STATE_INIT:
|
||||
switch (token->type) {
|
||||
case TOKEN_TYPE_INTEGER:
|
||||
ctx->am->expr = expr_integer(ctx->am, token->integer);
|
||||
AM_EXPR(ctx->am) = expr_integer(ctx->am, token->integer);
|
||||
ctx->state = PARSE_STATE_DONE;
|
||||
break;
|
||||
case TOKEN_TYPE_SYMBOL:
|
||||
ctx->am->expr = expr_symbol(ctx->am, &token->symbol);
|
||||
AM_EXPR(ctx->am) = expr_symbol(ctx->am, &token->symbol);
|
||||
ctx->state = PARSE_STATE_DONE;
|
||||
break;
|
||||
case TOKEN_TYPE_OPEN_PAREN:
|
||||
push_state(ctx, PARSE_STATE_DONE);
|
||||
ctx->am->expr = expr_empty_list(ctx->am);
|
||||
AM_EXPR(ctx->am) = expr_empty_list(ctx->am);
|
||||
ctx->state = PARSE_STATE_LIST;
|
||||
break;
|
||||
case TOKEN_TYPE_CLOSE_PAREN:
|
||||
@@ -69,13 +69,13 @@ parse_state_t parse_proc(parse_ctx_t *ctx, const token_t *token)
|
||||
case TOKEN_TYPE_OPEN_PAREN:
|
||||
am_push(ctx->am);
|
||||
push_state(ctx, PARSE_STATE_LIST);
|
||||
ctx->am->expr = expr_empty_list(ctx->am);
|
||||
AM_EXPR(ctx->am) = expr_empty_list(ctx->am);
|
||||
ctx->state = PARSE_STATE_LIST;
|
||||
break;
|
||||
case TOKEN_TYPE_CLOSE_PAREN:
|
||||
ctx->state = pop_state(ctx);
|
||||
if (ctx->state == PARSE_STATE_LIST) {
|
||||
expr_t *expr = ctx->am->expr;
|
||||
expr_t *expr = AM_EXPR(ctx->am);
|
||||
am_pop(ctx->am);
|
||||
append(ctx, expr);
|
||||
}
|
||||
|
||||
32
lib/prim.c
32
lib/prim.c
@@ -13,49 +13,49 @@ typedef struct {
|
||||
|
||||
static void add(am_t *am)
|
||||
{
|
||||
assert(am->argl);
|
||||
assert(AM_ARGL(am));
|
||||
|
||||
int64_t total = 0;
|
||||
for (expr_t *list = am->argl; !list->is_atom; list = list->pair.cdr) {
|
||||
for (expr_t *list = AM_ARGL(am); !list->is_atom; list = list->pair.cdr) {
|
||||
assert(list->pair.car->is_atom);
|
||||
assert(list->pair.car->atom.type == ATOM_TYPE_INTEGER);
|
||||
total += list->pair.car->atom.integer;
|
||||
}
|
||||
am->val = expr_integer(am, total);
|
||||
AM_VAL(am) = expr_integer(am, total);
|
||||
}
|
||||
|
||||
static void mul(am_t *am)
|
||||
{
|
||||
assert(am->argl);
|
||||
assert(AM_ARGL(am));
|
||||
|
||||
int64_t total = 1;
|
||||
for (expr_t *list = am->argl; !list->is_atom; list = list->pair.cdr) {
|
||||
for (expr_t *list = AM_ARGL(am); !list->is_atom; list = list->pair.cdr) {
|
||||
assert(list->pair.car->is_atom);
|
||||
assert(list->pair.car->atom.type == ATOM_TYPE_INTEGER);
|
||||
total *= list->pair.car->atom.integer;
|
||||
}
|
||||
am->val = expr_integer(am, total);
|
||||
AM_VAL(am) = expr_integer(am, total);
|
||||
}
|
||||
|
||||
static void sub(am_t *am)
|
||||
{
|
||||
assert(am->argl);
|
||||
assert(!am->argl->is_atom);
|
||||
assert(am->argl->pair.car->is_atom);
|
||||
assert(am->argl->pair.car->atom.type == ATOM_TYPE_INTEGER);
|
||||
assert(AM_ARGL(am));
|
||||
assert(!AM_ARGL(am)->is_atom);
|
||||
assert(AM_ARGL(am)->pair.car->is_atom);
|
||||
assert(AM_ARGL(am)->pair.car->atom.type == ATOM_TYPE_INTEGER);
|
||||
|
||||
int64_t total = am->argl->pair.car->atom.integer;
|
||||
if (!am->argl->is_atom && am->argl->pair.cdr->is_atom) {
|
||||
int64_t total = AM_ARGL(am)->pair.car->atom.integer;
|
||||
if (!AM_ARGL(am)->is_atom && AM_ARGL(am)->pair.cdr->is_atom) {
|
||||
total *= -1;
|
||||
} else {
|
||||
for (expr_t *list = am->argl->pair.cdr; !list->is_atom;
|
||||
for (expr_t *list = AM_ARGL(am)->pair.cdr; !list->is_atom;
|
||||
list = list->pair.cdr) {
|
||||
assert(list->pair.car->is_atom);
|
||||
assert(list->pair.car->atom.type == ATOM_TYPE_INTEGER);
|
||||
total -= list->pair.car->atom.integer;
|
||||
}
|
||||
}
|
||||
am->val = expr_integer(am, total);
|
||||
AM_VAL(am) = expr_integer(am, total);
|
||||
}
|
||||
|
||||
static const prim_table_entry_t prim_table[] = {
|
||||
@@ -67,8 +67,8 @@ static const prim_table_entry_t prim_table[] = {
|
||||
void prim_load(am_t *am)
|
||||
{
|
||||
for (unsigned i = 0; i < NELEMS(prim_table); ++i) {
|
||||
am->expr = expr_str_symbol(am, prim_table[i].name);
|
||||
am->val = expr_prim_proc(am, prim_table[i].prim_proc);
|
||||
AM_EXPR(am) = expr_str_symbol(am, prim_table[i].name);
|
||||
AM_VAL(am) = expr_prim_proc(am, prim_table[i].prim_proc);
|
||||
env_set(am);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -4,12 +4,12 @@
|
||||
|
||||
size_t print(am_t *am, char *buffer, size_t buffer_size)
|
||||
{
|
||||
assert(am->val->is_atom);
|
||||
assert(am->val->atom.type == ATOM_TYPE_INTEGER);
|
||||
assert(AM_VAL(am)->is_atom);
|
||||
assert(AM_VAL(am)->atom.type == ATOM_TYPE_INTEGER);
|
||||
|
||||
size_t i = 0;
|
||||
|
||||
int64_t value = am->val->atom.integer;
|
||||
int64_t value = AM_VAL(am)->atom.integer;
|
||||
if (value < 0) {
|
||||
buffer[i++] = '-';
|
||||
value *= -1;
|
||||
|
||||
Reference in New Issue
Block a user