commit 07844d71887f047c789d68e131e4c8bff8561f64
parent 657ec61d59d3e342024e7fa4ebcef0bb52bad7f0
Author: Andres Navarro <canavarro82@gmail.com>
Date: Mon, 5 Dec 2011 21:09:19 -0300
Added file searching in require.
Diffstat:
7 files changed, 217 insertions(+), 13 deletions(-)
diff --git a/src/kgc.c b/src/kgc.c
@@ -627,6 +627,9 @@ static void markroot (klisp_State *K) {
markvalue(K, K->curr_port);
+ markvalue(K, K->require_path);
+ markvalue(K, K->require_table);
+
/* Mark all objects in the auxiliary stack,
(all valid indexes are below top) and all the objects in
the two protected areas */
diff --git a/src/kgports.c b/src/kgports.c
@@ -4,11 +4,11 @@
** See Copyright Notice in klisp.h
*/
-#include <assert.h>
#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <stdint.h>
+#include <string.h>
#include "kstate.h"
#include "kobject.h"
@@ -770,8 +770,98 @@ void load(klisp_State *K)
}
}
-/* ?.? require, it's like load except in a standard environment */
-/* TODO check to see if the files was required before! */
+/* Helpers for require */
+static bool readable(const char *filename) {
+ FILE *f = fopen(filename, "r"); /* try to open file */
+ if (f == NULL) return false; /* open failed */
+ fclose(f);
+ return true;
+}
+
+/* Path can't/shouldn't contain embedded zeros */
+static const char *get_next_template(klisp_State *K, const char *path,
+ TValue *next) {
+ const char *l;
+ while (*path == *KLISP_PATHSEP) path++; /* skip separators */
+ if (*path == '\0') return NULL; /* no more templates */
+ l = strchr(path, *KLISP_PATHSEP); /* find next separator */
+ if (l == NULL) l = path + strlen(path);
+ *next = kstring_new_bs(K, path, l-path); /* template */
+ return l; /* pointer to the end of the template */
+}
+
+/* no strings should contains embedded zeroes */
+static TValue str_sub(klisp_State *K, TValue s, TValue p, TValue r)
+{
+ const char *sp = kstring_buf(s);
+ const char *pp = kstring_buf(p);
+ const char *rp = kstring_buf(r);
+
+ uint32_t size = kstring_size(s);
+ uint32_t psize = kstring_size(p);
+ uint32_t rsize = kstring_size(r);
+ int32_t diff_size = rsize - psize;
+
+ const char *wild;
+
+ /* first calculate needed size */
+ while ((wild = strstr(sp, pp)) != NULL) {
+ size += diff_size;
+ sp = wild + psize;
+ }
+
+ /* now construct result buffer and fill it */
+ TValue res = kstring_new_s(K, size);
+ char *resp = kstring_buf(res);
+ sp = kstring_buf(s);
+ while ((wild = strstr(sp, pp)) != NULL) {
+ ptrdiff_t l = wild - sp;
+ memcpy(resp, sp, l);
+ resp += l;
+ memcpy(resp, rp, rsize);
+ resp += rsize;
+ sp = wild + psize;
+ }
+ strcpy(resp, sp); /* the size was calculated beforehand */
+ return res;
+}
+
+static TValue find_file (klisp_State *K, TValue name, TValue pname) {
+ /* not used in klisp */
+ /* name = luaL_gsub(L, name, ".", LUA_DIRSEP); */
+ /* lua_getfield(L, LUA_ENVIRONINDEX, pname); */
+ klisp_assert(ttisstring(name) && !kstring_emptyp(name));
+ const char *path = kstring_buf(pname);
+ TValue next = K->empty_string;
+ krooted_vars_push(K, &next);
+ TValue wild = kstring_new_b(K, KLISP_PATH_MARK);
+ krooted_tvs_push(K, wild);
+
+ while ((path = get_next_template(K, path, &next)) != NULL) {
+ next = str_sub(K, next, wild, name);
+ if (readable(kstring_buf(next))) { /* does file exist and is readable? */
+ krooted_tvs_pop(K);
+ krooted_vars_pop(K);
+ return next; /* return that file name */
+ }
+ }
+
+ krooted_tvs_pop(K);
+ krooted_vars_pop(K);
+ return K->empty_string; /* return empty_string */
+}
+
+/* ?.? require */
+/*
+** require is like load except that:
+** - require first checks to see if the file was already required
+** and if so, doesnt' do anything
+** - require looks for the named file in a number of locations
+** configurable via env var KLISP_PATH
+** - When/if the file is found, evaluation happens in an initially
+** standard environment
+*/
+/* TODO check if file was required */
void require(klisp_State *K)
{
TValue *xparams = K->next_xparams;
@@ -780,13 +870,27 @@ void require(klisp_State *K)
klisp_assert(ttisenvironment(K->next_env));
UNUSED(denv);
UNUSED(xparams);
- bind_1tp(K, ptree, "string", ttisstring, filename);
+ bind_1tp(K, ptree, "string", ttisstring, name);
+
+ if (kstring_emptyp(name)) {
+ klispE_throw_simple(K, "Empty name");
+ return;
+ }
+ TValue filename = K->empty_string;
+ krooted_vars_push(K, &filename);
+ filename = find_file(K, name, K->require_path);
+
+ if (kstring_emptyp(filename)) {
+ klispE_throw_simple_with_irritants(K, "Not found", 1, name);
+ return;
+ }
/* the reads must be guarded to close the file if there is some error
this continuation also will return inert after the evaluation of the
last expression is done */
TValue port = kmake_fport(K, filename, false, false);
krooted_tvs_push(K, port);
+ krooted_vars_pop(K); /* filename already rooted */
TValue inert_cont = kmake_continuation(K, kget_cc(K), do_return_value, 1,
KINERT);
diff --git a/src/kgsystem.c b/src/kgsystem.c
@@ -4,7 +4,6 @@
** See Copyright Notice in klisp.h
*/
-#include <assert.h>
#include <string.h>
#include <stdlib.h>
#include <stdbool.h>
diff --git a/src/klimits.h b/src/klimits.h
@@ -63,6 +63,11 @@
#define MINCONTNAMETABSIZE 32
#endif
+/* minimum size for the require table (must be power of 2) */
+#ifndef MINREQUIRETABSIZE
+#define MINREQUIRETABSIZE 32
+#endif
+
/* starting size for ground environment hashtable */
/* at last count, there were about 200 bindings in ground env */
#define ENVTABSIZE 512
diff --git a/src/klispconf.h b/src/klispconf.h
@@ -25,6 +25,7 @@
** non-ansi feature or library.
*/
#if defined(__STRICT_ANSI__)
+/* XXX currently unused */
#define KLISP_ANSI
#endif
@@ -36,11 +37,13 @@
#if defined(KLISP_USE_LINUX)
#define KLISP_USE_POSIX
#define KLISP_USE_DLOPEN /* needs an extra library: -ldl */
+/* XXX currently unused */
#define KLISP_USE_READLINE /* needs some extra libraries */
#endif
#if defined(KLISP_USE_MACOSX)
#define KLISP_USE_POSIX
+/* XXX currently unused */
#define KLISP_DL_DYLD /* does not need extra library */
#endif
@@ -57,7 +60,6 @@
*/
#define KLISP_QL(x) "'" x "'"
#define KLISP_QS KLISP_QL("%s")
-/* /TODO */
/*
@@ KLISP_USE_POSIX includes all functionallity listed as X/Open System
@@ -72,16 +74,87 @@
#endif
/*
-@@ LUA_PATH and LUA_CPATH are the names of the environment variables that
-@* Lua check to set its paths.
-@@ KLISP_INIT is the name of the environment variable that klisp
+@@ KLISP_PATH and KLISP_CPATH are the names of the environment variables that
+@* Klisp check to set its paths.
+@@ KLISP_INIT is the name of the environment variable that Klisp
@* checks for initialization code.
** CHANGE them if you want different names.
*/
-//#define LUA_PATH "LUA_PATH"
-//#define LUA_CPATH "LUA_CPATH"
+#define KLISP_PATH "KLISP_PATH"
+#define KLISP_CPATH "KLISP_CPATH"
#define KLISP_INIT "KLISP_INIT"
+
+/*
+@@ KLISP_PATH_DEFAULT is the default path that Klisp uses to look for
+@* Klisp libraries.
+@@ KLISP_CPATH_DEFAULT is the default path that Klisp uses to look for
+@* C libraries.
+** CHANGE them if your machine has a non-conventional directory
+** hierarchy or if you want to install your libraries in
+** non-conventional directories.
+*/
+#if defined(_WIN32)
+/*
+** In Windows, any exclamation mark ('!') in the path is replaced by the
+** path of the directory of the executable file of the current process.
+*/
+#define KLISP_LDIR "!\\klisp\\"
+#define KLISP_CDIR "!\\"
+#define KLISP_PATH_DEFAULT \
+ ".\\?.k;" ".\\?" \
+ KLISP_LDIR"?.k;" KLISP_LDIR"?;" \
+ KLISP_CDIR"?.k;" KLISP_CDIR"?;"
+/* XXX Not used for now */
+#define KLISP_CPATH_DEFAULT \
+ ".\\?.dll;" KLISP_CDIR"?.dll;" KLISP_CDIR"loadall.dll"
+
+#else
+#define KLISP_ROOT "/usr/local/"
+#define KLISP_LDIR KLISP_ROOT "share/klisp/0.3/"
+#define KLISP_CDIR KLISP_ROOT "lib/klisp/0.3/"
+#define KLISP_PATH_DEFAULT \
+ "./?.k;./?;" \
+ KLISP_LDIR"?.k;" KLISP_LDIR"?;" \
+ KLISP_CDIR"?;" KLISP_CDIR"?.k"
+/* XXX Not used for now */
+#define KLISP_CPATH_DEFAULT \
+ "./?.so;" KLISP_CDIR"?.so;" KLISP_CDIR"loadall.so"
+#endif
+
+
+/*
+@@ KLISP_DIRSEP is the directory separator (for submodules).
+** XXX KLISP_DIRSEP is not currently used
+** This allows naturally looking paths in windows while still using
+** CHANGE it if your machine does not use "/" as the directory separator
+** and is not Windows. (On Windows Klisp automatically uses "\".)
+*/
+#if defined(_WIN32)
+#define KLISP_DIRSEP "\\"
+#else
+#define KLISP_DIRSEP "/"
+#endif
+
+
+/*
+@@ KLISP_PATHSEP is the character that separates templates in a path.
+@@ KLISP_PATH_MARK is the string that marks the substitution points in a
+@* template.
+@@ KLISP_EXECDIR in a Windows path is replaced by the executable's
+@* directory.
+@@ XXX KLISP_IGMARK is not currently used in klisp.
+@@ KLISP_IGMARK is a mark to ignore all before it when bulding the
+@* klispopen_ function name.
+** CHANGE them if for some reason your system cannot use those
+** characters. (E.g., if one of those characters is a common character
+** in file/directory names.) Probably you do not need to change them.
+*/
+#define KLISP_PATHSEP ";"
+#define KLISP_PATH_MARK "?"
+#define KLISP_EXECDIR "!"
+#define KLISP_IGMARK "-"
+
/*
@@ klisp_stdin_is_tty detects whether the standard input is a 'tty' (that
@* is, whether we're running klisp interactively).
@@ -117,7 +190,7 @@
#define KTRACK_MARKS true
*/
-/* TODO use this defines */
+/* TODO use this defines everywhere */
#define KTRACK_NAMES true
#define KTRACK_SI true
diff --git a/src/kstate.c b/src/kstate.c
@@ -13,14 +13,15 @@
** problem. ASK John.
*/
+#include <stdlib.h>
#include <stddef.h>
#include <setjmp.h>
+#include <string.h>
#include "klisp.h"
#include "klimits.h"
#include "kstate.h"
#include "kobject.h"
-#include "kstring.h"
#include "kpair.h"
#include "kmem.h"
#include "keval.h"
@@ -191,6 +192,21 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
/* initialize writer */
K->write_displayp = false; /* set on each call to write */
+ /* initialize require facilities */
+ {
+ char *str = getenv(KLISP_PATH);
+ if (str == NULL)
+ str = KLISP_PATH_DEFAULT;
+
+ K->require_path = kstring_new_b_imm(K, str);
+ /* replace dirsep with forward slashes,
+ windows will happily accept forward slashes */
+ str = kstring_buf(K->require_path);
+ while ((str = strchr(str, *KLISP_DIRSEP)) != NULL)
+ *str++ = '/';
+ }
+ K->require_table = klispH_new(K, 0, MINREQUIRETABSIZE, 0);
+
/* initialize temp stack */
K->ssize = KS_ISSIZE;
K->stop = 0; /* stack is empty */
diff --git a/src/kstate.h b/src/kstate.h
@@ -155,6 +155,10 @@ struct klisp_State {
/* writer */
bool write_displayp;
+ /* require */
+ TValue require_path;
+ TValue require_table;
+
/* auxiliary stack (XXX this could be a vector) */
int32_t ssize; /* total size of array */
int32_t stop; /* top of the stack (all elements are below this index) */
