klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

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:
Mdoc/html/Continuations.html | 17+++++++++++------
Mdoc/klisp.info | 31++++++++++++++++++-------------
Mdoc/src/continuations.texi | 14++++++++++----
Msrc/kgcontinuations.c | 8++++++--
Msrc/klisp.c | 89+++++++++++++++++++++++++++++++++++++++++++++++++++++++------------------------
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"> -&mdash; Applicative: <b>exit</b> (<var>exit</var>)<var><a name="index-exit-137"></a></var><br> +&mdash; 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; }