X-Git-Url: https://git.gag.com/?p=fw%2Faltos;a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_builtin.c;h=d89404dcca93185dac78f8aafb5df98045bff61e;hp=6fc28820d403f1bd3d44ad77609d00fafa6737d7;hb=2e58b6c380bc6440490c47650fbf11d45b3f2e72;hpb=0ced351c8f4449f7086b04e42c822d649f040d1f

diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c
index 6fc28820..d89404dc 100644
--- a/src/lisp/ao_lisp_builtin.c
+++ b/src/lisp/ao_lisp_builtin.c
@@ -210,11 +210,17 @@ ao_lisp_do_set(struct ao_lisp_cons *cons)
 ao_poly
 ao_lisp_do_setq(struct ao_lisp_cons *cons)
 {
+	ao_poly	name;
 	if (!ao_lisp_check_argc(_ao_lisp_atom_setq, cons, 2, 2))
 		return AO_LISP_NIL;
+	name = cons->car;
+	if (ao_lisp_poly_type(name) != AO_LISP_ATOM)
+		return ao_lisp_error(AO_LISP_INVALID, "set! of non-atom");
+	if (!ao_lisp_atom_ref(ao_lisp_frame_current, name))
+		return ao_lisp_error(AO_LISP_INVALID, "atom not defined");
 	return ao_lisp__cons(_ao_lisp_atom_set,
 			     ao_lisp__cons(ao_lisp__cons(_ao_lisp_atom_quote,
-							 ao_lisp__cons(cons->car, AO_LISP_NIL)),
+							 ao_lisp__cons(name, AO_LISP_NIL)),
 					   cons->cdr));
 }
 
@@ -559,5 +565,33 @@ ao_lisp_do_not(struct ao_lisp_cons *cons)
 		return _ao_lisp_bool_false;
 }
 
+ao_poly
+ao_lisp_do_listp(struct ao_lisp_cons *cons)
+{
+	ao_poly	v;
+	if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1))
+		return AO_LISP_NIL;
+	v = ao_lisp_arg(cons, 0);
+	for (;;) {
+		if (v == AO_LISP_NIL)
+			return _ao_lisp_bool_true;
+		if (ao_lisp_poly_type(v) != AO_LISP_CONS)
+			return _ao_lisp_bool_false;
+		v = ao_lisp_poly_cons(v)->cdr;
+	}
+}
+
+ao_poly
+ao_lisp_do_pairp(struct ao_lisp_cons *cons)
+{
+	ao_poly	v;
+	if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1))
+		return AO_LISP_NIL;
+	v = ao_lisp_arg(cons, 0);
+	if (ao_lisp_poly_type(v) == AO_LISP_CONS)
+		return _ao_lisp_bool_true;
+	return _ao_lisp_bool_false;
+}
+
 #define AO_LISP_BUILTIN_FUNCS
 #include "ao_lisp_builtin.h"