Expose more of the module system.

The system path can more easily modified at runtime,
and the module/cache and module/loading tables are now exposed.
Properly cache native modules as well.

doc/Parser.md

@@ -101,16 +101,16 @@ the double quote with a backslash. For unprintable characters, you can either us
 one of a few common escapes, use the `\xHH` escape to escape a single byte in
 hexidecimal. The supported escapes are:
 
-    - \\xHH Escape a single arbitrary byte in hexidecimal.
+- \\xHH Escape a single arbitrary byte in hexidecimal.
-    - \\n Newline (ASCII 10)
+- \\n Newline (ASCII 10)
-    - \\t Tab character (ASCII 9)
+- \\t Tab character (ASCII 9)
-    - \\r Carriage Return (ASCII 13)
+- \\r Carriage Return (ASCII 13)
-    - \\0 Null (ASCII 0)
+- \\0 Null (ASCII 0)
-    - \\z Null (ASCII 0)
+- \\z Null (ASCII 0)
-    - \\f Form Feed (ASCII 12)
+- \\f Form Feed (ASCII 12)
-    - \\e Escape (ASCII 27)
+- \\e Escape (ASCII 27)
-    - \\" Double Quote (ASCII 34)
+- \\" Double Quote (ASCII 34)
-    - \\\\ Backslash (ASCII 92)
+- \\\\ Backslash (ASCII 92)
 
 Strings can also contain literal newline characters that will be ignore.
 This lets one define a multiline string that does not contain newline characters.

src/core/core.janet

@@ -7,9 +7,7 @@
 ###
 ###
 
-(var *env*
+(var *env* "The current environment." _env)
-  "The current environment."
-  _env)
 
 (def defn :macro
   "(def name & more)\n\nDefine a function. Equivalent to (def name (fn name [args] ...))."
@@ -931,7 +929,7 @@ value, one key will be ignored."
   ret)
 
 (defn zipcoll
-  "Creates an table or tuple from two arrays/tuples.
+  "Creates a table from two arrays/tuples.
   Returns a new table."
   [keys vals]
   (def res @{})
@@ -1146,8 +1144,8 @@ value, one key will be ignored."
                            ,(aux (+ 2 i))
                            ,$res)))) 0)))
 
-(put _env sentinel nil)
+(put _env 'sentinel nil)
-(put _env match-1 nil)
+(put _env 'match-1 nil)
 
 ###
 ###
@@ -1223,7 +1221,7 @@ value, one key will be ignored."
 (defmacro doc
   "Shows documentation for the given symbol."
   [sym]
-  (tuple doc* '_env (tuple 'quote sym)))
+  ~(,doc* *env* ',sym))
 
 ###
 ###
@@ -1385,8 +1383,6 @@ value, one key will be ignored."
   [parent &]
   (def parent (if parent parent _env))
   (def newenv (table/setproto @{} parent))
-  (put newenv '_env @{:value newenv :private true
-                      :doc "The environment table for the current scope."})
   newenv)
 
 (defn run-context
@@ -1539,104 +1535,114 @@ value, one key will be ignored."
     (res)
     (error (res :error))))
 
-(do
+(def module/paths
-  (def syspath (or (os/getenv "JANET_PATH") "/usr/local/lib/janet/"))
+  "The list of paths to look for modules. The followig
-  (defglobal 'module/paths
+  substitutions are preformed on each path. :sys: becomes
-    @["./?.janet"
+  module/*syspath*, :name: becomes the last part of the module
-      "./?/init.janet"
+  name after the last /, and :all: is the module name literally. 
-      "./janet_modules/?.janet"
+  :native: becomes the dynamic library file extension, usually dll
-      "./janet_modules/?/init.janet"
+  or so."
-      (string syspath janet/version "/?.janet")
+  @["./:all:.janet"
-      (string syspath janet/version "/?/init.janet")
+    "./:all:/init.janet"
-      (string syspath "/?.janet")
+    ":sys:/:all:.janet"
-      (string syspath "/?/init.janet")])
+    ":sys:/:all:/init.janet"])
-  (defglobal 'module/native-paths
-    @["./?.so"
-      "./?/??.so"
-      "./janet_modules/?.so"
-      "./janet_modules/?/??.so"
-      (string syspath janet/version "/?.so")
-      (string syspath janet/version "/?/??.so")
-      (string syspath "/?.so")
-      (string syspath "/?/??.so")]))
 
-(if (= :windows (os/which))
+(def module/native-paths
-   (loop [i :range [0 (length module/native-paths)]]
+  "See doc for module/paths"
-     (def x (get module/native-paths i))
+  @["./:all:.:native:"
-     (put
+    "./:all:/:name:.:native:"
-       module/native-paths
+    ":sys:/:all:.:native:"
-       i
+    ":sys:/:all:/:name:.:native:"])
-       (string/replace ".so" ".dll" x))))
+
+(var module/*syspath*
+  "The path where globally installed libraries are located.
+  The default value is the environment variable JANET_PATH,
+  and if that is not set /usr/local/lib/janet on linux/posix, and
+  on Windows the default is the empty string."
+  (or (os/getenv "JANET_PATH")
+      (if (= :windows (os/which)) "" "/usr/local/lib/janet")))
 
 (defn module/find
   "Try to match a module or path name from the patterns in paths."
   [path paths]
   (def parts (string/split "/" path))
-  (def lastpart (get parts (- (length parts) 1)))
+  (def name (get parts (- (length parts) 1)))
-  (array/push
+  (def nati (if (= :windows (os/which)) "dll" "so"))
-    (map (fn [x]
+  (defn sub-path
-           (def y (string/replace "??" lastpart x))
+    [p]
-           (string/replace "?" path y))
+    (->> p
-         paths)
+         (string/replace ":name:" name)
-    path))
+         (string/replace ":sys:" module/*syspath*)
+         (string/replace ":native:" nati)
+         (string/replace ":all:" path)))
+  (array/push (map sub-path paths) path))
 
-(def require
+(def module/cache
-  "(require module & args)\n\n
+  "Table mapping loaded module identifiers to their environments."
-  Require a module with the given name. Will search all of the paths in
+  @{})
+
+(def module/loading
+  "Table mapping currently loading modules to true. Used to prevent
+  circular dependencies."
+  @{})
+
+# Require helpers
+(defn- check-mod
+  [f testpath]
+  (or f (file/open testpath)))
+(defn- find-mod [path]
+  (def paths (module/find path module/paths))
+  (reduce check-mod nil paths))
+(defn- check-native
+  [p testpath]
+  (or p
+    (do
+      (def f (file/open testpath))
+      (if f (do (file/close f) testpath)))))
+(defn- find-native [path]
+  (def paths (module/find path module/native-paths))
+  (reduce check-native nil paths))
+
+(defn require
+  "Require a module with the given name. Will search all of the paths in
   module/paths, then the path as a raw file path. Returns the new environment
   returned from compiling and running the file."
-  (do
+  [path & args]
+  (when (get module/loading path)
+    (error (string "circular dependency: module " path " is loading")))
+  (def {:exit exit-on-error} (table ;args))
+  (if-let [check (get module/cache path)]
+    check
+    (if-let [f (find-mod path)]
+      (do
+        # Normal janet module
+        (def newenv (make-env))
+        (put module/loading path true)
+        (defn chunks [buf _] (file/read f 2048 buf))
+        (run-context newenv chunks
+                     (fn [sig x f source]
+                       (when (not= sig :dead)
+                         (status-pp sig x f source)
+                         (if exit-on-error (os/exit 1))))
+                     path)
+        (file/close f)
+        (put module/loading path false)
+        (put module/cache path newenv)
+        newenv)
+      (do
+        # Try native module
+        (def n (find-native path))
+        (if (not n)
+          (error (string "could not open file for module " path)))
+        (def e (make-env))
+        (native n e)
+        (put module/cache path e)
+        e))))
 
-    (defn check-mod
+(put _env 'find-native nil)
-      [f testpath]
+(put _env 'check-native nil)
-      (if f f (file/open testpath)))
+(put _env 'find-mod nil)
-
+(put _env 'check-mod nil)
-    (defn find-mod [path]
-      (def paths (module/find path module/paths))
-      (reduce check-mod nil paths))
-
-    (defn check-native
-      [p testpath]
-      (if p
-        p
-        (do
-          (def f (file/open testpath))
-          (if f (do (file/close f) testpath)))))
-
-    (defn find-native [path]
-      (def paths (module/find path module/native-paths))
-      (reduce check-native nil paths))
-
-    (def cache @{})
-    (def loading @{})
-    (fn require [path & args]
-      (when (get loading path)
-        (error (string "circular dependency: module " path " is loading")))
-      (def {:exit exit-on-error} (table ;args))
-      (if-let [check (get cache path)]
-        check
-        (if-let [f (find-mod path)]
-          (do
-            # Normal janet module
-            (def newenv (make-env))
-            (put cache path newenv)
-            (put loading path true)
-            (defn chunks [buf _] (file/read f 1024 buf))
-            (run-context newenv chunks
-                         (fn [sig x f source]
-                           (when (not= sig :dead)
-                             (status-pp sig x f source)
-                             (if exit-on-error (os/exit 1))))
-                         path)
-            (file/close f)
-            (put loading path false)
-            newenv)
-          (do
-            # Try native module
-            (def n (find-native path))
-            (if (not n)
-              (error (string "could not open file for module " path)))
-            (native n (make-env))))))))
 
 (defn import*
   "Import a module into a given environment table. This is the
@@ -1662,7 +1668,7 @@ value, one key will be ignored."
                      x
                      (string x)))
                  args))
-  (tuple import* '_env (string path) ;argm))
+  (tuple import* '*env* (string path) ;argm))
 
 (defn repl
   "Run a repl. The first parameter is an optional function to call to
@@ -1673,7 +1679,6 @@ value, one key will be ignored."
   (def newenv (make-env))
   (default chunks (fn [buf _] (file/read stdin :line buf)))
   (default onsignal (fn [sig x f source]
-                      (put newenv '_fiber @{:value f})
                       (case sig
                         :dead (do
                                 (put newenv '_ @{:value x})
@@ -1700,3 +1705,6 @@ value, one key will be ignored."
          :when (symbol? k)]
     (put symbol-set k true))
   (sort (keys symbol-set)))
+
+# Use dynamic *env* from now on
+(put _env '_env nil)

src/mainclient/init.janet

@@ -49,7 +49,7 @@
       (+= i (dohandler (string/slice arg 1 2) i))
       (do
         (set *no-file* false)
-        (import* _env arg :prefix "" :exit *exit-on-error*)
+        (import* *env* arg :prefix "" :exit *exit-on-error*)
         (++ i))))
 
   (when (or *should-repl* *no-file*)

test/suite1.janet

@@ -140,7 +140,7 @@
 
 # Marshal
 
-(def um-lookup (env-lookup _env))
+(def um-lookup (env-lookup *env*))
 (def m-lookup (invert um-lookup))
 
 (defn testmarsh [x msg]