Beispiel #1
0
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;
}
Beispiel #2
0
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);
}
Beispiel #3
0
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;
}
Beispiel #4
0
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;
}
Beispiel #5
0
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;
}
Beispiel #6
0
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;
}
Beispiel #7
0
Datei: eval.c Projekt: S010/misc
struct expr    *
atom_t(void)
{
	struct expr    *e;

	e = new_expr(LATOM);
	e->v.atom = new_atom("t");

	return e;
}
Beispiel #8
0
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(&quote);
	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;
}
Beispiel #9
0
Datei: eval.c Projekt: S010/misc
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();
}
Beispiel #10
0
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)));
}
Beispiel #11
0
atom_t *new_number(const double value) {
	atom_t *atom = new_atom(ATOM_NUMBER);
	number(atom) = value;
	return atom;
}
Beispiel #12
0
atom_t *new_builtin(atom_t *(*func_)(atom_t *)) {
	atom_t *atom = new_atom(ATOM_BUILTIN);
	func(atom) = func_;
	return atom;
}
Beispiel #13
0
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;
}
Beispiel #14
0
atom_t *new_symbol(const char *value) {
	atom_t *atom = new_atom(ATOM_SYMBOL);
	symbol(atom) = zstrdup(value);
	return atom;
}
Beispiel #15
0
atom_t *new_string(const char *value) {
	atom_t *atom = new_atom(ATOM_STRING);
	string(atom) = zstrdup(value);
	return atom;
}
Beispiel #16
0
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);
}
Beispiel #17
0
atom_t *new_boolean(const bool value) {
	atom_t *atom = new_atom(ATOM_BOOLEAN);
	boolean(atom) = value;
	return atom;
}