commit 2e48b96cd94d6e1d670c55eb17ff2a4f25ed6f6c
parent 7b33ec2288862677ffd476749a4c21e92fbc2c73
Author: Andres Navarro <canavarro82@gmail.com>
Date: Thu, 24 Nov 2011 16:46:45 -0300
Changed the interpreter code to return exit_values that depend on the value passed to the root continuation. Added optional argument to exit.
Diffstat:
5 files changed, 107 insertions(+), 52 deletions(-)
diff --git a/doc/html/Continuations.html b/doc/html/Continuations.html
@@ -218,15 +218,20 @@ to <code>guard-dynamic-extent</code>.
</p></blockquote></div>
<div class="defun">
-— Applicative: <b>exit</b> (<var>exit</var>)<var><a name="index-exit-137"></a></var><br>
+— Applicative: <b>exit</b> (<var>exit </var>[<var>object</var>])<var><a name="index-exit-137"></a></var><br>
<blockquote><!-- TODO add xref -->
<p>Applicative <code>exit</code> initiates an abnormal transfer of
-<code>#inert</code> to <code>root-continuation</code>.
-
- <p>That is:
- <pre class="example"> (exit ) == (apply-continuation root-continuation #inert)
+<code>object</code> (or <code>#inert</code> if <code>object</code> was not specified),
+to <code>root-continuation</code>.
+ That is:
+ <pre class="example"> (exit) == (apply-continuation root-continuation #inert)
+ (exit obj) == (apply-continuation root-continuation obj)
</pre>
- </blockquote></div>
+ <p>SOURCE NOTE: This applicative doesn't have the optional argument in
+the report. It was added to klisp to allow a simple way to terminate
+the interpreter passing a value that is then tried to convert to an
+exit status.
+</p></blockquote></div>
<!-- *-texinfo-*- -->
</body></html>
diff --git a/doc/klisp.info b/doc/klisp.info
@@ -1379,12 +1379,17 @@ continuation type is encapsulated.
the new continuation, with no operands and the dynamic environment
of the call to `guard-dynamic-extent'.
- -- Applicative: exit (exit)
- Applicative `exit' initiates an abnormal transfer of `#inert' to
- `root-continuation'.
-
+ -- Applicative: exit (exit [object])
+ Applicative `exit' initiates an abnormal transfer of `object' (or
+ `#inert' if `object' was not specified), to `root-continuation'.
That is:
- (exit ) == (apply-continuation root-continuation #inert)
+ (exit) == (apply-continuation root-continuation #inert)
+ (exit obj) == (apply-continuation root-continuation obj)
+
+ SOURCE NOTE: This applicative doesn't have the optional argument in
+ the report. It was added to klisp to allow a simple way to
+ terminate the interpreter passing a value that is then tried to
+ convert to an exit status.
File: klisp.info, Node: Encapsulations, Next: Promises, Prev: Continuations, Up: Top
@@ -2823,13 +2828,13 @@ Node: Pairs and lists22662
Node: Environments39685
Node: Combiners49892
Node: Continuations55928
-Node: Encapsulations64102
-Node: Promises65555
-Node: Keyed Variables69478
-Node: Numbers72249
-Node: Strings91748
-Node: Characters97095
-Node: Ports99805
-Node: Alphabetical Index117409
+Node: Encapsulations64461
+Node: Promises65914
+Node: Keyed Variables69837
+Node: Numbers72608
+Node: Strings92107
+Node: Characters97454
+Node: Ports100164
+Node: Alphabetical Index117768
End Tag Table
diff --git a/doc/src/continuations.texi b/doc/src/continuations.texi
@@ -182,15 +182,21 @@ continuation, with no operands and the dynamic environment of the call
to @code{guard-dynamic-extent}.
@end deffn
-@deffn Applicative exit (exit)
+@deffn Applicative exit (exit [object])
@c TODO add xref
Applicative @code{exit} initiates an abnormal transfer of
-@code{#inert} to @code{root-continuation}.
-
+@code{object} (or @code{#inert} if @code{object} was not specified),
+to @code{root-continuation}.
That is:
@example
-(exit ) @equiv{} (apply-continuation root-continuation #inert)
+(exit) @equiv{} (apply-continuation root-continuation #inert)
+(exit obj) @equiv{} (apply-continuation root-continuation obj)
@end example
+
+ SOURCE NOTE: This applicative doesn't have the optional argument in
+the report. It was added to klisp to allow a simple way to terminate
+the interpreter passing a value that is then tried to convert to an
+exit status.
@end deffn
diff --git a/src/kgcontinuations.c b/src/kgcontinuations.c
@@ -341,6 +341,8 @@ void guard_dynamic_extent(klisp_State *K)
}
/* 7.3.4 exit */
+/* Unlike in the report, in klisp this takes an optional argument
+ to be passed to the root continuation (defaults to #inert) */
void kgexit(klisp_State *K)
{
TValue *xparams = K->next_xparams;
@@ -350,11 +352,13 @@ void kgexit(klisp_State *K)
UNUSED(denv);
UNUSED(xparams);
- check_0p(K, ptree);
+ TValue obj = ptree;
+ if (!get_opt_tpar(K, obj, "any", anytype))
+ obj = KINERT;
/* TODO: look out for guards and dynamic variables */
/* should be probably handled in kcall_cont() */
- kcall_cont(K, K->root_cont, KINERT);
+ kcall_cont(K, K->root_cont, obj);
}
/* init ground */
diff --git a/src/klisp.c b/src/klisp.c
@@ -30,6 +30,7 @@
#include "kread.h"
#include "kwrite.h"
#include "kerror.h"
+#include "kghelpers.h" /* for do_return_value */
#include "kgcontinuations.h" /* for do_pass_value */
#include "kgcontrol.h" /* for do_seq */
#include "kscript.h"
@@ -139,7 +140,7 @@ static void show_error(klisp_State *K, TValue obj) {
static int report (klisp_State *K, int status)
{
- if (status != 0) {
+ if (status != EXIT_SUCCESS) {
const char *msg = "Error!";
k_message(progname, msg);
show_error(K, K->next_value);
@@ -253,12 +254,22 @@ static int dostring (klisp_State *K, const char *s, const char *name)
/* only port remains in the root stack */
krooted_tvs_push(K, inner_cont);
+ /* This continuation will discard the result of the evaluation
+ and pass the root continuation #inert instead. This has to do with
+ the way the exit value of the interpreter is calculated (see man page)
+ */
+ TValue discard_cont = kmake_continuation(K, inner_cont, do_return_value,
+ 1, KINERT);
+
+ krooted_tvs_pop(K); /* pop inner cont */
+ krooted_tvs_push(K, discard_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,
+ TValue eval_cont = kmake_continuation(K, discard_cont, do_str_eval,
1, env);
- krooted_tvs_pop(K); /* pop inner cont */
+ krooted_tvs_pop(K); /* pop discard cont */
krooted_tvs_push(K, eval_cont);
TValue read_cont = kmake_continuation(K, eval_cont, do_str_read,
1, port);
@@ -269,8 +280,7 @@ static int dostring (klisp_State *K, const char *s, const char *name)
klispS_run(K);
- int status = errorp? 1 : 0;
-
+ int status = errorp? EXIT_FAILURE : EXIT_SUCCESS;
/* get the standard environment again in K->next_env */
K->next_env = env;
return report(K, status);
@@ -330,7 +340,7 @@ static int dofile(klisp_State *K, const char *name)
krooted_tvs_pop(K);
krooted_tvs_pop(K);
K->next_value = error_obj;
- return report(K, 1);
+ return report(K, EXIT_FAILURE);
}
TValue name_str = kstring_new_b(K, name);
@@ -369,12 +379,23 @@ static int dofile(klisp_State *K, const char *name)
/* only port remains in the root stack */
krooted_tvs_push(K, inner_cont);
+
+ /* This continuation will discard the result of the evaluation
+ and pass the root continuation #inert instead. This has to do with
+ the way the exit value of the interpreter is calculated (see man page)
+ */
+ TValue discard_cont = kmake_continuation(K, inner_cont, do_return_value,
+ 1, KINERT);
+
+ krooted_tvs_pop(K); /* pop inner cont */
+ krooted_tvs_push(K, discard_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_file_eval,
+ TValue eval_cont = kmake_continuation(K, discard_cont, do_file_eval,
1, env);
- krooted_tvs_pop(K); /* pop inner cont */
+ krooted_tvs_pop(K); /* pop discard cont */
krooted_tvs_push(K, eval_cont);
TValue read_cont = kmake_continuation(K, eval_cont, do_file_read,
1, port);
@@ -385,7 +406,7 @@ static int dofile(klisp_State *K, const char *name)
klispS_run(K);
- int status = errorp? 1 : 0;
+ int status = errorp? EXIT_FAILURE : EXIT_SUCCESS;
/* get the standard environment again in K->next_env */
K->next_env = env;
@@ -459,6 +480,8 @@ static int runargs (klisp_State *K, char **argv, int n)
TValue env = K->next_env;
UNUSED(env);
+ /* TEMP All passes to root cont and all resulting values will be ignored,
+ the only way to interrupt the running of arguments is to throw an error */
for (int i = 1; i < n; i++) {
if (argv[i] == NULL)
continue;
@@ -473,7 +496,7 @@ static int runargs (klisp_State *K, char **argv, int n)
klisp_assert(chunk != NULL);
if (dostring(K, chunk, "=(command line)") != 0)
- return 1;
+ return EXIT_FAILURE;
break;
}
// case 'l': /* no libraries for now */
@@ -481,14 +504,14 @@ static int runargs (klisp_State *K, char **argv, int n)
break;
}
}
- return 0;
+ return EXIT_SUCCESS;
}
static int handle_klispinit(klisp_State *K)
{
const char *init = getenv(KLISP_INIT);
if (init == NULL)
- return 0; /* status OK */
+ return EXIT_SUCCESS;
else
return dostring(K, init, "=" KLISP_INIT);
}
@@ -500,12 +523,12 @@ struct Smain {
int status;
};
-static int pmain(klisp_State *K)
+static void pmain(klisp_State *K)
{
/* This is weird but was done to follow lua scheme */
struct Smain *s = (struct Smain *) pvalue(K->next_value);
char **argv = s->argv;
- s->status = 0;
+ s->status = EXIT_SUCCESS;
/* There is a standard env in K->next_env, a common one is used for all
evaluations (init, expression args, script/repl) */
@@ -524,16 +547,16 @@ static int pmain(klisp_State *K)
/* init (eval KLISP_INIT env variable contents) */
s->status = handle_klispinit(K);
- if (s->status != 0)
- return 0;
+ if (s->status != EXIT_SUCCESS)
+ return;
bool has_i = false, has_v = false, has_e = false;
int script = collectargs(argv, &has_i, &has_v, &has_e);
if (script < 0) { /* invalid args? */
print_usage();
- s->status = 1;
- return 0;
+ s->status = EXIT_FAILURE;
+ return;
}
if (has_v)
@@ -541,15 +564,15 @@ static int pmain(klisp_State *K)
s->status = runargs(K, argv, (script > 0) ? script : s->argc);
- if (s->status != 0)
- return 0;
+ if (s->status != EXIT_SUCCESS)
+ return;
if (script > 0) {
s->status = handle_script(K, argv, script);
}
- if (s->status != 0)
- return 0;
+ if (s->status != EXIT_SUCCESS)
+ return;
if (has_i) {
dotty(K);
@@ -561,13 +584,10 @@ static int pmain(klisp_State *K)
s->status = dofile(K, NULL);
}
}
-
- return 0;
}
int main(int argc, char *argv[])
{
- int status;
struct Smain s;
klisp_State *K = klispL_newstate();
@@ -580,9 +600,24 @@ int main(int argc, char *argv[])
s.argc = argc;
s.argv = argv;
K->next_value = p2tv(&s);
- status = pmain(K);
+
+ pmain(K);
+
+ if (s.status == EXIT_SUCCESS) {
+ /* must check value passed to the root continuation to
+ return proper exit status */
+ if (ttisinert(K->next_value)) {
+ s.status = EXIT_SUCCESS;
+ } else if (ttisboolean(K->next_value)) {
+ s.status = kis_true(K->next_value)? EXIT_SUCCESS : EXIT_FAILURE;
+ } else if (ttisfixint(K->next_value)) {
+ s.status = ivalue(K->next_value);
+ } else {
+ s.status = EXIT_FAILURE;
+ }
+ }
klisp_close(K);
- return (status || s.status)? EXIT_FAILURE : EXIT_SUCCESS;
+ return s.status;
}