Added garbage collection and multiple additions to the lisp
This commit is contained in:
parent
4af5f5156e
commit
e781174511
|
@ -7,13 +7,17 @@ void init_sl3();
|
||||||
uint32_t Readline(FILE* source_file, char* temp);
|
uint32_t Readline(FILE* source_file, char* temp);
|
||||||
struct cell* parse(char* program, int32_t size);
|
struct cell* parse(char* program, int32_t size);
|
||||||
void writeobj(FILE *ofp, struct cell* op);
|
void writeobj(FILE *ofp, struct cell* op);
|
||||||
|
void garbage_init();
|
||||||
|
void garbage_collect();
|
||||||
|
|
||||||
/*** Main Driver ***/
|
/*** Main Driver ***/
|
||||||
int main()
|
int main()
|
||||||
{
|
{
|
||||||
|
garbage_init();
|
||||||
init_sl3();
|
init_sl3();
|
||||||
for(;;)
|
for(;;)
|
||||||
{
|
{
|
||||||
|
garbage_collect();
|
||||||
int read;
|
int read;
|
||||||
char* message = calloc(1024, sizeof(char));
|
char* message = calloc(1024, sizeof(char));
|
||||||
read = Readline(stdin, message);
|
read = Readline(stdin, message);
|
||||||
|
|
|
@ -6,11 +6,14 @@
|
||||||
|
|
||||||
enum otype
|
enum otype
|
||||||
{
|
{
|
||||||
INT = 1,
|
FREE = 1,
|
||||||
SYM = (1 << 1),
|
MARKED = (1 << 1),
|
||||||
CONS = (1 << 2),
|
INT = (1 << 2),
|
||||||
PROC = (1 << 3),
|
SYM = (1 << 3),
|
||||||
PRIMOP = (1 << 4),
|
CONS = (1 << 4),
|
||||||
|
PROC = (1 << 5),
|
||||||
|
PRIMOP = (1 << 6),
|
||||||
|
ASCII = (1 << 7)
|
||||||
};
|
};
|
||||||
|
|
||||||
typedef struct cell* (*Operation)(struct cell *);
|
typedef struct cell* (*Operation)(struct cell *);
|
||||||
|
@ -35,4 +38,4 @@ typedef struct cell
|
||||||
struct cell* make_cons(struct cell* a, struct cell* b);
|
struct cell* make_cons(struct cell* a, struct cell* b);
|
||||||
|
|
||||||
/* Global objects */
|
/* Global objects */
|
||||||
struct cell *all_symbols, *top_env, *nil, *tee, *quote, *s_if, *s_lambda, *s_define, *s_setb;
|
struct cell *all_symbols, *top_env, *nil, *tee, *quote, *s_if, *s_lambda, *s_define, *s_setb, *s_cond, *s_begin;
|
||||||
|
|
|
@ -1,8 +1,112 @@
|
||||||
#include "lisp.h"
|
#include "lisp.h"
|
||||||
|
|
||||||
|
struct cell *free_cells, *gc_block_start, *gc_block_end;
|
||||||
|
int64_t left_to_take;
|
||||||
|
|
||||||
|
int64_t cells_remaining()
|
||||||
|
{
|
||||||
|
return left_to_take;
|
||||||
|
}
|
||||||
|
|
||||||
|
void update_remaining()
|
||||||
|
{
|
||||||
|
int64_t count = 0;
|
||||||
|
struct cell* i = free_cells;
|
||||||
|
while(NULL != i)
|
||||||
|
{
|
||||||
|
count = count + 1;
|
||||||
|
i = i->cdr;
|
||||||
|
}
|
||||||
|
left_to_take = count;
|
||||||
|
}
|
||||||
|
|
||||||
|
void reclaim_marked()
|
||||||
|
{
|
||||||
|
struct cell* i;
|
||||||
|
for(i= gc_block_start; i < gc_block_end; i = i + 1)
|
||||||
|
{
|
||||||
|
if(i->type & MARKED)
|
||||||
|
{
|
||||||
|
i->type = FREE;
|
||||||
|
i->car = NULL;
|
||||||
|
i->cdr = free_cells;
|
||||||
|
i->env = NULL;
|
||||||
|
free_cells = i;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void mark_all_cells()
|
||||||
|
{
|
||||||
|
struct cell* i;
|
||||||
|
for(i= gc_block_start; i < gc_block_end; i = i + 1)
|
||||||
|
{
|
||||||
|
/* if not in the free list */
|
||||||
|
if(!(i->type & FREE))
|
||||||
|
{
|
||||||
|
/* Mark it */
|
||||||
|
i->type = i->type | MARKED;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void unmark_cells(struct cell* list)
|
||||||
|
{
|
||||||
|
for(; NULL != list; list = list->cdr)
|
||||||
|
{
|
||||||
|
list->type = list->type & ~MARKED;
|
||||||
|
if((list->type & CONS)|| list->type & PROC )
|
||||||
|
{
|
||||||
|
unmark_cells(list->car);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void garbage_collect()
|
||||||
|
{
|
||||||
|
mark_all_cells();
|
||||||
|
unmark_cells(all_symbols);
|
||||||
|
unmark_cells(top_env);
|
||||||
|
unmark_cells(nil);
|
||||||
|
unmark_cells(tee);
|
||||||
|
unmark_cells(quote);
|
||||||
|
unmark_cells(s_if);
|
||||||
|
unmark_cells(s_lambda);
|
||||||
|
unmark_cells(s_define);
|
||||||
|
unmark_cells(s_setb);
|
||||||
|
unmark_cells(s_cond);
|
||||||
|
unmark_cells(s_begin);
|
||||||
|
reclaim_marked();
|
||||||
|
update_remaining();
|
||||||
|
}
|
||||||
|
|
||||||
|
void garbage_init()
|
||||||
|
{
|
||||||
|
int number_of_Cells = 1000000;
|
||||||
|
gc_block_start = calloc(number_of_Cells + 1, sizeof(cell));
|
||||||
|
gc_block_end = gc_block_start + number_of_Cells;
|
||||||
|
free_cells = NULL;
|
||||||
|
garbage_collect();
|
||||||
|
}
|
||||||
|
|
||||||
|
struct cell* pop_cons()
|
||||||
|
{
|
||||||
|
if(NULL == free_cells)
|
||||||
|
{
|
||||||
|
printf("OOOPS we ran out of cells");
|
||||||
|
exit(EXIT_FAILURE);
|
||||||
|
}
|
||||||
|
struct cell* i;
|
||||||
|
i = free_cells;
|
||||||
|
free_cells = i->cdr;
|
||||||
|
i->cdr = NULL;
|
||||||
|
left_to_take = left_to_take - 1;
|
||||||
|
return i;
|
||||||
|
}
|
||||||
|
|
||||||
struct cell* make_int(int a)
|
struct cell* make_int(int a)
|
||||||
{
|
{
|
||||||
struct cell* c = calloc(1, sizeof(cell));
|
struct cell* c = pop_cons();
|
||||||
c->type = INT;
|
c->type = INT;
|
||||||
c->value = a;
|
c->value = a;
|
||||||
return c;
|
return c;
|
||||||
|
@ -10,7 +114,7 @@ struct cell* make_int(int a)
|
||||||
|
|
||||||
struct cell* make_sym(char* name)
|
struct cell* make_sym(char* name)
|
||||||
{
|
{
|
||||||
struct cell* c = calloc(1, sizeof(cell));
|
struct cell* c = pop_cons();
|
||||||
c->type = SYM;
|
c->type = SYM;
|
||||||
c->string = name;
|
c->string = name;
|
||||||
return c;
|
return c;
|
||||||
|
@ -18,7 +122,7 @@ struct cell* make_sym(char* name)
|
||||||
|
|
||||||
struct cell* make_cons(struct cell* a, struct cell* b)
|
struct cell* make_cons(struct cell* a, struct cell* b)
|
||||||
{
|
{
|
||||||
struct cell* c = calloc(1, sizeof(cell));
|
struct cell* c = pop_cons();
|
||||||
c->type = CONS;
|
c->type = CONS;
|
||||||
c->car = a;
|
c->car = a;
|
||||||
c->cdr = b;
|
c->cdr = b;
|
||||||
|
@ -27,7 +131,7 @@ struct cell* make_cons(struct cell* a, struct cell* b)
|
||||||
|
|
||||||
struct cell* make_proc(struct cell* a, struct cell* b, struct cell* env)
|
struct cell* make_proc(struct cell* a, struct cell* b, struct cell* env)
|
||||||
{
|
{
|
||||||
struct cell* c = calloc(1, sizeof(cell));
|
struct cell* c = pop_cons();
|
||||||
c->type = PROC;
|
c->type = PROC;
|
||||||
c->car = a;
|
c->car = a;
|
||||||
c->cdr = b;
|
c->cdr = b;
|
||||||
|
@ -37,7 +141,7 @@ struct cell* make_proc(struct cell* a, struct cell* b, struct cell* env)
|
||||||
|
|
||||||
struct cell* make_prim(void* fun)
|
struct cell* make_prim(void* fun)
|
||||||
{
|
{
|
||||||
struct cell* c = calloc(1, sizeof(cell));
|
struct cell* c = pop_cons();
|
||||||
c->type = PRIMOP;
|
c->type = PRIMOP;
|
||||||
c->function = fun;
|
c->function = fun;
|
||||||
return c;
|
return c;
|
||||||
|
|
|
@ -1,17 +1,6 @@
|
||||||
#include "lisp.h"
|
#include "lisp.h"
|
||||||
|
|
||||||
/* Support functions */
|
/* Support functions */
|
||||||
struct cell* car(struct cell* a)
|
|
||||||
{
|
|
||||||
return a->car;
|
|
||||||
}
|
|
||||||
|
|
||||||
struct cell* cdr(struct cell* a)
|
|
||||||
{
|
|
||||||
return a->cdr;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
struct cell* findsym(char *name)
|
struct cell* findsym(char *name)
|
||||||
{
|
{
|
||||||
struct cell* symlist;
|
struct cell* symlist;
|
||||||
|
@ -44,24 +33,27 @@ struct cell* extend(struct cell* env, struct cell* symbol, struct cell* value)
|
||||||
|
|
||||||
struct cell* multiple_extend(struct cell* env, struct cell* syms, struct cell* vals)
|
struct cell* multiple_extend(struct cell* env, struct cell* syms, struct cell* vals)
|
||||||
{
|
{
|
||||||
if(nil == syms)
|
if(nil == syms)
|
||||||
{
|
{
|
||||||
return env;
|
return env;
|
||||||
}
|
}
|
||||||
return multiple_extend(extend(env, car(syms), car(vals)), cdr(syms), cdr(vals));
|
return multiple_extend(extend(env, syms->car, vals->car), syms->cdr, vals->cdr);
|
||||||
}
|
}
|
||||||
|
|
||||||
struct cell* extend_top(struct cell* sym, struct cell* val)
|
struct cell* extend_top(struct cell* sym, struct cell* val)
|
||||||
{
|
{
|
||||||
top_env->cdr = make_cons(make_cons(sym, val), cdr(top_env));
|
top_env->cdr = make_cons(make_cons(sym, val), top_env->cdr);
|
||||||
return val;
|
return val;
|
||||||
}
|
}
|
||||||
|
|
||||||
struct cell* assoc(struct cell* key, struct cell* alist)
|
struct cell* assoc(struct cell* key, struct cell* alist)
|
||||||
{
|
{
|
||||||
if(nil == alist) return nil;
|
if(nil == alist) return nil;
|
||||||
if(car(car(alist)) == key) return car(alist);
|
for(; nil != alist; alist = alist->cdr)
|
||||||
return assoc(key, cdr(alist));
|
{
|
||||||
|
if(alist->car->car == key) return alist->car;
|
||||||
|
}
|
||||||
|
return nil;
|
||||||
}
|
}
|
||||||
|
|
||||||
/*** Evaluator (Eval/Apply) ***/
|
/*** Evaluator (Eval/Apply) ***/
|
||||||
|
@ -70,7 +62,7 @@ struct cell* make_proc(struct cell* a, struct cell* b, struct cell* env);
|
||||||
struct cell* evlis(struct cell* exps, struct cell* env)
|
struct cell* evlis(struct cell* exps, struct cell* env)
|
||||||
{
|
{
|
||||||
if(exps == nil) return nil;
|
if(exps == nil) return nil;
|
||||||
return make_cons(eval(car(exps), env), evlis(cdr(exps), env));
|
return make_cons(eval(exps->car, env), evlis(exps->cdr, env));
|
||||||
}
|
}
|
||||||
|
|
||||||
struct cell* progn(struct cell* exps, struct cell* env)
|
struct cell* progn(struct cell* exps, struct cell* env)
|
||||||
|
@ -78,9 +70,9 @@ struct cell* progn(struct cell* exps, struct cell* env)
|
||||||
if(exps == nil) return nil;
|
if(exps == nil) return nil;
|
||||||
for(;;)
|
for(;;)
|
||||||
{
|
{
|
||||||
if(cdr(exps) == nil) return eval(car(exps), env);
|
if(exps->cdr == nil) return eval(exps->car, env);
|
||||||
eval(car(exps), env);
|
eval(exps->car, env);
|
||||||
exps = cdr(exps);
|
exps = exps->cdr;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -103,6 +95,27 @@ struct cell* apply(struct cell* proc, struct cell* vals)
|
||||||
return temp;
|
return temp;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
struct cell* evcond(struct cell* exp, struct cell* env)
|
||||||
|
{
|
||||||
|
if(tee == eval(exp->car->car, env))
|
||||||
|
{
|
||||||
|
return eval(exp->car->cdr->car, env);
|
||||||
|
}
|
||||||
|
|
||||||
|
return evcond(exp->cdr, env);
|
||||||
|
}
|
||||||
|
|
||||||
|
struct cell* prim_begin(struct cell* exp, struct cell* env)
|
||||||
|
{
|
||||||
|
struct cell* ret;
|
||||||
|
ret = eval(exp->car, env);
|
||||||
|
if(nil != exp->cdr)
|
||||||
|
{
|
||||||
|
ret = prim_begin(exp->cdr, env);
|
||||||
|
}
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
struct cell* eval(struct cell* exp, struct cell* env)
|
struct cell* eval(struct cell* exp, struct cell* env)
|
||||||
{
|
{
|
||||||
if(exp == nil) return nil;
|
if(exp == nil) return nil;
|
||||||
|
@ -118,32 +131,35 @@ struct cell* eval(struct cell* exp, struct cell* env)
|
||||||
fprintf(stderr,"Unbound symbol\n");
|
fprintf(stderr,"Unbound symbol\n");
|
||||||
exit(EXIT_FAILURE);
|
exit(EXIT_FAILURE);
|
||||||
}
|
}
|
||||||
return cdr(tmp);
|
return tmp->cdr;
|
||||||
}
|
}
|
||||||
case CONS:
|
case CONS:
|
||||||
{
|
{
|
||||||
if(car(exp) == s_if)
|
if(exp->car == s_if)
|
||||||
{
|
{
|
||||||
if(eval(car(cdr(exp)), env) != nil)
|
if(eval(exp->cdr->car, env) != nil)
|
||||||
{
|
{
|
||||||
return eval(car(cdr(cdr(exp))), env);
|
return eval(exp->cdr->cdr->car, env);
|
||||||
}
|
}
|
||||||
return eval(car(cdr(cdr(cdr(exp)))), env);
|
return eval(exp->cdr->cdr->cdr->car, env);
|
||||||
}
|
}
|
||||||
if(car(exp) == s_lambda) return make_proc(car(cdr(exp)), cdr(cdr(exp)), env);
|
if(exp->car == s_cond) return evcond(exp->cdr, env);
|
||||||
if(car(exp) == quote) return car(cdr(exp));
|
if(exp->car == s_begin) return prim_begin(exp->cdr, env);
|
||||||
if(car(exp) == s_define) return(extend_top(car(cdr(exp)), eval(car(cdr(cdr(exp))), env)));
|
if(exp->car == s_lambda) return make_proc(exp->cdr->car, exp->cdr->cdr, env);
|
||||||
if(car(exp) == s_setb)
|
if(exp->car == quote) return exp->cdr->car;
|
||||||
|
if(exp->car == s_define) return(extend_top(exp->cdr->car, eval(exp->cdr->cdr->car, env)));
|
||||||
|
if(exp->car == s_setb)
|
||||||
{
|
{
|
||||||
struct cell* pair = assoc(car(cdr(exp)), env);
|
struct cell* pair = assoc(exp->cdr->car, env);
|
||||||
struct cell* newval = eval(car(cdr(cdr(exp))), env);
|
struct cell* newval = eval(exp->cdr->cdr->car, env);
|
||||||
pair->cdr = newval;
|
pair->cdr = newval;
|
||||||
return newval;
|
return newval;
|
||||||
}
|
}
|
||||||
return apply(eval(car(exp), env), evlis(cdr(exp), env));
|
return apply(eval(exp->car, env), evlis(exp->cdr, env));
|
||||||
}
|
}
|
||||||
case PRIMOP: return exp;
|
case PRIMOP: return exp;
|
||||||
case PROC: return exp;
|
case PROC: return exp;
|
||||||
|
default: return exp;
|
||||||
}
|
}
|
||||||
/* Not reached */
|
/* Not reached */
|
||||||
return exp;
|
return exp;
|
||||||
|
@ -154,19 +170,19 @@ struct cell* make_int(int a);
|
||||||
struct cell* prim_sum(struct cell* args)
|
struct cell* prim_sum(struct cell* args)
|
||||||
{
|
{
|
||||||
int sum;
|
int sum;
|
||||||
for(sum = 0; nil != args; args = cdr(args))
|
for(sum = 0; nil != args; args = args->cdr)
|
||||||
{
|
{
|
||||||
sum = sum + car(args)->value;
|
sum = sum + args->car->value;
|
||||||
}
|
}
|
||||||
return make_int(sum);
|
return make_int(sum);
|
||||||
}
|
}
|
||||||
|
|
||||||
struct cell* prim_sub(struct cell* args)
|
struct cell* prim_sub(struct cell* args)
|
||||||
{
|
{
|
||||||
int sum = car(args)->value;
|
int sum = args->car->value;
|
||||||
for(args = cdr(args); nil != args; args = cdr(args))
|
for(args = args->cdr; nil != args; args = args->cdr)
|
||||||
{
|
{
|
||||||
sum = sum - car(args)->value;
|
sum = sum - args->car->value;
|
||||||
}
|
}
|
||||||
return make_int(sum);
|
return make_int(sum);
|
||||||
}
|
}
|
||||||
|
@ -174,21 +190,187 @@ struct cell* prim_sub(struct cell* args)
|
||||||
struct cell* prim_prod(struct cell* args)
|
struct cell* prim_prod(struct cell* args)
|
||||||
{
|
{
|
||||||
int prod;
|
int prod;
|
||||||
for(prod = 1; nil != args; args = cdr(args))
|
for(prod = 1; nil != args; args = args->cdr)
|
||||||
{
|
{
|
||||||
prod = prod * car(args)->value;
|
prod = prod * args->car->value;
|
||||||
}
|
}
|
||||||
return make_int(prod);
|
return make_int(prod);
|
||||||
}
|
}
|
||||||
|
|
||||||
struct cell* prim_numeq(struct cell* args)
|
struct cell* prim_div(struct cell* args)
|
||||||
{
|
{
|
||||||
return car(args)->value == car(cdr(args))->value ? tee : nil;
|
int div = args->car->value;
|
||||||
|
for(args = args->cdr; nil != args; args = args->cdr)
|
||||||
|
{
|
||||||
|
div = div / args->car->value;
|
||||||
|
}
|
||||||
|
return make_int(div);
|
||||||
}
|
}
|
||||||
|
|
||||||
struct cell* prim_cons(struct cell* args) { return make_cons(car(args), car(cdr(args))); }
|
struct cell* prim_mod(struct cell* args)
|
||||||
struct cell* prim_car(struct cell* args) { return car(car(args)); }
|
{
|
||||||
struct cell* prim_cdr(struct cell* args) { return cdr(car(args)); }
|
int mod = args->car->value % args->cdr->car->value;
|
||||||
|
if(nil != args->cdr->cdr)
|
||||||
|
{
|
||||||
|
printf("wrong number of arguments to mod\n");
|
||||||
|
exit(EXIT_FAILURE);
|
||||||
|
}
|
||||||
|
return make_int(mod);
|
||||||
|
}
|
||||||
|
|
||||||
|
struct cell* prim_and(struct cell* args)
|
||||||
|
{
|
||||||
|
for(; nil != args; args = args->cdr)
|
||||||
|
{
|
||||||
|
if(tee != args->car) return nil;
|
||||||
|
}
|
||||||
|
return tee;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct cell* prim_or(struct cell* args)
|
||||||
|
{
|
||||||
|
for(; nil != args; args = args->cdr)
|
||||||
|
{
|
||||||
|
if(tee == args->car) return tee;
|
||||||
|
}
|
||||||
|
return nil;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct cell* prim_not(struct cell* args)
|
||||||
|
{
|
||||||
|
if(tee != args->car) return tee;
|
||||||
|
return nil;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct cell* prim_numgt(struct cell* args)
|
||||||
|
{
|
||||||
|
int temp = args->car->value;
|
||||||
|
for(args = args->cdr; nil != args; args = args->cdr)
|
||||||
|
{
|
||||||
|
if(temp <= args->car->value)
|
||||||
|
{
|
||||||
|
return nil;
|
||||||
|
}
|
||||||
|
temp = args->car->value;
|
||||||
|
}
|
||||||
|
return tee;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct cell* prim_numge(struct cell* args)
|
||||||
|
{
|
||||||
|
int temp = args->car->value;
|
||||||
|
for(args = args->cdr; nil != args; args = args->cdr)
|
||||||
|
{
|
||||||
|
if(temp < args->car->value)
|
||||||
|
{
|
||||||
|
return nil;
|
||||||
|
}
|
||||||
|
temp = args->car->value;
|
||||||
|
}
|
||||||
|
return tee;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct cell* prim_numeq(struct cell* args)
|
||||||
|
{
|
||||||
|
int temp = args->car->value;
|
||||||
|
for(args = args->cdr; nil != args; args = args->cdr)
|
||||||
|
{
|
||||||
|
if(temp != args->car->value)
|
||||||
|
{
|
||||||
|
return nil;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return tee;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct cell* prim_numle(struct cell* args)
|
||||||
|
{
|
||||||
|
int temp = args->car->value;
|
||||||
|
for(args = args->cdr; nil != args; args = args->cdr)
|
||||||
|
{
|
||||||
|
if(temp > args->car->value)
|
||||||
|
{
|
||||||
|
return nil;
|
||||||
|
}
|
||||||
|
temp = args->car->value;
|
||||||
|
}
|
||||||
|
return tee;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct cell* prim_numlt(struct cell* args)
|
||||||
|
{
|
||||||
|
int temp = args->car->value;
|
||||||
|
for(args = args->cdr; nil != args; args = args->cdr)
|
||||||
|
{
|
||||||
|
if(temp >= args->car->value)
|
||||||
|
{
|
||||||
|
return nil;
|
||||||
|
}
|
||||||
|
temp = args->car->value;
|
||||||
|
}
|
||||||
|
return tee;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct cell* prim_listp(struct cell* args)
|
||||||
|
{
|
||||||
|
if(CONS == args->car->type)
|
||||||
|
{
|
||||||
|
return tee;
|
||||||
|
}
|
||||||
|
return nil;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct cell* prim_display(struct cell* args)
|
||||||
|
{
|
||||||
|
for(; nil != args; args = args->cdr)
|
||||||
|
{
|
||||||
|
if(INT == args->car->type)
|
||||||
|
{
|
||||||
|
printf("%d", args->car->value);
|
||||||
|
}
|
||||||
|
else if(ASCII == args->car->type)
|
||||||
|
{
|
||||||
|
printf("%c", args->car->value);
|
||||||
|
}
|
||||||
|
else if(CONS == args->car->type)
|
||||||
|
{
|
||||||
|
prim_display(args->car);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
printf("%s", args->car->string);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return tee;
|
||||||
|
}
|
||||||
|
|
||||||
|
int64_t cells_remaining();
|
||||||
|
struct cell* prim_freecell(struct cell* args)
|
||||||
|
{
|
||||||
|
if(nil == args)
|
||||||
|
{
|
||||||
|
printf("Remaining Cells: ");
|
||||||
|
}
|
||||||
|
return make_int(cells_remaining());
|
||||||
|
}
|
||||||
|
|
||||||
|
struct cell* prim_ascii(struct cell* args)
|
||||||
|
{
|
||||||
|
struct cell* temp;
|
||||||
|
for(temp = args; nil != temp; temp = temp->cdr)
|
||||||
|
{
|
||||||
|
if(INT == temp->car->type)
|
||||||
|
{
|
||||||
|
temp->car->type = ASCII;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return args;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct cell* prim_list(struct cell* args) {return args;}
|
||||||
|
struct cell* prim_cons(struct cell* args) { return make_cons(args->car, args->cdr->car); }
|
||||||
|
struct cell* prim_car(struct cell* args) { return args->car->car; }
|
||||||
|
struct cell* prim_cdr(struct cell* args) { return args->car->cdr; }
|
||||||
|
|
||||||
/*** Initialization ***/
|
/*** Initialization ***/
|
||||||
struct cell* intern(char *name);
|
struct cell* intern(char *name);
|
||||||
|
@ -199,17 +381,33 @@ void init_sl3()
|
||||||
nil = make_sym("nil");
|
nil = make_sym("nil");
|
||||||
all_symbols = make_cons(nil, nil);
|
all_symbols = make_cons(nil, nil);
|
||||||
top_env = make_cons(make_cons(nil, nil), nil);
|
top_env = make_cons(make_cons(nil, nil), nil);
|
||||||
tee = intern("t");
|
tee = intern("#t");
|
||||||
extend_top(tee, tee);
|
extend_top(tee, tee);
|
||||||
quote = intern("quote");
|
quote = intern("quote");
|
||||||
s_if = intern("if");
|
s_if = intern("if");
|
||||||
|
s_cond = intern("cond");
|
||||||
s_lambda = intern("lambda");
|
s_lambda = intern("lambda");
|
||||||
s_define = intern("define");
|
s_define = intern("define");
|
||||||
s_setb = intern("set!");
|
s_setb = intern("set!");
|
||||||
|
s_begin = intern("begin");
|
||||||
extend_top(intern("+"), make_prim(prim_sum));
|
extend_top(intern("+"), make_prim(prim_sum));
|
||||||
extend_top(intern("-"), make_prim(prim_sub));
|
extend_top(intern("-"), make_prim(prim_sub));
|
||||||
extend_top(intern("*"), make_prim(prim_prod));
|
extend_top(intern("*"), make_prim(prim_prod));
|
||||||
|
extend_top(intern("/"), make_prim(prim_div));
|
||||||
|
extend_top(intern("mod"), make_prim(prim_mod));
|
||||||
|
extend_top(intern("and"), make_prim(prim_and));
|
||||||
|
extend_top(intern("or"), make_prim(prim_or));
|
||||||
|
extend_top(intern("not"), make_prim(prim_not));
|
||||||
|
extend_top(intern(">"), make_prim(prim_numgt));
|
||||||
|
extend_top(intern(">="), make_prim(prim_numge));
|
||||||
extend_top(intern("="), make_prim(prim_numeq));
|
extend_top(intern("="), make_prim(prim_numeq));
|
||||||
|
extend_top(intern("<="), make_prim(prim_numle));
|
||||||
|
extend_top(intern("<"), make_prim(prim_numlt));
|
||||||
|
extend_top(intern("display"), make_prim(prim_display));
|
||||||
|
extend_top(intern("free_mem"), make_prim(prim_freecell));
|
||||||
|
extend_top(intern("ascii!"), make_prim(prim_ascii));
|
||||||
|
extend_top(intern("list?"), make_prim(prim_listp));
|
||||||
|
extend_top(intern("list"), make_prim(prim_list));
|
||||||
extend_top(intern("cons"), make_prim(prim_cons));
|
extend_top(intern("cons"), make_prim(prim_cons));
|
||||||
extend_top(intern("car"), make_prim(prim_car));
|
extend_top(intern("car"), make_prim(prim_car));
|
||||||
extend_top(intern("cdr"), make_prim(prim_cdr));
|
extend_top(intern("cdr"), make_prim(prim_cdr));
|
||||||
|
|
|
@ -36,6 +36,7 @@ void writeobj(FILE *ofp, struct cell* op)
|
||||||
}
|
}
|
||||||
case PRIMOP: fprintf(ofp, "#<PRIMOP>"); break;
|
case PRIMOP: fprintf(ofp, "#<PRIMOP>"); break;
|
||||||
case PROC: fprintf(ofp, "#<PROC>"); break;
|
case PROC: fprintf(ofp, "#<PROC>"); break;
|
||||||
|
case ASCII: fprintf(ofp, "%c", op->value); break;
|
||||||
default: exit(1);
|
default: exit(1);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
@ -104,6 +104,12 @@ bool is_integer(char* a)
|
||||||
|
|
||||||
struct cell* atom(struct cell* a)
|
struct cell* atom(struct cell* a)
|
||||||
{
|
{
|
||||||
|
/* Check for quotes */
|
||||||
|
if('\'' == a->string[0])
|
||||||
|
{
|
||||||
|
a->string = a->string + 1;
|
||||||
|
return make_cons(quote, make_cons(a, nil));
|
||||||
|
}
|
||||||
/* Check for integer */
|
/* Check for integer */
|
||||||
if(is_integer(a->string))
|
if(is_integer(a->string))
|
||||||
{
|
{
|
||||||
|
@ -228,7 +234,7 @@ uint32_t Readline(FILE* source_file, char* temp)
|
||||||
}
|
}
|
||||||
|
|
||||||
Line_complete:
|
Line_complete:
|
||||||
if(1 >= i)
|
if(1 > i)
|
||||||
{
|
{
|
||||||
return Readline(source_file, temp);
|
return Readline(source_file, temp);
|
||||||
}
|
}
|
||||||
|
|
|
@ -2,7 +2,7 @@ all: lisp.h lisp.c lisp_cell.c lisp_eval.c lisp_print.c lisp_read.c
|
||||||
gcc -ggdb lisp.h lisp.c lisp_cell.c lisp_eval.c lisp_print.c lisp_read.c -o lisp
|
gcc -ggdb lisp.h lisp.c lisp_cell.c lisp_eval.c lisp_print.c lisp_read.c -o lisp
|
||||||
|
|
||||||
lisp: lisp.h lisp.c lisp_cell.c lisp_eval.c lisp_print.c lisp_read.c
|
lisp: lisp.h lisp.c lisp_cell.c lisp_eval.c lisp_print.c lisp_read.c
|
||||||
gcc lisp.h lisp.c lisp_cell.c lisp_eval.c lisp_print.c lisp_read.c -o lisp
|
gcc -O2 lisp.h lisp.c lisp_cell.c lisp_eval.c lisp_print.c lisp_read.c -o lisp
|
||||||
|
|
||||||
coverage-test: lisp.h lisp.c lisp_cell.c lisp_eval.c lisp_print.c lisp_read.c
|
coverage-test: lisp.h lisp.c lisp_cell.c lisp_eval.c lisp_print.c lisp_read.c
|
||||||
gcc -fprofile-arcs -ftest-coverage lisp.h lisp.c lisp_cell.c lisp_eval.c lisp_print.c lisp_read.c -o lisp
|
gcc -fprofile-arcs -ftest-coverage lisp.h lisp.c lisp_cell.c lisp_eval.c lisp_print.c lisp_read.c -o lisp
|
||||||
|
|
Loading…
Reference in New Issue