mirror of
				https://github.com/janet-lang/janet
				synced 2025-10-31 15:43:01 +00:00 
			
		
		
		
	Address #1434 - add dynamic bindings for module state.
This commit is contained in:
		| @@ -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-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)) | (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 | (def module/cache | ||||||
|   "A table, mapping loaded module identifiers to their environments." |   "A table, mapping loaded module identifiers to their environments." | ||||||
|   @{}) |   @{}) | ||||||
| @@ -2795,24 +2800,25 @@ | |||||||
|   keyword name of a loader in `module/loaders`. Returns the modified `module/paths`. |   keyword name of a loader in `module/loaders`. Returns the modified `module/paths`. | ||||||
|   ``` |   ``` | ||||||
|   [ext loader] |   [ext loader] | ||||||
|  |   (def mp (dyn *module/paths* module/paths)) | ||||||
|   (defn- find-prefix |   (defn- find-prefix | ||||||
|     [pre] |     [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:")) |   (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:")) |   (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:")) |   (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:")) |   (def curall-index (find-prefix ":cur:/:all:")) | ||||||
|   (array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-relative]) |   (array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative]) | ||||||
|   module/paths) |   mp) | ||||||
|  |  | ||||||
| (module/add-paths ":native:" :native) | (module/add-paths ":native:" :native) | ||||||
| (module/add-paths "/init.janet" :source) | (module/add-paths "/init.janet" :source) | ||||||
| (module/add-paths ".janet" :source) | (module/add-paths ".janet" :source) | ||||||
| (module/add-paths ".jimage" :image) | (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 | # Version of fexists that works even with a reduced OS | ||||||
| (defn- fexists | (defn- fexists | ||||||
| @@ -2842,7 +2848,8 @@ | |||||||
|   ``` |   ``` | ||||||
|   [path] |   [path] | ||||||
|   (var ret nil) |   (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) |     (when (mod-filter checker path) | ||||||
|       (if (function? p) |       (if (function? p) | ||||||
|         (when-let [res (p path)] |         (when-let [res (p path)] | ||||||
| @@ -2858,7 +2865,7 @@ | |||||||
|                      (when (string? t) |                      (when (string? t) | ||||||
|                        (when (mod-filter chk path) |                        (when (mod-filter chk path) | ||||||
|                          (module/expand-path path t)))) |                          (module/expand-path path t)))) | ||||||
|           paths (filter identity (map expander module/paths)) |           paths (filter identity (map expander mp)) | ||||||
|           str-parts (interpose "\n    " paths)] |           str-parts (interpose "\n    " paths)] | ||||||
|       [nil (string "could not find module " path ":\n    " ;str-parts)]))) |       [nil (string "could not find module " path ":\n    " ;str-parts)]))) | ||||||
|  |  | ||||||
| @@ -3013,13 +3020,15 @@ | |||||||
|   of files as modules.`` |   of files as modules.`` | ||||||
|   @{:native (fn native-loader [path &] (native path (make-env))) |   @{:native (fn native-loader [path &] (native path (make-env))) | ||||||
|     :source (fn source-loader [path args] |     :source (fn source-loader [path args] | ||||||
|               (put module/loading path true) |               (def ml (dyn *module/loading* module/loading)) | ||||||
|               (defer (put module/loading path nil) |               (put ml path true) | ||||||
|  |               (defer (put ml path nil) | ||||||
|                 (dofile path ;args))) |                 (dofile path ;args))) | ||||||
|     :preload (fn preload-loader [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) |                  (if (function? m) | ||||||
|                    (set (module/cache path) (m path ;args)) |                    (set (mc path) (m path ;args)) | ||||||
|                    m))) |                    m))) | ||||||
|     :image (fn image-loader [path &] (load-image (slurp path)))}) |     :image (fn image-loader [path &] (load-image (slurp path)))}) | ||||||
|  |  | ||||||
| @@ -3027,15 +3036,18 @@ | |||||||
|   [path args kargs] |   [path args kargs] | ||||||
|   (def [fullpath mod-kind] (module/find path)) |   (def [fullpath mod-kind] (module/find path)) | ||||||
|   (unless fullpath (error mod-kind)) |   (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 |     check | ||||||
|     (if (module/loading fullpath) |     (if (ml fullpath) | ||||||
|       (error (string "circular dependency " fullpath " detected")) |       (error (string "circular dependency " fullpath " detected")) | ||||||
|       (do |       (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"))) |         (unless loader (error (string "module type " mod-kind " unknown"))) | ||||||
|         (def env (loader fullpath args)) |         (def env (loader fullpath args)) | ||||||
|         (put module/cache fullpath env) |         (put mc fullpath env) | ||||||
|         env)))) |         env)))) | ||||||
|  |  | ||||||
| (defn require | (defn require | ||||||
|   | |||||||
| @@ -1595,7 +1595,7 @@ JANET_CORE_FN(os_clock, | |||||||
|     struct timespec tv; |     struct timespec tv; | ||||||
|     if (janet_gettime(&tv, source)) janet_panic("could not get time"); |     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) { |     if (janet_cstrcmp(formatstr, "double") == 0) { | ||||||
|         double dtime = tv.tv_sec + (tv.tv_nsec / 1E9); |         double dtime = tv.tv_sec + (tv.tv_nsec / 1E9); | ||||||
|         return janet_wrap_number(dtime); |         return janet_wrap_number(dtime); | ||||||
| @@ -1603,7 +1603,8 @@ JANET_CORE_FN(os_clock, | |||||||
|         return janet_wrap_number(tv.tv_sec); |         return janet_wrap_number(tv.tv_sec); | ||||||
|     } else if (janet_cstrcmp(formatstr, "tuple") == 0) { |     } else if (janet_cstrcmp(formatstr, "tuple") == 0) { | ||||||
|         Janet tup[2] = {janet_wrap_integer(tv.tv_sec), |         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)); |         return janet_wrap_tuple(janet_tuple_n(tup, 2)); | ||||||
|     } else { |     } else { | ||||||
|         janet_panicf("expected :double, :int, or :tuple, got %v", argv[1]); |         janet_panicf("expected :double, :int, or :tuple, got %v", argv[1]); | ||||||
|   | |||||||
		Reference in New Issue
	
	Block a user
	 Calvin Rose
					Calvin Rose