From 9c437796d3665cf8bf0754100eece2c372ac5ab9 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 12 May 2024 14:42:05 -0500 Subject: [PATCH 01/63] Add first versions of bundle/* module The bundle module contains tools for modifying the contents of (dyn *syspath*) and providing a common interface for installing packages (called "bundles"). The functions are: * bundle/install * bundle/uninstall * bundle/manifest * bundle/do-hook * bundle/list * bundle/add-file * bundle/add-directory A bundle is a directory that contains any number of source files and other extra files, as well as a directory "hooks/", which contains a flat listing of janet scripts. This version of the bundle module is not responsible for building C source modules or for downloading files over the network. --- src/boot/boot.janet | 161 +++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 153 insertions(+), 8 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index dfbe9ef7..6c194243 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -688,7 +688,7 @@ ~(if (def ,(def sym (gensym)) ,br) (do (def ,bl ,sym) ,(aux (+ 2 i))) ,fal2))))) - (aux 0)) + (aux 0)) (defmacro when-let "Same as `(if-let bindings (do ;body))`." @@ -2143,8 +2143,8 @@ (def ret (case (type x) :tuple (if (= (tuple/type x) :brackets) - (tuple/brackets ;(map recur x)) - (dotup x)) + (tuple/brackets ;(map recur x)) + (dotup x)) :array (map recur x) :struct (table/to-struct (dotable x recur)) :table (dotable x recur) @@ -2958,7 +2958,7 @@ :core/stream path (file/open path :rb))) (def path-is-file (= f path)) - (default env (make-env)) + (default env (make-env (curenv))) (def spath (string path)) (put env :source (or source (if-not path-is-file spath path))) (var exit-error nil) @@ -3879,10 +3879,10 @@ ~(defn ,alias ,;meta [,;formal-args] (,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))) - (defmacro ffi/defbind - "Generate bindings for native functions in a convenient manner." - [name ret-type & body] - ~(ffi/defbind-alias ,name ,name ,ret-type ,;body)) +(defmacro ffi/defbind + "Generate bindings for native functions in a convenient manner." + [name ret-type & body] + ~(ffi/defbind-alias ,name ,name ,ret-type ,;body)) ### ### @@ -3959,6 +3959,151 @@ (merge-into module/cache old-modcache) nil) +### +### +### Bundle tools +### +### + +(compwhen (dyn 'os/stat) + + (defdyn *bundle-manifest* "Current manifest table of an installed package. Bound when executing hooks.") + + (defn- get-manifest-filename + [&opt bundle-name] + (string (dyn *syspath*) "/.manifests/" bundle-name (when bundle-name ".jdn"))) + + (defn- get-hook-filename + [&opt bundle-name hook] + (string (dyn *syspath*) "/.hooks/" bundle-name (when bundle-name (string "/" hook)))) + + (defn- prime-bundle-paths + [] + (def mf (get-manifest-filename)) + (def hf (get-hook-filename)) + (os/mkdir mf) + (os/mkdir hf) + nil) + + (defn- copy-hooks + [hooks-src bundle-name] + (os/mkdir (get-hook-filename bundle-name)) + (when (os/stat hooks-src :mode) + (each hook (os/dir hooks-src) + (def hookpath (string hooks-src "/" hook)) + (def source (slurp hookpath)) + (spit (get-hook-filename bundle-name hook) source)))) + + (defn- get-files [] + (def manifest (dyn *bundle-manifest*)) + (assert manifest "nothing bound to (dyn *bundle-manifest*)") + (def files (get manifest :files @[])) + (put manifest :files files) + files) + + (defn bundle/manifest + "Get the manifest for a give installed bundle" + [bundle-name] + (def name (get-manifest-filename bundle-name)) + (assert (fexists name) (string "no bundle " bundle-name " found")) + (parse (slurp name))) + + (defn bundle/do-hook + "Run a given hook for an installed bundle" + [bundle-name hook] + (bundle/manifest bundle-name) # assert good bundle-name + (def filename (get-hook-filename bundle-name hook)) + (when (os/stat filename :mode) + (def dir (os/cwd)) + (def real-syspath (os/realpath (dyn *syspath*))) # if syspath is a relative path + (def env (make-env)) + (def manifest-name (get-manifest-filename bundle-name)) + (def manifest (bundle/manifest bundle-name)) + (def srcdir (get manifest :local-source)) + (def filename-real (os/realpath filename)) + (put env *bundle-manifest* manifest) + (merge-into env manifest) + (put env *syspath* real-syspath) + # After install, srcdir does not always exist + (when (os/stat srcdir :mode) (os/cd srcdir)) + (defer (os/cd dir) + (print "running " filename-real " for bundle " bundle-name) + (dofile filename-real :env env) + (spit manifest-name (string/format "%j\n" manifest))))) + + (defn bundle/uninstall + "Remove a bundle from the current syspath" + [bundle-name] + (bundle/do-hook bundle-name "uninstall.janet") + (def man (bundle/manifest bundle-name)) + (def files (get man :files [])) + (each file (reverse files) + (print "removing " file) + (case (os/stat file :mode) + :file (os/rm file) + :directory (os/rmdir file))) + (os/rm (get-manifest-filename bundle-name)) + (def hf (get-hook-filename bundle-name)) + (each hook (os/dir hf) + (os/rm (string hf "/" hook))) + (os/rmdir hf) + nil) + + (defn bundle/install + "Install a bundle from the local filesystem with a name `bundle-name`." + [path &opt bundle-name &keys config] + (default bundle-name (last (string/split "/" path))) + (assert (next bundle-name) "cannot use empty bundle-name") + (assert (not (fexists (get-manifest-filename bundle-name))) + "bundle is already installed") + (prime-bundle-paths) + (def src-hooks (string path "/hooks/")) + (copy-hooks src-hooks bundle-name) + (def man @{:bundle-name bundle-name :local-source path}) + (when config (merge-into man config)) + (spit (get-manifest-filename bundle-name) (string/format "%j\n" man)) + (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name)) + (bundle/do-hook bundle-name "deps.janet") + (bundle/do-hook bundle-name "build.janet") + (bundle/do-hook bundle-name "install.janet")) + nil) + + (defn bundle/add-directory + "Add a directory during the install process relative to `(dyn *syspath*)`" + [dest &opt chmod-mode] + (def files (get-files)) + (def absdest (string (dyn *syspath*) "/" dest)) + (unless (os/mkdir absdest) + (errorf "collision at %s, directory already exists" absdest)) + (when chmod-mode + (os/chmod absdest chmod-mode)) + (array/push files absdest) + (print "adding " absdest) + absdest) + + (defn bundle/add-file + "Add files during an install relative to `(dyn *syspath*)`" + [src &opt dest chmod-mode] + (default dest src) + (def files (get-files)) + (def absdest (string (dyn *syspath*) "/" dest)) + (when (os/stat absdest :mode) + (errorf "collision at %s, file already exists" absdest)) + (spit absdest (slurp src)) + (when chmod-mode + (os/chmod dest chmod-mode)) + (array/push files absdest) + (print "adding " absdest) + absdest) + + (defn bundle/list + "Get a list of all installed bundles in lexical order." + [] + (def d (get-manifest-filename)) + (if (os/stat d :mode) + (sort (seq [x :in (os/dir (get-manifest-filename))] + (string/slice x 0 -5))) + @[]))) ### ### From 367c4b14f548f037997cb48a611b79bdd114cd01 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 12 May 2024 15:08:27 -0500 Subject: [PATCH 02/63] Sync manifest on error so that we uninstall the correct files. If we cannot create files during install, we want to be able to do a correct rollback. --- src/boot/boot.janet | 49 +++++++++++++++++++++++++++------------------ 1 file changed, 29 insertions(+), 20 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 6c194243..f25f54d8 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4001,6 +4001,13 @@ (put manifest :files files) files) + (defn- sync-manifest + [&opt manifest] + (default manifest (dyn *bundle-manifest*)) + (def bn (get manifest :bundle-name)) + (def manifest-name (get-manifest-filename bn)) + (spit manifest-name (string/format "%j\n" manifest))) + (defn bundle/manifest "Get the manifest for a give installed bundle" [bundle-name] @@ -4029,7 +4036,7 @@ (defer (os/cd dir) (print "running " filename-real " for bundle " bundle-name) (dofile filename-real :env env) - (spit manifest-name (string/format "%j\n" manifest))))) + (sync-manifest manifest)))) (defn bundle/uninstall "Remove a bundle from the current syspath" @@ -4071,30 +4078,32 @@ (defn bundle/add-directory "Add a directory during the install process relative to `(dyn *syspath*)`" [dest &opt chmod-mode] - (def files (get-files)) - (def absdest (string (dyn *syspath*) "/" dest)) - (unless (os/mkdir absdest) - (errorf "collision at %s, directory already exists" absdest)) - (when chmod-mode - (os/chmod absdest chmod-mode)) - (array/push files absdest) - (print "adding " absdest) - absdest) + (edefer (sync-manifest) + (def files (get-files)) + (def absdest (string (dyn *syspath*) "/" dest)) + (unless (os/mkdir absdest) + (errorf "collision at %s, directory already exists" absdest)) + (array/push files absdest) + (when chmod-mode + (os/chmod absdest chmod-mode)) + (print "adding " absdest) + absdest)) (defn bundle/add-file "Add files during an install relative to `(dyn *syspath*)`" [src &opt dest chmod-mode] (default dest src) - (def files (get-files)) - (def absdest (string (dyn *syspath*) "/" dest)) - (when (os/stat absdest :mode) - (errorf "collision at %s, file already exists" absdest)) - (spit absdest (slurp src)) - (when chmod-mode - (os/chmod dest chmod-mode)) - (array/push files absdest) - (print "adding " absdest) - absdest) + (edefer (sync-manifest) + (def files (get-files)) + (def absdest (string (dyn *syspath*) "/" dest)) + (when (os/stat absdest :mode) + (errorf "collision at %s, file already exists" absdest)) + (spit absdest (slurp src)) + (array/push files absdest) + (when chmod-mode + (os/chmod dest chmod-mode)) + (print "adding " absdest) + absdest)) (defn bundle/list "Get a list of all installed bundles in lexical order." From 1f39a0f180ed935ba905b37b5a8636048591cd1c Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 13 May 2024 12:06:17 -0500 Subject: [PATCH 03/63] Add bundle/backup and buffer/format-at bundle/backup is needed to make failed reinstalls able to rollback. It also allows python wheel like functionality, where bundles can be build on one machine, packaged, and then distributed and installed on other compatible machines without compilers. buffer/format-at is to buffer/format as buffer/push-at is to buffer/push. It allows us to format in the middle of an existing buffer. Prior, to do this operation and extra buffer creating was required. --- src/boot/boot.janet | 77 ++++++++++++++++++++++++++++++++++++++++----- src/core/buffer.c | 22 +++++++++++++ 2 files changed, 91 insertions(+), 8 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index f25f54d8..ef07b8da 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4001,6 +4001,16 @@ (put manifest :files files) files) + (defn- rmrf + "rm -rf in janet" + [x] + (case (os/stat x :mode) + :file (os/rm x) + :directory (do + (each y (os/dir x) (rmrf (string x "/" y))) + (os/rmdir x))) + nil) + (defn- sync-manifest [&opt manifest] (default manifest (dyn *bundle-manifest*)) @@ -4050,10 +4060,7 @@ :file (os/rm file) :directory (os/rmdir file))) (os/rm (get-manifest-filename bundle-name)) - (def hf (get-hook-filename bundle-name)) - (each hook (os/dir hf) - (os/rm (string hf "/" hook))) - (os/rmdir hf) + (rmrf (get-hook-filename bundle-name)) nil) (defn bundle/install @@ -4066,8 +4073,8 @@ (prime-bundle-paths) (def src-hooks (string path "/hooks/")) (copy-hooks src-hooks bundle-name) - (def man @{:bundle-name bundle-name :local-source path}) - (when config (merge-into man config)) + (def man @{:bundle-name bundle-name :local-source path :config config}) + (merge-into man config) (spit (get-manifest-filename bundle-name) (string/format "%j\n" man)) (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name)) (bundle/do-hook bundle-name "deps.janet") @@ -4075,6 +4082,54 @@ (bundle/do-hook bundle-name "install.janet")) nil) + (defn bundle/backup + "Take an installed bundle and create a bundle source directory that can be used to + reinstall this bundle on a compatible system. This is used to create backups for installed + bundles without rebuilding." + [bundle-name dest-dir] + (def man (bundle/manifest bundle-name)) + (def files (get man :files @[])) + (assert (os/mkdir dest-dir) (string "could not create directory " dest-dir " (or it already exists)")) + (def hooks-dir (string dest-dir "/hooks")) + (def install-hook (string dest-dir "/hooks/install.janet")) + (edefer (rmrf dest-dir) # don't leave garbage on failure + (var i 0) + (def install-source @[]) + (def syspath (os/realpath (dyn *syspath*))) + (os/mkdir hooks-dir) + (each file files + (def {:mode mode :permissions perm} (os/stat file)) + (def relpath (string/triml (slice file (length syspath) -1) "/")) + (case mode + :directory (array/push install-source ~(bundle/add-directory ,relpath ,perm)) + :file (do + (def filename (string/format "file_%04d" (++ i))) + (spit (string dest-dir "/" filename) (slurp file)) + (array/push install-source ~(bundle/add-file ,filename ,relpath ,perm))) + (errorf "unexpected file %v" file))) + (def b @"") + (each form install-source (buffer/format b "%j\n" form)) + (spit install-hook b)) + dest-dir) + + (defn bundle/reinstall + "Reinstall an existing bundle from the local source code. Should not break installation in reinstallation fails." + [bundle-name] + (def manifest (bundle/manifest bundle-name)) + (def path (get manifest :local-source)) + (def config (get manifest :config @{})) + (assert (= :directory (os/stat path :mode)) "local source not available") + + (def backup-dir (string (dyn *syspath*) "/.temp_" bundle-name)) + (def backup-bundle-source (bundle/backup bundle-name backup-dir)) + (edefer (do + (bundle/install bundle-name backup-bundle-source) + (rmrf backup-bundle-source)) + (bundle/uninstall bundle-name) + (bundle/install path bundle-name ;(kvs config))) + (rmrf backup-bundle-source) + bundle-name) + (defn bundle/add-directory "Add a directory during the install process relative to `(dyn *syspath*)`" [dest &opt chmod-mode] @@ -4101,7 +4156,7 @@ (spit absdest (slurp src)) (array/push files absdest) (when chmod-mode - (os/chmod dest chmod-mode)) + (os/chmod absdest chmod-mode)) (print "adding " absdest) absdest)) @@ -4112,7 +4167,13 @@ (if (os/stat d :mode) (sort (seq [x :in (os/dir (get-manifest-filename))] (string/slice x 0 -5))) - @[]))) + @[])) + + (defn bundle/update-all + "Reinstall all bundles" + [] + (each bundle (bundle/list) + (bundle/reinstall bundle)))) ### ### diff --git a/src/core/buffer.c b/src/core/buffer.c index 5d9e7b3d..335c4347 100644 --- a/src/core/buffer.c +++ b/src/core/buffer.c @@ -655,6 +655,27 @@ JANET_CORE_FN(cfun_buffer_format, return argv[0]; } +JANET_CORE_FN(cfun_buffer_format_at, + "(buffer/format-at buffer at format & args)", + "Snprintf like functionality for printing values into a buffer. Returns " + "the modified buffer.") { + janet_arity(argc, 2, -1); + JanetBuffer *buffer = janet_getbuffer(argv, 0); + int32_t at = janet_getinteger(argv, 1); + if (at < 0) { + at += buffer->count + 1; + } + if (at > buffer->count) janet_panicf("expected index at to be in range [0, %d), got %d", buffer->count, at); + int32_t oldcount = buffer->count; + buffer->count = at; + const char *strfrmt = (const char *) janet_getstring(argv, 2); + janet_buffer_format(buffer, strfrmt, 2, argc, argv); + if (buffer->count < oldcount) { + buffer->count = oldcount; + } + return argv[0]; +} + void janet_lib_buffer(JanetTable *env) { JanetRegExt buffer_cfuns[] = { JANET_CORE_REG("buffer/new", cfun_buffer_new), @@ -681,6 +702,7 @@ void janet_lib_buffer(JanetTable *env) { JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle), JANET_CORE_REG("buffer/blit", cfun_buffer_blit), JANET_CORE_REG("buffer/format", cfun_buffer_format), + JANET_CORE_REG("buffer/format-at", cfun_buffer_format_at), JANET_REG_END }; janet_core_cfuns_ext(env, NULL, buffer_cfuns); From e1cdd0f8cce511af1288aa851136737f6e6af8b5 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 13 May 2024 12:47:46 -0500 Subject: [PATCH 04/63] Update CHANGELOG.md --- CHANGELOG.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 370f7e8c..808eb39f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,9 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add `bundle/` module for managing packages within Janet. This should replace the jpm packaging + format eventually and is much simpler and amenable to more complicated builds. +- Add `buffer/format-at` - Add long form command line options for readable CLI usage - Fix bug with `net/accept-loop` that would sometimes miss connections. From 5e58110e19a8902f10940dc61fc2e0baa926ed2d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 13 May 2024 18:37:30 -0500 Subject: [PATCH 05/63] Add copyfile for copying large files. --- src/boot/boot.janet | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index ef07b8da..dae46df5 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4011,6 +4011,17 @@ (os/rmdir x))) nil) + (defn- copyfile + [from to] + (def b (buffer/new 0x10000)) + (with [ffrom (file/open from :rb)] + (with [fto (file/open to :wb)] + (forever + (file/read ffrom 0x10000 b) + (when (empty? b) (buffer/trim b) (break)) + (file/write fto b) + (buffer/clear b))))) + (defn- sync-manifest [&opt manifest] (default manifest (dyn *bundle-manifest*)) @@ -4066,6 +4077,7 @@ (defn bundle/install "Install a bundle from the local filesystem with a name `bundle-name`." [path &opt bundle-name &keys config] + (def path (os/realpath path)) (default bundle-name (last (string/split "/" path))) (assert (next bundle-name) "cannot use empty bundle-name") (assert (not (fexists (get-manifest-filename bundle-name))) @@ -4075,7 +4087,7 @@ (copy-hooks src-hooks bundle-name) (def man @{:bundle-name bundle-name :local-source path :config config}) (merge-into man config) - (spit (get-manifest-filename bundle-name) (string/format "%j\n" man)) + (sync-manifest man) (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name)) (bundle/do-hook bundle-name "deps.janet") (bundle/do-hook bundle-name "build.janet") @@ -4104,7 +4116,7 @@ :directory (array/push install-source ~(bundle/add-directory ,relpath ,perm)) :file (do (def filename (string/format "file_%04d" (++ i))) - (spit (string dest-dir "/" filename) (slurp file)) + (copyfile file (string dest-dir "/" filename)) (array/push install-source ~(bundle/add-file ,filename ,relpath ,perm))) (errorf "unexpected file %v" file))) (def b @"") @@ -4113,7 +4125,7 @@ dest-dir) (defn bundle/reinstall - "Reinstall an existing bundle from the local source code. Should not break installation in reinstallation fails." + "Reinstall an existing bundle from the local source code." [bundle-name] (def manifest (bundle/manifest bundle-name)) (def path (get manifest :local-source)) @@ -4153,7 +4165,7 @@ (def absdest (string (dyn *syspath*) "/" dest)) (when (os/stat absdest :mode) (errorf "collision at %s, file already exists" absdest)) - (spit absdest (slurp src)) + (copyfile src absdest) (array/push files absdest) (when chmod-mode (os/chmod absdest chmod-mode)) From 3151fa398823a820ac466d6615c346da702c8faa Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 13 May 2024 18:45:43 -0500 Subject: [PATCH 06/63] Don't expose bundle/do-hook. This is really an internal detail - rather than users writing custom hooks, custom functionality should just be normal janet scripts. --- src/boot/boot.janet | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index dae46df5..0a0de6d0 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4036,9 +4036,8 @@ (assert (fexists name) (string "no bundle " bundle-name " found")) (parse (slurp name))) - (defn bundle/do-hook - "Run a given hook for an installed bundle" - [bundle-name hook] + (defn- do-hook + [bundle-name hook from-source] (bundle/manifest bundle-name) # assert good bundle-name (def filename (get-hook-filename bundle-name hook)) (when (os/stat filename :mode) @@ -4053,7 +4052,7 @@ (merge-into env manifest) (put env *syspath* real-syspath) # After install, srcdir does not always exist - (when (os/stat srcdir :mode) (os/cd srcdir)) + (when (and from-source (os/stat srcdir :mode)) (os/cd srcdir)) (defer (os/cd dir) (print "running " filename-real " for bundle " bundle-name) (dofile filename-real :env env) @@ -4062,7 +4061,7 @@ (defn bundle/uninstall "Remove a bundle from the current syspath" [bundle-name] - (bundle/do-hook bundle-name "uninstall.janet") + (do-hook bundle-name "uninstall.janet" false) (def man (bundle/manifest bundle-name)) (def files (get man :files [])) (each file (reverse files) @@ -4089,9 +4088,9 @@ (merge-into man config) (sync-manifest man) (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name)) - (bundle/do-hook bundle-name "deps.janet") - (bundle/do-hook bundle-name "build.janet") - (bundle/do-hook bundle-name "install.janet")) + (do-hook bundle-name "deps.janet" true) + (do-hook bundle-name "build.janet" true) + (do-hook bundle-name "install.janet" true)) nil) (defn bundle/backup From cd34b89977d198c7c3f13b7454b9935b17344d66 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 13 May 2024 19:38:14 -0500 Subject: [PATCH 07/63] Rename bundle/backup to bundle/pack. --- src/boot/boot.janet | 43 ++++++++++++++++++++++++++----------------- 1 file changed, 26 insertions(+), 17 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 0a0de6d0..c6711020 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3985,15 +3985,6 @@ (os/mkdir hf) nil) - (defn- copy-hooks - [hooks-src bundle-name] - (os/mkdir (get-hook-filename bundle-name)) - (when (os/stat hooks-src :mode) - (each hook (os/dir hooks-src) - (def hookpath (string hooks-src "/" hook)) - (def source (slurp hookpath)) - (spit (get-hook-filename bundle-name hook) source)))) - (defn- get-files [] (def manifest (dyn *bundle-manifest*)) (assert manifest "nothing bound to (dyn *bundle-manifest*)") @@ -4022,6 +4013,14 @@ (file/write fto b) (buffer/clear b))))) + (defn- copy-hooks + [hooks-src bundle-name] + (os/mkdir (get-hook-filename bundle-name)) + (when (os/stat hooks-src :mode) + (each hook (os/dir hooks-src) + (def hookpath (string hooks-src "/" hook)) + (copyfile hookpath (get-hook-filename bundle-name hook))))) + (defn- sync-manifest [&opt manifest] (default manifest (dyn *bundle-manifest*)) @@ -4065,7 +4064,7 @@ (def man (bundle/manifest bundle-name)) (def files (get man :files [])) (each file (reverse files) - (print "removing " file) + (print "- " file) (case (os/stat file :mode) :file (os/rm file) :directory (os/rmdir file))) @@ -4075,7 +4074,8 @@ (defn bundle/install "Install a bundle from the local filesystem with a name `bundle-name`." - [path &opt bundle-name &keys config] + [&opt path bundle-name &keys config] + (default path ".") (def path (os/realpath path)) (default bundle-name (last (string/split "/" path))) (assert (next bundle-name) "cannot use empty bundle-name") @@ -4093,7 +4093,7 @@ (do-hook bundle-name "install.janet" true)) nil) - (defn bundle/backup + (defn bundle/pack "Take an installed bundle and create a bundle source directory that can be used to reinstall this bundle on a compatible system. This is used to create backups for installed bundles without rebuilding." @@ -4102,12 +4102,18 @@ (def files (get man :files @[])) (assert (os/mkdir dest-dir) (string "could not create directory " dest-dir " (or it already exists)")) (def hooks-dir (string dest-dir "/hooks")) + (def old-hooks-dir (string dest-dir "/old-hooks")) (def install-hook (string dest-dir "/hooks/install.janet")) (edefer (rmrf dest-dir) # don't leave garbage on failure (var i 0) (def install-source @[]) (def syspath (os/realpath (dyn *syspath*))) (os/mkdir hooks-dir) + (os/mkdir old-hooks-dir) + (def current-hooks (get-hook-filename bundle-name)) + (each file (os/dir current-hooks) + (def from (string current-hooks "/" file)) + (copyfile from (string old-hooks-dir "/" file))) (each file files (def {:mode mode :permissions perm} (os/stat file)) (def relpath (string/triml (slice file (length syspath) -1) "/")) @@ -4131,10 +4137,13 @@ (def config (get manifest :config @{})) (assert (= :directory (os/stat path :mode)) "local source not available") - (def backup-dir (string (dyn *syspath*) "/.temp_" bundle-name)) - (def backup-bundle-source (bundle/backup bundle-name backup-dir)) + (def backup-dir (string (dyn *syspath*) "/" bundle-name ".backup")) + (def backup-bundle-source (bundle/pack bundle-name backup-dir)) (edefer (do - (bundle/install bundle-name backup-bundle-source) + (bundle/install backup-bundle-source bundle-name) + # Restore old manifest and hooks that point to local source instead of backup source + (copy-hooks (string backup-bundle-source "/old-hooks") bundle-name) + (sync-manifest manifest) (rmrf backup-bundle-source)) (bundle/uninstall bundle-name) (bundle/install path bundle-name ;(kvs config))) @@ -4152,7 +4161,7 @@ (array/push files absdest) (when chmod-mode (os/chmod absdest chmod-mode)) - (print "adding " absdest) + (print "+ " absdest) absdest)) (defn bundle/add-file @@ -4168,7 +4177,7 @@ (array/push files absdest) (when chmod-mode (os/chmod absdest chmod-mode)) - (print "adding " absdest) + (print "+ " absdest) absdest)) (defn bundle/list From 4d9bcd6bcc55e3f1099a9c0164cdf7ed5daca2b5 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 13 May 2024 19:42:44 -0500 Subject: [PATCH 08/63] Add is-backup option to bundle/pack. We don't always to keep the old manifest and hooks. --- src/boot/boot.janet | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index c6711020..22315834 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4097,7 +4097,7 @@ "Take an installed bundle and create a bundle source directory that can be used to reinstall this bundle on a compatible system. This is used to create backups for installed bundles without rebuilding." - [bundle-name dest-dir] + [bundle-name dest-dir &opt is-backup] (def man (bundle/manifest bundle-name)) (def files (get man :files @[])) (assert (os/mkdir dest-dir) (string "could not create directory " dest-dir " (or it already exists)")) @@ -4109,18 +4109,20 @@ (def install-source @[]) (def syspath (os/realpath (dyn *syspath*))) (os/mkdir hooks-dir) - (os/mkdir old-hooks-dir) - (def current-hooks (get-hook-filename bundle-name)) - (each file (os/dir current-hooks) - (def from (string current-hooks "/" file)) - (copyfile from (string old-hooks-dir "/" file))) + (when is-backup + (os/mkdir old-hooks-dir) + (spit (string dest-dir "/old-manifest.jdn") (string/format "%j\n" man)) + (def current-hooks (get-hook-filename bundle-name)) + (each file (os/dir current-hooks) + (def from (string current-hooks "/" file)) + (copyfile from (string old-hooks-dir "/" file)))) (each file files (def {:mode mode :permissions perm} (os/stat file)) (def relpath (string/triml (slice file (length syspath) -1) "/")) (case mode :directory (array/push install-source ~(bundle/add-directory ,relpath ,perm)) :file (do - (def filename (string/format "file_%04d" (++ i))) + (def filename (string/format "file_%06d" (++ i))) (copyfile file (string dest-dir "/" filename)) (array/push install-source ~(bundle/add-file ,filename ,relpath ,perm))) (errorf "unexpected file %v" file))) @@ -4136,9 +4138,8 @@ (def path (get manifest :local-source)) (def config (get manifest :config @{})) (assert (= :directory (os/stat path :mode)) "local source not available") - (def backup-dir (string (dyn *syspath*) "/" bundle-name ".backup")) - (def backup-bundle-source (bundle/pack bundle-name backup-dir)) + (def backup-bundle-source (bundle/pack bundle-name backup-dir true)) (edefer (do (bundle/install backup-bundle-source bundle-name) # Restore old manifest and hooks that point to local source instead of backup source From 09b6fc4670cd0014a03f8c58b4fe7750deffa958 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 13 May 2024 20:59:06 -0500 Subject: [PATCH 09/63] Change storage locations for bundles. Organize metadata a bit more cleanly under .bundles// --- src/boot/boot.janet | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 22315834..bd454500 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3969,21 +3969,21 @@ (defdyn *bundle-manifest* "Current manifest table of an installed package. Bound when executing hooks.") - (defn- get-manifest-filename + (defn- bundle-dir [&opt bundle-name] - (string (dyn *syspath*) "/.manifests/" bundle-name (when bundle-name ".jdn"))) + (string (dyn *syspath*) "/.bundles/" bundle-name)) - (defn- get-hook-filename - [&opt bundle-name hook] - (string (dyn *syspath*) "/.hooks/" bundle-name (when bundle-name (string "/" hook)))) + (defn- bundle-file + [bundle-name filename] + (string (dyn *syspath*) "/.bundles/" bundle-name "/" filename)) + + (defn- get-manifest-filename + [bundle-name] + (bundle-file bundle-name "manifest.jdn")) (defn- prime-bundle-paths [] - (def mf (get-manifest-filename)) - (def hf (get-hook-filename)) - (os/mkdir mf) - (os/mkdir hf) - nil) + (os/mkdir (bundle-dir))) (defn- get-files [] (def manifest (dyn *bundle-manifest*)) @@ -4015,11 +4015,11 @@ (defn- copy-hooks [hooks-src bundle-name] - (os/mkdir (get-hook-filename bundle-name)) (when (os/stat hooks-src :mode) (each hook (os/dir hooks-src) - (def hookpath (string hooks-src "/" hook)) - (copyfile hookpath (get-hook-filename bundle-name hook))))) + (when (string/has-suffix? ".janet" hook) + (def hookpath (string hooks-src "/" hook)) + (copyfile hookpath (bundle-file bundle-name hook)))))) (defn- sync-manifest [&opt manifest] @@ -4038,7 +4038,7 @@ (defn- do-hook [bundle-name hook from-source] (bundle/manifest bundle-name) # assert good bundle-name - (def filename (get-hook-filename bundle-name hook)) + (def filename (bundle-file bundle-name hook)) (when (os/stat filename :mode) (def dir (os/cwd)) (def real-syspath (os/realpath (dyn *syspath*))) # if syspath is a relative path @@ -4068,8 +4068,7 @@ (case (os/stat file :mode) :file (os/rm file) :directory (os/rmdir file))) - (os/rm (get-manifest-filename bundle-name)) - (rmrf (get-hook-filename bundle-name)) + (rmrf (bundle-dir bundle-name)) nil) (defn bundle/install @@ -4082,6 +4081,7 @@ (assert (not (fexists (get-manifest-filename bundle-name))) "bundle is already installed") (prime-bundle-paths) + (os/mkdir (bundle-dir bundle-name)) (def src-hooks (string path "/hooks/")) (copy-hooks src-hooks bundle-name) (def man @{:bundle-name bundle-name :local-source path :config config}) @@ -4091,7 +4091,8 @@ (do-hook bundle-name "deps.janet" true) (do-hook bundle-name "build.janet" true) (do-hook bundle-name "install.janet" true)) - nil) + (print "installed " bundle-name) + bundle-name) (defn bundle/pack "Take an installed bundle and create a bundle source directory that can be used to @@ -4112,7 +4113,7 @@ (when is-backup (os/mkdir old-hooks-dir) (spit (string dest-dir "/old-manifest.jdn") (string/format "%j\n" man)) - (def current-hooks (get-hook-filename bundle-name)) + (def current-hooks (bundle-dir bundle-name)) (each file (os/dir current-hooks) (def from (string current-hooks "/" file)) (copyfile from (string old-hooks-dir "/" file)))) @@ -4184,10 +4185,9 @@ (defn bundle/list "Get a list of all installed bundles in lexical order." [] - (def d (get-manifest-filename)) + (def d (bundle-dir)) (if (os/stat d :mode) - (sort (seq [x :in (os/dir (get-manifest-filename))] - (string/slice x 0 -5))) + (sort (os/dir d)) @[])) (defn bundle/update-all From 4a0f67f3bd1904cc44ea0b3600275e752921e71b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 13 May 2024 21:35:55 -0500 Subject: [PATCH 10/63] Update copyright. --- src/boot/boot.janet | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index bd454500..51f56c5a 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1,5 +1,5 @@ # The core janet library -# Copyright 2023 © Calvin Rose +# Copyright 2024 © Calvin Rose ### ### From 42bd27c24b44126470a9ab87613251a717e636cc Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 14 May 2024 16:45:27 -0500 Subject: [PATCH 11/63] Use a single janet file for hooks.. --- src/boot/boot.janet | 271 +++++++++++++++++++++----------------------- 1 file changed, 130 insertions(+), 141 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 51f56c5a..eab5e733 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2677,8 +2677,8 @@ (defn eval ``Evaluates a form in the current environment. If more control over the environment is needed, use `run-context`.`` - [form] - (def res (compile form nil :eval)) + [form &opt env] + (def res (compile form env :eval)) (if (= (type res) :function) (res) (error (get res :error)))) @@ -2717,9 +2717,9 @@ (defn eval-string ``Evaluates a string in the current environment. If more control over the environment is needed, use `run-context`.`` - [str] + [str &opt env] (var ret nil) - (each x (parse-all str) (set ret (eval x))) + (each x (parse-all str) (set ret (eval x env))) ret) (def load-image-dict @@ -2768,8 +2768,8 @@ (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/paths* "Dynamic binding for overriding `module/paths`") +(defdyn *module/loading* "Dynamic binding for overriding `module/loading`") (defdyn *module/loaders* "Dynamic binding for overriding `module/loaders`") (def module/cache @@ -2947,6 +2947,32 @@ (set debugger-on-status-var debugger-on-status) +(defn- env-walk + [pred &opt env local] + (default env (fiber/getenv (fiber/current))) + (def envs @[]) + (do (var e env) (while e (array/push envs e) (set e (table/getproto e)) (if local (break)))) + (def ret-set @{}) + (loop [envi :in envs + k :keys envi + :when (pred k)] + (put ret-set k true)) + (sort (keys ret-set))) + +(defn all-bindings + ``Get all symbols available in an environment. Defaults to the current + fiber's environment. If `local` is truthy, will not show inherited bindings + (from prototype tables).`` + [&opt env local] + (env-walk symbol? env local)) + +(defn all-dynamics + ``Get all dynamic bindings in an environment. Defaults to the current + fiber's environment. If `local` is truthy, will not show inherited bindings + (from prototype tables).`` + [&opt env local] + (env-walk keyword? env local)) + (defn dofile ``Evaluate a file, file path, or stream and return the resulting environment. :env, :expander, :source, :evaluator, :read, and :parser are passed through to the underlying @@ -3110,32 +3136,6 @@ ### ### -(defn- env-walk - [pred &opt env local] - (default env (fiber/getenv (fiber/current))) - (def envs @[]) - (do (var e env) (while e (array/push envs e) (set e (table/getproto e)) (if local (break)))) - (def ret-set @{}) - (loop [envi :in envs - k :keys envi - :when (pred k)] - (put ret-set k true)) - (sort (keys ret-set))) - -(defn all-bindings - ``Get all symbols available in an environment. Defaults to the current - fiber's environment. If `local` is truthy, will not show inherited bindings - (from prototype tables).`` - [&opt env local] - (env-walk symbol? env local)) - -(defn all-dynamics - ``Get all dynamic bindings in an environment. Defaults to the current - fiber's environment. If `local` is truthy, will not show inherited bindings - (from prototype tables).`` - [&opt env local] - (env-walk keyword? env local)) - (defdyn *doc-width* "Width in columns to print documentation printed with `doc-format`.") @@ -3967,15 +3967,13 @@ (compwhen (dyn 'os/stat) - (defdyn *bundle-manifest* "Current manifest table of an installed package. Bound when executing hooks.") - (defn- bundle-dir [&opt bundle-name] - (string (dyn *syspath*) "/.bundles/" bundle-name)) + (string (os/realpath (dyn *syspath*)) "/_bundles/" bundle-name)) (defn- bundle-file [bundle-name filename] - (string (dyn *syspath*) "/.bundles/" bundle-name "/" filename)) + (string (os/realpath (dyn *syspath*)) "/_bundles/" bundle-name "/" filename)) (defn- get-manifest-filename [bundle-name] @@ -3985,9 +3983,7 @@ [] (os/mkdir (bundle-dir))) - (defn- get-files [] - (def manifest (dyn *bundle-manifest*)) - (assert manifest "nothing bound to (dyn *bundle-manifest*)") + (defn- get-files [manifest] (def files (get manifest :files @[])) (put manifest :files files) files) @@ -4013,17 +4009,18 @@ (file/write fto b) (buffer/clear b))))) - (defn- copy-hooks - [hooks-src bundle-name] - (when (os/stat hooks-src :mode) - (each hook (os/dir hooks-src) - (when (string/has-suffix? ".janet" hook) - (def hookpath (string hooks-src "/" hook)) - (copyfile hookpath (bundle-file bundle-name hook)))))) + (defn- copyrf + [from to] + (case (os/stat from :mode) + :file (copyfile from to) + :directory (do + (os/mkdir to) + (each y (os/dir from) + (copyrf (string from "/" y) (string to "/" y))))) + nil) (defn- sync-manifest - [&opt manifest] - (default manifest (dyn *bundle-manifest*)) + [manifest] (def bn (get manifest :bundle-name)) (def manifest-name (get-manifest-filename bn)) (spit manifest-name (string/format "%j\n" manifest))) @@ -4035,32 +4032,31 @@ (assert (fexists name) (string "no bundle " bundle-name " found")) (parse (slurp name))) + (defn- get-bundle-module + [bundle-name] + (def manifest (bundle/manifest bundle-name)) + (def dir (os/cwd)) + (os/cd (get manifest :local-source ".")) + (defer (os/cd dir) + # like :fresh true, but recursive + (with-dyns [*module/cache* @{} + *module/loading* @{}] + (require (string "_bundles/" bundle-name))))) + (defn- do-hook - [bundle-name hook from-source] - (bundle/manifest bundle-name) # assert good bundle-name - (def filename (bundle-file bundle-name hook)) - (when (os/stat filename :mode) - (def dir (os/cwd)) - (def real-syspath (os/realpath (dyn *syspath*))) # if syspath is a relative path - (def env (make-env)) - (def manifest-name (get-manifest-filename bundle-name)) - (def manifest (bundle/manifest bundle-name)) - (def srcdir (get manifest :local-source)) - (def filename-real (os/realpath filename)) - (put env *bundle-manifest* manifest) - (merge-into env manifest) - (put env *syspath* real-syspath) - # After install, srcdir does not always exist - (when (and from-source (os/stat srcdir :mode)) (os/cd srcdir)) - (defer (os/cd dir) - (print "running " filename-real " for bundle " bundle-name) - (dofile filename-real :env env) - (sync-manifest manifest)))) + [module bundle-name hook & args] + (def hookf (module/value module (symbol hook))) + (unless hookf (break)) + (def manifest (bundle/manifest bundle-name)) + (def dir (os/cwd)) + (os/cd (get manifest :local-source ".")) + (defer (os/cd dir) + (print "running hook " hook " for bundle " bundle-name) + (hookf ;args))) (defn bundle/uninstall "Remove a bundle from the current syspath" [bundle-name] - (do-hook bundle-name "uninstall.janet" false) (def man (bundle/manifest bundle-name)) (def files (get man :files [])) (each file (reverse files) @@ -4082,53 +4078,50 @@ "bundle is already installed") (prime-bundle-paths) (os/mkdir (bundle-dir bundle-name)) - (def src-hooks (string path "/hooks/")) - (copy-hooks src-hooks bundle-name) - (def man @{:bundle-name bundle-name :local-source path :config config}) + # Copy some files into the new location unconditionally + (def implicit-sources (string path "/bundle")) + (when (= :directory (os/stat implicit-sources :mode)) + (copyrf implicit-sources (bundle-dir bundle-name))) + (def man @{:bundle-name bundle-name :local-source path :files @[]}) (merge-into man config) (sync-manifest man) (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name)) - (do-hook bundle-name "deps.janet" true) - (do-hook bundle-name "build.janet" true) - (do-hook bundle-name "install.janet" true)) + (def module (get-bundle-module bundle-name)) + (do-hook module bundle-name :build man) + (do-hook module bundle-name :install man) + (if (empty? (get man :files)) (print "no files installed, is this a valid bundle?")) + (sync-manifest man)) (print "installed " bundle-name) bundle-name) (defn bundle/pack "Take an installed bundle and create a bundle source directory that can be used to - reinstall this bundle on a compatible system. This is used to create backups for installed - bundles without rebuilding." + reinstall the bundle on a compatible system. This is used to create backups for installed + bundles without rebuilding, or make a prebuilt bundle for other systems." [bundle-name dest-dir &opt is-backup] + (var i 0) (def man (bundle/manifest bundle-name)) (def files (get man :files @[])) (assert (os/mkdir dest-dir) (string "could not create directory " dest-dir " (or it already exists)")) - (def hooks-dir (string dest-dir "/hooks")) - (def old-hooks-dir (string dest-dir "/old-hooks")) - (def install-hook (string dest-dir "/hooks/install.janet")) + (os/mkdir (string dest-dir "/bundle")) + (def install-hook (string dest-dir "/bundle/init.janet")) (edefer (rmrf dest-dir) # don't leave garbage on failure - (var i 0) (def install-source @[]) (def syspath (os/realpath (dyn *syspath*))) - (os/mkdir hooks-dir) - (when is-backup - (os/mkdir old-hooks-dir) - (spit (string dest-dir "/old-manifest.jdn") (string/format "%j\n" man)) - (def current-hooks (bundle-dir bundle-name)) - (each file (os/dir current-hooks) - (def from (string current-hooks "/" file)) - (copyfile from (string old-hooks-dir "/" file)))) + (when is-backup (copyrf (bundle-dir bundle-name) (string dest-dir "/old-bundle"))) (each file files (def {:mode mode :permissions perm} (os/stat file)) (def relpath (string/triml (slice file (length syspath) -1) "/")) (case mode - :directory (array/push install-source ~(bundle/add-directory ,relpath ,perm)) + :directory (array/push install-source ~(bundle/add-directory manifest ,relpath ,perm)) :file (do (def filename (string/format "file_%06d" (++ i))) (copyfile file (string dest-dir "/" filename)) - (array/push install-source ~(bundle/add-file ,filename ,relpath ,perm))) + (array/push install-source ~(bundle/add-file manifest ,filename ,relpath ,perm))) (errorf "unexpected file %v" file))) - (def b @"") - (each form install-source (buffer/format b "%j\n" form)) + (def b @"(defn install [manifest]\n") + (each form install-source (buffer/format b " %j\n" form)) + (buffer/push b ")") (spit install-hook b)) dest-dir) @@ -4143,9 +4136,7 @@ (def backup-bundle-source (bundle/pack bundle-name backup-dir true)) (edefer (do (bundle/install backup-bundle-source bundle-name) - # Restore old manifest and hooks that point to local source instead of backup source - (copy-hooks (string backup-bundle-source "/old-hooks") bundle-name) - (sync-manifest manifest) + (copyrf (string backup-bundle-source "/old-bundle") (bundle-dir bundle-name)) (rmrf backup-bundle-source)) (bundle/uninstall bundle-name) (bundle/install path bundle-name ;(kvs config))) @@ -4154,33 +4145,31 @@ (defn bundle/add-directory "Add a directory during the install process relative to `(dyn *syspath*)`" - [dest &opt chmod-mode] - (edefer (sync-manifest) - (def files (get-files)) - (def absdest (string (dyn *syspath*) "/" dest)) - (unless (os/mkdir absdest) - (errorf "collision at %s, directory already exists" absdest)) - (array/push files absdest) - (when chmod-mode - (os/chmod absdest chmod-mode)) - (print "+ " absdest) - absdest)) + [manifest dest &opt chmod-mode] + (def files (get-files manifest)) + (def absdest (string (dyn *syspath*) "/" dest)) + (unless (os/mkdir absdest) + (errorf "collision at %s, directory already exists" absdest)) + (array/push files absdest) + (when chmod-mode + (os/chmod absdest chmod-mode)) + (print "+ " absdest) + absdest) (defn bundle/add-file "Add files during an install relative to `(dyn *syspath*)`" - [src &opt dest chmod-mode] + [manifest src &opt dest chmod-mode] (default dest src) - (edefer (sync-manifest) - (def files (get-files)) - (def absdest (string (dyn *syspath*) "/" dest)) - (when (os/stat absdest :mode) - (errorf "collision at %s, file already exists" absdest)) - (copyfile src absdest) - (array/push files absdest) - (when chmod-mode - (os/chmod absdest chmod-mode)) - (print "+ " absdest) - absdest)) + (def files (get-files manifest)) + (def absdest (string (dyn *syspath*) "/" dest)) + (when (os/stat absdest :mode) + (errorf "collision at %s, file already exists" absdest)) + (copyfile src absdest) + (array/push files absdest) + (when chmod-mode + (os/chmod absdest chmod-mode)) + (print "+ " absdest) + absdest) (defn bundle/list "Get a list of all installed bundles in lexical order." @@ -4232,6 +4221,28 @@ (compwhen (not (dyn 'os/isatty)) (defmacro os/isatty [&] true)) +(def- long-to-short + "map long options to short options" + {"-help" "h" + "-version" "v" + "-stdin" "s" + "-eval" "e" + "-expression" "E" + "-debug" "d" + "-repl" "r" + "-noprofile" "R" + "-persistent" "p" + "-quiet" "q" + "-flycheck" "k" + "-syspath" "m" + "-compile" "c" + "-image" "i" + "-nocolor" "n" + "-color" "N" + "-library" "l" + "-lint-warn" "w" + "-lint-error" "x"}) + (defn cli-main `Entrance for the Janet CLI tool. Call this function with the command line arguments as an array or tuple of strings to invoke the CLI interface.` @@ -4263,28 +4274,6 @@ (def x (in args (+ i 1))) (or (scan-number x) (keyword x))) - (def- long-to-short - "map long options to short options" - {"-help" "h" - "-version" "v" - "-stdin" "s" - "-eval" "e" - "-expression" "E" - "-debug" "d" - "-repl" "r" - "-noprofile" "R" - "-persistent" "p" - "-quiet" "q" - "-flycheck" "k" - "-syspath" "m" - "-compile" "c" - "-image" "i" - "-nocolor" "n" - "-color" "N" - "-library" "l" - "-lint-warn" "w" - "-lint-error" "x"}) - # Flag handlers (def handlers {"h" (fn [&] From 3c8346f24ede40ee9c4c360ddbf48b565fe0e3fa Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 14 May 2024 20:51:29 -0500 Subject: [PATCH 12/63] Install to bundle/ instead of _bundles/ --- src/boot/boot.janet | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index eab5e733..586cce11 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3969,11 +3969,11 @@ (defn- bundle-dir [&opt bundle-name] - (string (os/realpath (dyn *syspath*)) "/_bundles/" bundle-name)) + (string (os/realpath (dyn *syspath*)) "/bundle/" bundle-name)) (defn- bundle-file [bundle-name filename] - (string (os/realpath (dyn *syspath*)) "/_bundles/" bundle-name "/" filename)) + (string (os/realpath (dyn *syspath*)) "/bundle/" bundle-name "/" filename)) (defn- get-manifest-filename [bundle-name] @@ -4041,7 +4041,7 @@ # like :fresh true, but recursive (with-dyns [*module/cache* @{} *module/loading* @{}] - (require (string "_bundles/" bundle-name))))) + (require (string "bundle/" bundle-name))))) (defn- do-hook [module bundle-name hook & args] @@ -4089,6 +4089,7 @@ (def module (get-bundle-module bundle-name)) (do-hook module bundle-name :build man) (do-hook module bundle-name :install man) + (do-hook module bundle-name :check man) (if (empty? (get man :files)) (print "no files installed, is this a valid bundle?")) (sync-manifest man)) (print "installed " bundle-name) From 980981c9eea233d148b7cff9ee4f0ac1f8fb91a8 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 15 May 2024 07:30:29 -0500 Subject: [PATCH 13/63] Print message if no hook found, but looked for --- src/boot/boot.janet | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 586cce11..62012a1a 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4046,7 +4046,9 @@ (defn- do-hook [module bundle-name hook & args] (def hookf (module/value module (symbol hook))) - (unless hookf (break)) + (unless hookf + (print "no hook " hook " found for bundle " bundle-name) + (break)) (def manifest (bundle/manifest bundle-name)) (def dir (os/cwd)) (os/cd (get manifest :local-source ".")) From f0092ef69b2fab4795d3a4e01033122a386007ef Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 16 May 2024 19:06:07 -0500 Subject: [PATCH 14/63] Add module/*make-env* --- src/boot/boot.janet | 41 ++++++++++++++++++++++++++++++++--------- 1 file changed, 32 insertions(+), 9 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 62012a1a..14e6763d 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1423,6 +1423,11 @@ ~(setdyn ,(bindings i) ,(bindings (+ i 1))))) ~(,resume (,fiber/new (fn [] ,;dyn-forms ,;body) :p))) +(defmacro with-env + `Run a block of code with a given environment table` + [env & body] + ~(,resume (,fiber/new (fn [] ,;body) : ,env))) + (defmacro with-vars ``Evaluates `body` with each var in `vars` temporarily bound. Similar signature to `let`, but each binding must be a var.`` @@ -2771,6 +2776,7 @@ (defdyn *module/paths* "Dynamic binding for overriding `module/paths`") (defdyn *module/loading* "Dynamic binding for overriding `module/loading`") (defdyn *module/loaders* "Dynamic binding for overriding `module/loaders`") +(defdyn *module/make-env* "Dynamic binding for create new environments for `import`, `require`, and `dofile`. Overrides `make-env`.") (def module/cache "A table, mapping loaded module identifiers to their environments." @@ -2984,7 +2990,7 @@ :core/stream path (file/open path :rb))) (def path-is-file (= f path)) - (default env (make-env (curenv))) + (default env ((dyn *module/make-env* make-env))) (def spath (string path)) (put env :source (or source (if-not path-is-file spath path))) (var exit-error nil) @@ -4036,12 +4042,20 @@ [bundle-name] (def manifest (bundle/manifest bundle-name)) (def dir (os/cwd)) - (os/cd (get manifest :local-source ".")) + (def workdir (get manifest :local-source ".")) + (try + (os/cd workdir) + ([_] (print "cannot enter source directory " workdir " for bundle " bundle-name))) (defer (os/cd dir) - # like :fresh true, but recursive - (with-dyns [*module/cache* @{} - *module/loading* @{}] - (require (string "bundle/" bundle-name))))) + (def new-env (make-env)) + (put new-env *module/cache* @{}) + (put new-env *module/loading* @{}) + (put new-env *module/make-env* (fn make-bundle-env [&] (make-env new-env))) + (put new-env :workdir workdir) + (put new-env :bundle-name bundle-name) + (put new-env :bundle-dir (bundle-dir bundle-name)) + (with-env new-env + (require (string "@syspath/bundle/" bundle-name))))) (defn- do-hook [module bundle-name hook & args] @@ -4051,7 +4065,7 @@ (break)) (def manifest (bundle/manifest bundle-name)) (def dir (os/cwd)) - (os/cd (get manifest :local-source ".")) + (os/cd (get module :workdir ".")) (defer (os/cd dir) (print "running hook " hook " for bundle " bundle-name) (hookf ;args))) @@ -4074,6 +4088,7 @@ [&opt path bundle-name &keys config] (default path ".") (def path (os/realpath path)) + (def clean (get config :clean)) (default bundle-name (last (string/split "/" path))) (assert (next bundle-name) "cannot use empty bundle-name") (assert (not (fexists (get-manifest-filename bundle-name))) @@ -4089,6 +4104,8 @@ (sync-manifest man) (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name)) (def module (get-bundle-module bundle-name)) + (when clean + (do-hook module bundle-name :clean man)) (do-hook module bundle-name :build man) (do-hook module bundle-name :install man) (do-hook module bundle-name :check man) @@ -4130,19 +4147,20 @@ (defn bundle/reinstall "Reinstall an existing bundle from the local source code." - [bundle-name] + [bundle-name &keys new-config] (def manifest (bundle/manifest bundle-name)) (def path (get manifest :local-source)) (def config (get manifest :config @{})) (assert (= :directory (os/stat path :mode)) "local source not available") (def backup-dir (string (dyn *syspath*) "/" bundle-name ".backup")) + (rmrf backup-dir) (def backup-bundle-source (bundle/pack bundle-name backup-dir true)) (edefer (do (bundle/install backup-bundle-source bundle-name) (copyrf (string backup-bundle-source "/old-bundle") (bundle-dir bundle-name)) (rmrf backup-bundle-source)) (bundle/uninstall bundle-name) - (bundle/install path bundle-name ;(kvs config))) + (bundle/install path bundle-name ;(kvs config) ;(kvs new-config))) (rmrf backup-bundle-source) bundle-name) @@ -4182,6 +4200,11 @@ (sort (os/dir d)) @[])) + (defn bundle/installed? + "Check if a bundle is installed." + [bundle-name] + (not (not (os/stat (bundle-dir bundle-name) :mode)))) + (defn bundle/update-all "Reinstall all bundles" [] From dc5cc630ffd42220c1d136e8653d4ed92d6c9eb8 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 18 May 2024 06:24:39 -0500 Subject: [PATCH 15/63] Keep track of hooks and simple dependency tracking. Refuse to install bundle unless dependencies are present. Dependencies can be found for a bundle pre-install by looking in ./bundle/info.jdn --- src/boot/boot.janet | 30 +++++++++++++++++++++++------- test/suite-value.janet | 2 +- 2 files changed, 24 insertions(+), 8 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 49866b72..d86d67ef 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4047,7 +4047,7 @@ (os/cd workdir) ([_] (print "cannot enter source directory " workdir " for bundle " bundle-name))) (defer (os/cd dir) - (def new-env (make-env)) + (def new-env (make-env (curenv))) (put new-env *module-cache* @{}) (put new-env *module-loading* @{}) (put new-env *module-make-env* (fn make-bundle-env [&] (make-env new-env))) @@ -4074,6 +4074,10 @@ "Remove a bundle from the current syspath" [bundle-name] (def man (bundle/manifest bundle-name)) + (def all-hooks (get man :hooks @[])) + (when (index-of :uninstall all-hooks) + (def module (get-bundle-module bundle-name)) + (do-hook module bundle-name :uninstall man)) (def files (get man :files [])) (each file (reverse files) (print "- " file) @@ -4083,12 +4087,18 @@ (rmrf (bundle-dir bundle-name)) nil) + (defn bundle/installed? + "Check if a bundle is installed." + [bundle-name] + (not (not (os/stat (bundle-dir bundle-name) :mode)))) + (defn bundle/install "Install a bundle from the local filesystem with a name `bundle-name`." [&opt path bundle-name &keys config] (default path ".") (def path (os/realpath path)) (def clean (get config :clean)) + (def check (get config :check)) (default bundle-name (last (string/split "/" path))) (assert (next bundle-name) "cannot use empty bundle-name") (assert (not (fexists (get-manifest-filename bundle-name))) @@ -4101,14 +4111,25 @@ (copyrf implicit-sources (bundle-dir bundle-name))) (def man @{:bundle-name bundle-name :local-source path :files @[]}) (merge-into man config) + (def infofile (bundle-file bundle-name "info.jdn")) (sync-manifest man) (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name)) + (when (os/stat infofile :mode) + (def info (-> infofile slurp parse)) + (def deps (get info :dependencies @[])) + (def missing (filter (complement bundle/installed?) deps)) + (when (next missing) + (error (string "missing dependencies " (string/join missing ", ")))) + (put man :info info)) (def module (get-bundle-module bundle-name)) + (def all-hooks (seq [[k v] :pairs module :when (symbol? k) :unless (get v :private)] (keyword k))) + (put man :hooks all-hooks) (when clean (do-hook module bundle-name :clean man)) (do-hook module bundle-name :build man) (do-hook module bundle-name :install man) - (do-hook module bundle-name :check man) + (when check + (do-hook module bundle-name :check man)) (if (empty? (get man :files)) (print "no files installed, is this a valid bundle?")) (sync-manifest man)) (print "installed " bundle-name) @@ -4200,11 +4221,6 @@ (sort (os/dir d)) @[])) - (defn bundle/installed? - "Check if a bundle is installed." - [bundle-name] - (not (not (os/stat (bundle-dir bundle-name) :mode)))) - (defn bundle/update-all "Reinstall all bundles" [] diff --git a/test/suite-value.janet b/test/suite-value.janet index 650cc99b..bbd443a6 100644 --- a/test/suite-value.janet +++ b/test/suite-value.janet @@ -42,7 +42,7 @@ (defn buffer-factory [] - @"im am a buffer") + @"i am a buffer") (assert (not= (buffer-factory) (buffer-factory)) "buffer instantiation") From 4d61ba20ce1dcec42b5595979176f77604b6077f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 19 May 2024 09:55:39 -0500 Subject: [PATCH 16/63] Fix -Werror=calloc-transposed-args --- src/core/compile.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/compile.c b/src/core/compile.c index 4f45ff1f..93ae2039 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -934,7 +934,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) { int32_t slotchunks = (def->slotcount + 31) >> 5; /* numchunks is min of slotchunks and scope->ua.count */ int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks; - uint32_t *chunks = janet_calloc(sizeof(uint32_t), slotchunks); + uint32_t *chunks = janet_calloc(slotchunks, sizeof(uint32_t)); if (NULL == chunks) { JANET_OUT_OF_MEMORY; } From 7387a1d91e709e2ce935674742b2bc6b8ec969d7 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 10:48:26 -0500 Subject: [PATCH 17/63] Add `bundle/prune` and support for :auto-remove. This allows dependencies to be marked such that they are not primary dependencies installed by the users - rather, they are dependencies of dependencies. This distinction is important when a user installs a package that itself has dependencies. This also interacts with new features to prevent a user from breaking their installation by installing needed packages or installing/uninstalling bundles out of order. --- examples/sample-bundle/bundle/info.jdn | 3 + examples/sample-bundle/bundle/init.janet | 3 + examples/sample-bundle/mymod.janet | 3 + src/boot/boot.janet | 87 +++++++++++++++++++++--- 4 files changed, 85 insertions(+), 11 deletions(-) create mode 100644 examples/sample-bundle/bundle/info.jdn create mode 100644 examples/sample-bundle/bundle/init.janet create mode 100644 examples/sample-bundle/mymod.janet diff --git a/examples/sample-bundle/bundle/info.jdn b/examples/sample-bundle/bundle/info.jdn new file mode 100644 index 00000000..54875852 --- /dev/null +++ b/examples/sample-bundle/bundle/info.jdn @@ -0,0 +1,3 @@ +@{ + :dependencies ["spork"] +} diff --git a/examples/sample-bundle/bundle/init.janet b/examples/sample-bundle/bundle/init.janet new file mode 100644 index 00000000..10aa476d --- /dev/null +++ b/examples/sample-bundle/bundle/init.janet @@ -0,0 +1,3 @@ +(defn install + [manifest &] + (bundle/add-file manifest "mymod.janet")) diff --git a/examples/sample-bundle/mymod.janet b/examples/sample-bundle/mymod.janet new file mode 100644 index 00000000..088ab194 --- /dev/null +++ b/examples/sample-bundle/mymod.janet @@ -0,0 +1,3 @@ +(defn myfn + [x] + (+ x x)) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index f36b3f41..8e102685 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4094,8 +4094,15 @@ (print "running hook " hook " for bundle " bundle-name) (hookf ;args))) - (defn bundle/uninstall - "Remove a bundle from the current syspath" + (defn bundle/list + "Get a list of all installed bundles in lexical order." + [] + (def d (bundle-dir)) + (if (os/stat d :mode) + (sort (os/dir d)) + @[])) + + (defn- bundle-uninstall-unchecked [bundle-name] (def man (bundle/manifest bundle-name)) (def all-hooks (get man :hooks @[])) @@ -4111,6 +4118,61 @@ (rmrf (bundle-dir bundle-name)) nil) + (defn bundle/uninstall + "Remove a bundle from the current syspath" + [bundle-name] + (def breakage @{}) + (each b (bundle/list) + (unless (= b bundle-name) + (def m (bundle/manifest b)) + (def deps (get m :dependencies [])) + (each d deps + (if (= d bundle-name) (put breakage b true))))) + (when (next breakage) + (def breakage-list (sorted (keys breakage))) + (errorf "cannot uninstall %s, breaks dependent bundles %n" bundle-name breakage-list)) + (bundle-uninstall-unchecked bundle-name)) + + (defn bundle/topolist + "Get topological order of all bundles, such that each bundle is listed after its dependencies. + DFS (tarjan)" + [] + (def visited @{}) + (def cycle-detect @{}) + (def order @[]) + (defn visit + [b] + (if (get visited b) (break)) + (if (get cycle-detect b) (errorf "cycle detected in bundle dependencies: %s" b)) + (put cycle-detect b true) + (each d (get (bundle/manifest b) :dependencies []) (visit d)) + (put cycle-detect b nil) + (put visited b true) + (array/push order b)) + (each b (bundle/list) (visit b)) + order) + + (defn bundle/prune + "Remove all orphaned bundles from the syspath. An orphaned bundle is a bundle that is + marked for :auto-remove and is not depended on by any other bundle." + [] + (def topo (bundle/topolist)) + (def rtopo (reverse topo)) + # Check which auto-remove packages can be dropped + # Iterate in (reverse) topological order, and if we see an auto-remove package and have not already seen + # something that depends on it, then it is a root package and can be pruned. + (def exempt @{}) + (def to-drop @[]) + (each b rtopo + (def m (bundle/manifest b)) + (if (or (get exempt b) (not (get m :auto-remove))) + (do + (put exempt b true) + (each d (get m :dependencies []) (put exempt d true))) + (array/push to-drop b))) + (print "pruning " (length to-drop) " bundles") + (each b to-drop (bundle-uninstall-unchecked b))) + (defn bundle/installed? "Check if a bundle is installed." [bundle-name] @@ -4127,6 +4189,14 @@ (assert (next bundle-name) "cannot use empty bundle-name") (assert (not (fexists (get-manifest-filename bundle-name))) "bundle is already installed") + # Check meta file for dependencies + (def infofile-pre (string path "/bundle/info.jdn")) + (when (os/stat infofile-pre :mode) + (def info (-> infofile-pre slurp parse)) + (def deps (get info :deps @[])) + (def missing (seq [d :in deps :when (not (bundle/installed? d))] (string d))) + (when (next missing) (errorf "missing dependencies %s" (string/join missing ", ")))) + # Setup installed paths (prime-bundle-paths) (os/mkdir (bundle-dir bundle-name)) # Copy some files into the new location unconditionally @@ -4136,6 +4206,7 @@ (def man @{:bundle-name bundle-name :local-source path :files @[]}) (merge-into man config) (def infofile (bundle-file bundle-name "info.jdn")) + (put man :auto-remove (get config :auto-remove)) (sync-manifest man) (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name)) (when (os/stat infofile :mode) @@ -4144,10 +4215,12 @@ (def missing (filter (complement bundle/installed?) deps)) (when (next missing) (error (string "missing dependencies " (string/join missing ", ")))) + (put man :dependencies deps) (put man :info info)) (def module (get-bundle-module bundle-name)) (def all-hooks (seq [[k v] :pairs module :when (symbol? k) :unless (get v :private)] (keyword k))) (put man :hooks all-hooks) + (do-hook module bundle-name :dependencies man) (when clean (do-hook module bundle-name :clean man)) (do-hook module bundle-name :build man) @@ -4204,7 +4277,7 @@ (bundle/install backup-bundle-source bundle-name) (copyrf (string backup-bundle-source "/old-bundle") (bundle-dir bundle-name)) (rmrf backup-bundle-source)) - (bundle/uninstall bundle-name) + (bundle-uninstall-unchecked bundle-name) (bundle/install path bundle-name ;(kvs config) ;(kvs new-config))) (rmrf backup-bundle-source) bundle-name) @@ -4237,14 +4310,6 @@ (print "+ " absdest) absdest) - (defn bundle/list - "Get a list of all installed bundles in lexical order." - [] - (def d (bundle-dir)) - (if (os/stat d :mode) - (sort (os/dir d)) - @[])) - (defn bundle/update-all "Reinstall all bundles" [] From 46bdcece4df9a0802475a846eacbf7ea7994c1f8 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 10:56:40 -0500 Subject: [PATCH 18/63] Add some better logging when pruning bundles. --- src/boot/boot.janet | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 8e102685..5dac149d 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4171,7 +4171,11 @@ (each d (get m :dependencies []) (put exempt d true))) (array/push to-drop b))) (print "pruning " (length to-drop) " bundles") - (each b to-drop (bundle-uninstall-unchecked b))) + (each b to-drop + (print "- " b)) + (each b to-drop + (print "uninstalling " b) + (bundle-uninstall-unchecked b))) (defn bundle/installed? "Check if a bundle is installed." From 7d8af2f99afa5e90eb433b66406453434bcc10c2 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 12:39:46 -0500 Subject: [PATCH 19/63] Add some testing to the bundle/ module. --- .gitignore | 1 + examples/sample-bundle/bundle/info.jdn | 2 +- examples/sample-bundle/mymod.janet | 6 +- examples/sample-dep1/bundle/info.jdn | 3 + examples/sample-dep1/bundle/init.janet | 3 + examples/sample-dep1/dep1.janet | 0 examples/sample-dep2/bundle/info.jdn | 1 + examples/sample-dep2/bundle/init.janet | 0 examples/sample-dep2/dep2.janet | 3 + test/suite-bundle.janet | 103 +++++++++++++++++++++++++ 10 files changed, 120 insertions(+), 2 deletions(-) create mode 100644 examples/sample-dep1/bundle/info.jdn create mode 100644 examples/sample-dep1/bundle/init.janet create mode 100644 examples/sample-dep1/dep1.janet create mode 100644 examples/sample-dep2/bundle/info.jdn create mode 100644 examples/sample-dep2/bundle/init.janet create mode 100644 examples/sample-dep2/dep2.janet create mode 100644 test/suite-bundle.janet diff --git a/.gitignore b/.gitignore index caeac6eb..ae5e64de 100644 --- a/.gitignore +++ b/.gitignore @@ -48,6 +48,7 @@ janet.wasm # Generated files *.gen.h *.gen.c +*.tmp # Generate test files *.out diff --git a/examples/sample-bundle/bundle/info.jdn b/examples/sample-bundle/bundle/info.jdn index 54875852..1ea8cbec 100644 --- a/examples/sample-bundle/bundle/info.jdn +++ b/examples/sample-bundle/bundle/info.jdn @@ -1,3 +1,3 @@ @{ - :dependencies ["spork"] + :dependencies ["sample-dep1" "sample-dep2"] } diff --git a/examples/sample-bundle/mymod.janet b/examples/sample-bundle/mymod.janet index 088ab194..8eb0c813 100644 --- a/examples/sample-bundle/mymod.janet +++ b/examples/sample-bundle/mymod.janet @@ -1,3 +1,7 @@ +(import dep1) +(import dep2) + (defn myfn [x] - (+ x x)) + (def y (dep2/function x)) + (dep1/function y)) diff --git a/examples/sample-dep1/bundle/info.jdn b/examples/sample-dep1/bundle/info.jdn new file mode 100644 index 00000000..4db882df --- /dev/null +++ b/examples/sample-dep1/bundle/info.jdn @@ -0,0 +1,3 @@ +@{ + :dependencies ["sample-dep2"] +} diff --git a/examples/sample-dep1/bundle/init.janet b/examples/sample-dep1/bundle/init.janet new file mode 100644 index 00000000..3441e07d --- /dev/null +++ b/examples/sample-dep1/bundle/init.janet @@ -0,0 +1,3 @@ +(defn install + [manifest &] + (bundle/add-file manifest "dep1.janet")) diff --git a/examples/sample-dep1/dep1.janet b/examples/sample-dep1/dep1.janet new file mode 100644 index 00000000..e69de29b diff --git a/examples/sample-dep2/bundle/info.jdn b/examples/sample-dep2/bundle/info.jdn new file mode 100644 index 00000000..7270cf99 --- /dev/null +++ b/examples/sample-dep2/bundle/info.jdn @@ -0,0 +1 @@ +@{} diff --git a/examples/sample-dep2/bundle/init.janet b/examples/sample-dep2/bundle/init.janet new file mode 100644 index 00000000..e69de29b diff --git a/examples/sample-dep2/dep2.janet b/examples/sample-dep2/dep2.janet new file mode 100644 index 00000000..9649f7b9 --- /dev/null +++ b/examples/sample-dep2/dep2.janet @@ -0,0 +1,3 @@ +(defn function + [x] + (* x x)) diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet new file mode 100644 index 00000000..319d78e9 --- /dev/null +++ b/test/suite-bundle.janet @@ -0,0 +1,103 @@ +# Copyright (c) 2024 Calvin Rose +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to +# deal in the Software without restriction, including without limitation the +# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +# sell copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +# IN THE SOFTWARE. + +(import ./helper :prefix "" :exit true) +(start-suite) + +(assert true) # smoke test + +# Copy since not exposed in boot.janet +(defn- rmrf + "rm -rf in janet" + [x] + (case (os/stat x :mode) + :file (os/rm x) + :directory (do + (each y (os/dir x) (rmrf (string x "/" y))) + (os/rmdir x))) + nil) + +# Setup a temporary syspath for manipultation +(def syspath (string "./" (gensym) "_jpm_tree.tmp")) +(os/mkdir syspath) +(setdyn *syspath* (os/realpath syspath)) +(setdyn *out* @"") +(assert (empty? (bundle/list)) "initial bundle/list") +(assert (empty? (bundle/topolist)) "initial bundle/topolist") + +# Try (and fail) to install sample-bundle (missing deps) +(assert-error "missing dependencies sample-dep1, sample-dep2" + (bundle/install "./examples/sample-bundle" "sample-bundle")) + +# Install deps (dep1 as :auto-remove) +(assert-no-error "sample-dep2" + (print (dyn *syspath*)) + (bundle/install "./examples/sample-dep2")) +(assert-no-error "sample-dep1" (bundle/install "./examples/sample-dep1")) +(assert-no-error "sample-dep2 reinstall" (bundle/reinstall "sample-dep2")) +(assert-no-error "sample-dep1 reinstall" (bundle/reinstall "sample-dep1" :auto-remove true)) + +(assert (= 2 (length (bundle/list))) "bundles are listed correctly 1") +(assert (= 2 (length (bundle/topolist))) "bundles are listed correctly 2") + +# Now install sample-bundle +(assert-no-error "sample-bundle install" (bundle/install "./examples/sample-bundle")) + +(assert (= 3 (length (bundle/list))) "bundles are listed correctly 3") +(assert (= 3 (length (bundle/topolist))) "bundles are listed correctly 4") + +# Check topolist has not bad order +(def tlist (bundle/topolist)) +(assert (> (index-of "sample-bundle" tlist) (index-of "sample-dep2" tlist)) "topolist 1") +(assert (> (index-of "sample-bundle" tlist) (index-of "sample-dep1" tlist)) "topolist 2") +(assert (> (index-of "sample-dep1" tlist) (index-of "sample-dep2" tlist)) "topolist 3") + +# Prune should do nothing +(assert-no-error "first prune" (bundle/prune)) +(assert (= 3 (length (bundle/list))) "bundles are listed correctly 3") +(assert (= 3 (length (bundle/topolist))) "bundles are listed correctly 4") + +# Manual uninstall of dep1 and dep2 shouldn't work either since that would break dependencies +(assert-error "cannot uninstall sample-dep1, breaks dependent bundles @[\"sample-bundle\"]" + (bundle/uninstall "sample-dep1")) + +# Now re-install sample-bundle as auto-remove +(assert-no-error "sample-bundle install" (bundle/reinstall "sample-bundle" :auto-remove true)) + +# Reinstallation should also work without being concerned about breaking dependencies +(assert-no-error "reinstall dep" (bundle/reinstall "sample-dep2")) + +# Now prune should get rid of everything except sample-dep2 +(assert-no-error "second prune" (bundle/prune)) + +# Now check that we exactly one package left, which is dep2 +(assert (= 1 (length (bundle/list))) "bundles are listed correctly 5") +(assert (= 1 (length (bundle/topolist))) "bundles are listed correctly 6") + +# Which we can uninstall manually +(assert-no-error "uninstall dep2" (bundle/uninstall "sample-dep2")) + +# Now check bundle listing is again empty +(assert (= 0 (length (bundle/list))) "bundles are listed correctly 7") +(assert (= 0 (length (bundle/topolist))) "bundles are listed correctly 8") + +(rmrf syspath) + +(end-suite) From 2260a593bdf38b1746166c7af30fa7b727d556f4 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 12:57:09 -0500 Subject: [PATCH 20/63] Add some test usage for the sample bundle. --- examples/sample-dep1/dep1.janet | 3 +++ examples/sample-dep2/bundle/init.janet | 3 +++ test/suite-bundle.janet | 9 +++++++-- 3 files changed, 13 insertions(+), 2 deletions(-) diff --git a/examples/sample-dep1/dep1.janet b/examples/sample-dep1/dep1.janet index e69de29b..213f68cf 100644 --- a/examples/sample-dep1/dep1.janet +++ b/examples/sample-dep1/dep1.janet @@ -0,0 +1,3 @@ +(defn function + [x] + (+ x x)) diff --git a/examples/sample-dep2/bundle/init.janet b/examples/sample-dep2/bundle/init.janet index e69de29b..f312ee1a 100644 --- a/examples/sample-dep2/bundle/init.janet +++ b/examples/sample-dep2/bundle/init.janet @@ -0,0 +1,3 @@ +(defn install + [manifest &] + (bundle/add-file manifest "dep2.janet")) diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index 319d78e9..9fd35dbc 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -35,9 +35,10 @@ nil) # Setup a temporary syspath for manipultation -(def syspath (string "./" (gensym) "_jpm_tree.tmp")) +(def syspath (string "./" (string (math/random)) "_jpm_tree.tmp")) +(rmrf syspath) (os/mkdir syspath) -(setdyn *syspath* (os/realpath syspath)) +(put root-env *syspath* (os/realpath syspath)) (setdyn *out* @"") (assert (empty? (bundle/list)) "initial bundle/list") (assert (empty? (bundle/topolist)) "initial bundle/topolist") @@ -74,6 +75,10 @@ (assert (= 3 (length (bundle/list))) "bundles are listed correctly 3") (assert (= 3 (length (bundle/topolist))) "bundles are listed correctly 4") +# Check that we can import the main dependency +(import mymod) +(assert (= 288 (mymod/myfn 12)) "using sample-bundle") + # Manual uninstall of dep1 and dep2 shouldn't work either since that would break dependencies (assert-error "cannot uninstall sample-dep1, breaks dependent bundles @[\"sample-bundle\"]" (bundle/uninstall "sample-dep1")) From 8334504f4e5aa253502a45db3eeb4db265490b4e Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 13:23:11 -0500 Subject: [PATCH 21/63] More work on fixing bunlde tools install. --- src/boot/boot.janet | 4 +++- src/core/util.c | 3 +++ test/suite-bundle.janet | 3 +-- 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 5dac149d..8460e025 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4067,6 +4067,7 @@ (def manifest (bundle/manifest bundle-name)) (def dir (os/cwd)) (def workdir (get manifest :local-source ".")) + (def fixed-syspath (os/realpath (dyn *syspath*))) (try (os/cd workdir) ([_] (print "cannot enter source directory " workdir " for bundle " bundle-name))) @@ -4077,8 +4078,9 @@ (put new-env *module-make-env* (fn make-bundle-env [&] (make-env new-env))) (put new-env :workdir workdir) (put new-env :bundle-name bundle-name) - (put new-env :bundle-dir (bundle-dir bundle-name)) + (put new-env *syspath* fixed-syspath) (with-env new-env + (put new-env :bundle-dir (bundle-dir bundle-name)) # get the syspath right (require (string "@syspath/bundle/" bundle-name))))) (defn- do-hook diff --git a/src/core/util.c b/src/core/util.c index 9d7aab3a..09cf36f2 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -958,6 +958,9 @@ const char *janet_strerror(int e) { #ifdef JANET_WINDOWS /* Microsoft strerror seems sane here and is thread safe by default */ return strerror(e); +#elif defined(_GNU_SOURCE) + /* See https://linux.die.net/man/3/strerror_r */ + return strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf)); #else strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf)); return janet_vm.strerror_buf; diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index 9fd35dbc..8904b4a7 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -39,7 +39,7 @@ (rmrf syspath) (os/mkdir syspath) (put root-env *syspath* (os/realpath syspath)) -(setdyn *out* @"") +#(setdyn *out* @"") (assert (empty? (bundle/list)) "initial bundle/list") (assert (empty? (bundle/topolist)) "initial bundle/topolist") @@ -49,7 +49,6 @@ # Install deps (dep1 as :auto-remove) (assert-no-error "sample-dep2" - (print (dyn *syspath*)) (bundle/install "./examples/sample-dep2")) (assert-no-error "sample-dep1" (bundle/install "./examples/sample-dep1")) (assert-no-error "sample-dep2 reinstall" (bundle/reinstall "sample-dep2")) From 641a16c133e4ffe782ee907e5dde2342348cbd5e Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 15:42:28 -0500 Subject: [PATCH 22/63] Add suite-bundle to meson test list. --- meson.build | 1 + src/boot/boot.janet | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/meson.build b/meson.build index 47e24987..73faf6e3 100644 --- a/meson.build +++ b/meson.build @@ -249,6 +249,7 @@ test_files = [ 'test/suite-asm.janet', 'test/suite-boot.janet', 'test/suite-buffer.janet', + 'test/suite-bundle.janet', 'test/suite-capi.janet', 'test/suite-cfuns.janet', 'test/suite-compile.janet', diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 8460e025..034fe9d4 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3999,11 +3999,11 @@ (defn- bundle-dir [&opt bundle-name] - (string (os/realpath (dyn *syspath*)) "/bundle/" bundle-name)) + (string (dyn *syspath*) "/bundle/" bundle-name)) (defn- bundle-file [bundle-name filename] - (string (os/realpath (dyn *syspath*)) "/bundle/" bundle-name "/" filename)) + (string (dyn *syspath*) "/bundle/" bundle-name "/" filename)) (defn- get-manifest-filename [bundle-name] From 8e0340252b889ac798658b9e232c29a47d27560e Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 15:50:51 -0500 Subject: [PATCH 23/63] Add verbose errors to ci --- .github/workflows/test.yml | 4 ++-- test/suite-bundle.janet | 4 +++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 98fa7d02..e26ed7ed 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -73,7 +73,7 @@ jobs: - name: Compile the project run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine - name: Test the project - run: make test UNAME=MINGW RUN=wine + run: make test UNAME=MINGW RUN=wine VERBOSE=1 test-arm-linux: name: Build and test ARM32 cross compilation @@ -88,4 +88,4 @@ jobs: - name: Compile the project run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc - name: Test the project - run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test + run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test VERBOSE=1 diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index 8904b4a7..c5f202c0 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -39,7 +39,7 @@ (rmrf syspath) (os/mkdir syspath) (put root-env *syspath* (os/realpath syspath)) -#(setdyn *out* @"") +(setdyn *out* @"") (assert (empty? (bundle/list)) "initial bundle/list") (assert (empty? (bundle/topolist)) "initial bundle/topolist") @@ -60,6 +60,8 @@ # Now install sample-bundle (assert-no-error "sample-bundle install" (bundle/install "./examples/sample-bundle")) +(assert-error "" (bundle/install "./examples/sample-dep11111")) + (assert (= 3 (length (bundle/list))) "bundles are listed correctly 3") (assert (= 3 (length (bundle/topolist))) "bundles are listed correctly 4") From 14d1dc874938e73b0846e813620bbbbba1a47130 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 16:00:43 -0500 Subject: [PATCH 24/63] Pathing is not quite working... --- test/suite-bundle.janet | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index c5f202c0..1866974a 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -24,20 +24,23 @@ (assert true) # smoke test # Copy since not exposed in boot.janet +(def- sep (if (= :windows (os/which)) "\\" "/")) (defn- rmrf "rm -rf in janet" [x] (case (os/stat x :mode) :file (os/rm x) :directory (do - (each y (os/dir x) (rmrf (string x "/" y))) + (each y (os/dir x) (rmrf (string x sep y))) (os/rmdir x))) nil) # Setup a temporary syspath for manipultation -(def syspath (string "./" (string (math/random)) "_jpm_tree.tmp")) +(math/seedrandom (os/cryptorand 16)) +(def syspath (string "." sep (string (math/random)) "_jpm_tree.tmp")) (rmrf syspath) -(os/mkdir syspath) +(assert (os/mkdir syspath)) +(print (os/ (put root-env *syspath* (os/realpath syspath)) (setdyn *out* @"") (assert (empty? (bundle/list)) "initial bundle/list") From 750b448f7564e5a86cc20a0205db1d6bf8ff54f1 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 16:02:23 -0500 Subject: [PATCH 25/63] typo doing previous CI trigger. --- test/suite-bundle.janet | 1 - 1 file changed, 1 deletion(-) diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index 1866974a..74c1d350 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -40,7 +40,6 @@ (def syspath (string "." sep (string (math/random)) "_jpm_tree.tmp")) (rmrf syspath) (assert (os/mkdir syspath)) -(print (os/ (put root-env *syspath* (os/realpath syspath)) (setdyn *out* @"") (assert (empty? (bundle/list)) "initial bundle/list") From e88042b2fa9fc79fb8b57542ed706bc0b655d7cc Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 16:09:49 -0500 Subject: [PATCH 26/63] Pick default bundle name better. --- src/boot/boot.janet | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 034fe9d4..117b842b 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4191,7 +4191,13 @@ (def path (os/realpath path)) (def clean (get config :clean)) (def check (get config :check)) - (default bundle-name (last (string/split "/" path))) + (default bundle-name + (let [sep (if (string/find "\\" path) "\\" "/")] + (last (string/split sep path)))) + (assert (not (string/check-set "\\/" bundle-name)) + (string "bundle-name " + bundle-name + " cannot contain path separators")) (assert (next bundle-name) "cannot use empty bundle-name") (assert (not (fexists (get-manifest-filename bundle-name))) "bundle is already installed") From 6d5fc1d743a4427af0520937b4a0652d98ca22f8 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 16:15:58 -0500 Subject: [PATCH 27/63] Even more verbose --- test/suite-bundle.janet | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index 74c1d350..934dd949 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -41,7 +41,7 @@ (rmrf syspath) (assert (os/mkdir syspath)) (put root-env *syspath* (os/realpath syspath)) -(setdyn *out* @"") +#(setdyn *out* @"") (assert (empty? (bundle/list)) "initial bundle/list") (assert (empty? (bundle/topolist)) "initial bundle/topolist") @@ -56,6 +56,7 @@ (assert-no-error "sample-dep2 reinstall" (bundle/reinstall "sample-dep2")) (assert-no-error "sample-dep1 reinstall" (bundle/reinstall "sample-dep1" :auto-remove true)) +(eprintf "%.99M" (bundle/list)) (assert (= 2 (length (bundle/list))) "bundles are listed correctly 1") (assert (= 2 (length (bundle/topolist))) "bundles are listed correctly 2") From eb21d4fff48ee657ef83b7b4b54b386dd4f919fd Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 16:36:08 -0500 Subject: [PATCH 28/63] Allow using keywords as names for anonymous functions. This allows for better stack traces in macros and generally easier debugging. --- src/boot/boot.janet | 63 ++++++++++++++++++++++----------------------- src/core/specials.c | 7 ++++- 2 files changed, 37 insertions(+), 33 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 117b842b..2652c628 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -244,7 +244,7 @@ (let [[[err fib]] catch f (gensym) r (gensym)] - ~(let [,f (,fiber/new (fn [] ,body) :ie) + ~(let [,f (,fiber/new (fn :try [] ,body) :ie) ,r (,resume ,f)] (if (,= (,fiber/status ,f) :error) (do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1)) @@ -256,7 +256,7 @@ error, and the second is the return value or error.` [& body] (let [f (gensym) r (gensym)] - ~(let [,f (,fiber/new (fn [] ,;body) :ie) + ~(let [,f (,fiber/new (fn :protect [] ,;body) :ie) ,r (,resume ,f)] [(,not= :error (,fiber/status ,f)) ,r]))) @@ -313,7 +313,7 @@ [form & body] (with-syms [f r] ~(do - (def ,f (,fiber/new (fn [] ,;body) :ti)) + (def ,f (,fiber/new (fn :defer [] ,;body) :ti)) (def ,r (,resume ,f)) ,form (if (= (,fiber/status ,f) :dead) @@ -326,7 +326,7 @@ [form & body] (with-syms [f r] ~(do - (def ,f (,fiber/new (fn [] ,;body) :ti)) + (def ,f (,fiber/new (fn :edefer [] ,;body) :ti)) (def ,r (,resume ,f)) (if (= (,fiber/status ,f) :dead) ,r @@ -338,7 +338,7 @@ [tag & body] (with-syms [res target payload fib] ~(do - (def ,fib (,fiber/new (fn [] [,tag (do ,;body)]) :i0)) + (def ,fib (,fiber/new (fn :prompt [] [,tag (do ,;body)]) :i0)) (def ,res (,resume ,fib)) (def [,target ,payload] ,res) (if (,= ,tag ,target) @@ -629,17 +629,17 @@ ``Create a generator expression using the `loop` syntax. Returns a fiber that yields all values inside the loop in order. See `loop` for details.`` [head & body] - ~(,fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi)) + ~(,fiber/new (fn :generate [] (loop ,head (yield (do ,;body)))) :yi)) (defmacro coro "A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`." [& body] - (tuple fiber/new (tuple 'fn '[] ;body) :yi)) + (tuple fiber/new (tuple 'fn :coro '[] ;body) :yi)) (defmacro fiber-fn "A wrapper for making fibers. Same as `(fiber/new (fn [] ;body) flags)`." [flags & body] - (tuple fiber/new (tuple 'fn '[] ;body) flags)) + (tuple fiber/new (tuple 'fn :fiber-fn '[] ;body) flags)) (defn sum "Returns the sum of xs. If xs is empty, returns 0." @@ -702,11 +702,11 @@ (case (length functions) 0 nil 1 (in functions 0) - 2 (let [[f g] functions] (fn [& x] (f (g ;x)))) - 3 (let [[f g h] functions] (fn [& x] (f (g (h ;x))))) - 4 (let [[f g h i] functions] (fn [& x] (f (g (h (i ;x)))))) + 2 (let [[f g] functions] (fn :comp [& x] (f (g ;x)))) + 3 (let [[f g h] functions] (fn :comp [& x] (f (g (h ;x))))) + 4 (let [[f g h i] functions] (fn :comp [& x] (f (g (h (i ;x)))))) (let [[f g h i] functions] - (comp (fn [x] (f (g (h (i x))))) + (comp (fn :comp [x] (f (g (h (i x))))) ;(tuple/slice functions 4 -1))))) (defn identity @@ -717,7 +717,7 @@ (defn complement "Returns a function that is the complement to the argument." [f] - (fn [x] (not (f x)))) + (fn :complement [x] (not (f x)))) (defmacro- do-extreme [order args] @@ -880,7 +880,7 @@ ``Sorts `ind` in-place by calling a function `f` on each element and comparing the result with `<`.`` [f ind] - (sort ind (fn [x y] (< (f x) (f y))))) + (sort ind (fn :sort-by-comp [x y] (< (f x) (f y))))) (defn sorted ``Returns a new sorted array without modifying the old one. @@ -893,7 +893,7 @@ ``Returns a new sorted array that compares elements by invoking a function `f` on each element and comparing the result with `<`.`` [f ind] - (sorted ind (fn [x y] (< (f x) (f y))))) + (sorted ind (fn :sorted-by-comp [x y] (< (f x) (f y))))) (defn reduce ``Reduce, also know as fold-left in many languages, transforms @@ -1192,7 +1192,7 @@ ``Returns the juxtaposition of functions. In other words, `((juxt* a b c) x)` evaluates to `[(a x) (b x) (c x)]`.`` [& funs] - (fn [& args] + (fn :juxt* [& args] (def ret @[]) (each f funs (array/push ret (f ;args))) @@ -1205,7 +1205,7 @@ (def $args (gensym)) (each f funs (array/push parts (tuple apply f $args))) - (tuple 'fn (tuple '& $args) (tuple/slice parts 0))) + (tuple 'fn :juxt (tuple '& $args) (tuple/slice parts 0))) (defmacro defdyn ``Define an alias for a keyword that is used as a dynamic binding. The @@ -1421,12 +1421,12 @@ (def dyn-forms (seq [i :range [0 (length bindings) 2]] ~(setdyn ,(bindings i) ,(bindings (+ i 1))))) - ~(,resume (,fiber/new (fn [] ,;dyn-forms ,;body) :p))) + ~(,resume (,fiber/new (fn :with-dyns [] ,;dyn-forms ,;body) :p))) (defmacro with-env `Run a block of code with a given environment table` [env & body] - ~(,resume (,fiber/new (fn [] ,;body) : ,env))) + ~(,resume (,fiber/new (fn :with-env [] ,;body) : ,env))) (defmacro with-vars ``Evaluates `body` with each var in `vars` temporarily bound. Similar signature to @@ -1441,7 +1441,7 @@ (with-syms [ret f s] ~(do ,;saveold - (def ,f (,fiber/new (fn [] ,;setnew ,;body) :ti)) + (def ,f (,fiber/new (fn :with-vars [] ,;setnew ,;body) :ti)) (def ,ret (,resume ,f)) ,;restoreold (if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f))))) @@ -1450,7 +1450,7 @@ "Partial function application." [f & more] (if (zero? (length more)) f - (fn [& r] (f ;more ;r)))) + (fn :partial [& r] (f ;more ;r)))) (defn every? ``Evaluates to the last element of `ind` if all preceding elements are truthy, @@ -1807,7 +1807,6 @@ (printf (dyn *pretty-format* "%q") x) (flush)) - (defn file/lines "Return an iterator over the lines of a file." [file] @@ -2330,7 +2329,7 @@ x))) x)) (def expanded (macex arg on-binding)) - (def name-splice (if name [name] [])) + (def name-splice (if name [name] [:short-fn])) (def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol prefix '$ i))) ~(fn ,;name-splice [,;fn-args ,;(if vararg ['& (symbol prefix '$&)] [])] ,expanded)) @@ -2547,7 +2546,7 @@ :read read :expander expand} opts) (default env (or (fiber/getenv (fiber/current)) @{})) - (default chunks (fn [buf p] (getline "" buf env))) + (default chunks (fn chunks [buf p] (getline "" buf env))) (default onstatus debug/stacktrace) (default on-compile-error bad-compile) (default on-compile-warning warn-compile) @@ -2867,7 +2866,7 @@ (set ret [fullpath mod-kind]) (break)))))) (if ret ret - (let [expander (fn [[t _ chk]] + (let [expander (fn :expander [[t _ chk]] (when (string? t) (when (mod-filter chk path) (module/expand-path path t)))) @@ -2934,7 +2933,7 @@ set to a truthy value." [env &opt level is-repl] (default level 1) - (fn [f x] + (fn :debugger [f x] (def fs (fiber/status f)) (if (= :dead fs) (when is-repl @@ -3704,7 +3703,7 @@ [&opt chunks onsignal env parser read] (default env (make-env)) (default chunks - (fn [buf p] + (fn :chunks [buf p] (getline (string "repl:" @@ -3735,18 +3734,18 @@ Returns a fiber that is scheduled to run the function. ``` [f & args] - (ev/go (fn _call [&] (f ;args)))) + (ev/go (fn :call [&] (f ;args)))) (defmacro ev/spawn "Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`." [& body] - ~(,ev/go (fn _spawn [&] ,;body))) + ~(,ev/go (fn :spawn [&] ,;body))) (defmacro ev/do-thread ``Run some code in a new thread. Suspends the current fiber until the thread is complete, and evaluates to nil.`` [& body] - ~(,ev/thread (fn _do-thread [&] ,;body))) + ~(,ev/thread (fn :do-thread [&] ,;body))) (defn- acquire-release [acq rel lock body] @@ -3775,7 +3774,7 @@ (defmacro ev/spawn-thread ``Run some code in a new thread. Like `ev/do-thread`, but returns nil immediately.`` [& body] - ~(,ev/thread (fn _spawn-thread [&] ,;body) nil :n)) + ~(,ev/thread (fn :spawn-thread [&] ,;body) nil :n)) (defmacro ev/with-deadline `` @@ -3824,7 +3823,7 @@ (def ,res @[]) ,;(seq [[i body] :pairs bodies] ~(do - (def ,ftemp (,ev/go (fn [] (put ,res ,i ,body)) nil ,chan)) + (def ,ftemp (,ev/go (fn :ev/gather [] (put ,res ,i ,body)) nil ,chan)) (,put ,fset ,ftemp ,ftemp))) (,wait-for-fibers ,chan ,fset) ,res)))) diff --git a/src/core/specials.c b/src/core/specials.c index bae6e4a2..934f25d3 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -925,6 +925,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { int structarg = 0; int allow_extra = 0; int selfref = 0; + int hasname = 0; int seenamp = 0; int seenopt = 0; int namedargs = 0; @@ -943,6 +944,10 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { head = argv[0]; if (janet_checktype(head, JANET_SYMBOL)) { selfref = 1; + hasname = 1; + parami = 1; + } else if (janet_checktype(head, JANET_KEYWORD)) { + hasname = 1; parami = 1; } if (parami >= argn || !janet_checktype(argv[parami], JANET_TUPLE)) { @@ -1103,7 +1108,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG; if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG; - if (selfref) def->name = janet_unwrap_symbol(head); + if (hasname) def->name = janet_unwrap_symbol(head); /* Also correctly unwraps keyword */ janet_def_addflags(def); defindex = janetc_addfuncdef(c, def); From 4fbc71c70d41d143cd6c5d6fbd161e5b1f624fbb Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 16:43:51 -0500 Subject: [PATCH 29/63] Just don't do backslashes. --- src/boot/boot.janet | 14 ++++++++------ test/suite-bundle.janet | 7 ++++++- 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 2652c628..410af40d 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4004,6 +4004,10 @@ [bundle-name filename] (string (dyn *syspath*) "/bundle/" bundle-name "/" filename)) + (defn- bundle-rpath + [path] + (string/replace-all "\\" "/" (os/realpath path))) + (defn- get-manifest-filename [bundle-name] (bundle-file bundle-name "manifest.jdn")) @@ -4066,7 +4070,7 @@ (def manifest (bundle/manifest bundle-name)) (def dir (os/cwd)) (def workdir (get manifest :local-source ".")) - (def fixed-syspath (os/realpath (dyn *syspath*))) + (def fixed-syspath (bundle-rpath (dyn *syspath*))) (try (os/cd workdir) ([_] (print "cannot enter source directory " workdir " for bundle " bundle-name))) @@ -4187,12 +4191,10 @@ "Install a bundle from the local filesystem with a name `bundle-name`." [&opt path bundle-name &keys config] (default path ".") - (def path (os/realpath path)) + (def path (bundle-rpath path)) (def clean (get config :clean)) (def check (get config :check)) - (default bundle-name - (let [sep (if (string/find "\\" path) "\\" "/")] - (last (string/split sep path)))) + (default bundle-name (last (string/split sep path))) (assert (not (string/check-set "\\/" bundle-name)) (string "bundle-name " bundle-name @@ -4256,7 +4258,7 @@ (def install-hook (string dest-dir "/bundle/init.janet")) (edefer (rmrf dest-dir) # don't leave garbage on failure (def install-source @[]) - (def syspath (os/realpath (dyn *syspath*))) + (def syspath (bundle-rpath (dyn *syspath*)) (when is-backup (copyrf (bundle-dir bundle-name) (string dest-dir "/old-bundle"))) (each file files (def {:mode mode :permissions perm} (os/stat file)) diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index 934dd949..4522131f 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -24,6 +24,9 @@ (assert true) # smoke test # Copy since not exposed in boot.janet +(defn- bundle-rpath + [path] + (string/replace-all "\\" "/" (os/realpath path))) (def- sep (if (= :windows (os/which)) "\\" "/")) (defn- rmrf "rm -rf in janet" @@ -40,8 +43,10 @@ (def syspath (string "." sep (string (math/random)) "_jpm_tree.tmp")) (rmrf syspath) (assert (os/mkdir syspath)) -(put root-env *syspath* (os/realpath syspath)) +(put root-env *syspath* (bundle-rpath syspath)) #(setdyn *out* @"") +(pp (bundle/list)) +(pp (bundle/topolist)) (assert (empty? (bundle/list)) "initial bundle/list") (assert (empty? (bundle/topolist)) "initial bundle/topolist") From 25990867e2aaa9b864fcd999f528afdb30d20f2e Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 16:46:04 -0500 Subject: [PATCH 30/63] Missing ) --- src/boot/boot.janet | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 410af40d..a32ad6d8 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4258,7 +4258,7 @@ (def install-hook (string dest-dir "/bundle/init.janet")) (edefer (rmrf dest-dir) # don't leave garbage on failure (def install-source @[]) - (def syspath (bundle-rpath (dyn *syspath*)) + (def syspath (bundle-rpath (dyn *syspath*))) (when is-backup (copyrf (bundle-dir bundle-name) (string dest-dir "/old-bundle"))) (each file files (def {:mode mode :permissions perm} (os/stat file)) From cb529bbd63e8d4e6efe5874715f35c70cbb5a152 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 16:48:27 -0500 Subject: [PATCH 31/63] Pass on linux. --- src/boot/boot.janet | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index a32ad6d8..9fcfd374 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4194,7 +4194,7 @@ (def path (bundle-rpath path)) (def clean (get config :clean)) (def check (get config :check)) - (default bundle-name (last (string/split sep path))) + (default bundle-name (last (string/split "/" path))) (assert (not (string/check-set "\\/" bundle-name)) (string "bundle-name " bundle-name From 1844beecc3934147e996bf4e292b5de336552da8 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 08:45:38 -0500 Subject: [PATCH 32/63] More work on improving stacktraces slightly. Add extra information about when we change fibers. The janet stack is really a spaghetti stack, where each fiber represents a group of stack frames as well as a place where we can longjmp to. It is therefor useful information for the programmer to know where each stack frame is. However, an argument could be made that this clutters the stackframe and is more of a hindrance than a help. --- src/boot/boot.janet | 79 ++++++++++++++++++++++++--------------------- src/core/compile.c | 2 +- src/core/debug.c | 5 ++- src/core/vm.c | 2 +- 4 files changed, 48 insertions(+), 40 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 9fcfd374..fe596c57 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2405,6 +2405,33 @@ (defdyn *err-color* "Whether or not to turn on error coloring in stacktraces and other error messages.") +(defdyn *err-line-col* + "Whether or not to print the line of source code that caused an error.") + +(defn- print-line-col + ``Print the source code at a line, column in a source file. If unable to open + the file, prints nothing.`` + [where line col] + (if-not line (break)) + (unless (string? where) (break)) + (unless (dyn *err-line-col*) (break)) + (def ec (dyn *err-color*)) + (when-with [f (file/open where :r)] + (def source-code (file/read f :all)) + (var index 0) + (repeat (dec line) + (if-not index (break)) + (set index (string/find "\n" source-code index)) + (if index (++ index))) + (when index + (def line-end (string/find "\n" source-code index)) + (def s (if ec "\e[31m")) + (def e (if ec "\e[0m")) + (eprint s " " (string/slice source-code index line-end) e) + (when col + (+= index col) + (eprint s (string/repeat " " (inc col)) "^" e))))) + (defn bad-parse "Default handler for a parse error." [p where] @@ -2419,29 +2446,10 @@ col ": parse error: " (:error p) - (if ec "\e[0m" "")) + (if ec "\e[0m")) + (print-line-col where line col) (eflush)) -(defn- print-line-col - ``Print the source code at a line, column in a source file. If unable to open - the file, prints nothing.`` - [where line col] - (if-not line (break)) - (unless (string? where) (break)) - (when-with [f (file/open where :r)] - (def source-code (file/read f :all)) - (var index 0) - (repeat (dec line) - (if-not index (break)) - (set index (string/find "\n" source-code index)) - (if index (++ index))) - (when index - (def line-end (string/find "\n" source-code index)) - (eprint " " (string/slice source-code index line-end)) - (when col - (+= index col) - (eprint (string/repeat " " (inc col)) "^"))))) - (defn warn-compile "Default handler for a compile warning." [msg level where &opt line col] @@ -2454,10 +2462,8 @@ ":" col ": compile warning (" level "): ") - (eprint msg) - (when ec - (print-line-col where line col) - (eprin "\e[0m")) + (eprint msg (if ec "\e[0m")) + (print-line-col where line col) (eflush)) (defn bad-compile @@ -2474,10 +2480,8 @@ ": compile error: ") (if macrof (debug/stacktrace macrof msg "") - (eprint msg)) - (when ec - (print-line-col where line col) - (eprin "\e[0m")) + (eprint msg (if ec "\e[0m"))) + (print-line-col where line col) (eflush)) (defn curenv @@ -3049,7 +3053,7 @@ ``A table of loading method names to loading functions. This table lets `require` and `import` load many different kinds of files as modules.`` - @{:native (fn native-loader [path &] (native path (make-env))) + @{:native (fn native-loader [path &] (native path ((dyn *module-make-env* make-env)))) :source (fn source-loader [path args] (def ml (dyn *module-loading* module/loading)) (put ml path true) @@ -3996,18 +4000,19 @@ (compwhen (dyn 'os/stat) - (defn- bundle-dir - [&opt bundle-name] - (string (dyn *syspath*) "/bundle/" bundle-name)) - - (defn- bundle-file - [bundle-name filename] - (string (dyn *syspath*) "/bundle/" bundle-name "/" filename)) (defn- bundle-rpath [path] (string/replace-all "\\" "/" (os/realpath path))) + (defn- bundle-dir + [&opt bundle-name] + (string (bundle-rpath (dyn *syspath*)) "/bundle/" bundle-name)) + + (defn- bundle-file + [bundle-name filename] + (string (bundle-rpath (dyn *syspath*)) "/bundle/" bundle-name "/" filename)) + (defn- get-manifest-filename [bundle-name] (bundle-file bundle-name "manifest.jdn")) diff --git a/src/core/compile.c b/src/core/compile.c index 93ae2039..587db3a5 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -1056,7 +1056,7 @@ JanetCompileResult janet_compile_lint(Janet source, if (c.result.status == JANET_COMPILE_OK) { JanetFuncDef *def = janetc_pop_funcdef(&c); - def->name = janet_cstring("_thunk"); + def->name = janet_cstring("thunk"); janet_def_addflags(def); c.result.funcdef = def; } else { diff --git a/src/core/debug.c b/src/core/debug.c index 35b2b331..e9d96abd 100644 --- a/src/core/debug.c +++ b/src/core/debug.c @@ -164,7 +164,7 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) { } } if (frame->flags & JANET_STACKFRAME_TAILCALL) - janet_eprintf(" (tailcall)"); + janet_eprintf(" (tail call)"); if (frame->func && frame->pc) { int32_t off = (int32_t)(frame->pc - def->bytecode); if (def->sourcemap) { @@ -180,6 +180,9 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) { } } janet_eprintf("\n"); + if (i <= 0 && fi > 0) { /* no next frame, first stack frame in fiber. First fiber is trivial. */ + janet_eprintf(" in parent fiber\n"); + } } } diff --git a/src/core/vm.c b/src/core/vm.c index acaeba98..91a86318 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -318,7 +318,7 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh Janet lr = janet_method_lookup(rhs, rmethod); Janet argv[2] = { rhs, lhs }; if (janet_checktype(lr, JANET_NIL)) { - janet_panicf("could not find method :%s for %v, or :%s for %v", + janet_panicf("could not find method :%s for %v or :%s for %v", lmethod, lhs, rmethod, rhs); } From de977819ce769b099934abeeb409096a3f4a273b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 09:03:01 -0500 Subject: [PATCH 33/63] Add some tracing. --- src/boot/boot.janet | 4 ++-- test/suite-buffer.janet | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index fe596c57..c7e6372e 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4007,11 +4007,11 @@ (defn- bundle-dir [&opt bundle-name] - (string (bundle-rpath (dyn *syspath*)) "/bundle/" bundle-name)) + (tracev (string (bundle-rpath (dyn *syspath*)) "/bundle/" bundle-name))) (defn- bundle-file [bundle-name filename] - (string (bundle-rpath (dyn *syspath*)) "/bundle/" bundle-name "/" filename)) + (tracev (string (bundle-rpath (dyn *syspath*)) "/bundle/" bundle-name "/" filename))) (defn- get-manifest-filename [bundle-name] diff --git a/test/suite-buffer.janet b/test/suite-buffer.janet index 9821e384..b6ceecec 100644 --- a/test/suite-buffer.janet +++ b/test/suite-buffer.janet @@ -1,4 +1,4 @@ -# Copyright (c) 2023 Calvin Rose +# Copyright (c) 2024 Calvin Rose # # Permission is hereby granted, free of charge, to any person obtaining a copy # of this software and associated documentation files (the "Software"), to From 2fafe2b5d1c53a26f77c883e01629c02395e5b18 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 09:09:04 -0500 Subject: [PATCH 34/63] Make rmrf stronger. --- src/boot/boot.janet | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index c7e6372e..38d1e22d 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4030,10 +4030,11 @@ "rm -rf in janet" [x] (case (os/stat x :mode) - :file (os/rm x) + nil nil :directory (do (each y (os/dir x) (rmrf (string x "/" y))) - (os/rmdir x))) + (os/rmdir x)) + (os/rm x)) nil) (defn- copyfile From 7911e74222de960f95527353e8971913f32b636b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 09:11:24 -0500 Subject: [PATCH 35/63] Use lstat instead of stat --- src/boot/boot.janet | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 38d1e22d..fbf90e9f 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4029,7 +4029,7 @@ (defn- rmrf "rm -rf in janet" [x] - (case (os/stat x :mode) + (case (os/lstat x :mode) nil nil :directory (do (each y (os/dir x) (rmrf (string x "/" y))) From 6cd35ed9c81168bfbfc85011289bf03fa3226aa2 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 09:27:22 -0500 Subject: [PATCH 36/63] Try and be OS sensitive when using path separators. --- src/boot/boot.janet | 57 ++++++++++++++++++++++++----------------- test/suite-bundle.janet | 18 ++++++------- 2 files changed, 43 insertions(+), 32 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index fbf90e9f..0cbb554e 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4000,18 +4000,21 @@ (compwhen (dyn 'os/stat) + (defn- sep [] (if (= :windows (os/which)) "\\" "/")) (defn- bundle-rpath [path] - (string/replace-all "\\" "/" (os/realpath path))) + (os/realpath path)) (defn- bundle-dir [&opt bundle-name] - (tracev (string (bundle-rpath (dyn *syspath*)) "/bundle/" bundle-name))) + (def s (sep)) + (string (bundle-rpath (dyn *syspath*)) s "bundle" s bundle-name)) (defn- bundle-file [bundle-name filename] - (tracev (string (bundle-rpath (dyn *syspath*)) "/bundle/" bundle-name "/" filename))) + (def s (sep)) + (string (bundle-rpath (dyn *syspath*)) s "bundle" s bundle-name s filename)) (defn- get-manifest-filename [bundle-name] @@ -4032,7 +4035,9 @@ (case (os/lstat x :mode) nil nil :directory (do - (each y (os/dir x) (rmrf (string x "/" y))) + (def s (sep)) + (each y (os/dir x) + (rmrf (string x s y))) (os/rmdir x)) (os/rm x)) nil) @@ -4053,9 +4058,10 @@ (case (os/stat from :mode) :file (copyfile from to) :directory (do + (def s (sep)) (os/mkdir to) (each y (os/dir from) - (copyrf (string from "/" y) (string to "/" y))))) + (copyrf (string from s y) (string to s y))))) nil) (defn- sync-manifest @@ -4122,7 +4128,7 @@ (do-hook module bundle-name :uninstall man)) (def files (get man :files [])) (each file (reverse files) - (print "- " file) + (print "remove " file) (case (os/stat file :mode) :file (os/rm file) :directory (os/rmdir file))) @@ -4183,7 +4189,7 @@ (array/push to-drop b))) (print "pruning " (length to-drop) " bundles") (each b to-drop - (print "- " b)) + (print "uninstall " b)) (each b to-drop (print "uninstalling " b) (bundle-uninstall-unchecked b))) @@ -4200,7 +4206,8 @@ (def path (bundle-rpath path)) (def clean (get config :clean)) (def check (get config :check)) - (default bundle-name (last (string/split "/" path))) + (def s (sep)) + (default bundle-name (last (string/split "/" (string/replace-all "\\" "/" path)))) (assert (not (string/check-set "\\/" bundle-name)) (string "bundle-name " bundle-name @@ -4209,7 +4216,7 @@ (assert (not (fexists (get-manifest-filename bundle-name))) "bundle is already installed") # Check meta file for dependencies - (def infofile-pre (string path "/bundle/info.jdn")) + (def infofile-pre (string path s "bundle" s "info.jdn")) (when (os/stat infofile-pre :mode) (def info (-> infofile-pre slurp parse)) (def deps (get info :deps @[])) @@ -4219,7 +4226,7 @@ (prime-bundle-paths) (os/mkdir (bundle-dir bundle-name)) # Copy some files into the new location unconditionally - (def implicit-sources (string path "/bundle")) + (def implicit-sources (string path s "bundle")) (when (= :directory (os/stat implicit-sources :mode)) (copyrf implicit-sources (bundle-dir bundle-name))) (def man @{:bundle-name bundle-name :local-source path :files @[]}) @@ -4260,20 +4267,21 @@ (def man (bundle/manifest bundle-name)) (def files (get man :files @[])) (assert (os/mkdir dest-dir) (string "could not create directory " dest-dir " (or it already exists)")) - (os/mkdir (string dest-dir "/bundle")) - (def install-hook (string dest-dir "/bundle/init.janet")) + (def s (sep)) + (os/mkdir (string dest-dir s "bundle")) + (def install-hook (string dest-dir s "bundle" s "init.janet")) (edefer (rmrf dest-dir) # don't leave garbage on failure (def install-source @[]) (def syspath (bundle-rpath (dyn *syspath*))) - (when is-backup (copyrf (bundle-dir bundle-name) (string dest-dir "/old-bundle"))) + (when is-backup (copyrf (bundle-dir bundle-name) (string dest-dir s "old-bundle"))) (each file files (def {:mode mode :permissions perm} (os/stat file)) - (def relpath (string/triml (slice file (length syspath) -1) "/")) + (def relpath (string/triml (slice file (length syspath) -1) s)) (case mode :directory (array/push install-source ~(bundle/add-directory manifest ,relpath ,perm)) :file (do (def filename (string/format "file_%06d" (++ i))) - (copyfile file (string dest-dir "/" filename)) + (copyfile file (string dest-dir s filename)) (array/push install-source ~(bundle/add-file manifest ,filename ,relpath ,perm))) (errorf "unexpected file %v" file))) (def b @"(defn install [manifest]\n") @@ -4288,13 +4296,14 @@ (def manifest (bundle/manifest bundle-name)) (def path (get manifest :local-source)) (def config (get manifest :config @{})) + (def s (sep)) (assert (= :directory (os/stat path :mode)) "local source not available") - (def backup-dir (string (dyn *syspath*) "/" bundle-name ".backup")) + (def backup-dir (string (dyn *syspath*) s bundle-name ".backup")) (rmrf backup-dir) (def backup-bundle-source (bundle/pack bundle-name backup-dir true)) (edefer (do (bundle/install backup-bundle-source bundle-name) - (copyrf (string backup-bundle-source "/old-bundle") (bundle-dir bundle-name)) + (copyrf (string backup-bundle-source s "old-bundle") (bundle-dir bundle-name)) (rmrf backup-bundle-source)) (bundle-uninstall-unchecked bundle-name) (bundle/install path bundle-name ;(kvs config) ;(kvs new-config))) @@ -4305,13 +4314,14 @@ "Add a directory during the install process relative to `(dyn *syspath*)`" [manifest dest &opt chmod-mode] (def files (get-files manifest)) - (def absdest (string (dyn *syspath*) "/" dest)) + (def s (sep)) + (def absdest (string (dyn *syspath*) s dest)) (unless (os/mkdir absdest) (errorf "collision at %s, directory already exists" absdest)) - (array/push files absdest) + (array/push files (os/realpath absdest)) (when chmod-mode (os/chmod absdest chmod-mode)) - (print "+ " absdest) + (print "add " absdest) absdest) (defn bundle/add-file @@ -4319,14 +4329,15 @@ [manifest src &opt dest chmod-mode] (default dest src) (def files (get-files manifest)) - (def absdest (string (dyn *syspath*) "/" dest)) + (def s (sep)) + (def absdest (string (dyn *syspath*) s dest)) (when (os/stat absdest :mode) (errorf "collision at %s, file already exists" absdest)) (copyfile src absdest) - (array/push files absdest) + (array/push files (os/realpath absdest)) (when chmod-mode (os/chmod absdest chmod-mode)) - (print "+ " absdest) + (print "add " absdest) absdest) (defn bundle/update-all diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index 4522131f..a92a318d 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -27,26 +27,27 @@ (defn- bundle-rpath [path] (string/replace-all "\\" "/" (os/realpath path))) -(def- sep (if (= :windows (os/which)) "\\" "/")) + (defn- rmrf "rm -rf in janet" [x] - (case (os/stat x :mode) - :file (os/rm x) + (case (os/lstat x :mode) + nil nil :directory (do - (each y (os/dir x) (rmrf (string x sep y))) - (os/rmdir x))) + (each y (os/dir x) + (rmrf (string x "/" y))) + (os/rmdir x)) + (os/rm x)) nil) + # Setup a temporary syspath for manipultation (math/seedrandom (os/cryptorand 16)) -(def syspath (string "." sep (string (math/random)) "_jpm_tree.tmp")) +(def syspath (string (math/random) "_jpm_tree.tmp")) (rmrf syspath) (assert (os/mkdir syspath)) (put root-env *syspath* (bundle-rpath syspath)) #(setdyn *out* @"") -(pp (bundle/list)) -(pp (bundle/topolist)) (assert (empty? (bundle/list)) "initial bundle/list") (assert (empty? (bundle/topolist)) "initial bundle/topolist") @@ -61,7 +62,6 @@ (assert-no-error "sample-dep2 reinstall" (bundle/reinstall "sample-dep2")) (assert-no-error "sample-dep1 reinstall" (bundle/reinstall "sample-dep1" :auto-remove true)) -(eprintf "%.99M" (bundle/list)) (assert (= 2 (length (bundle/list))) "bundles are listed correctly 1") (assert (= 2 (length (bundle/topolist))) "bundles are listed correctly 2") From 074ae4fc0dc45486130b0fe54674f3670284df7d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 09:31:26 -0500 Subject: [PATCH 37/63] When directory isn't empty, print what is in it. --- src/boot/boot.janet | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 0cbb554e..c7c0665e 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4038,7 +4038,10 @@ (def s (sep)) (each y (os/dir x) (rmrf (string x s y))) - (os/rmdir x)) + (try + (os/rmdir x) + ([e f] (debug/stacktrace f e) + (each y (os/dir x) (eprint " - " y))))) (os/rm x)) nil) From 6968275ddf809e43f8a53fda7cbf8bd632f3e109 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 09:39:17 -0500 Subject: [PATCH 38/63] Update rmrf again to be more strict and failure early --- src/boot/boot.janet | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index c7c0665e..826f0101 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4040,8 +4040,9 @@ (rmrf (string x s y))) (try (os/rmdir x) - ([e f] (debug/stacktrace f e) - (each y (os/dir x) (eprint " - " y))))) + ([e f] + (each y (os/dir x) (eprint " - " y)) + (propagate e f)))) (os/rm x)) nil) From aee077c1bd26e7c9398c787e77a3e0843b4e7e6c Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 09:53:04 -0500 Subject: [PATCH 39/63] Is qemu-arm buggy? --- src/boot/boot.janet | 1 + 1 file changed, 1 insertion(+) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 826f0101..e7e9d489 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4041,6 +4041,7 @@ (try (os/rmdir x) ([e f] + (eprint "printing files in " x "...") (each y (os/dir x) (eprint " - " y)) (propagate e f)))) (os/rm x)) From f7c90bc1ffe8768cd852aebe69cffec8408bb26a Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 10:21:52 -0500 Subject: [PATCH 40/63] Add testing for making and removing directory. --- src/core/os.c | 13 +++++++++++-- test/suite-bundle.janet | 3 +++ 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index 9e0fb5dc..3155589e 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -2411,8 +2411,17 @@ JANET_CORE_FN(os_dir, /* Read directory items with opendir / readdir / closedir */ struct dirent *dp; DIR *dfd = opendir(dir); - if (dfd == NULL) janet_panicf("cannot open directory %s", dir); - while ((dp = readdir(dfd)) != NULL) { + if (dfd == NULL) janet_panicf("cannot open directory %s: %s", dir, janet_strerror(errno)); + for (;;) { + errno = 0; + dp = readdir(dfd); + if (dp == NULL) { + if (errno) { + closedir(dfd); + janet_panicf("failed to read directory %s: %s", dir, janet_strerror(errno)); + } + break; + } if (!strcmp(dp->d_name, ".") || !strcmp(dp->d_name, "..")) { continue; } diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index a92a318d..645616c3 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -40,6 +40,9 @@ (os/rm x)) nil) +# Test mkdir -> rmdir +(assert (os/mkdir "./tempdir123")) +(rmrf "./tempdir123") # Setup a temporary syspath for manipultation (math/seedrandom (os/cryptorand 16)) From 7efb39d60820a66f2092f671e04f4ba3a18b9e20 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 10:28:19 -0500 Subject: [PATCH 41/63] Check bundle listing before reinstall. --- src/boot/boot.janet | 6 ++++-- test/suite-bundle.janet | 3 +++ 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index e7e9d489..aebf8b13 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4323,7 +4323,8 @@ (def absdest (string (dyn *syspath*) s dest)) (unless (os/mkdir absdest) (errorf "collision at %s, directory already exists" absdest)) - (array/push files (os/realpath absdest)) + (def absdest (os/realpath absdest)) + (array/push files absdest) (when chmod-mode (os/chmod absdest chmod-mode)) (print "add " absdest) @@ -4339,7 +4340,8 @@ (when (os/stat absdest :mode) (errorf "collision at %s, file already exists" absdest)) (copyfile src absdest) - (array/push files (os/realpath absdest)) + (def absdest (os/realpath absdest)) + (array/push files absdest) (when chmod-mode (os/chmod absdest chmod-mode)) (print "add " absdest) diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index 645616c3..ef618e80 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -62,6 +62,9 @@ (assert-no-error "sample-dep2" (bundle/install "./examples/sample-dep2")) (assert-no-error "sample-dep1" (bundle/install "./examples/sample-dep1")) + +(assert (= 2 (length (bundle/list))) "bundles are listed correctly 0") + (assert-no-error "sample-dep2 reinstall" (bundle/reinstall "sample-dep2")) (assert-no-error "sample-dep1 reinstall" (bundle/reinstall "sample-dep1" :auto-remove true)) From b8aec50763add056e7f70545398a514468477790 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 10:35:53 -0500 Subject: [PATCH 42/63] Something is up with code. --- src/boot/boot.janet | 4 +++- test/suite-bundle.janet | 5 +++-- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index aebf8b13..8cb9b846 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4122,7 +4122,9 @@ (def d (bundle-dir)) (if (os/stat d :mode) (sort (os/dir d)) - @[])) + (do + (eprint "bundle dir does not exists: " d) + @[]))) (defn- bundle-uninstall-unchecked [bundle-name] diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index ef618e80..a43a7778 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -57,13 +57,14 @@ # Try (and fail) to install sample-bundle (missing deps) (assert-error "missing dependencies sample-dep1, sample-dep2" (bundle/install "./examples/sample-bundle" "sample-bundle")) +(assert (empty? (bundle/list))) # Install deps (dep1 as :auto-remove) (assert-no-error "sample-dep2" (bundle/install "./examples/sample-dep2")) +(assert (= 1 (length (bundle/list)))) (assert-no-error "sample-dep1" (bundle/install "./examples/sample-dep1")) - -(assert (= 2 (length (bundle/list))) "bundles are listed correctly 0") +(assert (= 2 (length (bundle/list)))) (assert-no-error "sample-dep2 reinstall" (bundle/reinstall "sample-dep2")) (assert-no-error "sample-dep1 reinstall" (bundle/reinstall "sample-dep1" :auto-remove true)) From 6998865d7b028c1908c908a799b16eccbac57849 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 10:41:12 -0500 Subject: [PATCH 43/63] Mingw is a sepate os/which target than windows. --- src/boot/boot.janet | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 8cb9b846..a5f8b35c 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4000,7 +4000,8 @@ (compwhen (dyn 'os/stat) - (defn- sep [] (if (= :windows (os/which)) "\\" "/")) + (def- seps {:windows "\\" :mingw "\\" :cygwin "\\"}) + (defn- sep [] (get seps (os/which) "/")) (defn- bundle-rpath [path] From 1225cd31c8a2dd0dbe49b6d81e1248aa133478c3 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 10:54:00 -0500 Subject: [PATCH 44/63] Assert that prime-bunlde-paths is working. --- src/boot/boot.janet | 9 ++++++--- src/core/os.c | 3 ++- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index a5f8b35c..9e95c678 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4023,7 +4023,10 @@ (defn- prime-bundle-paths [] - (os/mkdir (bundle-dir))) + (def s (sep)) + (def path (string (dyn *syspath*) s "bundle")) + (os/mkdir path) + (assert (os/stat path :mode))) (defn- get-files [manifest] (def files (get manifest :files @[])) @@ -4223,6 +4226,8 @@ (assert (next bundle-name) "cannot use empty bundle-name") (assert (not (fexists (get-manifest-filename bundle-name))) "bundle is already installed") + # Setup installed paths + (prime-bundle-paths) # Check meta file for dependencies (def infofile-pre (string path s "bundle" s "info.jdn")) (when (os/stat infofile-pre :mode) @@ -4230,8 +4235,6 @@ (def deps (get info :deps @[])) (def missing (seq [d :in deps :when (not (bundle/installed? d))] (string d))) (when (next missing) (errorf "missing dependencies %s" (string/join missing ", ")))) - # Setup installed paths - (prime-bundle-paths) (os/mkdir (bundle-dir bundle-name)) # Copy some files into the new location unconditionally (def implicit-sources (string path s "bundle")) diff --git a/src/core/os.c b/src/core/os.c index 3155589e..2cd079d8 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -2417,8 +2417,9 @@ JANET_CORE_FN(os_dir, dp = readdir(dfd); if (dp == NULL) { if (errno) { + int olderr = errno; closedir(dfd); - janet_panicf("failed to read directory %s: %s", dir, janet_strerror(errno)); + janet_panicf("failed to read directory %s: %s", dir, janet_strerror(olderr)); } break; } From 87db463f4e812555a6530be3b86d04b5b347949f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 11:07:23 -0500 Subject: [PATCH 45/63] Shouldn't make a difference... --- src/boot/boot.janet | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 9e95c678..ed107baf 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4010,7 +4010,7 @@ (defn- bundle-dir [&opt bundle-name] (def s (sep)) - (string (bundle-rpath (dyn *syspath*)) s "bundle" s bundle-name)) + (string (bundle-rpath (dyn *syspath*)) s "bundle" (if bundle-name s) bundle-name)) (defn- bundle-file [bundle-name filename] @@ -4024,7 +4024,7 @@ (defn- prime-bundle-paths [] (def s (sep)) - (def path (string (dyn *syspath*) s "bundle")) + (def path (bundle-dir)) (os/mkdir path) (assert (os/stat path :mode))) @@ -4042,12 +4042,7 @@ (def s (sep)) (each y (os/dir x) (rmrf (string x s y))) - (try - (os/rmdir x) - ([e f] - (eprint "printing files in " x "...") - (each y (os/dir x) (eprint " - " y)) - (propagate e f)))) + (os/rmdir x)) (os/rm x)) nil) From fd5315793c146aef54f1b707fa0475f914724d67 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 11:16:31 -0500 Subject: [PATCH 46/63] Test feature flag --- src/core/features.h | 2 ++ test/suite-bundle.janet | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/core/features.h b/src/core/features.h index b3e1f752..c9bc72be 100644 --- a/src/core/features.h +++ b/src/core/features.h @@ -76,4 +76,6 @@ #define __BSD_VISIBLE 1 #endif +#define _FILE_OFFSET_BITS 64 + #endif diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index a43a7778..091b5678 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -41,8 +41,8 @@ nil) # Test mkdir -> rmdir -(assert (os/mkdir "./tempdir123")) -(rmrf "./tempdir123") +(assert (os/mkdir "tempdir123")) +(rmrf "tempdir123") # Setup a temporary syspath for manipultation (math/seedrandom (os/cryptorand 16)) From fe348187cc8d42ff0a54a609dacbabff777b1911 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 11:22:09 -0500 Subject: [PATCH 47/63] Be explicit about 64 bit offset on windows. --- CHANGELOG.md | 3 +++ src/core/io.c | 11 ++++++++--- test/suite-bundle.janet | 3 ++- 3 files changed, 13 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ad692895..10987dda 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,9 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add extra optional `env` argument to `eval` and `eval-string`. +- Allow naming function literals with a keyword. This allows better stacktraces for macros without + accidentally adding new bindings. - Add `bundle/` module for managing packages within Janet. This should replace the jpm packaging format eventually and is much simpler and amenable to more complicated builds. - Add macros `ev/with-lock`, `ev/with-rlock`, and `ev/with-wlock` for using mutexes and rwlocks. diff --git a/src/core/io.c b/src/core/io.c index 49dba260..75e2ec5e 100644 --- a/src/core/io.c +++ b/src/core/io.c @@ -41,6 +41,11 @@ static void io_file_marshal(void *p, JanetMarshalContext *ctx); static void *io_file_unmarshal(JanetMarshalContext *ctx); static Janet io_file_next(void *p, Janet key); +#ifdef JANET_WINDOWS +#define ftell _ftelli64 +#define fseek _fseeki64 +#endif + const JanetAbstractType janet_file_type = { "core/file", cfun_io_gc, @@ -337,7 +342,7 @@ JANET_CORE_FN(cfun_io_fseek, JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type); if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed"); - long int offset = 0; + int64_t offset = 0; int whence = SEEK_CUR; if (argc >= 2) { const uint8_t *whence_sym = janet_getkeyword(argv, 1); @@ -351,7 +356,7 @@ JANET_CORE_FN(cfun_io_fseek, janet_panicf("expected one of :cur, :set, :end, got %v", argv[1]); } if (argc == 3) { - offset = (long) janet_getinteger64(argv, 2); + offset = (int64_t) janet_getinteger64(argv, 2); } } if (fseek(iof->file, offset, whence)) janet_panic("error seeking file"); @@ -365,7 +370,7 @@ JANET_CORE_FN(cfun_io_ftell, JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type); if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed"); - long pos = ftell(iof->file); + int64_t pos = ftell(iof->file); if (pos == -1) janet_panic("error getting position in file"); return janet_wrap_number((double)pos); } diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index 091b5678..7f548625 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -50,7 +50,8 @@ (rmrf syspath) (assert (os/mkdir syspath)) (put root-env *syspath* (bundle-rpath syspath)) -#(setdyn *out* @"") +(unless (os/getenv "VERBOSE") + (setdyn *out* @"")) (assert (empty? (bundle/list)) "initial bundle/list") (assert (empty? (bundle/topolist)) "initial bundle/topolist") From 74560ff805180894d4f6c31e3bb7297efa8e20f6 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 11:30:59 -0500 Subject: [PATCH 48/63] Turn off cluttered traces. --- src/core/debug.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/debug.c b/src/core/debug.c index e9d96abd..1bfb9e67 100644 --- a/src/core/debug.c +++ b/src/core/debug.c @@ -180,9 +180,11 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) { } } janet_eprintf("\n"); - if (i <= 0 && fi > 0) { /* no next frame, first stack frame in fiber. First fiber is trivial. */ + /* Print fiber points optionally. Clutters traces but provides info + if (i <= 0 && fi > 0) { janet_eprintf(" in parent fiber\n"); } + */ } } From 16ac681ed93e1f328b0b959b0866a58eb14889ef Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 11:39:08 -0500 Subject: [PATCH 49/63] Remove redundant stuff from stacktrace. Rather than try and make ascii art, focus on whether information is present in the stack trace that peoplpe actually need, and be terse. Tools can better handler simpler and more stable interfaces. --- src/boot/boot.janet | 30 ------------------------------ 1 file changed, 30 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index ed107baf..ff48afdb 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2405,33 +2405,6 @@ (defdyn *err-color* "Whether or not to turn on error coloring in stacktraces and other error messages.") -(defdyn *err-line-col* - "Whether or not to print the line of source code that caused an error.") - -(defn- print-line-col - ``Print the source code at a line, column in a source file. If unable to open - the file, prints nothing.`` - [where line col] - (if-not line (break)) - (unless (string? where) (break)) - (unless (dyn *err-line-col*) (break)) - (def ec (dyn *err-color*)) - (when-with [f (file/open where :r)] - (def source-code (file/read f :all)) - (var index 0) - (repeat (dec line) - (if-not index (break)) - (set index (string/find "\n" source-code index)) - (if index (++ index))) - (when index - (def line-end (string/find "\n" source-code index)) - (def s (if ec "\e[31m")) - (def e (if ec "\e[0m")) - (eprint s " " (string/slice source-code index line-end) e) - (when col - (+= index col) - (eprint s (string/repeat " " (inc col)) "^" e))))) - (defn bad-parse "Default handler for a parse error." [p where] @@ -2447,7 +2420,6 @@ ": parse error: " (:error p) (if ec "\e[0m")) - (print-line-col where line col) (eflush)) (defn warn-compile @@ -2463,7 +2435,6 @@ col ": compile warning (" level "): ") (eprint msg (if ec "\e[0m")) - (print-line-col where line col) (eflush)) (defn bad-compile @@ -2481,7 +2452,6 @@ (if macrof (debug/stacktrace macrof msg "") (eprint msg (if ec "\e[0m"))) - (print-line-col where line col) (eflush)) (defn curenv From 7529abb542de5a6e3886c6daeec891301e22b9b0 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 11:53:53 -0500 Subject: [PATCH 50/63] Move functions in boot.janet around. --- src/boot/boot.janet | 63 +++++++++++++++++++++++---------------------- 1 file changed, 32 insertions(+), 31 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index ff48afdb..65de763f 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2926,32 +2926,6 @@ (set debugger-on-status-var debugger-on-status) -(defn- env-walk - [pred &opt env local] - (default env (fiber/getenv (fiber/current))) - (def envs @[]) - (do (var e env) (while e (array/push envs e) (set e (table/getproto e)) (if local (break)))) - (def ret-set @{}) - (loop [envi :in envs - k :keys envi - :when (pred k)] - (put ret-set k true)) - (sort (keys ret-set))) - -(defn all-bindings - ``Get all symbols available in an environment. Defaults to the current - fiber's environment. If `local` is truthy, will not show inherited bindings - (from prototype tables).`` - [&opt env local] - (env-walk symbol? env local)) - -(defn all-dynamics - ``Get all dynamic bindings in an environment. Defaults to the current - fiber's environment. If `local` is truthy, will not show inherited bindings - (from prototype tables).`` - [&opt env local] - (env-walk keyword? env local)) - (defn dofile ``Evaluate a file, file path, or stream and return the resulting environment. :env, :expander, :source, :evaluator, :read, and :parser are passed through to the underlying @@ -3115,6 +3089,33 @@ ### ### +(defn- env-walk + [pred &opt env local] + (default env (fiber/getenv (fiber/current))) + (def envs @[]) + (do (var e env) (while e (array/push envs e) (set e (table/getproto e)) (if local (break)))) + (def ret-set @{}) + (loop [envi :in envs + k :keys envi + :when (pred k)] + (put ret-set k true)) + (sort (keys ret-set))) + +(defn all-bindings + ``Get all symbols available in an environment. Defaults to the current + fiber's environment. If `local` is truthy, will not show inherited bindings + (from prototype tables).`` + [&opt env local] + (env-walk symbol? env local)) + +(defn all-dynamics + ``Get all dynamic bindings in an environment. Defaults to the current + fiber's environment. If `local` is truthy, will not show inherited bindings + (from prototype tables).`` + [&opt env local] + (env-walk keyword? env local)) + + (defdyn *doc-width* "Width in columns to print documentation printed with `doc-format`.") @@ -3880,12 +3881,12 @@ ~(defn ,alias ,;meta [,;formal-args] (,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args)) ~(defn ,alias ,;meta [,;formal-args] - (,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))) + (,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args)))) -(defmacro ffi/defbind - "Generate bindings for native functions in a convenient manner." - [name ret-type & body] - ~(ffi/defbind-alias ,name ,name ,ret-type ,;body)) + (defmacro ffi/defbind + "Generate bindings for native functions in a convenient manner." + [name ret-type & body] + ~(ffi/defbind-alias ,name ,name ,ret-type ,;body))) ### ### From cb54fb02c17d0822850f4c14ea196332d5fc1b0a Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 12:01:27 -0500 Subject: [PATCH 51/63] Whitespace. --- test/suite-bundle.janet | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index 7f548625..d9ae0566 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -61,7 +61,7 @@ (assert (empty? (bundle/list))) # Install deps (dep1 as :auto-remove) -(assert-no-error "sample-dep2" +(assert-no-error "sample-dep2" (bundle/install "./examples/sample-dep2")) (assert (= 1 (length (bundle/list)))) (assert-no-error "sample-dep1" (bundle/install "./examples/sample-dep1")) From 600e8229330acdf53d70ab600028a376972be92d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 26 May 2024 16:26:08 -0500 Subject: [PATCH 52/63] Change interface for bundle/install Name argument should be inferred in most cases. Also use :name instead of :bundle-name in most places to be terser and simpler. --- examples/sample-bundle/bundle/info.jdn | 1 + examples/sample-dep1/bundle/info.jdn | 1 + examples/sample-dep2/bundle/info.jdn | 4 ++- src/boot/boot.janet | 38 +++++++++++++------------- test/suite-bundle.janet | 2 +- 5 files changed, 25 insertions(+), 21 deletions(-) diff --git a/examples/sample-bundle/bundle/info.jdn b/examples/sample-bundle/bundle/info.jdn index 1ea8cbec..02f43b32 100644 --- a/examples/sample-bundle/bundle/info.jdn +++ b/examples/sample-bundle/bundle/info.jdn @@ -1,3 +1,4 @@ @{ + :name "sample-bundle" :dependencies ["sample-dep1" "sample-dep2"] } diff --git a/examples/sample-dep1/bundle/info.jdn b/examples/sample-dep1/bundle/info.jdn index 4db882df..0f61a3c1 100644 --- a/examples/sample-dep1/bundle/info.jdn +++ b/examples/sample-dep1/bundle/info.jdn @@ -1,3 +1,4 @@ @{ + :name "sample-dep1" :dependencies ["sample-dep2"] } diff --git a/examples/sample-dep2/bundle/info.jdn b/examples/sample-dep2/bundle/info.jdn index 7270cf99..5ee1b6ff 100644 --- a/examples/sample-dep2/bundle/info.jdn +++ b/examples/sample-dep2/bundle/info.jdn @@ -1 +1,3 @@ -@{} +@{ + :name "sample-dep2" +} diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 9357692f..39ca5741 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4041,7 +4041,7 @@ (defn- sync-manifest [manifest] - (def bn (get manifest :bundle-name)) + (def bn (get manifest :name)) (def manifest-name (get-manifest-filename bn)) (spit manifest-name (string/format "%j\n" manifest))) @@ -4067,7 +4067,7 @@ (put new-env *module-loading* @{}) (put new-env *module-make-env* (fn make-bundle-env [&] (make-env new-env))) (put new-env :workdir workdir) - (put new-env :bundle-name bundle-name) + (put new-env :name bundle-name) (put new-env *syspath* fixed-syspath) (with-env new-env (put new-env :bundle-dir (bundle-dir bundle-name)) # get the syspath right @@ -4076,9 +4076,7 @@ (defn- do-hook [module bundle-name hook & args] (def hookf (module/value module (symbol hook))) - (unless hookf - (print "no hook " hook " found for bundle " bundle-name) - (break)) + (unless hookf (break)) (def manifest (bundle/manifest bundle-name)) (def dir (os/cwd)) (os/cd (get module :workdir ".")) @@ -4176,15 +4174,24 @@ (defn bundle/install "Install a bundle from the local filesystem with a name `bundle-name`." - [&opt path bundle-name &keys config] - (default path ".") + [path &keys config] (def path (bundle-rpath path)) (def clean (get config :clean)) (def check (get config :check)) (def s (sep)) - (default bundle-name (last (string/split "/" (string/replace-all "\\" "/" path)))) + # Check meta file for dependencies and default name + (def infofile-pre (string path s "bundle" s "info.jdn")) + (var default-bundle-name nil) + (when (os/stat infofile-pre :mode) + (def info (-> infofile-pre slurp parse)) + (def deps (get info :dependencies @[])) + (set default-bundle-name (get info :name)) + (def missing (seq [d :in deps :when (not (bundle/installed? d))] (string d))) + (when (next missing) (errorf "missing dependencies %s" (string/join missing ", ")))) + (def bundle-name (get config :name default-bundle-name)) + (assert bundle-name (errorf "unable to infer bundle name for %v, use :name argument" path)) (assert (not (string/check-set "\\/" bundle-name)) - (string "bundle-name " + (string "bundle name " bundle-name " cannot contain path separators")) (assert (next bundle-name) "cannot use empty bundle-name") @@ -4192,19 +4199,12 @@ "bundle is already installed") # Setup installed paths (prime-bundle-paths) - # Check meta file for dependencies - (def infofile-pre (string path s "bundle" s "info.jdn")) - (when (os/stat infofile-pre :mode) - (def info (-> infofile-pre slurp parse)) - (def deps (get info :deps @[])) - (def missing (seq [d :in deps :when (not (bundle/installed? d))] (string d))) - (when (next missing) (errorf "missing dependencies %s" (string/join missing ", ")))) (os/mkdir (bundle-dir bundle-name)) # Copy some files into the new location unconditionally (def implicit-sources (string path s "bundle")) (when (= :directory (os/stat implicit-sources :mode)) (copyrf implicit-sources (bundle-dir bundle-name))) - (def man @{:bundle-name bundle-name :local-source path :files @[]}) + (def man @{:name bundle-name :local-source path :files @[]}) (merge-into man config) (def infofile (bundle-file bundle-name "info.jdn")) (put man :auto-remove (get config :auto-remove)) @@ -4277,11 +4277,11 @@ (rmrf backup-dir) (def backup-bundle-source (bundle/pack bundle-name backup-dir true)) (edefer (do - (bundle/install backup-bundle-source bundle-name) + (bundle/install backup-bundle-source :name bundle-name) (copyrf (string backup-bundle-source s "old-bundle") (bundle-dir bundle-name)) (rmrf backup-bundle-source)) (bundle-uninstall-unchecked bundle-name) - (bundle/install path bundle-name ;(kvs config) ;(kvs new-config))) + (bundle/install path :name bundle-name ;(kvs config) ;(kvs new-config))) (rmrf backup-bundle-source) bundle-name) diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index d9ae0566..f7452bd2 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -57,7 +57,7 @@ # Try (and fail) to install sample-bundle (missing deps) (assert-error "missing dependencies sample-dep1, sample-dep2" - (bundle/install "./examples/sample-bundle" "sample-bundle")) + (bundle/install "./examples/sample-bundle")) (assert (empty? (bundle/list))) # Install deps (dep1 as :auto-remove) From 8fca6b7af48112cce4b9c4124fc7ccb3ecd6dc03 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 29 May 2024 07:20:37 -0500 Subject: [PATCH 53/63] Don't expose bundle/pack, do expose bundle/add Bundle/pack is a strange interface that is mostly just to implement a safe reinistall process when the original source is lost. --- src/boot/boot.janet | 30 +++++++++++++++++++++++------- 1 file changed, 23 insertions(+), 7 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 39ca5741..9771b592 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4124,20 +4124,22 @@ (bundle-uninstall-unchecked bundle-name)) (defn bundle/topolist - "Get topological order of all bundles, such that each bundle is listed after its dependencies. - DFS (tarjan)" + "Get topological order of all bundles, such that each bundle is listed after its dependencies." [] (def visited @{}) (def cycle-detect @{}) (def order @[]) + (def stack @[]) (defn visit [b] + (array/push stack b) (if (get visited b) (break)) - (if (get cycle-detect b) (errorf "cycle detected in bundle dependencies: %s" b)) + (if (get cycle-detect b) (errorf "cycle detected in bundle dependencies: %s" (string/join stack " -> "))) (put cycle-detect b true) (each d (get (bundle/manifest b) :dependencies []) (visit d)) (put cycle-detect b nil) (put visited b true) + (array/pop stack) (array/push order b)) (each b (bundle/list) (visit b)) order) @@ -4233,7 +4235,7 @@ (print "installed " bundle-name) bundle-name) - (defn bundle/pack + (defn- bundle/pack "Take an installed bundle and create a bundle source directory that can be used to reinstall the bundle on a compatible system. This is used to create backups for installed bundles without rebuilding, or make a prebuilt bundle for other systems." @@ -4259,9 +4261,9 @@ (copyfile file (string dest-dir s filename)) (array/push install-source ~(bundle/add-file manifest ,filename ,relpath ,perm))) (errorf "unexpected file %v" file))) - (def b @"(defn install [manifest]\n") - (each form install-source (buffer/format b " %j\n" form)) - (buffer/push b ")") + (def b @"(defn install [manifest]") + (each form install-source (buffer/format b "\n %j" form)) + (buffer/push b ")\n") (spit install-hook b)) dest-dir) @@ -4317,6 +4319,20 @@ (print "add " absdest) absdest) + (defn bundle/add + "Add files and directories during a bundle install relative to `(dyn *syspath*)`. + Added paths will be recorded in the bundle manifest such that they are properly tracked + and removed during an upgrade or uninstall." + [manifest src &opt dest chmod-mode] + (default dest src) + (def s (sep)) + (case (os/stat src :mode) + :directory + (let [absdest (bundle/add-directory manifest dest chmod-mode)] + (each d (os/dir src) (bundle/add manifest (string src s d) (string dest s d) chmod-mode)) + absdest) + :file (bundle/add-file manifest src dest chmod-mode))) + (defn bundle/update-all "Reinstall all bundles" [] From f4fd481415a334ad59e40c5c83df3aa2419ec961 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 29 May 2024 19:37:14 -0500 Subject: [PATCH 54/63] copyfile should copy permission bits --- src/boot/boot.janet | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 9771b592..693dd2a3 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4019,12 +4019,13 @@ (defn- copyfile [from to] + (def mode (os/stat from :permissions)) (def b (buffer/new 0x10000)) (with [ffrom (file/open from :rb)] (with [fto (file/open to :wb)] (forever (file/read ffrom 0x10000 b) - (when (empty? b) (buffer/trim b) (break)) + (when (empty? b) (buffer/trim b) (os/chmod to mode) (break)) (file/write fto b) (buffer/clear b))))) From e37575e763d0f365feea45c8218ffe52b92df480 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 31 May 2024 19:17:51 -0500 Subject: [PATCH 55/63] Allow passing configs to bundle reinstall. --- src/boot/boot.janet | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 693dd2a3..dd793013 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4336,9 +4336,9 @@ (defn bundle/update-all "Reinstall all bundles" - [] - (each bundle (bundle/list) - (bundle/reinstall bundle)))) + [&keys configs] + (each bundle (bundle/topolist) + (bundle/reinstall bundle ;(kvs configs))))) ### ### @@ -4700,9 +4700,8 @@ (each s core-sources (do-one-file s)) - # Create C source file that contains images a uint8_t buffer. This - # can be compiled and linked statically into the main janet library - # and example client. + # Create C source file that contains the boot image in a uint8_t buffer. This + # can be compiled and linked statically into the main janet library and client (print "static const unsigned char janet_core_image_bytes[] = {") (loop [line :in (partition 16 image)] (prin " ") From 58441dc49f3816f3419e1204aeb89f3ec9fdb601 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 12 Jun 2024 19:22:08 -0500 Subject: [PATCH 56/63] Update gitignore. --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index ae5e64de..1e5ec418 100644 --- a/.gitignore +++ b/.gitignore @@ -49,6 +49,7 @@ janet.wasm *.gen.h *.gen.c *.tmp +temp.* # Generate test files *.out From 92ff1d3be43f725121764ecc67d1fd992e15d7ce Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 14 Jun 2024 16:58:57 -0500 Subject: [PATCH 57/63] Add `only` option to `merge-module` and `import`. This allows importing only selected bindings. For example, (import foo :only [bar baz]) (foo/bar) # works (foo/buzz) # doesn't work, even if the foo module has a buzz function. --- CHANGELOG.md | 1 + src/boot/boot.janet | 12 +++++++----- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 10987dda..6a7597ff 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add `:only` argument to `import` to allow for easier control over imported bindings. - Add extra optional `env` argument to `eval` and `eval-string`. - Allow naming function literals with a keyword. This allows better stacktraces for macros without accidentally adding new bindings. diff --git a/src/boot/boot.janet b/src/boot/boot.janet index dd793013..9878e669 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3040,9 +3040,10 @@ ``Merge a module source into the `target` environment with a `prefix`, as with the `import` macro. This lets users emulate the behavior of `import` with a custom module table. If `export` is truthy, then merged functions are not marked as private. Returns - the modified target environment.`` - [target source &opt prefix export] - (loop [[k v] :pairs source :when (symbol? k) :when (not (v :private))] + the modified target environment. If an array `only` is passed, only merge keys in `only`.`` + [target source &opt prefix export only] + (def only-set (if only (invert only))) + (loop [[k v] :pairs source :when (symbol? k) :when (not (v :private)) :when (or (not only) (in only-set k))] (def newv (table/setproto @{:private (not export)} v)) (put target (symbol prefix k) newv)) target) @@ -3055,13 +3056,14 @@ (def kargs (table ;args)) (def {:as as :prefix prefix - :export ep} kargs) + :export ep + :only only} kargs) (def newenv (require-1 path args kargs)) (def prefix (or (and as (string as "/")) prefix (string (last (string/split "/" path)) "/"))) - (merge-module env newenv prefix ep)) + (merge-module env newenv prefix ep only)) (defmacro import ``Import a module. First requires the module, and then merges its From 16a3c85baa350714742e83e6aea1d05766c8d1d9 Mon Sep 17 00:00:00 2001 From: Philip Nelson Date: Fri, 14 Jun 2024 18:15:31 -0700 Subject: [PATCH 58/63] Fix buffer push uint max --- src/core/buffer.c | 6 +++--- src/core/capi.c | 4 ++-- src/include/janet.h | 1 + test/suite-buffer.janet | 12 ++++++------ 4 files changed, 12 insertions(+), 11 deletions(-) diff --git a/src/core/buffer.c b/src/core/buffer.c index a34f29fb..08d3da0a 100644 --- a/src/core/buffer.c +++ b/src/core/buffer.c @@ -375,7 +375,7 @@ JANET_CORE_FN(cfun_buffer_push_uint16, uint16_t data; uint8_t bytes[2]; } u; - u.data = (uint16_t) janet_getinteger(argv, 2); + u.data = (uint16_t) janet_getuinteger(argv, 2); if (reverse) { uint8_t temp = u.bytes[1]; u.bytes[1] = u.bytes[0]; @@ -396,7 +396,7 @@ JANET_CORE_FN(cfun_buffer_push_uint32, uint32_t data; uint8_t bytes[4]; } u; - u.data = (uint32_t) janet_getinteger(argv, 2); + u.data = janet_getuinteger(argv, 2); if (reverse) reverse_u32(u.bytes); janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes); @@ -414,7 +414,7 @@ JANET_CORE_FN(cfun_buffer_push_uint64, uint64_t data; uint8_t bytes[8]; } u; - u.data = (uint64_t) janet_getuinteger64(argv, 2); + u.data = janet_getuinteger64(argv, 2); if (reverse) reverse_u64(u.bytes); janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes); diff --git a/src/core/capi.c b/src/core/capi.c index 166f2c5e..b3f90b4f 100644 --- a/src/core/capi.c +++ b/src/core/capi.c @@ -303,9 +303,9 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) { uint32_t janet_getuinteger(const Janet *argv, int32_t n) { Janet x = argv[n]; if (!janet_checkuint(x)) { - janet_panicf("bad slot #%d, expected 32 bit signed integer, got %v", n, x); + janet_panicf("bad slot #%d, expected 32 bit unsigned integer, got %v", n, x); } - return janet_unwrap_integer(x); + return (uint32_t) janet_unwrap_number(x); } int64_t janet_getinteger64(const Janet *argv, int32_t n) { diff --git a/src/include/janet.h b/src/include/janet.h index 49430e55..d894c915 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -2021,6 +2021,7 @@ JANET_API void *janet_getpointer(const Janet *argv, int32_t n); JANET_API int32_t janet_getnat(const Janet *argv, int32_t n); JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n); JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n); +JANET_API uint32_t janet_getuinteger(const Janet *argv, int32_t n); JANET_API uint64_t janet_getuinteger64(const Janet *argv, int32_t n); JANET_API size_t janet_getsize(const Janet *argv, int32_t n); JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n); diff --git a/test/suite-buffer.janet b/test/suite-buffer.janet index b6ceecec..28fb83d5 100644 --- a/test/suite-buffer.janet +++ b/test/suite-buffer.janet @@ -85,9 +85,9 @@ (buffer/push-uint16 buffer-uint16-le :le 0x0102) (assert (= "\x02\x01" (string buffer-uint16-le)) "buffer/push-uint16 little endian") -(def buffer-uint16-negative @"") -(buffer/push-uint16 buffer-uint16-negative :be -1) -(assert (= "\xff\xff" (string buffer-uint16-negative)) "buffer/push-uint16 negative") +(def buffer-uint16-max @"") +(buffer/push-uint16 buffer-uint16-max :be 0xFFFF) +(assert (= "\xff\xff" (string buffer-uint16-max)) "buffer/push-uint16 max") (def buffer-uint32-be @"") (buffer/push-uint32 buffer-uint32-be :be 0x01020304) @@ -97,9 +97,9 @@ (buffer/push-uint32 buffer-uint32-le :le 0x01020304) (assert (= "\x04\x03\x02\x01" (string buffer-uint32-le)) "buffer/push-uint32 little endian") -(def buffer-uint32-negative @"") -(buffer/push-uint32 buffer-uint32-negative :be -1) -(assert (= "\xff\xff\xff\xff" (string buffer-uint32-negative)) "buffer/push-uint32 negative") +(def buffer-uint32-max @"") +(buffer/push-uint32 buffer-uint32-max :be 0xFFFFFFFF) +(assert (= "\xff\xff\xff\xff" (string buffer-uint32-max)) "buffer/push-uint32 max") (def buffer-float32-be @"") (buffer/push-float32 buffer-float32-be :be 1.234) From 75710ccabdc8a791cd5d6cdb528163824353469a Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 15 Jun 2024 06:47:47 -0500 Subject: [PATCH 59/63] Error on buffer/push-uint16 with non 16 bit unsigned integer. --- src/core/buffer.c | 2 +- src/core/capi.c | 17 +++++++++++++++++ src/core/util.c | 14 ++++++++++++++ src/include/janet.h | 6 ++++++ test/suite-buffer.janet | 2 ++ 5 files changed, 40 insertions(+), 1 deletion(-) diff --git a/src/core/buffer.c b/src/core/buffer.c index 08d3da0a..2983a0fc 100644 --- a/src/core/buffer.c +++ b/src/core/buffer.c @@ -375,7 +375,7 @@ JANET_CORE_FN(cfun_buffer_push_uint16, uint16_t data; uint8_t bytes[2]; } u; - u.data = (uint16_t) janet_getuinteger(argv, 2); + u.data = janet_getuinteger16(argv, 2); if (reverse) { uint8_t temp = u.bytes[1]; u.bytes[1] = u.bytes[0]; diff --git a/src/core/capi.c b/src/core/capi.c index b3f90b4f..9dd5d29d 100644 --- a/src/core/capi.c +++ b/src/core/capi.c @@ -308,6 +308,23 @@ uint32_t janet_getuinteger(const Janet *argv, int32_t n) { return (uint32_t) janet_unwrap_number(x); } +int16_t janet_getinteger16(const Janet *argv, int32_t n) { + Janet x = argv[n]; + if (!janet_checkint16(x)) { + janet_panicf("bad slot #%d, expected 16 bit signed integer, got %v", n, x); + } + return (int16_t) janet_unwrap_number(x); +} + +uint16_t janet_getuinteger16(const Janet *argv, int32_t n) { + Janet x = argv[n]; + if (!janet_checkuint16(x)) { + janet_panicf("bad slot #%d, expected 16 bit unsigned integer, got %v", n, x); + } + return (uint16_t) janet_unwrap_number(x); +} + + int64_t janet_getinteger64(const Janet *argv, int32_t n) { #ifdef JANET_INT_TYPES return janet_unwrap_s64(argv[n]); diff --git a/src/core/util.c b/src/core/util.c index 09cf36f2..4bb37abc 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -826,6 +826,20 @@ int janet_checkuint64(Janet x) { return janet_checkuint64range(dval); } +int janet_checkint16(Janet x) { + if (!janet_checktype(x, JANET_NUMBER)) + return 0; + double dval = janet_unwrap_number(x); + return janet_checkint16range(dval); +} + +int janet_checkuint16(Janet x) { + if (!janet_checktype(x, JANET_NUMBER)) + return 0; + double dval = janet_unwrap_number(x); + return janet_checkuint16range(dval); +} + int janet_checksize(Janet x) { if (!janet_checktype(x, JANET_NUMBER)) return 0; diff --git a/src/include/janet.h b/src/include/janet.h index d894c915..c321d03a 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -897,12 +897,16 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer); /* End of tagged union implementation */ #endif +JANET_API int janet_checkint16(Janet x); +JANET_API int janet_checkuint16(Janet x); JANET_API int janet_checkint(Janet x); JANET_API int janet_checkuint(Janet x); JANET_API int janet_checkint64(Janet x); JANET_API int janet_checkuint64(Janet x); JANET_API int janet_checksize(Janet x); JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at); +#define janet_checkint16range(x) ((x) >= INT16_MIN && (x) <= INT16_MAX && (x) == (int16_t)(x)) +#define janet_checkuint16range(x) ((x) >= 0 && (x) <= UINT16_MAX && (x) == (uint16_t)(x)) #define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x)) #define janet_checkuintrange(x) ((x) >= 0 && (x) <= UINT32_MAX && (x) == (uint32_t)(x)) #define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x)) @@ -2020,8 +2024,10 @@ JANET_API void *janet_getpointer(const Janet *argv, int32_t n); JANET_API int32_t janet_getnat(const Janet *argv, int32_t n); JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n); +JANET_API int16_t janet_getinteger16(const Janet *argv, int32_t n); JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n); JANET_API uint32_t janet_getuinteger(const Janet *argv, int32_t n); +JANET_API uint16_t janet_getuinteger16(const Janet *argv, int32_t n); JANET_API uint64_t janet_getuinteger64(const Janet *argv, int32_t n); JANET_API size_t janet_getsize(const Janet *argv, int32_t n); JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n); diff --git a/test/suite-buffer.janet b/test/suite-buffer.janet index 28fb83d5..e5de3f86 100644 --- a/test/suite-buffer.janet +++ b/test/suite-buffer.janet @@ -88,6 +88,8 @@ (def buffer-uint16-max @"") (buffer/push-uint16 buffer-uint16-max :be 0xFFFF) (assert (= "\xff\xff" (string buffer-uint16-max)) "buffer/push-uint16 max") +(assert-error "too large" (buffer/push-uint16 @"" 0x1FFFF)) +(assert-error "too small" (buffer/push-uint16 @"" -0x1)) (def buffer-uint32-be @"") (buffer/push-uint32 buffer-uint32-be :be 0x01020304) From 0d9e999113f8ac9e4240db4eb68c0e975cf6c0ee Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 15 Jun 2024 07:11:48 -0500 Subject: [PATCH 60/63] Prepare for 1.35.0 release. --- CHANGELOG.md | 2 +- Makefile | 4 ++-- meson.build | 2 +- src/conf/janetconf.h | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6a7597ff..72addf6d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,7 @@ # Changelog All notable changes to this project will be documented in this file. -## Unreleased - ??? +## 1.35.0 - 2024-06-15 - Add `:only` argument to `import` to allow for easier control over imported bindings. - Add extra optional `env` argument to `eval` and `eval-string`. - Allow naming function literals with a keyword. This allows better stacktraces for macros without diff --git a/Makefile b/Makefile index b143680b..e3af90c9 100644 --- a/Makefile +++ b/Makefile @@ -204,9 +204,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile ######################## ifeq ($(UNAME), Darwin) -SONAME=libjanet.1.34.dylib +SONAME=libjanet.1.35.dylib else -SONAME=libjanet.so.1.34 +SONAME=libjanet.so.1.35 endif build/c/shell.c: src/mainclient/shell.c diff --git a/meson.build b/meson.build index 73faf6e3..9e5dc86f 100644 --- a/meson.build +++ b/meson.build @@ -20,7 +20,7 @@ project('janet', 'c', default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'], - version : '1.34.0') + version : '1.35.0') # Global settings janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index a51bde90..ade662bc 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -7,7 +7,7 @@ #define JANET_VERSION_MINOR 34 #define JANET_VERSION_PATCH 0 #define JANET_VERSION_EXTRA "" -#define JANET_VERSION "1.34.0" +#define JANET_VERSION "1.35.0" /* #define JANET_BUILD "local" */ From 7cd106a10c27bde21f8ece863cb07f7cd8d1ff09 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 15 Jun 2024 07:11:48 -0500 Subject: [PATCH 61/63] Prepare for 1.35.0 release. --- src/conf/janetconf.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index ade662bc..94270b6f 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -4,7 +4,7 @@ #define JANETCONF_H #define JANET_VERSION_MAJOR 1 -#define JANET_VERSION_MINOR 34 +#define JANET_VERSION_MINOR 35 #define JANET_VERSION_PATCH 0 #define JANET_VERSION_EXTRA "" #define JANET_VERSION "1.35.0" From 2d6c2ee7c0356c02f143b367f522878a8d2de9a6 Mon Sep 17 00:00:00 2001 From: sogaiu <983021772@users.noreply.github.com> Date: Sun, 16 Jun 2024 08:48:30 +0900 Subject: [PATCH 62/63] Tweak some dyn var docstrings --- src/boot/boot.janet | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 9878e669..5ebc7428 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2746,8 +2746,8 @@ (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-paths* "Dynamic binding for overriding `module/paths`") +(defdyn *module-loading* "Dynamic binding for overriding `module/loading`") (defdyn *module-loaders* "Dynamic binding for overriding `module/loaders`") (defdyn *module-make-env* "Dynamic binding for creating new environments for `import`, `require`, and `dofile`. Overrides `make-env`.") From f95de25b15e62cd54ad2bb676281a1321a823411 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 16 Jun 2024 07:58:38 -0500 Subject: [PATCH 63/63] Update docstrings. --- src/boot/boot.janet | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 5ebc7428..222901f4 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2654,7 +2654,7 @@ (defn eval ``Evaluates a form in the current environment. If more control over the - environment is needed, use `run-context`.`` + environment is needed, use `run-context`. Optionally pass in an `env` table with available bindings.`` [form &opt env] (def res (compile form env :eval)) (if (= (type res) :function) @@ -2694,7 +2694,7 @@ (defn eval-string ``Evaluates a string in the current environment. If more control over the - environment is needed, use `run-context`.`` + environment is needed, use `run-context`. Optionally pass in an `env` table with available bindings.`` [str &opt env] (var ret nil) (each x (parse-all str) (set ret (eval x env))) @@ -3040,7 +3040,7 @@ ``Merge a module source into the `target` environment with a `prefix`, as with the `import` macro. This lets users emulate the behavior of `import` with a custom module table. If `export` is truthy, then merged functions are not marked as private. Returns - the modified target environment. If an array `only` is passed, only merge keys in `only`.`` + the modified target environment. If a tuple or array `only` is passed, only merge keys in `only`.`` [target source &opt prefix export only] (def only-set (if only (invert only))) (loop [[k v] :pairs source :when (symbol? k) :when (not (v :private)) :when (or (not only) (in only-set k))] @@ -3073,7 +3073,8 @@ to re-export the imported symbols. If "`:exit true`" is given as an argument, any errors encountered at the top level in the module will cause `(os/exit 1)` to be called. Dynamic bindings will NOT be imported. Use :fresh to bypass the - module cache.`` + module cache. Use `:only [foo bar baz]` to only import select bindings into the + current environment.`` [path & args] (def ps (partition 2 args)) (def argm (mapcat (fn [[k v]] [k (if (= k :as) (string v) v)]) ps)) @@ -3744,7 +3745,7 @@ (acquire-release ev/acquire-rlock ev/release-rlock lock body)) (defmacro ev/with-wlock - ``Run a body of code after acquiring read access to an rwlock. Will automatically release the lock when done.`` + ``Run a body of code after acquiring write access to an rwlock. Will automatically release the lock when done.`` [lock & body] (acquire-release ev/acquire-wlock ev/release-wlock lock body)) @@ -4178,7 +4179,7 @@ (not (not (os/stat (bundle-dir bundle-name) :mode)))) (defn bundle/install - "Install a bundle from the local filesystem with a name `bundle-name`." + "Install a bundle from the local filesystem. The name of the bundle will be infered from the bundle, or passed as a parameter :name in `config`." [path &keys config] (def path (bundle-rpath path)) (def clean (get config :clean))