1
0
mirror of https://github.com/janet-lang/janet synced 2024-11-15 13:14:48 +00:00

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.
This commit is contained in:
Calvin Rose 2019-01-18 12:04:34 -05:00
parent b4934ceddc
commit b84b0e4828
4 changed files with 119 additions and 111 deletions

View File

@ -7,9 +7,7 @@
### ###
### ###
(var *env* (var *env* "The current environment." _env)
"The current environment."
_env)
(def defn :macro (def defn :macro
"(def name & more)\n\nDefine a function. Equivalent to (def name (fn name [args] ...))." "(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) ret)
(defn zipcoll (defn zipcoll
"Creates an table or tuple from two arrays/tuples. "Creates a table from two arrays/tuples.
Returns a new table." Returns a new table."
[keys vals] [keys vals]
(def res @{}) (def res @{})
@ -1146,8 +1144,8 @@ value, one key will be ignored."
,(aux (+ 2 i)) ,(aux (+ 2 i))
,$res)))) 0))) ,$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 (defmacro doc
"Shows documentation for the given symbol." "Shows documentation for the given symbol."
[sym] [sym]
(tuple doc* '_env (tuple 'quote sym))) ~(,doc* *env* ',sym))
### ###
### ###
@ -1385,8 +1383,6 @@ value, one key will be ignored."
[parent &] [parent &]
(def parent (if parent parent _env)) (def parent (if parent parent _env))
(def newenv (table/setproto @{} parent)) (def newenv (table/setproto @{} parent))
(put newenv '_env @{:value newenv :private true
:doc "The environment table for the current scope."})
newenv) newenv)
(defn run-context (defn run-context
@ -1539,89 +1535,90 @@ value, one key will be ignored."
(res) (res)
(error (res :error)))) (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 (defn module/find
"Try to match a module or path name from the patterns in paths." "Try to match a module or path name from the patterns in paths."
[path paths] [path paths]
(def parts (string/split "/" path)) (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 @{})
module/paths, then the path as a raw file path. Returns the new environment
returned from compiling and running the file."
(do
(defn check-mod (def module/loading
"Table mapping currently loading modules to true. Used to prevent
circular dependencies."
@{})
# Require helpers
(defn- check-mod
[f testpath] [f testpath]
(if f f (file/open testpath))) (or f (file/open testpath)))
(defn- find-mod [path]
(defn find-mod [path]
(def paths (module/find path module/paths)) (def paths (module/find path module/paths))
(reduce check-mod nil paths)) (reduce check-mod nil paths))
(defn- check-native
(defn check-native
[p testpath] [p testpath]
(if p (or p
p
(do (do
(def f (file/open testpath)) (def f (file/open testpath))
(if f (do (file/close f) testpath))))) (if f (do (file/close f) testpath)))))
(defn- find-native [path]
(defn find-native [path]
(def paths (module/find path module/native-paths)) (def paths (module/find path module/native-paths))
(reduce check-native nil paths)) (reduce check-native nil paths))
(def cache @{}) (defn require
(def loading @{}) "Require a module with the given name. Will search all of the paths in
(fn require [path & args] module/paths, then the path as a raw file path. Returns the new environment
(when (get loading path) returned from compiling and running the file."
[path & args]
(when (get module/loading path)
(error (string "circular dependency: module " path " is loading"))) (error (string "circular dependency: module " path " is loading")))
(def {:exit exit-on-error} (table ;args)) (def {:exit exit-on-error} (table ;args))
(if-let [check (get cache path)] (if-let [check (get module/cache path)]
check check
(if-let [f (find-mod path)] (if-let [f (find-mod path)]
(do (do
# Normal janet module # Normal janet module
(def newenv (make-env)) (def newenv (make-env))
(put cache path newenv) (put module/loading path true)
(put loading path true) (defn chunks [buf _] (file/read f 2048 buf))
(defn chunks [buf _] (file/read f 1024 buf))
(run-context newenv chunks (run-context newenv chunks
(fn [sig x f source] (fn [sig x f source]
(when (not= sig :dead) (when (not= sig :dead)
@ -1629,14 +1626,23 @@ value, one key will be ignored."
(if exit-on-error (os/exit 1)))) (if exit-on-error (os/exit 1))))
path) path)
(file/close f) (file/close f)
(put loading path false) (put module/loading path false)
(put module/cache path newenv)
newenv) newenv)
(do (do
# Try native module # Try native module
(def n (find-native path)) (def n (find-native path))
(if (not n) (if (not n)
(error (string "could not open file for module " path))) (error (string "could not open file for module " path)))
(native n (make-env)))))))) (def e (make-env))
(native n e)
(put module/cache path e)
e))))
(put _env 'find-native nil)
(put _env 'check-native nil)
(put _env 'find-mod nil)
(put _env 'check-mod nil)
(defn import* (defn import*
"Import a module into a given environment table. This is the "Import a module into a given environment table. This is the
@ -1662,7 +1668,7 @@ value, one key will be ignored."
x x
(string x))) (string x)))
args)) args))
(tuple import* '_env (string path) ;argm)) (tuple import* '*env* (string path) ;argm))
(defn repl (defn repl
"Run a repl. The first parameter is an optional function to call to "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)) (def newenv (make-env))
(default chunks (fn [buf _] (file/read stdin :line buf))) (default chunks (fn [buf _] (file/read stdin :line buf)))
(default onsignal (fn [sig x f source] (default onsignal (fn [sig x f source]
(put newenv '_fiber @{:value f})
(case sig (case sig
:dead (do :dead (do
(put newenv '_ @{:value x}) (put newenv '_ @{:value x})
@ -1700,3 +1705,6 @@ value, one key will be ignored."
:when (symbol? k)] :when (symbol? k)]
(put symbol-set k true)) (put symbol-set k true))
(sort (keys symbol-set))) (sort (keys symbol-set)))
# Use dynamic *env* from now on
(put _env '_env nil)

View File

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

View File

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