commit 252802e64cf2670540276320c09c5a631f3c3ad2
parent bc11d230ec4342dc8997eb367d6aaf89d0391c02
Author: Andres Navarro <canavarro82@gmail.com>
Date: Sun, 20 Nov 2011 23:31:15 -0300
Added -e argument handling (string evaluation)
Diffstat:
9 files changed, 171 insertions(+), 19 deletions(-)
diff --git a/src/kenvironment.c b/src/kenvironment.c
@@ -314,7 +314,7 @@ TValue kget_keyed_static_var(klisp_State *K, TValue env, TValue key)
}
/* environments with hashtable bindings */
-/* TEMP: for now only for ground environment */
+/* TEMP: for now only for ground & std environments */
TValue kmake_table_environment(klisp_State *K, TValue parents)
{
TValue new_env = kmake_environment(K, parents);
diff --git a/src/kerror.h b/src/kerror.h
@@ -13,6 +13,7 @@
#include "klisp.h"
#include "kstate.h"
+#include "kpair.h" /* for klist */
TValue klispE_new(klisp_State *K, TValue who, TValue cont, TValue msg,
TValue irritants);
diff --git a/src/kgc.c b/src/kgc.c
@@ -581,7 +581,7 @@ static void markroot (klisp_State *K) {
K->grayagain = NULL;
K->weak = NULL;
- /* TEMP: this is quite awfull, think of other way to do this */
+ /* TEMP: this is quite awful, think of other way to do this */
/* MAYBE: some of these could be FIXED */
markvalue(K, K->name_table);
markvalue(K, K->cont_name_table);
@@ -612,6 +612,8 @@ static void markroot (klisp_State *K) {
markvalue(K, K->ktok_sexp_comment);
markvalue(K, K->shared_dict);
+ markvalue(K, K->curr_port);
+
/* Mark all objects in the auxiliary stack,
(all valid indexes are below top), all the objects in
the two protected areas, and the three dummy pairs */
diff --git a/src/kgcontinuations.h b/src/kgcontinuations.h
@@ -62,7 +62,6 @@ void kgexit(klisp_State *K, TValue *xparams, TValue ptree,
TValue denv);
void do_extended_cont(klisp_State *K, TValue *xparams, TValue obj);
-void do_pass_value(klisp_State *K, TValue *xparams, TValue obj);
/* init ground */
void kinit_continuations_ground_env(klisp_State *K);
diff --git a/src/kgenvironments.c b/src/kgenvironments.c
@@ -313,7 +313,9 @@ void make_kernel_standard_environment(klisp_State *K, TValue *xparams,
UNUSED(denv);
check_0p(K, ptree);
- TValue new_env = kmake_environment(K, K->ground_env);
+ /* std environments have hashtable for bindings */
+ TValue new_env = kmake_table_environment(K, K->ground_env);
+// TValue new_env = kmake_environment(K, K->ground_env);
kapply_cc(K, new_env);
}
diff --git a/src/kgports.c b/src/kgports.c
@@ -704,7 +704,9 @@ void get_module(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
TValue port = kmake_fport(K, filename, false, false);
krooted_tvs_push(K, port);
- TValue env = kmake_environment(K, K->ground_env);
+ /* std environments have hashtable for bindings */
+ TValue env = kmake_table_environment(K, K->ground_env);
+// TValue env = kmake_environment(K, K->ground_env);
krooted_tvs_push(K, env);
if (get_opt_tpar(K, maybe_env, "environment", ttisenvironment)) {
diff --git a/src/klisp.c b/src/klisp.c
@@ -15,8 +15,19 @@
#include "klisp.h"
#include "kstate.h"
#include "kauxlib.h"
+
+#include "kstring.h"
+#include "kcontinuation.h"
+#include "koperative.h"
+#include "kenvironment.h"
+#include "kport.h"
+#include "kread.h"
+#include "kerror.h"
+#include "kgcontinuations.h" /* for do_pass_value */
#include "kscript.h"
+/* TODO update dependencies in makefile */
+
/* TODO this should be moved to a file named like klispconf.h (see lua) */
/*
@@ KLISP_PROGNAME is the default name for the stand-alone klisp program.
@@ -60,11 +71,139 @@ static void k_message (const char *pname, const char *msg)
fflush(stderr);
}
+static int report (klisp_State *K, int status) {
+ if (status && !lua_isnil(L, -1)) {
+/* TODO show error */
+ const char *msg = "Error! \n";
+ k_message(progname, msg)
+ }
+ return status;
+}
+
static void print_version (void)
{
k_message(NULL, KLISP_RELEASE " " KLISP_COPYRIGHT);
}
+/* REFACTOR maybe these should be moved to a general place to be used
+ from any program */
+void do_str_eval(klisp_State *K, TValue *xparams, TValue obj)
+{
+ /*
+ ** xparams[0]: dynamic environment
+ */
+ TValue denv = xparams[0];
+ ktail_eval(K, obj, denv);
+}
+
+void do_str_read(klisp_State *K, TValue *xparams, TValue obj)
+{
+ /*
+ ** xparams[0]: port
+ */
+ TValue port = xparams[0];
+ UNUSED(obj);
+ /* read just one value (as mutable data) */
+ TValue obj1 = kread_from_port(K, port, true);
+
+ if (ttiseof(obj1)) {
+ klispE_throw_simple_with_irritants(K, "No object could be read",
+ 1, port);
+ return;
+ }
+
+ krooted_tvs_push(K, obj1);
+ TValue obj2 = kread_from_port(K, port, true);
+ krooted_tvs_pop(K);
+
+ if (!ttiseof(obj2)) {
+ klispE_throw_simple_with_irritants(K, "More than one expression read",
+ 1, port);
+ return;
+ }
+
+ /* all ok, just one exp read */
+ kapply_cc(K, obj1);
+}
+
+void do_int_mark_error(klisp_State *K, TValue *xparams, TValue ptree,
+ TValue denv)
+{
+ /*
+ ** xparams[0]: errorp pointer
+ */
+ UNUSED(denv);
+ bool *errorp = (bool *) pvalue(xparams[0]);
+ *errorp = true;
+ /* ptree is (object divert) */
+ TValue error_obj = kcar(ptree);
+ /* pass the error along after setting the flag */
+ kapply_cc(K, error_obj);
+}
+
+static int dostring (klisp_State *K, const char *s, const char *name)
+{
+ bool errorp = false; /* may be set to true in error handler */
+
+ UNUSED(name); /* could use as filename?? */
+ /* create a string input port */
+ TValue str = kstring_new_b(K, s);
+ krooted_tvs_push(K, str);
+ TValue port = kmake_mport(K, str, false, false);
+ krooted_tvs_pop(K);
+ krooted_tvs_push(K, port);
+
+ /* create the guard set error flag after errors */
+ TValue exit_int = kmake_operative(K, do_int_mark_error,
+ 1, p2tv(&errorp));
+ krooted_tvs_push(K, exit_int);
+ TValue exit_guard = kcons(K, K->error_cont, exit_int);
+ krooted_tvs_pop(K); /* already in guard */
+ krooted_tvs_push(K, exit_guard);
+ TValue exit_guards = kcons(K, exit_guard, KNIL);
+ krooted_tvs_pop(K); /* alread in guards */
+ krooted_tvs_push(K, exit_guards);
+
+ TValue entry_guards = KNIL;
+
+ /* this is needed for interception code */
+ TValue env = kmake_empty_environment(K);
+ krooted_tvs_push(K, env);
+ TValue outer_cont = kmake_continuation(K, K->root_cont,
+ do_pass_value, 2, entry_guards, env);
+ kset_outer_cont(outer_cont);
+ krooted_tvs_push(K, outer_cont);
+ TValue inner_cont = kmake_continuation(K, outer_cont,
+ do_pass_value, 2, exit_guards, env);
+ kset_inner_cont(inner_cont);
+ krooted_tvs_pop(K); krooted_tvs_pop(K); krooted_tvs_pop(K);
+
+ /* only port remains in the root stack */
+ krooted_tvs_push(K, inner_cont);
+
+ /* XXX This should probably be an extra param to the function */
+ env = K->next_env; /* this is the standard env that should be used for
+ evaluation */
+ TValue eval_cont = kmake_continuation(K, inner_cont, do_str_eval,
+ 1, env);
+ krooted_tvs_pop(K); /* pop inner cont */
+ krooted_tvs_push(K, eval_cont);
+ TValue read_cont = kmake_continuation(K, eval_cont, do_str_read,
+ 1, port);
+ krooted_tvs_pop(K); /* pop eval cont */
+ krooted_tvs_pop(K); /* pop port */
+ kset_cc(K, read_cont); /* this will protect all conts from gc */
+ klispS_apply_cc(K, KINERT);
+
+ klispS_run(K);
+
+ int status = errorp? 1 : 0;
+
+ /* get the standard environment again in K->next_env */
+ K->next_env = env;
+ return report(K, status);
+}
+
/* check that argument has no extra characters at the end */
#define notail(x) {if ((x)[2] != '\0') return -1;}
@@ -105,6 +244,11 @@ static int collectargs (char **argv, bool *pi, bool *pv, bool *pe)
static int runargs (klisp_State *K, char **argv, int n)
{
+ /* There is a standard env in K->next_env, a common one is used for all
+ evaluations (init, expression args, script/repl) */
+ TValue env = K->next_env;
+ UNUSED(env);
+
for (int i = 1; i < n; i++) {
if (argv[i] == NULL)
continue;
@@ -118,10 +262,8 @@ static int runargs (klisp_State *K, char **argv, int n)
chunk = argv[++i];
klisp_assert(chunk != NULL);
- /* TODO do string */
- UNUSED(K);
-// if (dostring(L, chunk, "=(command line)") != 0)
-// return 1;
+ if (dostring(K, chunk, "=(command line)") != 0)
+ return 1;
break;
}
// case 'l': /* no libraries for now */
@@ -142,9 +284,13 @@ struct Smain {
static int pmain (klisp_State *K)
{
/* This is weird but was done to follow lua scheme */
- struct Smain *s = (struct Smain *) pvalue(K->next_obj);
+ struct Smain *s = (struct Smain *) pvalue(K->next_value);
char **argv = s->argv;
+ /* There is a standard env in K->next_env, a common one is used for all
+ evaluations (init, expression args, script/repl) */
+ //TValue env = K->next_env;
+
if (argv[0] && argv[0][0])
progname = argv[0];
@@ -204,7 +350,7 @@ int main(int argc, char *argv[])
/* This is weird but was done to follow lua scheme */
s.argc = argc;
s.argv = argv;
- K->next_obj = p2tv(&s);
+ K->next_value = p2tv(&s);
status = pmain(K);
klisp_close(K);
diff --git a/src/kread.c b/src/kread.c
@@ -559,7 +559,7 @@ TValue kread(klisp_State *K)
return obj;
}
-
+/* port is protected from GC in curr_port */
TValue kread_from_port(klisp_State *K, TValue port, bool mut)
{
K->curr_port = port;
diff --git a/src/kstate.c b/src/kstate.c
@@ -38,7 +38,7 @@
#include "kbytevector.h"
#include "kgpairs_lists.h" /* for creating list_app */
-#include "kerror.h" /* for creating error hierarchy */
+#include "kgerror.h" /* for creating error hierarchy */
#include "kgc.h" /* for memory freeing & gc init */
@@ -248,6 +248,9 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
kinit_ground_env(K);
+ /* create a std environment and leave it in K->next_env */
+ K->next_env = kmake_table_environment(K, K->ground_env);
+
/* set the threshold for gc start now that we have allocated all mem */
K->GCthreshold = 4*K->totalbytes;
@@ -263,8 +266,6 @@ void do_root_exit(klisp_State *K, TValue *xparams, TValue obj)
/* Just save the value and end the loop */
K->next_value = obj;
- /* TEMP the return code is SUCCESS iff obj is inert */
- K->script_exit_code = ttisinert(obj)? EXIT_SUCCESS : EXIT_FAILURE;
K->next_func = NULL; /* force the loop to terminate */
return;
}
@@ -272,11 +273,9 @@ void do_root_exit(klisp_State *K, TValue *xparams, TValue obj)
void do_error_exit(klisp_State *K, TValue *xparams, TValue obj)
{
UNUSED(xparams);
- UNUSED(obj);
- /* TEMP Just pass a value to the root continuation that
- would result in an EXIT_FAILURE */
- kapply_cc(K, KFALSE);
+ /* TEMP Just pass the error to the root continuation */
+ kapply_cc(K, obj);
}
/*
@@ -589,6 +588,7 @@ void klispS_run(klisp_State *K)
(*fn)(K, K->next_xparams, K->next_value, K->next_env);
}
}
+ /* K->next_func is NULL, this means we should exit already */
break;
}
}
