Merge branch 'master' of github.com:janet-lang/janet

CHANGELOG.md

@@ -1,6 +1,18 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
+## 1.3.1 - 2019-09-21
+- Fix some linking issues when creating executables with native dependencies.
+- jpm now runs each test script in a new interpreter.
+- Fix an issue that prevent some valid programs from compiling.
+- Add `mean` to core.
+- Abstract types that implement the `:+`, `:-`, `:*`, `:/`, `:>`, `:==`, `:<`,
+  `:<=`, and `:>=` methods will work with the corresponding built-in
+  arithmetic functions. This means built-in integer types can now be used as
+  normal number values in many contexts.
+- Allow (length x) on typed arrays an other abstract types that implement
+  the :length method.
+
 ## 1.3.0 - 2019-09-05
 - Add `get-in`, `put-in`, `update-in`, and `freeze` to core.
 - Add `jpm run rule` and `jpm rules` to jpm to improve utility and discoverability of jpm.

Makefile

@@ -41,10 +41,14 @@ CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fpic -O2 -fvisibility=hi
 	   -DJANET_BUILD=$(JANET_BUILD)
 LDFLAGS=-rdynamic
 
+# For installation
+LDCONFIG:=ldconfig "$(LIBDIR)"
+
 # Check OS
 UNAME:=$(shell uname -s)
 ifeq ($(UNAME), Darwin)
 	CLIBS:=$(CLIBS) -ldl
+	LDCONFIG:=
 else ifeq ($(UNAME), Linux)
 	CLIBS:=$(CLIBS) -lrt -ldl
 endif
@@ -255,7 +259,10 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
 	src/include/janet.h src/conf/janetconf.h \
 	jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
 	build/doc.html README.md build/janet.c
-	tar -czvf $@ $^
+	$(eval JANET_DIST_DIR = "janet-$(shell basename $*)")
+	mkdir -p build/$(JANET_DIST_DIR)
+	cp -r $^ build/$(JANET_DIST_DIR)/
+	cd build && tar -czvf ../$@ $(JANET_DIST_DIR)
 
 #########################
 ##### Documentation #####
@@ -304,7 +311,7 @@ install: $(JANET_TARGET) build/janet.pc
 	cp jpm.1 '$(MANPATH)'
 	mkdir -p '$(PKG_CONFIG_PATH)'
 	cp build/janet.pc '$(PKG_CONFIG_PATH)/janet.pc'
-	-ldconfig $(LIBDIR)
+	-$(LDCONFIG)
 
 uninstall:
 	-rm '$(BINDIR)/janet'

README.md

@@ -62,7 +62,7 @@ documentation for symbols in the core library. For example,
 Shows documentation for the doc macro.
 
 To get a list of all bindings in the default
-environment, use the `(all-symbols)` function.
+environment, use the `(all-bindings)` function.
 
 ## Source
 

appveyor.yml

@@ -29,7 +29,7 @@ install:
     - call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvars32.bat"
     - build_win test-install
     - set janet_outname=%appveyor_repo_tag_name%
-    - if "%janet_outname%"=="" set janet_outname=v1.3.0
+    - if "%janet_outname%"=="" set janet_outname=v1.3.1
 build: off
 
 artifacts:

auxbin/jpm

@@ -372,6 +372,7 @@
         # Load entry environment and get main function.
         (def entry-env (dofile source))
         (def main ((entry-env 'main) :value))
+        (def dep-lflags @[])
 
         # Create marshalling dictionary
         (def mdict (invert (env-lookup root-env)))
@@ -403,6 +404,8 @@
                               "    janet_env_lookup_into(lookup, temptab, \""
                               prefix
                               "\", 0);\n\n")
+          (when-let [lfs (meta :lflags)]
+            (array/concat dep-lflags lfs))
           (buffer/push-string declarations
                               "extern void "
                               (meta :static-entry)
@@ -487,7 +490,7 @@ int main(int argc, const char **argv) {
                       #default
                       ["-lm"]))
   (def cc (opt opts :compiler default-compiler))
-  (def lflags [;(opt opts :lflags default-lflags) ;extra-lflags])
+  (def lflags [;dep-lflags ;(opt opts :lflags default-lflags) ;extra-lflags])
   (def cflags (getcflags opts))
   (def defines (make-defines (opt opts :defines {})))
   (print "compiling and linking " dest "...")
@@ -683,11 +686,13 @@ int main(int argc, const char **argv) {
   file is evaluated and a main function is looked for in the entry file. This function
   is marshalled into bytecode which is then embedded in a final executable for distribution.\n\n
   This executable can be installed as well to the --binpath given."
-  [&keys {:install install :name name :entry entry}]
+  [&keys {:install install :name name :entry entry :headers headers}]
   (def name (if is-win (string name ".exe") name))
   (def dest (string "build" sep name))
   (create-executable @{} entry dest)
   (add-dep "build" dest)
+  (when headers
+    (each h headers (add-dep dest h)))
   (when install
     (install-rule dest (dyn :binpath JANET_BINPATH))))
 
@@ -763,12 +768,14 @@ int main(int argc, const char **argv) {
   (phony "test" ["build"]
          (defn dodir
            [dir]
-           (each sub (os/dir dir)
+           (each sub (sort (os/dir dir))
              (def ndir (string dir sep sub))
              (case (os/stat ndir :mode)
                :file (when (string/has-suffix? ".janet" ndir)
                        (print "running " ndir " ...")
-                       (dofile ndir :exit true))
+                       (def result (os/execute [(dyn :executable "janet") ndir] :p))
+                       (when (not= 0 result)
+                         (os/exit result)))
                :directory (dodir ndir))))
          (dodir "test")
          (print "All tests passed.")))

build_win.bat

@@ -98,6 +98,7 @@ for %%f in (src\core\*.c) do (
     set "amalg_files=!amalg_files! %%f"
 )
 janet.exe tools\amalg.janet src\core\util.h src\core\state.h src\core\gc.h src\core\vector.h src\core\fiber.h src\core\regalloc.h src\core\compile.h src\core\emit.h src\core\symcache.h %amalg_files% build\core_image.c > build\janet.c
+janet.exe tools\removecr.janet build\janet.c
 
 echo === Successfully built janet.exe for Windows ===
 echo === Run 'build_win test' to run tests. ==
@@ -137,6 +138,7 @@ exit /b 0
 :DIST
 mkdir dist
 janet.exe tools\gendoc.janet > dist\doc.html
+janet.exe tools\removecr.janet dist\doc.html
 
 copy build\janet.c dist\janet.c
 copy janet.exe dist\janet.exe

meson.build

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

src/boot/boot.janet

@@ -445,6 +445,11 @@
   (each x xs (+= accum x))
   accum)
 
+(defn mean
+  "Returns the mean of xs. If empty, returns NaN."
+  [xs]
+  (/ (sum xs) (length xs)))
+
 (defn product
   "Returns the product of xs. If xs is empty, returns 1."
   [xs]

src/conf/janetconf.h

@@ -28,9 +28,9 @@
 
 #define JANET_VERSION_MAJOR 1
 #define JANET_VERSION_MINOR 3
-#define JANET_VERSION_PATCH 0
+#define JANET_VERSION_PATCH 1
 #define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.3.0"
+#define JANET_VERSION "1.3.1"
 
 /* #define JANET_BUILD "local" */
 

src/core/pp.c

@@ -30,7 +30,7 @@
 #endif
 
 /* Implements a pretty printer for Janet. The pretty printer
- * is farily simple and not that flexible, but fast. */
+ * is simple and not that flexible, but fast. */
 
 /* Temporary buffer size */
 #define BUFSIZE 64

src/core/specials.c

@@ -602,6 +602,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
         int32_t tempself = janetc_regalloc_temp(&tempscope.ra, JANETC_REGTEMP_0);
         janetc_emit(c, JOP_LOAD_SELF | (tempself << 8));
         janetc_emit(c, JOP_TAILCALL | (tempself << 8));
+        janetc_regalloc_freetemp(&c->scope->ra, tempself, JANETC_REGTEMP_0);
         /* Compile function */
         JanetFuncDef *def = janetc_pop_funcdef(c);
         def->name = janet_cstring("_while");
@@ -610,7 +611,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
         int32_t cloreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_0);
         janetc_emit(c, JOP_CLOSURE | (cloreg << 8) | (defindex << 16));
         janetc_emit(c, JOP_CALL | (cloreg << 8) | (cloreg << 16));
-        janetc_regalloc_free(&c->scope->ra, cloreg);
+        janetc_regalloc_freetemp(&c->scope->ra, cloreg, JANETC_REGTEMP_0);
         c->scope->flags |= JANET_SCOPE_CLOSURE;
         return janetc_cslot(janet_wrap_nil());
     }

src/core/value.c

@@ -299,6 +299,38 @@ int32_t janet_length(Janet x) {
             return janet_struct_length(janet_unwrap_struct(x));
         case JANET_TABLE:
             return janet_unwrap_table(x)->count;
+        case JANET_ABSTRACT: {
+            Janet argv[1] = { x };
+            Janet len = janet_mcall("length", 1, argv);
+            if (!janet_checkint(len))
+                janet_panicf("invalid integer length %v", len);
+            return janet_unwrap_integer(len);
+        }
+    }
+}
+
+Janet janet_lengthv(Janet x) {
+    switch (janet_type(x)) {
+        default:
+            janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x);
+        case JANET_STRING:
+        case JANET_SYMBOL:
+        case JANET_KEYWORD:
+            return janet_wrap_integer(janet_string_length(janet_unwrap_string(x)));
+        case JANET_ARRAY:
+            return janet_wrap_integer(janet_unwrap_array(x)->count);
+        case JANET_BUFFER:
+            return janet_wrap_integer(janet_unwrap_buffer(x)->count);
+        case JANET_TUPLE:
+            return janet_wrap_integer(janet_tuple_length(janet_unwrap_tuple(x)));
+        case JANET_STRUCT:
+            return janet_wrap_integer(janet_struct_length(janet_unwrap_struct(x)));
+        case JANET_TABLE:
+            return janet_wrap_integer(janet_unwrap_table(x)->count);
+        case JANET_ABSTRACT: {
+            Janet argv[1] = { x };
+            return janet_mcall("length", 1, argv);
+        }
     }
 }
 

src/core/vm.c

@@ -117,9 +117,16 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
     {\
         Janet op1 = stack[B];\
         vm_assert_type(op1, JANET_NUMBER);\
-        double x1 = janet_unwrap_number(op1);\
-        stack[A] = janet_wrap_number(x1 op CS);\
-        vm_pcnext();\
+        if (!janet_checktype(op1, JANET_NUMBER)) {\
+            vm_commit();\
+            Janet _argv[2] = { op1, janet_wrap_number(CS) };\
+            stack[A] = janet_mcall(#op, 2, _argv);\
+            vm_pcnext();\
+        } else {\
+            double x1 = janet_unwrap_number(op1);\
+            stack[A] = janet_wrap_number(x1 op CS);\
+            vm_pcnext();\
+        }\
     }
 #define _vm_bitop_immediate(op, type1)\
     {\
@@ -135,12 +142,19 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
     {\
         Janet op1 = stack[B];\
         Janet op2 = stack[C];\
-        vm_assert_type(op1, JANET_NUMBER);\
-        vm_assert_type(op2, JANET_NUMBER);\
-        double x1 = janet_unwrap_number(op1);\
-        double x2 = janet_unwrap_number(op2);\
-        stack[A] = wrap(x1 op x2);\
-        vm_pcnext();\
+        if (!janet_checktype(op1, JANET_NUMBER)) {\
+            vm_commit();\
+            Janet _argv[2] = { op1, op2 };\
+            stack[A] = janet_mcall(#op, 2, _argv);\
+            vm_pcnext();\
+        } else {\
+            vm_assert_type(op1, JANET_NUMBER);\
+            vm_assert_type(op2, JANET_NUMBER);\
+            double x1 = janet_unwrap_number(op1);\
+            double x2 = janet_unwrap_number(op2);\
+            stack[A] = wrap(x1 op x2);\
+            vm_pcnext();\
+        }\
     }
 #define vm_binop(op) _vm_binop(op, janet_wrap_number)
 #define vm_numcomp(op) _vm_binop(op, janet_wrap_boolean)
@@ -723,7 +737,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
 
     VM_OP(JOP_LENGTH)
     vm_commit();
-    stack[A] = janet_wrap_integer(janet_length(stack[E]));
+    stack[A] = janet_lengthv(stack[E]);
     vm_pcnext();
 
     VM_OP(JOP_MAKE_ARRAY) {
@@ -919,6 +933,37 @@ JanetSignal janet_pcall(
     return janet_continue(fiber, janet_wrap_nil(), out);
 }
 
+Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
+    /* At least 1 argument */
+    if (argc < 1) janet_panicf("method :%s expected at least 1 argument");
+    /* Find method */
+    Janet method;
+    if (janet_checktype(argv[0], JANET_ABSTRACT)) {
+        void *abst = janet_unwrap_abstract(argv[0]);
+        JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
+        if (!type->get)
+            janet_panicf("abstract value %v does not implement :%s", argv[0], name);
+        method = (type->get)(abst, janet_ckeywordv(name));
+    } else if (janet_checktype(argv[0], JANET_TABLE)) {
+        JanetTable *table = janet_unwrap_table(argv[0]);
+        method = janet_table_get(table, janet_ckeywordv(name));
+    } else if (janet_checktype(argv[0], JANET_STRUCT)) {
+        const JanetKV *st = janet_unwrap_struct(argv[0]);
+        method = janet_struct_get(st, janet_ckeywordv(name));
+    } else {
+        janet_panicf("could not find method :%s for %v", name, argv[0]);
+    }
+    /* Invoke method */
+    if (janet_checktype(method, JANET_CFUNCTION)) {
+        return (janet_unwrap_cfunction(method))(argc, argv);
+    } else if (janet_checktype(method, JANET_FUNCTION)) {
+        JanetFunction *fun = janet_unwrap_function(method);
+        return janet_call(fun, argc, argv);
+    } else {
+        janet_panicf("method %s has unexpected value %v", name, method);
+    }
+}
+
 /* Setup VM */
 int janet_init(void) {
     /* Garbage collection */

src/include/janet.h

@@ -1274,6 +1274,7 @@ JANET_API int janet_cstrcmp(const uint8_t *str, const char *other);
 JANET_API Janet janet_get(Janet ds, Janet key);
 JANET_API Janet janet_getindex(Janet ds, int32_t index);
 JANET_API int32_t janet_length(Janet x);
+JANET_API Janet janet_lengthv(Janet x);
 JANET_API void janet_put(Janet ds, Janet key, Janet value);
 JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
 JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
@@ -1286,6 +1287,7 @@ JANET_API void janet_deinit(void);
 JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
 JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
 JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
+JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
 JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
 
 /* Scratch Memory API */

test/suite5.janet

@@ -54,6 +54,7 @@
 (assert (= (a 2) (b 1) ) "tarray views pointing same buffer")
 (assert (= ((tarray/slice b) 3) (b 3) (a 6) 6) "tarray slice")
 (assert (= ((tarray/slice b 1) 2) (b 3) (a 6) 6) "tarray slice")
+(assert (= (:length a) (length a)) "length method and function")
 
 (assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal")
 

tools/removecr.janet

@@ -0,0 +1,9 @@
+# Remove carriage returns from file. Since piping things on 
+# windows may add bad line endings, we can just force removal
+# with this script.
+(def fname ((dyn :args) 1))
+(with [f (file/open fname :rb+)]
+  (def source (:read f :all))
+  (def new-source (string/replace-all "\r" "" source))
+  (:seek f :set 0)
+  (:write f new-source))