Skip to content

Commit

Permalink
Address #1434 - add dynamic bindings for module state.
Browse files Browse the repository at this point in the history
  • Loading branch information
bakpakin committed Apr 15, 2024
1 parent 89e74dc commit f92f3eb
Show file tree
Hide file tree
Showing 2 changed files with 32 additions and 19 deletions.
46 changes: 29 additions & 17 deletions src/boot/boot.janet
Original file line number Diff line number Diff line change
Expand Up @@ -2767,6 +2767,11 @@
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "@" x) (string/has-prefix? "." x)) x))
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))

(defdyn *module/cache* "Dynamic binding for overriding `module/cache`")
(defdyn *module/paths* "Dynamic binding for overriding `module/cache`")
(defdyn *module/loading* "Dynamic binding for overriding `module/cache`")
(defdyn *module/loaders* "Dynamic binding for overriding `module/loaders`")

(def module/cache
"A table, mapping loaded module identifiers to their environments."
@{})
Expand Down Expand Up @@ -2795,24 +2800,25 @@
keyword name of a loader in `module/loaders`. Returns the modified `module/paths`.
```
[ext loader]
(def mp (dyn *module/paths* module/paths))
(defn- find-prefix
[pre]
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) module/paths) 0))
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) mp) 0))
(def dyn-index (find-prefix ":@all:"))
(array/insert module/paths dyn-index [(string ":@all:" ext) loader check-dyn-relative])
(array/insert mp dyn-index [(string ":@all:" ext) loader check-dyn-relative])
(def all-index (find-prefix ".:all:"))
(array/insert module/paths all-index [(string ".:all:" ext) loader check-project-relative])
(array/insert mp all-index [(string ".:all:" ext) loader check-project-relative])
(def sys-index (find-prefix ":sys:"))
(array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
(array/insert mp sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
(def curall-index (find-prefix ":cur:/:all:"))
(array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-relative])
module/paths)
(array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative])
mp)

(module/add-paths ":native:" :native)
(module/add-paths "/init.janet" :source)
(module/add-paths ".janet" :source)
(module/add-paths ".jimage" :image)
(array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload check-not-relative])
(array/insert module/paths 0 [(fn is-cached [path] (if (in (dyn *module/cache* module/cache) path) path)) :preload check-not-relative])

# Version of fexists that works even with a reduced OS
(defn- fexists
Expand Down Expand Up @@ -2842,7 +2848,8 @@
```
[path]
(var ret nil)
(each [p mod-kind checker] module/paths
(def mp (dyn *module/paths* module/paths))
(each [p mod-kind checker] mp
(when (mod-filter checker path)
(if (function? p)
(when-let [res (p path)]
Expand All @@ -2858,7 +2865,7 @@
(when (string? t)
(when (mod-filter chk path)
(module/expand-path path t))))
paths (filter identity (map expander module/paths))
paths (filter identity (map expander mp))
str-parts (interpose "\n " paths)]
[nil (string "could not find module " path ":\n " ;str-parts)])))

Expand Down Expand Up @@ -3013,29 +3020,34 @@
of files as modules.``
@{:native (fn native-loader [path &] (native path (make-env)))
:source (fn source-loader [path args]
(put module/loading path true)
(defer (put module/loading path nil)
(def ml (dyn *module/loading* module/loading))
(put ml path true)
(defer (put ml path nil)
(dofile path ;args)))
:preload (fn preload-loader [path & args]
(when-let [m (in module/cache path)]
(def mc (dyn *module/cache* module/cache))
(when-let [m (in mc path)]
(if (function? m)
(set (module/cache path) (m path ;args))
(set (mc path) (m path ;args))
m)))
:image (fn image-loader [path &] (load-image (slurp path)))})

(defn- require-1
[path args kargs]
(def [fullpath mod-kind] (module/find path))
(unless fullpath (error mod-kind))
(if-let [check (if-not (kargs :fresh) (in module/cache fullpath))]
(def mc (dyn *module/cache* module/cache))
(def ml (dyn *module/loading* module/loading))
(def mls (dyn *module/loaders* module/loaders))
(if-let [check (if-not (kargs :fresh) (in mc fullpath))]
check
(if (module/loading fullpath)
(if (ml fullpath)
(error (string "circular dependency " fullpath " detected"))
(do
(def loader (if (keyword? mod-kind) (module/loaders mod-kind) mod-kind))
(def loader (if (keyword? mod-kind) (mls mod-kind) mod-kind))
(unless loader (error (string "module type " mod-kind " unknown")))
(def env (loader fullpath args))
(put module/cache fullpath env)
(put mc fullpath env)
env))))

(defn require
Expand Down
5 changes: 3 additions & 2 deletions src/core/os.c
Original file line number Diff line number Diff line change
Expand Up @@ -1595,15 +1595,16 @@ JANET_CORE_FN(os_clock,
struct timespec tv;
if (janet_gettime(&tv, source)) janet_panic("could not get time");

JanetKeyword formatstr = janet_optkeyword(argv, argc, 1 , (const uint8_t *) "double");
JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, (const uint8_t *) "double");
if (janet_cstrcmp(formatstr, "double") == 0) {
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
return janet_wrap_number(dtime);
} else if (janet_cstrcmp(formatstr, "int") == 0) {
return janet_wrap_number(tv.tv_sec);
} else if (janet_cstrcmp(formatstr, "tuple") == 0) {
Janet tup[2] = {janet_wrap_integer(tv.tv_sec),
janet_wrap_integer(tv.tv_nsec)};
janet_wrap_integer(tv.tv_nsec)
};
return janet_wrap_tuple(janet_tuple_n(tup, 2));
} else {
janet_panicf("expected :double, :int, or :tuple, got %v", argv[1]);
Expand Down

0 comments on commit f92f3eb

Please sign in to comment.