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:
parent
b4934ceddc
commit
b84b0e4828
@ -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)
|
||||||
|
@ -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*)
|
||||||
|
@ -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]
|
||||||
|
Loading…
Reference in New Issue
Block a user