Add upscope special form.

Upscope is similar to do, but does not introduce a new lexical scope.

src/boot/boot.janet

@@ -2271,11 +2271,23 @@
   @{})
 
 (defmacro comptime
-  "(comptime x)\n\n
+  "Evals x at compile time and returns the result. Similar to a top level unquote."
-  Evals x at compile time and returns the result. Similar to a top level unquote."
   [x]
   (eval x))
 
+(defmacro compif
+  "Check the condition cnd at compile time - if truthy, compile tru, else compile fals."
+  [cnd tru &opt fals]
+  (if (eval cnd)
+    tru
+    fals))
+
+(defmacro compwhen
+  "Check the condition cnd at compile time - if truthy, compile (upscope ;body), else compile nil."
+  [cnd & body]
+  (if (eval cnd)
+    ~(upscope ,;body)))
+
 (defn make-image
   "Create an image from an environment returned by require.
   Returns the image source as a string."
@@ -2328,18 +2340,16 @@
 (module/add-paths ".jimage" :image)
 
 # Version of fexists that works even with a reduced OS
-(if-let [has-stat (root-env 'os/stat)]
+(defn fexists
-  (let [stat (has-stat :value)]
+  [path]
-    (defglobal "fexists" (fn fexists [path] (= :file (stat path :mode)))))
+  (compif (dyn 'os/stat)
-  (defglobal "fexists"
+    (= :file (os/stat path :mode))
-    (fn fexists [path]
+    (when-let [f (file/open path :rb)]
-      (def f (file/open path :rb))
+      (def res
-      (when f
+        (try (do (file/read f 1) true)
-        (def res
+          ([err] nil)))
-          (try (do (file/read f 1) true)
+      (file/close f)
-            ([err] nil)))
+      res)))
-        (file/close f)
-        res))))
 
 (defn- mod-filter
   [x path]
@@ -2750,18 +2760,14 @@
 ###
 ###
 
-(defmacro- guarddef
+(compwhen (dyn 'ev/go)
-  [sym form]
+  (defn net/close "Alias for ev/close." [stream] (ev/close stream))
-  (if (dyn sym)
-    form))
-
-(guarddef ev/go
   (defmacro ev/spawn
     "Run some code in a new fiber. This is shorthand for (ev/call (fn [] ;body))."
     [& body]
     ~(,ev/call (fn [] ,;body))))
 
-(guarddef net/listen
+(compwhen (dyn 'net/listen)
   (defn net/server
     "Start a server asynchornously with net/listen and net/accept-loop. Returns the new server stream."
     [host port &opt handler type]
@@ -2770,11 +2776,6 @@
       (ev/call (fn [] (net/accept-loop s handler))))
     s))
 
-(guarddef ev/close
-  (defn net/close "Alias for ev/close." [stream] (ev/close stream)))
-
-(undef guarddef)
-
 ###
 ###
 ### CLI Tool Main

src/core/specials.c

@@ -336,10 +336,8 @@ static int defleaf(
 
         /* Put value in table when evaulated */
         janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
-        return 1;
-    } else {
-        return namelocal(c, sym, 0, s);
     }
+    return namelocal(c, sym, 0, s);
 }
 
 static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
@@ -470,6 +468,28 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) {
     return ret;
 }
 
+
+/* Compile an upscope form. Upscope forms execute their body sequentially and
+ * evaluate to the last expression in the body, but without lexical scope. */
+static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv) {
+    int32_t i;
+    JanetSlot ret = janetc_cslot(janet_wrap_nil());
+    JanetCompiler *c = opts.compiler;
+    JanetFopts subopts = janetc_fopts_default(c);
+    for (i = 0; i < argn; i++) {
+        if (i != argn - 1) {
+            subopts.flags = JANET_FOPTS_DROP;
+        } else {
+            subopts = opts;
+        }
+        ret = janetc_value(subopts, argv[i]);
+        if (i != argn - 1) {
+            janetc_freeslot(c, ret);
+        }
+    }
+    return ret;
+}
+
 /* Add a funcdef to the top most function scope */
 static int32_t janetc_addfuncdef(JanetCompiler *c, JanetFuncDef *def) {
     JanetScope *scope = c->scope;
@@ -854,6 +874,7 @@ static const JanetSpecial janetc_specials[] = {
     {"set", janetc_varset},
     {"splice", janetc_splice},
     {"unquote", janetc_unquote},
+    {"upscope", janetc_upscope},
     {"var", janetc_var},
     {"while", janetc_while}
 };