Fix bug in compiler with if form under certain conditions.

Begin bundled 'cook' tool for managing janet projects.

natives/json/Makefile

@@ -1,44 +0,0 @@
-# Copyright (c) 2018 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.
-
-CFLAGS:=-std=c99 -Wall -Wextra -O2 -shared -fpic
-CFLAGS=-std=c99 -Wall -Wextra -I../../src/include -O2 -shared -fpic
-OBJECTS:=json.o
-TARGET:=json.so
-
-# MacOS specifics
-UNAME:=$(shell uname -s)
-ifeq ($(UNAME), Darwin)
-	CFLAGS:=$(CFLAGS) -undefined dynamic_lookup
-endif
-
-all: $(TARGET)
-
-%.o: %.c $(HEADERS)
-	$(CC) $(CFLAGS) -c $<
-
-$(TARGET): $(OBJECTS)
-	$(CC) $(CFLAGS) -o $@ $^
-
-clean: 
-	rm $(OBJECTS)
-	rm $(TARGET)
-
-.PHONY: all clean

natives/json/build.janet

@@ -0,0 +1,5 @@
+(import cook)
+
+(cook/make-native
+    :name "json"
+    :source ["json.c"])

natives/json/build_win.bat

@@ -1,25 +0,0 @@
-@rem Generated batch script, run in 'Visual Studio Developer Prompt'
-
-@rem 
-
-@echo off
-
-cl /nologo /I..\..\src\include /c /O2 /W3 json.c
-@if errorlevel 1 goto :BUILDFAIL
-
-link /nologo /dll ..\..\janet.lib /out:json.dll *.obj
-if errorlevel 1 goto :BUILDFAIL
-
-@echo .
-@echo ======
-@echo Build Succeeded.
-@echo =====
-exit /b 0
-
-:BUILDFAIL
-@echo .
-@echo =====
-@echo BUILD FAILED. See Output For Details.
-@echo =====
-@echo .
-exit /b 1

natives/json/json.c

@@ -196,7 +196,7 @@ static const char *decode_one(const char **p, Janet *out, int depth) {
 
                 if (cp[1] != 'u' || cp[2] != 'l' || cp[3] != 'l')
                     goto badident;
-                *out = janet_wrap_nil();
+                *out = janet_csymbolv(":null");
                 *p = cp + 4;
                 break;
             }

src/core/core.janet

@@ -233,6 +233,22 @@
   (array/concat accum body)
   (tuple/slice accum 0))
 
+(defmacro try
+  "Try something and catch errors. Body is any expression,
+  and catch should be a form with the first element a tuple. This tuple
+  should contain a binding for errors and an optional binding for 
+  the fiber wrapping the body. Returns the result of body if no error,
+  or the result of catch if an error."
+  [body catch]
+  (let [[[err fib]] catch
+        f (gensym)
+        r (gensym)]
+    ~(let [,f (,fiber/new (fn [] ,body) :e)
+           ,r (resume ,f)]
+       (if (= (,fiber/status ,f) :error)
+         (do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
+         ,r))))
+
 (defmacro and
   "Evaluates to the last argument if all preceding elements are true, otherwise
   evaluates to false."

src/core/specials.c

@@ -369,8 +369,9 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
             falsebody = truebody;
             truebody = temp;
         }
-        janetc_scope(&tempscope, c, 0, "if-body");
+        janetc_scope(&tempscope, c, 0, "if-true");
-        target = janetc_value(bodyopts, truebody);
+        right = janetc_value(bodyopts, truebody);
+        if (!drop && !tail) janetc_copy(c, target, right);
         janetc_popscope(c);
         janetc_throwaway(bodyopts, falsebody);
         janetc_popscope(c);

test/suite3.janet

@@ -46,4 +46,11 @@
                   @[x y] (+ x y 10)
                   0)) "match 3")
 
+# Edge case should cause old compilers to fail due to
+# if statement optimization
+(var var-a 1)
+(var var-b (if false 2 (string "hello")))
+
+(assert (= var-b "hello") "regression 1")
+
 (end-suite)

tools/cook.janet

@@ -0,0 +1,104 @@
+# Library to help build janet natives and other
+# build artifacts.
+
+# Windows is the OS outlier
+(def- is-win (= (os/which) :windows))
+
+(defn- shell
+  "Do a shell command"
+  [& args]
+  (print ;args)
+  (def res (os/shell (string ;args)))
+  (unless (zero? res) 
+    (print "Error executing command: " ;args)
+    (os/exit res)))
+
+(defn- mkdir
+  "Make a directory. Not safe for user code."
+  [path]
+  (if is-win 
+    (shell "mkdir " path)
+    (shell "mkdir -p " path)))
+
+(defn- rm
+  "Remove a directory. Not safe for user code."
+  [path]
+  (if is-win
+    (shell "rmdir " path " /s")
+    (shell "rm -rf " path)))
+
+(defn- object-name
+  "Rename a source file so it can be built in a flat source tree."
+  [path]
+  (if is-win
+    (->> path
+         (string/replace-all "\\" "___")
+         (string/replace-all ".c" ".obj")
+         (string "build\\")))
+    (->> path
+         (string/replace-all "/" "___")
+         (string/replace-all ".c" ".o")
+         (string "build/")))
+
+(defn- lib-name
+  "Generate name for dynamic library."
+  [name]
+  (if is-win
+    (string "build\\" name ".dll")
+    (string "build/" name ".so")))
+
+# Defaults
+(def OPTIMIZE 2)
+(def CC (if is-win "cl" "cc"))
+(def LD (if is-win "link" (string CC " -shared")))
+(def CFLAGS (string (if is-win "/0" "-std=c99 -Wall -Wextra -fpic -O") OPTIMIZE))
+
+(defn- compile-c
+  "Compile a C file into an object file."
+  [opts src dest]
+  (def cc (or opts:compiler CC))
+  (def cflags (or opts:cflags CFLAGS))
+  (if is-win
+    (shell cc " /nologo /c " cflags " /Fo" dest " " src)
+    (shell cc " " cflags " -o " dest " -c " src)))
+
+(defn- link-c
+  "Link a number of object files together."
+  [opts target & objects]
+  (def ld (or opts:linker LD))
+  (def cflags (or opts:cflags CFLAGS))
+  (def olist (string/join objects " "))
+  (if is-win
+    (shell ld "/out:" target "  " olist)
+    (shell ld " " cflags " -o " target " " olist)))
+
+# Public
+
+(defn make-native
+  "Build a native binary. This is a shared library that can be loaded
+  dynamically by a janet runtime."
+  [& opts]
+  (def opt-table (table ;opts))
+  (mkdir "build")
+  (loop [src :in opt-table:source]
+    (compile-c opt-table src (object-name src)))
+  (link-c opt-table (lib-name opt-table:name) ;(map object-name opt-table:source)))
+
+(defn clean
+  "Remove all built artifacts."
+  []
+  (rm "build"))
+
+(defn make-archive
+  "Build a janet archive. This is a file that bundles together many janet
+  scripts into a janet form. This file can the be moved to any machine with
+  a janet vm and the required dependencies and run there."
+  [& opts]
+  (error "Not Yet Implemented."))
+
+(defn make-binary
+  "Make a binary executable that can be run on the current platform. This function
+  generates a self contained binary that can be run of the same architecture as the
+  build machine, as the current janet vm will be packaged with the output binary."
+  [& opts]
+  (error "Not Yet Implemented."))