commit 01cb406bffe88b68eea68b495631414f11a56093
parent 9d91b639cb26831d98193e6b9e61abf507aa0c8c
Author: Andres Navarro <canavarro82@gmail.com>
Date: Thu, 24 Nov 2011 19:18:25 -0300
Added get-interpreter-arguments and get-script-arguments to the ground environment.
Diffstat:
3 files changed, 62 insertions(+), 5 deletions(-)
diff --git a/doc/klisp.1 b/doc/klisp.1
@@ -46,7 +46,7 @@ The arguments given in the command line before
.IR script ,
including the name of the interpreter,
are available via the applicative
-.RI ' get-command-line '.
+.RI ' get-interpreter-arguments '.
.LP
At the very beginning,
before even handling the command line,
diff --git a/src/kgsystem.c b/src/kgsystem.c
@@ -175,6 +175,20 @@ void rename_file(klisp_State *K)
}
}
+/* used for both get_script_arguments and get_interpreter_arguments */
+void get_arguments(klisp_State *K)
+{
+ /*
+ * xparams[0]: immutable argument list
+ */
+ TValue ptree = K->next_value;
+ TValue *xparams = K->next_xparams;
+ check_0p(K, ptree);
+
+ TValue res = xparams[0];
+ kapply_cc(K, res);
+}
+
/* init ground */
void kinit_system_ground_env(klisp_State *K)
{
@@ -188,15 +202,18 @@ void kinit_system_ground_env(klisp_State *K)
/* ??.?.? jiffies-per-second */
add_applicative(K, ground_env, "jiffies-per-second", jiffies_per_second,
0);
-
/* ?.? file-exists? */
add_applicative(K, ground_env, "file-exists?", file_existsp, 0);
-
/* ?.? delete-file */
add_applicative(K, ground_env, "delete-file", delete_file, 0);
-
/* this isn't in r7rs but it's in ansi c and quite easy to implement */
-
/* ?.? rename-file */
add_applicative(K, ground_env, "rename-file", rename_file, 0);
+ /* The value for these two will get set later by the interpreter */
+ /* ?.? get-script-arguments */
+ add_applicative(K, ground_env, "get-script-arguments", get_arguments,
+ 1, KNIL);
+ /* ?.? get-interpreter-arguments */
+ add_applicative(K, ground_env, "get-interpreter-arguments", get_arguments,
+ 1, KNIL);
}
diff --git a/src/klisp.c b/src/klisp.c
@@ -25,6 +25,8 @@
#include "kstring.h"
#include "kcontinuation.h"
#include "koperative.h"
+#include "kapplicative.h"
+#include "ksymbol.h"
#include "kenvironment.h"
#include "kport.h"
#include "kread.h"
@@ -507,6 +509,40 @@ static int runargs (klisp_State *K, char **argv, int n)
return EXIT_SUCCESS;
}
+static void populate_argument_lists(klisp_State *K, char **argv, int argc,
+ int script)
+{
+ /* first create the script list */
+ TValue tail = KNIL;
+ TValue obj = KINERT;
+ krooted_tvs_push(K, tail);
+ krooted_tvs_push(K, obj);
+ while(argc > script) {
+ char *arg = argv[--argc];
+ obj = kstring_new_b_imm(K, arg);
+ tail = kimm_cons(K, obj, tail);
+ }
+ /* Store the script argument list */
+ obj = ksymbol_new(K, "get-script-arguments", KNIL);
+ klisp_assert(kbinds(K, K->ground_env, obj));
+ obj = kunwrap(kget_binding(K, K->ground_env, obj));
+ tv2op(obj)->extra[0] = tail;
+
+ while(argc > 0) {
+ char *arg = argv[--argc];
+ obj = kstring_new_b_imm(K, arg);
+ tail = kimm_cons(K, obj, tail);
+ }
+ /* Store the interpreter argument list */
+ obj = ksymbol_new(K, "get-interpreter-arguments", KNIL);
+ klisp_assert(kbinds(K, K->ground_env, obj));
+ obj = kunwrap(kget_binding(K, K->ground_env, obj));
+ tv2op(obj)->extra[0] = tail;
+
+ krooted_tvs_pop(K);
+ krooted_tvs_pop(K);
+}
+
static int handle_klispinit(klisp_State *K)
{
const char *init = getenv(KLISP_INIT);
@@ -562,6 +598,10 @@ static void pmain(klisp_State *K)
if (has_v)
print_version();
+ /* TEMP this could be either set before or after running the arguments,
+ we'll do it before for now */
+ populate_argument_lists(K, argv, s->argc, (script > 0) ? script : s->argc);
+
s->status = runargs(K, argv, (script > 0) ? script : s->argc);
if (s->status != EXIT_SUCCESS)
