commit 3b841c58a968ec6c43a3d405d2b9bfaaf20dae68
parent eb5be949efeda606d06702034f6bccbebe55772b
Author: Andres Navarro <canavarro82@gmail.com>
Date: Thu, 31 Mar 2011 17:01:59 -0300
Added $and? & $or? to the ground environment.
Diffstat:
5 files changed, 91 insertions(+), 7 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -88,7 +88,7 @@ kghelpers.o: kghelpers.c kghelpers.h kstate.h kstate.h klisp.h kpair.h \
kapplicative.h koperative.h kerror.h kobject.h ksymbol.h \
kcontinuation.h
kgbooleans.o: kgbooleans.c kgbooleans.c kghelpers.h kstate.h klisp.h \
- kobject.h kerror.h kpair.h kcontinuation.h
+ kobject.h kerror.h kpair.h kcontinuation.h ksymbol.h
kgeqp.o: kgeqp.c kgeqp.c kghelpers.h kstate.h klisp.h \
kobject.h kerror.h kpair.h kcontinuation.h
kgequalp.o: kgequalp.c kgequalp.c kghelpers.h kstate.h klisp.h \
diff --git a/src/kgbooleans.c b/src/kgbooleans.c
@@ -14,6 +14,7 @@
#include "klisp.h"
#include "kstate.h"
#include "kpair.h"
+#include "ksymbol.h"
#include "kcontinuation.h"
#include "kerror.h"
#include "kghelpers.h"
@@ -78,8 +79,85 @@ void orp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
kapply_cc(K, res);
}
+/* Helpers for $and? & $or? */
+
+/*
+** operands is a list, the other cases are handled before calling
+** term-bool is the termination boolean, i.e. the boolean that terminates
+** evaluation early and becomes the result of $and?/$or?
+** it is #t for $or? and #f for $and?
+** both $and? & $or? have to allow boolean checking while performing a tail
+** call that is acomplished by checking if the current continuation will
+** perform a boolean check, and in that case, no continuation is created
+*/
+void do_Sandp_Sorp(klisp_State *K, TValue *xparams, TValue obj)
+{
+ /*
+ ** xparams[0]: symbol name
+ ** xparams[1]: termination boolean
+ ** xparams[2]: remaining operands
+ ** xparams[3]: denv
+ */
+ TValue sname = xparams[0];
+ TValue term_bool = xparams[1];
+ TValue ls = xparams[2];
+ TValue denv = xparams[3];
+
+ if (!ttisboolean(obj)) {
+ klispE_throw_extra(K, ksymbol_buf(sname), ": expected boolean");
+ return;
+ } else if (ttisnil(ls) || tv_equal(obj, term_bool)) {
+ /* in both cases the value to be returned is obj:
+ if there are no more operands it is obvious otherwise, if
+ the termination bool is found:
+ $and? returns #f when it finds #f and $or? returns #t when it
+ finds #t */
+ kapply_cc(K, obj);
+ } else {
+ TValue first = kcar(ls);
+ ls = kcdr(ls);
+ /* This is the important part of tail context + bool check */
+ if (!ttisnil(ls) || !kis_bool_check_cont(kget_cc(K))) {
+ TValue new_cont =
+ kmake_continuation(K, kget_cc(K), KNIL, KNIL, do_Sandp_Sorp,
+ 4, sname, term_bool, ls, denv);
+ /*
+ ** Mark as a bool checking cont this is needed in the last operand
+ ** to allow both tail recursive behaviour and boolean checking.
+ ** While it is not necessary if this is not the last operand it
+ ** avoids a continuation in the last evaluation of the inner form
+ ** in the common use of
+ ** ($and?/$or? ($or?/$and? ...) ...)
+ */
+ kset_bool_check_cont(new_cont);
+ kset_cc(K, new_cont);
+ }
+ ktail_eval(K, first, denv);
+ }
+}
+
+void Sandp_Sorp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+ /*
+ ** xparams[0]: symbol name
+ ** xparams[1]: termination boolean
+ */
+ TValue sname = xparams[0];
+ TValue term_bool = xparams[1];
+
+ TValue ls = check_copy_list(K, ksymbol_buf(sname), ptree);
+ /* This will work even if ls is empty */
+ TValue new_cont =
+ kmake_continuation(K, kget_cc(K), KNIL, KNIL, do_Sandp_Sorp,
+ 4, sname, term_bool, ls, denv);
+ /* there's no need to mark it as bool checking, no evaluation
+ is done in the dynamic extent of this cont */
+ kset_cc(K, new_cont);
+ kapply_cc(K, knegp(term_bool)); /* pass dummy value to start */
+}
+
/* 6.1.4 $and? */
-/* TODO */
+/* uses Sandp_Sorp */
/* 6.1.5 $or? */
-/* TODO */
+/* uses Sandp_Sorp */
diff --git a/src/kgbooleans.h b/src/kgbooleans.h
@@ -30,11 +30,15 @@ void andp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
/* 6.1.3 or? */
void orp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+/* Helpers for $and? & $or? */
+void do_Sandp_Sorp(klisp_State *K, TValue *xparams, TValue obj);
+void Sandp_Sorp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+
/* 6.1.4 $and? */
-/* TODO */
+/* uses Sandp_Sorp */
/* 6.1.5 $or? */
-/* TODO */
+/* uses Sandp_Sorp */
/* Helper */
bool kbooleanp(TValue obj);
diff --git a/src/kground.c b/src/kground.c
@@ -359,10 +359,10 @@ void kinit_ground_env(klisp_State *K)
add_applicative(K, ground_env, "or?", orp, 0);
/* 6.1.4 $and? */
- /* TODO */
+ add_operative(K, ground_env, "$and?", Sandp_Sorp, 2, symbol, KFALSE);
/* 6.1.5 $or? */
- /* TODO */
+ add_operative(K, ground_env, "$or?", Sandp_Sorp, 2, symbol, KTRUE);
/*
** 6.2 Combiners
diff --git a/src/kobject.h b/src/kobject.h
@@ -213,6 +213,8 @@ typedef struct __attribute__ ((__packed__)) GCheader {
/* macros to easily check boolean values */
#define kis_true(o_) (tv_equal((o_), KTRUE))
#define kis_false(o_) (tv_equal((o_), KFALSE))
+/* unsafe, doesn't check type */
+#define knegp(o_) (kis_true(o_)? KFALSE : KTRUE)
/*
** Union of all Kernel non heap-allocated values (except doubles)
