klisp

commit 45c79f62417d156d4037f4e764e5e25cc9d69c8a
parent eceadc1056f0cab7828802df93c75e0c8d65803e
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Sun, 13 Mar 2011 01:46:57 -0300

Extracted out the control features from kground.c to a new file kgcontrol.c (and .h).

Diffstat:
M
src/Makefile
 | 
4
+++-
A
src/kgcontrol.c
 | 
108
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A
src/kgcontrol.h
 | 
37
+++++++++++++++++++++++++++++++++++++
M
src/kground.c
 | 
104
+++----------------------------------------------------------------------------

4 files changed, 151 insertions(+), 102 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -11,7 +11,7 @@ CORE_O=	kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \
 	kwrite.o kstate.o kmem.o kerror.o kauxlib.o kenvironment.o \
 	kcontinuation.o koperative.o kapplicative.o keval.o krepl.o \
 	kground.o kghelpers.o kgbooleans.o kgeqp.o kgequalp.o \
-	kgsymbols.o
+	kgsymbols.o kgcontrol.o
 
 KRN_T=	klisp
 KRN_O=	klisp.o
@@ -79,3 +79,5 @@ kgequalp.o: kgequalp.c kgequalp.c kghelpers.h kstate.h klisp.h \
 	kobject.h kerror.h kpair.h kcontinuation.h kgeqp.h kstring.h
 kgsymbols.o: kgsymbols.c kgsymbols.c kghelpers.h kstate.h klisp.h \
 	kobject.h kerror.h kpair.h kcontinuation.h kstring.h
+kgcontrol.o: kgcontrol.c kgcontrol.c kghelpers.h kstate.h klisp.h \
+	kobject.h kerror.h kpair.h kcontinuation.h
diff --git a/src/kgcontrol.c b/src/kgcontrol.c
@@ -0,0 +1,108 @@
+/*
+** kgcontrol.c
+** Control features for the ground environment
+** See Copyright Notice in klisp.h
+*/
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <stdint.h>
+
+#include "kstate.h"
+#include "kobject.h"
+#include "kpair.h"
+#include "kcontinuation.h"
+#include "kerror.h"
+
+#include "kghelpers.h"
+#include "kgcontrol.h"
+
+/* 4.5.1 inert? */
+/* uses typep */
+
+/* 4.5.2 $if */
+
+/* helpers */
+void select_clause(klisp_State *K, TValue *xparams, TValue obj);
+
+/*  ASK JOHN: both clauses should probably be copied (copy-es-immutable) */
+void Sif(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+    (void) denv;
+    (void) xparams;
+
+    bind_3p(K, "$if", ptree, test, cons_c, alt_c);
+
+    TValue new_cont = 
+	kmake_continuation(K, kget_cc(K), KNIL, KNIL, select_clause, 
+			   3, denv, cons_c, alt_c);
+
+    klispS_set_cc(K, new_cont);
+    ktail_eval(K, test, denv);
+}
+
+void select_clause(klisp_State *K, TValue *xparams, TValue obj)
+{
+    /*
+    ** xparams[0]: dynamic env
+    ** xparams[1]: consequent clause
+    ** xparams[2]: alternative clause
+    */
+    if (ttisboolean(obj)) {
+	TValue denv = xparams[0];
+	TValue clause = bvalue(obj)? xparams[1] : xparams[2];
+	ktail_eval(K, clause, denv);
+    } else {
+	klispE_throw(K, "$if: test is not a boolean");
+	return;
+    }
+}
+
+/* 5.1.1 $sequence */
+void Ssequence(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+    (void) xparams;
+
+    if (ttisnil(ptree)) {
+	kapply_cc(K, KINERT);
+    } else {
+	/* the list of instructions is copied to avoid mutation */
+	/* MAYBE: copy the evaluation structure, ASK John */
+	TValue ls = check_copy_list(K, "$sequence", ptree);
+	/* this is needed because seq continuation doesn't check for 
+	   nil sequence */
+	TValue tail = kcdr(ls);
+	if (ttispair(tail)) {
+	    TValue new_cont = kmake_continuation(K, kget_cc(K), KNIL, KNIL,
+					     do_seq, 2, tail, denv);
+	    kset_cc(K, new_cont);
+	} 
+	ktail_eval(K, kcar(ls), denv);
+    }
+}
+
+/* Helper (also used by $vau and $lambda) */
+/* the ramaining list can't be null, that case is managed before */
+void do_seq(klisp_State *K, TValue *xparams, TValue obj)
+{
+    /* 
+    ** xparams[0]: remaining list
+    ** xparams[1]: dynamic environment
+    */
+    TValue ls = xparams[0];
+    TValue first = kcar(ls);
+    TValue tail = kcdr(ls);
+    TValue denv = xparams[1];
+
+    if (ttispair(tail)) {
+	TValue new_cont = kmake_continuation(K, kget_cc(K), KNIL, KNIL,
+					     do_seq, 2, tail, denv);
+	kset_cc(K, new_cont);
+    }
+    ktail_eval(K, first, denv);
+}
+
+/* 5.6.1 $cond */
+/* TODO */
diff --git a/src/kgcontrol.h b/src/kgcontrol.h
@@ -0,0 +1,37 @@
+/*
+** kgcontrol.h
+** Control features for the ground environment
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef kgcontrol_h
+#define kgcontrol_h
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <stdint.h>
+
+#include "kobject.h"
+#include "klisp.h"
+#include "kstate.h"
+#include "kghelpers.h"
+
+/* Helper (also used by $vau and $lambda) */
+void do_seq(klisp_State *K, TValue *xparams, TValue obj);
+
+/* 4.5.1 inert? */
+/* uses typep */
+
+/* 4.5.2 $if */
+
+void Sif(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+
+/* 5.1.1 $sequence */
+void Ssequence(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+
+/* 5.6.1 $cond */
+/* TODO */
+
+#endif
diff --git a/src/kground.c b/src/kground.c
@@ -26,6 +26,8 @@
 #include "kgbooleans.h"
 #include "kgeqp.h"
 #include "kgequalp.h"
+#include "kgsymbols.h"
+#include "kgcontrol.h"
 
 /*
 ** This section will roughly follow the report and will reference the
@@ -34,51 +36,6 @@
 /* TODO: split in different files for each module */
 
 /*
-** 4.5 Control
-*/
-
-/* 4.5.1 inert? */
-/* uses typep */
-
-/* 4.5.2 $if */
-
-/* helpers */
-void select_clause(klisp_State *K, TValue *xparams, TValue obj);
-
-/*  ASK JOHN: both clauses should probably be copied (copy-es-immutable) */
-void Sif(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
-{
-    (void) denv;
-    (void) xparams;
-
-    bind_3p(K, "$if", ptree, test, cons_c, alt_c);
-
-    TValue new_cont = 
-	kmake_continuation(K, kget_cc(K), KNIL, KNIL, select_clause, 
-			   3, denv, cons_c, alt_c);
-
-    klispS_set_cc(K, new_cont);
-    ktail_eval(K, test, denv);
-}
-
-void select_clause(klisp_State *K, TValue *xparams, TValue obj)
-{
-    /*
-    ** xparams[0]: dynamic env
-    ** xparams[1]: consequent clause
-    ** xparams[2]: alternative clause
-    */
-    if (ttisboolean(obj)) {
-	TValue denv = xparams[0];
-	TValue clause = bvalue(obj)? xparams[1] : xparams[2];
-	ktail_eval(K, clause, denv);
-    } else {
-	klispE_throw(K, "$if: test is not a boolean");
-	return;
-    }
-}
-
-/*
 ** 4.6 Pairs and lists
 */
 
@@ -551,8 +508,7 @@ void do_match(klisp_State *K, TValue *xparams, TValue obj)
 /* 4.10.3 $vau */
 /* 5.3.1 $vau */
 
-/* Helper (also used by $sequence and $lambda) */
-void do_seq(klisp_State *K, TValue *xparams, TValue obj);
+/* Helper (also used by $lambda) */
 void do_vau(klisp_State *K, TValue *xparams, TValue obj, TValue denv);
 
 void Svau(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
@@ -570,26 +526,6 @@ void Svau(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     kapply_cc(K, new_op);
 }
 
-/* the ramaining list can't be null, that case is managed before */
-void do_seq(klisp_State *K, TValue *xparams, TValue obj)
-{
-    /* 
-    ** xparams[0]: remaining list
-    ** xparams[1]: dynamic environment
-    */
-    TValue ls = xparams[0];
-    TValue first = kcar(ls);
-    TValue tail = kcdr(ls);
-    TValue denv = xparams[1];
-
-    if (ttispair(tail)) {
-	TValue new_cont = kmake_continuation(K, kget_cc(K), KNIL, KNIL,
-					     do_seq, 2, tail, denv);
-	kset_cc(K, new_cont);
-    }
-    ktail_eval(K, first, denv);
-}
-
 void do_vau(klisp_State *K, TValue *xparams, TValue obj, TValue denv)
 {
     /*
@@ -651,33 +587,6 @@ void unwrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 */
 
 /*
-** 5.1 Control
-*/
-
-/* 5.1.1 $sequence */
-void Ssequence(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
-{
-    (void) xparams;
-
-    if (ttisnil(ptree)) {
-	kapply_cc(K, KINERT);
-    } else {
-	/* the list of instructions is copied to avoid mutation */
-	/* MAYBE: copy the evaluation structure, ASK John */
-	TValue ls = check_copy_list(K, "$sequence", ptree);
-	/* this is needed because seq continuation doesn't check for 
-	   nil sequence */
-	TValue tail = kcdr(ls);
-	if (ttispair(tail)) {
-	    TValue new_cont = kmake_continuation(K, kget_cc(K), KNIL, KNIL,
-					     do_seq, 2, tail, denv);
-	    kset_cc(K, new_cont);
-	} 
-	ktail_eval(K, kcar(ls), denv);
-    }
-}
-
-/*
 ** 5.2 Pairs and lists
 */
 
@@ -852,13 +761,6 @@ void apply(klisp_State *K, TValue *xparams, TValue ptree,
 }
 
 /*
-** 5.6 Control
-*/
-
-/* 5.6.1 $cond */
-/* TODO */
-
-/*
 ** 5.7 Pairs and lists
 */