Update module system.

Add relative imports and path normalization. This should
help towards a more composable build/dependency system.

src/boot/boot.janet

@@ -1578,42 +1578,43 @@
   [image]
   (unmarshal image (env-lookup _env)))
 
+(def- nati (if (= :windows (os/which)) ".dll" ".so"))
+(defn- check-. [x] (string/has-prefix? "." x))
+
 (def module/paths
-  "The list of paths to look for modules. The following
-  substitutions are preformed on each path. :sys: becomes
-  module/*syspath*, :name: becomes the last part of the module
-  name after the last /, and :all: is the module name literally.
-  :native: becomes the dynamic library file extension, usually dll
-  or so. Each element is a two element tuple, containing the path
+  "The list of paths to look for modules, templated for module/expand-path.
+  Each element is a two element tuple, containing the path
   template and a keyword :source, :native, or :image indicating how
   require should load files found at these paths.\n\nA tuple can also
   contain a third element, specifying a filter that prevents module/find
   from searching that path template if the filter doesn't match the input
-  path. The filter is often a file extension, including the period."
-  @[[":all:" :native (if (= (os/which) :windows) ".dll" ".so")]
+  path. The filter can be a string or a predicate function, and
+  is often a file extension, including the period."
+  @[# Full or relative paths, including extensions
+    [":all:" :native nati]
     [":all:" :image ".jimage"]
-    [":all:" :source]
+    [":all:" :source ".janet"]
+
+    # Relative to (dyn :current-file "./."). Path must start with .
+    [":cur:/:all:.janet" :source check-.]
+    [":cur:/:all:/init.janet" :source check-.]
+    [":cur:/:all:.jimage" :image check-.]
+    [(string ":cur:/:all:" nati) :native check-.]
+
+    # Relative to current dir (os/cwd)
     ["./:all:.janet" :source]
     ["./:all:/init.janet" :source]
+    ["./:all:.jimage" :image]
+    [(string "./:all:" nati) :native]
+
+    # System paths
     [":sys:/:all:.janet" :source]
     [":sys:/:all:/init.janet" :source]
-    ["./:all:.:native:" :native]
-    ["./:all:/:name:.:native:" :native]
-    [":sys:/:all:.:native:" :native]
-    ["./:all:.jimage" :image]
-    [":sys:/:all:.jimage" :image]])
+    [":sys:/:all:.jimage" :image]
+    [(string ":sys:/:all:" nati) :native]])
 
-(var module/*syspath*
-  "The path where globally installed libraries are located.
-  The default is set at build time and is /usr/local/lib/janet on linux/posix, and
-  on Windows is the empty string."
-  (or (process/opts "JANET_PATH") ""))
-
-(var module/*headerpath*
-  "The path where the janet headers are installed. Useful for building
-  native modules or compiling code at runtime. Default on linux/posix is
-  /usr/local/include/janet, and on Windows is the empty string."
-  (or (process/opts "JANET_HEADERPATH") ""))
+(setdyn :syspath (process/opts "JANET_PATH"))
+(setdyn :headerpath (process/opts "JANET_HEADERPATH"))
 
 # Version of fexists that works even with a reduced OS
 (if-let [has-stat (_env 'os/stat)]
@@ -1629,14 +1630,6 @@
         (file/close f)
         res))))
 
-(def nati (if (= :windows (os/which)) "dll" "so"))
-(defn- expand-path-name
-  [template name path]
-  (->> template
-       (string/replace ":name:" name)
-       (string/replace ":sys:" module/*syspath*)
-       (string/replace ":native:" nati)
-       (string/replace ":all:" path)))
 (defn- mod-filter
   [x path]
   (case (type x)
@@ -1650,8 +1643,6 @@
   or image if the module is found, otherwise a tuple with nil followed by
   an error message."
   [path]
-  (def parts (string/split "/" path))
-  (def name (last parts))
   (var ret nil)
   (each [p mod-kind checker] module/paths
     (when (mod-filter checker path)
@@ -1660,7 +1651,7 @@
                   (set ret [res mod-kind])
                   (break))
         (do
-          (def fullpath (expand-path-name p name path))
+          (def fullpath (string (module/expand-path path p)))
           (when (fexists fullpath)
             (set ret [fullpath mod-kind])
             (break))))))
@@ -1668,15 +1659,15 @@
     (let [expander (fn [[t _ chk]]
                      (when (string? t)
                        (when (mod-filter chk path)
-                         (expand-path-name t name path))))
+                         (module/expand-path path t))))
           paths (filter identity (map expander module/paths))
           str-parts (interpose "\n    " paths)]
       [nil (string "could not find module " path ":\n    " ;str-parts)])))
 
 (put _env 'fexists nil)
 (put _env 'nati nil)
-(put _env 'expand-path-name nil)
 (put _env 'mod-filter nil)
+(put _env 'check-. nil)
 
 (def module/cache
   "Table mapping loaded module identifiers to their environments."
@@ -1698,6 +1689,7 @@
            path
            (file/open path)))
   (default env (make-env))
+  (put env :current-file (string path))
   (defn chunks [buf _] (file/read f 2048 buf))
   (defn bp [&opt x y]
     (def ret (bad-parse x y))
@@ -1737,16 +1729,15 @@
   module/paths, then the path as a raw file path. Returns the new environment
   returned from compiling and running the file."
   [path & args]
-  (if-let [check (get module/cache path)]
+  (def [fullpath mod-kind] (module/find path))
+  (unless fullpath (error mod-kind))
+  (if-let [check (get module/cache fullpath)]
     check
     (do
-      (def [fullpath mod-kind] (module/find path))
-      (unless fullpath (error mod-kind))
       (def loader (module/loaders mod-kind))
       (unless loader (error (string "module type " mod-kind " unknown")))
       (def env (loader fullpath args))
       (put module/cache fullpath env)
-      (put module/cache path env)
       env)))
 
 (defn import*

src/core/corelib.c

@@ -93,6 +93,126 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
     return init;
 }
 
+static const char *janet_dyncstring(const char *name, const char *dflt) {
+    Janet x = janet_dyn(name);
+    if (janet_checktype(x, JANET_NIL)) return dflt;
+    if (!janet_checktype(x, JANET_STRING)) {
+        janet_panicf("expected string, got %v", x);
+    }
+    const uint8_t *jstr = janet_unwrap_string(x);
+    const char *cstr = (const char *)jstr;
+    if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
+        janet_panicf("string %v contains embedded 0s");
+    }
+    return cstr;
+}
+
+static int is_path_sep(char c) {
+#ifdef JANET_WINDOWS
+    if (c == '\\') return 1;
+#endif
+    return c == '/';
+}
+
+/* Used for module system. */
+static Janet janet_core_expand_path(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 2);
+    const char *input = janet_getcstring(argv, 0);
+    const char *template = janet_getcstring(argv, 1);
+    const char *curfile = janet_dyncstring("current-file", "./.");
+    const char *syspath = janet_dyncstring("syspath", "");
+    JanetBuffer *out = janet_buffer(0);
+    size_t tlen = strlen(template);
+
+    /* Calculate name */
+    const char *name = input + strlen(input) - 1;
+    while (name > input) {
+        if (is_path_sep(*(name - 1))) break;
+        name--;
+    }
+
+    /* Calculate dirpath from current file */
+    const char *curname = curfile + strlen(curfile) - 1;
+    while (curname > curfile) {
+        if (is_path_sep(*curname)) break;
+        curname--;
+    }
+
+    for (size_t i = 0; i < tlen; i++) {
+        if (template[i] == ':') {
+            if (strncmp(template + i, ":all:", 5) == 0) {
+                janet_buffer_push_cstring(out, input);
+                i += 4;
+            } else if (strncmp(template + i, ":cur:", 5) == 0) {
+                janet_buffer_push_bytes(out, (const uint8_t *) curfile, curname - curfile);
+                i += 4;
+            } else if (strncmp(template + i, ":dir:", 5) == 0) {
+                janet_buffer_push_bytes(out, (const uint8_t *) input, name - input);
+                i += 4;
+            } else if (strncmp(template + i, ":sys:", 5) == 0) {
+                janet_buffer_push_cstring(out, syspath);
+                i += 4;
+            } else if (strncmp(template + i, ":name:", 6) == 0) {
+                janet_buffer_push_cstring(out, name);
+                i += 5;
+            } else {
+                janet_buffer_push_u8(out, (uint8_t) template[i]);
+            }
+        } else {
+            janet_buffer_push_u8(out, (uint8_t) template[i]);
+        }
+    }
+
+    /* Normalize */
+    uint8_t *scan = out->data;
+    uint8_t *print = scan;
+    uint8_t *scanend = scan + out->count;
+    int normal_section_count = 0;
+    int dot_count = 0;
+    while (scan < scanend) {
+        if (*scan == '.') {
+            if (dot_count >= 0) {
+                dot_count++;
+            } else {
+                *print++ = '.';
+            }
+        } else if (is_path_sep(*scan)) {
+            if (dot_count == 1) {
+                ;
+            } else if (dot_count == 2) {
+                if (normal_section_count > 0) {
+                    /* unprint last separator */
+                    print--;
+                    /* unprint last section */
+                    while (print > out->data && !is_path_sep(*(print - 1)))
+                        print--;
+                    normal_section_count--;
+                } else {
+                    *print++ = '.';
+                    *print++ = '.';
+                    *print++ = '/';
+                }
+            } else if (scan == out->data || dot_count != 0) {
+                while (dot_count > 0) {
+                    --dot_count;
+                    *print++ = '.';
+                }
+                if (scan > out->data) {
+                    normal_section_count++;
+                }
+                *print++ = '/';
+            }
+            dot_count = 0;
+        } else {
+            dot_count = -1;
+            *print++ = *scan;
+        }
+        scan++;
+    }
+    out->count = print - out->data;
+    return janet_wrap_buffer(out);
+}
+
 static Janet janet_core_dyn(int32_t argc, Janet *argv) {
     janet_arity(argc, 1, 2);
     Janet value;
@@ -482,6 +602,14 @@ static const JanetReg corelib_cfuns[] = {
         JDOC("(untrace func)\n\n"
              "Disables tracing on a function. Returns the function.")
     },
+    {
+        "module/expand-path", janet_core_expand_path,
+        JDOC("(module/expand-path path template)\n\n"
+             "Expands a path template as found in module/paths for module/find. "
+             "This takes in a path (the argument to require) and a template string, template, "
+             "to expand the path to a path that can be "
+             "used for importing files.")
+    },
     {NULL, NULL, NULL}
 };
 

src/mainclient/init.janet

@@ -11,8 +11,8 @@
   (var *colorize* true)
   (var *compile-only* false)
 
-  (if-let [jp (os/getenv "JANET_PATH")] (set module/*syspath* jp))
-  (if-let [jp (os/getenv "JANET_HEADERPATH")] (set module/*headerpath* jp))
+  (if-let [jp (os/getenv "JANET_PATH")] (setdyn :syspath jp))
+  (if-let [jp (os/getenv "JANET_HEADERPATH")] (setdyn :headerpath jp))
 
   # Flag handlers
   (def handlers :private
@@ -42,7 +42,7 @@
      "q" (fn [&] (set *quiet* true) 1)
      "k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1)
      "n" (fn [&] (set *colorize* false) 1)
-     "m" (fn [i &] (set module/*syspath* (get process/args (+ i 1))) 2)
+     "m" (fn [i &] (setdyn :syspath (get process/args (+ i 1))) 2)
      "c" (fn [i &]
            (def e (require (get process/args (+ i 1))))
            (spit (get process/args (+ i 2)) (make-image e))
@@ -50,7 +50,7 @@
            3)
      "-" (fn [&] (set *handleopts* false) 1)
      "l" (fn [i &]
-           (import* (get process/args (+ i 1))
+           (dofile (get process/args (+ i 1))
                     :prefix "" :exit *exit-on-error*)
            2)
      "e" (fn [i &]
@@ -71,7 +71,7 @@
       (+= i (dohandler (string/slice arg 1 2) i))
       (do
         (set *no-file* false)
-        (import* arg :prefix "" :exit *exit-on-error* :compile-only *compile-only*)
+        (dofile arg :prefix "" :exit *exit-on-error* :compile-only *compile-only*)
         (set i lenargs))))
 
   (when (and (not *compile-only*) (or *should-repl* *no-file*))