withEvalOnce macro using implicit quasiquote. Close #26

kiss/src/kiss/Helpers.hx

@@ -369,6 +369,10 @@ class Helpers {
                 FieldExp(field, removeTypeAnnotations(innerExp));
             case KeyValueExp(keyExp, valueExp):
                 KeyValueExp(removeTypeAnnotations(keyExp), removeTypeAnnotations(valueExp));
+            case Unquote(innerExp):
+                Unquote(removeTypeAnnotations(innerExp));
+            case UnquoteList(innerExp):
+                UnquoteList(removeTypeAnnotations(innerExp));
             case None:
                 None;
             default:
@@ -606,7 +610,11 @@ class Helpers {
         }
         function float(v:Float) {
             return _symbol(Std.string(v));
-        } 
+        }
+        function let(bindings:Array<ReaderExp>, body:Array<ReaderExp>) {
+            return callSymbol("let", [list(bindings)].concat(body));
+        }
+        
         return {
             call: call,
             callSymbol: callSymbol,
@@ -625,7 +633,7 @@ class Helpers {
             field: field,
             keyValue: (key:ReaderExp, value:ReaderExp) -> KeyValueExp(key, value).withPosOf(posRef),
             begin: (exps:Array<ReaderExp>) -> callSymbol("begin", exps),
-            let: (bindings:Array<ReaderExp>, body:Array<ReaderExp>) -> callSymbol("let", [list(bindings)].concat(body)),
+            let: let,
             objectWith: objectWith,
             throwKissError: (reason:String) -> {
                 callSymbol("throw", [

kiss/src/kiss/Macros.hx

@@ -1231,6 +1231,19 @@ class Macros {
         typedCallMacro("intersect", "intersect", "Array<Array<Dynamic>>");
         typedCallMacro("concat", "concat", "Array<Dynamic>");
 
+        k.doc("withEvalOnce", 2, null, "(withEvalOnce [<symbols...>] <body...>)");
+        macros["withEvalOnce"] = (wholeExp:ReaderExp, exps:Array<ReaderExp>, k:KissState) -> {
+            var b = wholeExp.expBuilder();
+            var symbols = exps[0].argList("withEvalOnce");
+            var body = exps.slice(1);
+            var bindings = [];
+            for (symbol in symbols) {
+                bindings.push(symbol);
+                bindings.push(Unquote(symbol).withPosOf(symbol));
+            }
+            return Quasiquote(b.let(bindings, body)).withPosOf(wholeExp);
+        };
+
         return macros;
     }
 

projects/nat-archive-tool/src/nat/Lib.kiss

@@ -3,16 +3,22 @@
 
 // External programs can load Lib.kiss with (loadFrom "nat-archive-tool" "src/nat/Lib.kiss")
 
-(function log [msg]
+(function _log [msg]
     (#when (or test debug) (print msg)))
 
+(defMacro log [ui msg]
+    (withEvalOnce [ui msg]
+        (when ui
+            (ui.displayMessage msg))
+        (_log msg)))
+
 (defMacro hasComponent [e componentType]
     `(.exists .components ,e ,(symbolName componentType)))
 
 // Changes to the object returned by (readComponent) will not be saved! Use (withWritableComponents) for making changes
 (defMacro readComponent [e componentType]
     `(let [componentData (dictGet (the Map<String,String> .components ,e) ,(symbolName componentType))]
-        (log (+ "reading " componentData " as " ,(symbolName componentType) " for " .id ,e))
+        (log null (+ "reading " componentData " as " ,(symbolName componentType) " for " .id ,e))
         (the nat.components ,componentType 
             // TODO add to the documentation a hint that macros should use fully qualified type paths so macro caller classes don't need to import everything
             (tink.Json.parse componentData))))
@@ -20,12 +26,12 @@
 // TODO check not overwriting a component
 (defMacro addComponent [archive e componentType c]
     `(withWritableEntry ,archive ,e
-        (log (+ "adding " (the nat.components ,componentType ,c) " as " ,(symbolName componentType) " for " .id ,e))
+        (log null (+ "adding " (the nat.components ,componentType ,c) " as " ,(symbolName componentType) " for " .id ,e))
         (dictSet .components ,e ,(symbolName componentType) (tink.Json.stringify (the nat.components ,componentType ,c)))))
 
 (defMacro removeComponent [archive e componentType]
     `(withWritableEntry ,archive ,e
-        (log (+ "removing " ,(symbolName componentType) " component from " .id ,e))
+        (log null (+ "removing " ,(symbolName componentType) " component from " .id ,e))
         (.remove .components ,e ,(symbolName componentType))))
 
 // Retrieve multiple components from an Entity with mutable access.