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;
 }