cell make_long_integer(long long i) {
cell n;
n = make_ulong_integer(i < 0? -i: i);
if (i < 0)
n = new_atom(T_INTEGER, new_atom(-cadr(n), cddr(n)));
return n;
}
cell make_ulong_integer(unsigned long long u) {
cell n;
n = new_atom(u % S9_INT_SEG_LIMIT, NIL);
u /= S9_INT_SEG_LIMIT;
while (u) {
n = new_atom(u % S9_INT_SEG_LIMIT, n);
u /= S9_INT_SEG_LIMIT;
}
return new_atom(T_INTEGER, n);
}
long long int64_value(char *src, cell x) {
cell n;
long long v;
if (cadr(x) < 0)
n = new_atom(T_INTEGER, new_atom(-cadr(x), cddr(x)));
else
n = x;
v = uint64_value(src, n);
return cadr(x) < 0? -v: v;
}
atom_t *new_macro(atom_t *parameters_, atom_t *body_, environment_t *env_) {
atom_t *atom = new_atom(ATOM_MACRO);
parameters(atom) = parameters_;
body(atom) = body_;
environment(atom) = env_;
return atom;
}
atom_t *new_lambda(atom_t *parameters_, atom_t *body_, environment_t *env_) {
atom_t *atom = new_atom(ATOM_LAMBDA);
parameters(atom) = parameters_;
body(atom) = body_;
environment(atom) = env_;
return atom;
}
lisp_atom lp_defun(slist_elem* next)
{
slist* def_list=new_slist();
slist_elem* pos=0;
lisp_atom* fun=0;
lisp_atom ret;
char* sym=0;
/* if this symbol is named then we need to skip an arg*/
if(ATOM_CAST(next)->type==LTID)
{
sym=(char*)ATOM_CAST(next)->data;
pos=next->_next;
}else pos=next;
/* get params */
if(!pos||ATOM_CAST(pos)->type!=LTLIST)
LPRETURN_NIL(ret)
slist_pushb(def_list,(void*)atom_copy(ATOM_CAST(pos)));
/* get body */
pos=pos->_next;
if(!pos||ATOM_CAST(pos)->type!=LTLIST)
LPRETURN_NIL(ret)
slist_pushb(def_list,(void*)atom_copy(ATOM_CAST(pos)));
/* install macro or fn if not a lambda*/
fun=new_atom(LENORMAL,LTLISPFN,(void*)def_list);
if(sym&&!lisp_put_symbol(sym,(void*)fun))
LPRETURN_NIL(ret)
ret.type=LTLISPFN;
ret.data=(void*)fun;
return ret;
}
struct expr *
atom_t(void)
{
struct expr *e;
e = new_expr(LATOM);
e->v.atom = new_atom("t");
return e;
}
int main(int argc, char *argv[])
{
/*
struct cell *hmm = malloc (sizeof (struct cell));
hmm->stuff.cellist = NULL;
hmm->stuff.str = malloc(sizeof(wchar_t) * 3);
hmm->type_cell = atom;
wcscpy(hmm->stuff.str, L"no");
*/
/*
struct cell *amm = malloc (sizeof (struct cell));
amm->stuff.cellist = malloc(sizeof(struct cell)*2);
amm->stuff.cellist->stuff.cellist = NULL;
amm->stuff.cellist->stuff.str = malloc(sizeof(wchar_t) * 3);
wcscpy(amm->stuff.cellist->stuff.str, L"no");
++(amm->stuff.cellist);
amm->stuff.cellist->type_cell = end;
--(amm->stuff.cellist);
amm->type_cell = list;
amm->stuff.cellist->type_cell = atom;
free_all(amm, 1);
*/
wprintf(L"Hi!");
struct cell *a = new_list();
struct cell *b = new_funct(&car);
struct cell *c = new_list();
struct cell *d = new_funct("e);
struct cell *e = new_list();
struct cell *f = new_atom(L"dsdsds");
insert_atom_rel(e, f);
insert_atom_rel(c, d);
insert_atom_rel(c, e);
insert_atom_rel(a, b);
insert_atom_rel(a, c);
struct cell *g = eval(a);
wprintf(L"%ls", g->stuff.str);
free_all(g, 1, 1);
return 0;
}
struct expr *
defun(struct expr * e, struct context * ctx)
{
struct expr *pe, *pl;
struct list *l;
if (!e || list_len(e) < 4) {
free_expr(e);
return empty_list();
}
if (!e->v.list->next || !e->v.list->next->v || e->v.list->next->v->t != LATOM || !e->v.list->next->v->v.atom || !e->v.list->next->v->v.atom->v) {
free_expr(e);
return empty_list();
}
if (!e->v.list->next->next || !is_valid_p_expr(e->v.list->next->next->v)) {
free_expr(e);
return empty_list();
}
if (!e->v.list->next->next->next || !e->v.list->next->next->next->v) {
free_expr(e);
return empty_list();
}
pl = new_expr(LLIST);
pl->v.list = new_list();
pl->v.list->v = new_expr(LATOM);
pl->v.list->v->v.atom = new_atom("lambda");
pl->v.list->next = new_list();
pl->v.list->next->v = exprs_dup(e->v.list->next->next->v);
pl->v.list->next->next = new_list();
pl->v.list->next->next->v = exprs_dup(e->v.list->next->next->next->v);
pe = add_to_context(ctx, strdup(e->v.list->next->v->v.atom->v), pl);
full_free_expr(pe);
free_expr(e);
return empty_list();
}
void load_utils()
{
lisp_put_symbol("sleep",(void*)new_atom(LENORMAL,LTCFNPTR,(void*)new_lisp_cfn(1,1,1,lp_sleep)));
lisp_put_symbol("length",(void*)new_atom(LENORMAL,LTCFNPTR,(void*)new_lisp_cfn(1,1,1,lp_length)));
}
atom_t *new_number(const double value) {
atom_t *atom = new_atom(ATOM_NUMBER);
number(atom) = value;
return atom;
}
atom_t *new_builtin(atom_t *(*func_)(atom_t *)) {
atom_t *atom = new_atom(ATOM_BUILTIN);
func(atom) = func_;
return atom;
}
atom_t *new_cons(atom_t *car_, atom_t *cdr_) {
atom_t *atom = new_atom(ATOM_CONS);
car(atom) = car_;
cdr(atom) = cdr_;
return atom;
}
atom_t *new_symbol(const char *value) {
atom_t *atom = new_atom(ATOM_SYMBOL);
symbol(atom) = zstrdup(value);
return atom;
}
atom_t *new_string(const char *value) {
atom_t *atom = new_atom(ATOM_STRING);
string(atom) = zstrdup(value);
return atom;
}
void load_cmp()
{
lisp_install_symbol("=",(void*)new_atom(LENORMAL,LTCFNPTR,(void*)new_lisp_cfn(1,0,CFN_ARGNOCIEL,lp_eq)),0);
lisp_install_symbol("equal",(void*)new_atom(LENORMAL,LTCFNPTR,(void*)new_lisp_cfn(1,0,CFN_ARGNOCIEL,lp_eq)),0);
lisp_install_symbol("~=",(void*)new_atom(LENORMAL,LTCFNPTR,(void*)new_lisp_cfn(1,0,CFN_ARGNOCIEL,lp_neq)),0);
lisp_install_symbol("unequal",(void*)new_atom(LENORMAL,LTCFNPTR,(void*)new_lisp_cfn(1,0,CFN_ARGNOCIEL,lp_neq)),0);
lisp_install_symbol("<",(void*)new_atom(LENORMAL,LTCFNPTR,(void*)new_lisp_cfn(1,0,CFN_ARGNOCIEL,lp_lt)),0);
lisp_install_symbol("less",(void*)new_atom(LENORMAL,LTCFNPTR,(void*)new_lisp_cfn(1,0,CFN_ARGNOCIEL,lp_lt)),0);
lisp_install_symbol("<=",(void*)new_atom(LENORMAL,LTCFNPTR,(void*)new_lisp_cfn(1,0,CFN_ARGNOCIEL,lp_leq)),0);
lisp_install_symbol("less-or-equal",(void*)new_atom(LENORMAL,LTCFNPTR,(void*)new_lisp_cfn(1,0,CFN_ARGNOCIEL,lp_leq)),0);
lisp_install_symbol(">",(void*)new_atom(LENORMAL,LTCFNPTR,(void*)new_lisp_cfn(1,0,CFN_ARGNOCIEL,lp_gt)),0);
lisp_install_symbol("greater",(void*)new_atom(LENORMAL,LTCFNPTR,(void*)new_lisp_cfn(1,0,CFN_ARGNOCIEL,lp_gt)),0);
lisp_install_symbol(">=",(void*)new_atom(LENORMAL,LTCFNPTR,(void*)new_lisp_cfn(1,0,CFN_ARGNOCIEL,lp_geq)),0);
lisp_install_symbol("greater-or-equal",(void*)new_atom(LENORMAL,LTCFNPTR,(void*)new_lisp_cfn(1,0,CFN_ARGNOCIEL,lp_geq)),0);
}
atom_t *new_boolean(const bool value) {
atom_t *atom = new_atom(ATOM_BOOLEAN);
boolean(atom) = value;
return atom;
}