Update to 1.10.1

Make install-paths a function

CHANGELOG.md

@@ -1,7 +1,15 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
-## 1.10.1 - 2020-06-14
+## 1.10.1 - 2020-06-18
+- Expose `janet_table_clear` in API.
+- Respect `JANET_NO_PROCESSES` define when building
+- Fix `jpm` rules having multiple copies of the same dependency.
+- Fix `jpm` install in some cases.
+- Add `array/trim` and `buffer/trim` to shrink the backing capacity of these types
+  to their current length.
+
+## 1.10.0 - 2020-06-14
 - Hardcode default jpm paths on install so env variables are needed in fewer cases.
 - Add `:no-compile` to `create-executable` option for jpm.
 - Fix bug with the `trace` function.

jpm

@@ -29,7 +29,7 @@
     (def i (last (string/find-all sep exe)))
     (slice exe 0 i)))
 
-(def- install-paths 
+(defn- install-paths []
   {:headerpath (os/realpath (string exe-dir "/../include/janet"))
    :libpath (os/realpath (string exe-dir "/../lib"))
    :binpath exe-dir})
@@ -38,16 +38,16 @@
 
 # Default based on janet binary location
 (def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
-                          (get install-paths :headerpath)))
+                          (get (install-paths) :headerpath)))
 (def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
-                       (get install-paths :libpath)))
+                       (get (install-paths) :libpath)))
 # We want setting JANET_PATH to contain installed binaries. However, it is convenient
 # to have globally installed binaries got to the same place as jpm itself, which is on
 # the $PATH.
 (def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
                        (if-let [mp (os/getenv "JANET_MODPATH")] (string mp "/bin"))
                        (if-let [mp (os/getenv "JANET_PATH")] (string mp "/bin"))
-                       (get install-paths :binpath)))
+                       (get (install-paths) :binpath)))
 
 # modpath should only be derived from the syspath being used or an environment variable.
 (def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
@@ -76,11 +76,13 @@
 (defn rm
   "Remove a directory and all sub directories."
   [path]
-  (if (= (os/lstat path :mode) :directory)
-    (do
+  (case (os/lstat path :mode)
+    :directory (do
       (each subpath (os/dir path)
         (rm (string path sep subpath)))
       (os/rmdir path))
+    nil nil # do nothing if file does not exist
+    # Default, try to remove
     (os/rm path)))
 
 (defn- rimraf
@@ -88,7 +90,8 @@
   [path]
   (if is-win
     # windows get rid of read-only files
-    (os/shell (string `rmdir /S /Q "` path `"`))
+    (when (os/stat path :mode)
+      (os/shell (string `rmdir /S /Q "` path `"`)))
     (rm path)))
 
 (defn clear-cache
@@ -185,9 +188,27 @@
   (unless item (error (string "No rule for target " target)))
   item)
 
+(defn add-dep
+  "Add a dependency to an existing rule. Useful for extending phony
+  rules or extending the dependency graph of existing rules."
+  [target dep]
+  (def [deps] (gettarget target))
+  (unless (find |(= dep $) deps)
+    (array/push deps dep)))
+
+(defn- add-thunk
+  [target more &opt phony]
+  (def item (gettarget target))
+  (def [_ thunks pthunks] item)
+  (array/push (if phony pthunks thunks) more)
+  item)
+
 (defn- rule-impl
   [target deps thunk &opt phony]
-  (put (getrules) target @[(array/slice deps) @[thunk] phony]))
+  (def rules (getrules))
+  (unless (rules target) (put rules target @[(array/slice deps) @[] @[]]))
+  (each d deps (add-dep target d))
+  (add-thunk target thunk phony))
 
 (defmacro rule
   "Add a rule to the rule graph."
@@ -211,20 +232,6 @@
   [target deps & body]
   ~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/shell (,string ,;body))))) true))
 
-(defn add-dep
-  "Add a dependency to an existing rule. Useful for extending phony
-  rules or extending the dependency graph of existing rules."
-  [target dep]
-  (def [deps] (gettarget target))
-  (array/push deps dep))
-
-(defn- add-thunk
-  [target more]
-  (def item (gettarget target))
-  (def [_ thunks] item)
-  (array/push thunks more)
-  item)
-
 (defmacro add-body
   "Add recipe code to an existing rule. This makes existing rules do more but
   does not modify the dependency graph."
@@ -254,9 +261,11 @@
       (error (string "No rule for file " target " found."))))
   (def [deps thunks phony] item)
   (def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x))
-  (when (or phony (needs-build-some target realdeps))
-    (each thunk thunks (thunk)))
-  (unless phony target))
+  (each thunk phony (thunk))
+  (unless (empty? thunks)
+    (when (needs-build-some target realdeps)
+      (each thunk thunks (thunk))
+    target)))
 
 #
 # Importing a file
@@ -743,7 +752,7 @@ int main(int argc, const char **argv) {
                 :binpath (abspath (dyn :binpath JANET_BINPATH))]
       (os/cd module-dir)
       (unless fresh
-        (os/execute [(git-path) "pull" "origin" "master"] :p))
+        (os/execute [(git-path) "pull" "origin" "master" "--ff-only"] :p))
       (when tag
         (os/execute [(git-path) "reset" "--hard" tag] :p))
       (unless (dyn :offline)
@@ -762,9 +771,9 @@ int main(int argc, const char **argv) {
   (def name (last parts))
   (def path (string destdir sep name))
   (array/push (dyn :installed-files) path)
-  (add-body "install"
-            (mkdir destdir)
-            (copy src destdir)))
+  (phony "install" []
+          (mkdir destdir)
+          (copy src destdir)))
 
 (defn- make-lockfile
   [&opt filename]
@@ -928,7 +937,7 @@ int main(int argc, const char **argv) {
       (def name (last parts))
       (def path (string binpath sep name))
       (array/push (dyn :installed-files) path)
-      (add-body "install"
+      (phony "install" []
                 (def contents
                   (with [f (file/open main)]
                     (def first-line (:read f :line))
@@ -946,7 +955,7 @@ int main(int argc, const char **argv) {
     (def bat (string "@echo off\r\njanet \"" fullname "\" %*"))
     (def newname (string binpath sep name ".bat"))
     (array/push (dyn :installed-files) newname)
-    (add-body "install"
+    (phony "install" []
               (spit newname bat))))
 
 (defn- print-rule-tree
@@ -993,7 +1002,8 @@ int main(int argc, const char **argv) {
 
   (phony "build" [])
 
-  (phony "manifest" []
+  (phony "manifest" [manifest])
+  (rule manifest []
          (print "generating " manifest "...")
          (mkdir manifests)
          (def sha (pslurp (string "\"" (git-path) "\" rev-parse HEAD")))
@@ -1005,7 +1015,7 @@ int main(int argc, const char **argv) {
             :paths installed-files})
          (spit manifest (string/format "%j\n" man)))
 
-  (phony "install" ["uninstall" "build" "manifest"]
+  (phony "install" ["uninstall" "build" manifest]
          (when (dyn :test)
            (do-rule "test"))
          (print "Installed as '" (meta :name) "'."))

meson.build

@@ -20,7 +20,7 @@
 
 project('janet', 'c',
   default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
-  version : '1.10.0')
+  version : '1.10.1')
 
 # Global settings
 janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')

src/conf/janetconf.h

@@ -28,9 +28,9 @@
 
 #define JANET_VERSION_MAJOR 1
 #define JANET_VERSION_MINOR 10
-#define JANET_VERSION_PATCH 0
+#define JANET_VERSION_PATCH 1
 #define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.10.0"
+#define JANET_VERSION "1.10.1"
 
 /* #define JANET_BUILD "local" */
 

src/core/array.c

@@ -270,6 +270,26 @@ static Janet cfun_array_remove(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
+static Janet cfun_array_trim(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 1);
+    JanetArray *array = janet_getarray(argv, 0);
+    if (array->count) {
+        if (array->count < array->capacity) {
+            Janet *newData = realloc(array->data, array->count * sizeof(Janet));
+            if (NULL == newData) {
+                JANET_OUT_OF_MEMORY;
+            }
+            array->data = newData;
+            array->capacity = array->count;
+        }
+    } else {
+        array->capacity = 0;
+        free(array->data);
+        array->data = NULL;
+    }
+    return argv[0];
+}
+
 static const JanetReg array_cfuns[] = {
     {
         "array/new", cfun_array_new,
@@ -345,6 +365,11 @@ static const JanetReg array_cfuns[] = {
              "By default, n is 1. "
              "Returns the array.")
     },
+    {
+        "array/trim", cfun_array_trim,
+        JDOC("(array/trim arr)\n\n"
+             "Set the backing capacity of an array to its current length. Returns the modified array.")
+    },
     {NULL, NULL, NULL}
 };
 

src/core/buffer.c

@@ -197,6 +197,26 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
+static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 1);
+    JanetBuffer *buffer = janet_getbuffer(argv, 0);
+    if (buffer->count) {
+        if (buffer->count < buffer->capacity) {
+            uint8_t *newData = realloc(buffer->data, buffer->count);
+            if (NULL == newData) {
+                JANET_OUT_OF_MEMORY;
+            }
+            buffer->data = newData;
+            buffer->capacity = buffer->count;
+        }
+    } else {
+        buffer->capacity = 0;
+        free(buffer->data);
+        buffer->data = NULL;
+    }
+    return argv[0];
+}
+
 static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
     int32_t i;
     janet_arity(argc, 1, -1);
@@ -379,6 +399,12 @@ static const JanetReg buffer_cfuns[] = {
              "Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
              "Returns the modified buffer.")
     },
+    {
+        "buffer/trim", cfun_buffer_trim,
+        JDOC("(buffer/trim buffer)\n\n"
+             "Set the backing capacity of the buffer to the current length of the buffer. Returns the "
+             "modified buffer.")
+    },
     {
         "buffer/push-byte", cfun_buffer_u8,
         JDOC("(buffer/push-byte buffer x)\n\n"

src/core/os.c

@@ -1225,6 +1225,9 @@ static Janet os_rename(int32_t argc, Janet *argv) {
 static Janet os_realpath(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
     const char *src = janet_getcstring(argv, 0);
+#ifdef JANET_NO_REALPATH
+    janet_panic("os/realpath not enabled for this platform");
+#else
 #ifdef JANET_WINDOWS
     char *dest = _fullpath(NULL, src, _MAX_PATH);
 #else
@@ -1234,6 +1237,7 @@ static Janet os_realpath(int32_t argc, Janet *argv) {
     Janet ret = janet_cstringv(dest);
     free(dest);
     return ret;
+#endif
 }
 
 static Janet os_permission_string(int32_t argc, Janet *argv) {

src/include/janet.h

@@ -1302,6 +1302,7 @@ JANET_API void janet_table_merge_table(JanetTable *table, JanetTable *other);
 JANET_API void janet_table_merge_struct(JanetTable *table, JanetStruct other);
 JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
 JANET_API JanetTable *janet_table_clone(JanetTable *table);
+JANET_API void janet_table_clear(JanetTable *table);
 
 /* Fiber */
 JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);

tools/patch-jpm.janet

@@ -20,7 +20,7 @@
 (def- replace-peg
   (peg/compile
     ~(% (* '(to "###START###")
-           (constant ,(string/format "# Inserted by tools/patch-jpm.janet\n(def install-paths %j)" install-paths))
+           (constant ,(string/format "# Inserted by tools/patch-jpm.janet\n(defn- install-paths [] %j)" install-paths))
            (thru "###END###")
            '(any 1)))))