eval stringmap expressions

src/kiss/AsyncEmbeddedScript2.hx

@@ -103,6 +103,7 @@ class AsyncEmbeddedScript2 {
     private var breakPoints:Map<Int, () -> Bool> = [];
     private var onBreak:AsyncCommand2 = null;
     public var lastInstructionPointer(default,null):Int = -1;
+    var currentInstructionPointer:Int = 0;
     private var labels:Map<String,Int> = [];
 
     public var autoCC(default,default):Bool = true;
@@ -157,6 +158,7 @@ class AsyncEmbeddedScript2 {
     public var ranHscriptInstruction = false;
     #end
     private function runHscriptInstruction(instructionPointer:Int, skipping:Bool, cc:Continuation2) {
+        currentInstructionPointer = instructionPointer;
         #if test
         ranHscriptInstruction = true;
         #end
@@ -189,6 +191,7 @@ class AsyncEmbeddedScript2 {
         var wasRunning = running;
         running = true;
         var skipping = false;
+        currentInstructionPointer = instructionPointer;
         if (skipTarget != null) {
             if (instructionPointer == skipTarget) {
                 skipTarget = null;

src/kiss/Kiss.hx

@@ -1,5 +1,6 @@
 package kiss;
 
+import kiss.ReaderExp;
 #if macro
 import haxe.Exception;
 import haxe.macro.Context;
@@ -11,7 +12,6 @@ import sys.io.File;
 import kiss.Prelude;
 import kiss.Stream;
 import kiss.Reader;
-import kiss.ReaderExp;
 import kiss.FieldForms;
 import kiss.SpecialForms;
 import kiss.Macros;
@@ -77,39 +77,7 @@ typedef KissState = {
 #end
 
 class Kiss {
-    #if macro
-    public static function defaultKissState(?context:FrontendContext):KissState {
-        Sys.putEnv("KISS_BUILD_HXML", Prelude.joinPath(Helpers.libPath("kiss"), "build.hxml"));
-
-        var className = "";
-        var pack = [];
-        if (context == null) {
-            var clazz = Context.getLocalClass().get();
-            className = clazz.name;
-            pack = clazz.pack;
-        } else {
-            className = context.name;
-            pack = context.pack;
-        }
-        var k = {
-            className: className,
-            pack: pack,
-            file: "",
-            readTable: Reader.builtins(),
-            startOfLineReadTable: new ReadTable(),
-            startOfFileReadTable: new ReadTable(),
-            endOfFileReadTable: new ReadTable(),
-            fieldForms: new Map(),
-            specialForms: null,
-            specialFormMacroExpanders: null,
-            macros: null,
-            formDocs: new Map(),
-            doc: null,
-            wrapListExps: true,
-            loadedFiles: new Map<String, ReaderExp>(),
-            // Helpful built-in aliases
-            // These ones might conflict with a programmer's variable names, so they only apply in call expressions:
-            callAliases: [
+    public static var defaultCallAliases:Map<String,ReaderExpDef> = [
         // TODO some of these probably won't conflict, and could be passed as functions for a number of reasons
         "print" => Symbol("Prelude.print"),
         "sort" => Symbol("Prelude.sort"),
@@ -162,8 +130,8 @@ class Kiss {
         "fNinth" => Symbol("Prelude.fNinth"),
         "fTenth" => Symbol("Prelude.fTenth"),
         "uuid" => Symbol("Prelude.uuid"),
-            ],
-            identAliases: [
+    ];
+    public static var defaultIdentAliases:Map<String,ReaderExpDef> = [
         // These ones won't conflict with variables and might commonly be used with (apply)
         "extractOpt" => Symbol("Prelude.extractOpt"),
         "+" => Symbol("Prelude.add"),
@@ -192,7 +160,41 @@ class Kiss {
         applies (the Array<Array<Dynamic>>) to the result */
         /* concat used to live here as an alias but now it is in a macro that also
         applies (the Array<Dynamic>) to the result */
-            ],
+    ];
+    #if macro
+    public static function defaultKissState(?context:FrontendContext):KissState {
+        Sys.putEnv("KISS_BUILD_HXML", Prelude.joinPath(Helpers.libPath("kiss"), "build.hxml"));
+
+        var className = "";
+        var pack = [];
+        if (context == null) {
+            var clazz = Context.getLocalClass().get();
+            className = clazz.name;
+            pack = clazz.pack;
+        } else {
+            className = context.name;
+            pack = context.pack;
+        }
+        var k = {
+            className: className,
+            pack: pack,
+            file: "",
+            readTable: Reader.builtins(),
+            startOfLineReadTable: new ReadTable(),
+            startOfFileReadTable: new ReadTable(),
+            endOfFileReadTable: new ReadTable(),
+            fieldForms: new Map(),
+            specialForms: null,
+            specialFormMacroExpanders: null,
+            macros: null,
+            formDocs: new Map(),
+            doc: null,
+            wrapListExps: true,
+            loadedFiles: new Map<String, ReaderExp>(),
+            // Helpful built-in aliases
+            // These ones might conflict with a programmer's variable names, so they only apply in call expressions:
+            callAliases: defaultCallAliases,
+            identAliases: defaultIdentAliases,
             typeAliases: new Map(),
             fieldList: [],
             fieldDict: new Map(),
@@ -651,6 +653,17 @@ class Kiss {
                     buildFieldNames.remove(field.name);
                 }
 
+                if(field.meta != null) {
+                    for(meta in field.meta) {
+                        switch(meta) {
+                            case {name:name, params: null | []}:
+                                fossilCode += '@${name} ';
+                            case {name:name, params: params}:
+                                throw 'todo fossil build not implemented for call-form meta entry';
+                        }
+                    }
+                }
+
                 // Field modifiers:
                 var accessOrder = [
                     APublic,

src/kiss/KissInterp2.hx

@@ -11,9 +11,21 @@ class KissInterp2 {
 	public static function build():Array<Field> {
 		var fields = Kiss.build(Prelude.joinPath(Helpers.libPath("kiss"), "src/kiss/KissInterp2.kiss"));
 		
-		// TODO put imported types into the global variables interp
+		var preexistingNewBody = macro {};
+		for(field in fields) {
+			if(field.name == "new") {
+				switch(field.kind) {
+					case FFun(fun):
+						preexistingNewBody = fun.expr;
+					default:
+				}
+				fields.remove(field);
+			}
+		}
 
+		// TODO put imported types into the global variables interp
 		var imports = Context.getLocalImports();
+
 		fields.push({
 			pos: Context.currentPos(),
 			name: "new",
@@ -24,6 +36,10 @@ class KissInterp2 {
 				args: [],
 				expr: macro {
 					specialForms = _specialForms();
+					identAliases = kiss.Kiss.defaultIdentAliases;
+					callAliases = kiss.Kiss.defaultCallAliases;
+					globals["Prelude"] = kiss.Prelude;
+					$preexistingNewBody;
 				}
 			})
 		});

src/kiss/KissInterp2.kiss

@@ -4,6 +4,8 @@
 (import kiss.Reader.ReadTable)
 (import kiss.ReaderExp)
 (import kiss.ReaderExp.ReaderExpDef)
+(import kiss.ReaderExp.ReaderExpDef.Symbol)
+(import kiss.ReaderExp.ReaderExpDef.FieldExp)
 (import kiss.Stream)
 
 (prop &mut :ReadTable readTable (Reader.builtins))
@@ -11,6 +13,7 @@
 (prop &mut :ReadTable startOfFileReadTable (new Map))
 (prop &mut :ReadTable endOfFileReadTable (new Map))
 (prop &mut :Map<String,ReaderExpDef> identAliases (new Map))
+(prop &mut :Map<String,ReaderExpDef> callAliases (new Map))
 
 (prop :Map<String,Dynamic> globals [=>"false" false =>"true" true =>"null" null])
 (prop :Array<Map<String,Dynamic>> localScopes [])
@@ -20,16 +23,40 @@
 (method :Map<String,(Array<ReaderExp>,Dynamic->Void)->Void> _specialForms [] [
 	=>"if"
 		->[args cc]
-			(evalCC (first ~args)
+			(evalCC (first args)
 				->val
 					(if val
 							(evalCC (second args) cc)
 						(evalCC (third args) cc)))
+	=>"begin"
+		->[args cc]
+			(_evalAllCC args ->values
+				(cc (values.pop)))
+	=>"var"
+		->[args cc]
+			(let [name (symbolNameValue (first args))]
+				(evalCC (second args) ->val {(dictSet globals name val) (cc val)}))
 ])
 
+(method :ReaderExp read [:Dynamic input]
+	(typeCase [input]
+		([:String str]
+			(let [stream (Stream.fromString str)]
+				(read stream)))
+		([:Stream s]
+			(ifLet [(Some exp) (Reader.read s this)]
+					{
+						(s.dropWhitespace)
+						exp
+					}
+				(throw "Couldn't read valid expression from ${s.content}")))
+		(otherwise (throw "not valid for reading: $input"))))
+
 (method :Void evalCC [:Dynamic input :Dynamic->Void cc]
 	// Std.isOfType can't handle typedefs
-	(when (and (Reflect.hasField input "pos") (Reflect.hasField input "def"))
+	(when (and (Reflect.hasField input "pos")
+					// On python, hasField returns false because it is a keyword?
+					(#if python (Reflect.field input "def") (Reflect.hasField input "def")))
 		(evalCC input.def cc)
 		(return))
 	(typeCase [input]
@@ -41,20 +68,113 @@
 					(evalCC exp.def cc)
 				(throw "Couldn't read valid expression from $s")))
 		([:ReaderExpDef def]
+			// In case it needs to be transformed, pass this
+			(localVar &mut exp (object pos null def def))
 			(case def
+				// Special form call
 				((when (specialForms.exists form) (CallExp (object def (Symbol form)) args))
 					((dictGet specialForms form) args cc))
+				// Method/function call with call alias
+				((when (callAliases.exists name) (CallExp (object def (Symbol name)) args))
+					(evalCC (dictGet callAliases name) ->f
+						(_evalAllCC args ->values
+							// Function call
+							(cc (Reflect.callMethod null f values)))))
+				// Method/function call
+				((CallExp callable args)
+					(transformToFieldExp callable)
+					(evalCC callable ->f {
+						(_evalAllCC args ->values
+							(case callable
+								// Method call
+								((object def (FieldExp field obj safe))
+									(evalCC obj ->o {
+										(unless f
+											(throw "Null function pointer: $(kiss.Reader.toString callable.def) in $(Reflect.fields o)"))
+										(cc (Reflect.callMethod o f values))
+									}))
+								// Function call
+								(otherwise
+									(unless f
+										(throw "Null function pointer: $(kiss.Reader.toString callable.def)"))
+									(cc (Reflect.callMethod null f values)))))
+					}))
+				// Field access
+				((FieldExp field obj safe)
+					(evalCC obj ->v
+						(if v
+								(cc (Reflect.getProperty v field))
+							(if safe
+									(cc null)
+								(throw "field access on null! $(Reader.toString obj.def)")))))
+				// String literal
+				((StrExp str)
+					(cc str))
+				// Key value exp
+				((KeyValueExp keyExp valExp)
+					(evalCC keyExp ->key (evalCC valExp ->value (cc (objectWith key value)))))
+				// Array expression
+				((ListExp elements)
+					(case (first elements)
+						// Key value exps: it's a map
+						((object def (KeyValueExp _ _))
+							(_evalAllCC elements ->values
+								(let [m (new Map<String,Dynamic>)]
+									(doFor kvp values
+										(let [:String key kvp.key
+												:Dynamic value kvp.value]
+											(dictSet m key value)))
+									(cc m))))
+						// It's a list
+						(otherwise (_evalAllCC elements ->values
+							(cc values)))))
+				// Symbol
 				((Symbol ident)
 					// Check for numbers
 					(let [f (Std.parseFloat ident)]
 						(unless (Math.isNaN f)
 							(cc f)
 							(return)))
+					// Check for field access
+					(when (transformToFieldExp exp)
+						(evalCC exp cc)
+						(return))
+					// Check for ident aliases
+					(when (identAliases.exists ident)
+						(evalCC (dictGet identAliases ident) cc)
+						(return))
 					(doFor i (range localScopes.length)
 						(let [scope (nth localScopes (- localScopes.length i 1))]
 							(when (scope.exists ident)
 								(cc (dictGet scope ident))
 								(return))))
 					(cc (dictGet globals ident)))
-				(never otherwise)))
+				(otherwise
+					(throw "Can't interpret $(Reader.toString def)"))))
 		(otherwise (throw "Can't interpret ${input}"))))
+
+(method :Void _evalAllCC [:Array<Dynamic> inputs :Array<Dynamic>->Void cc &opt :Array<Dynamic> outputs]
+	(unless outputs (set outputs []))
+	(if inputs
+			(evalCC (inputs.shift) ->v {
+				(outputs.push v)
+				(_evalAllCC inputs cc outputs)
+			})
+		(cc outputs)))
+
+// Check if an identifier has field access in it, return true if transform it to FieldExp
+(method transformToFieldExp [:ReaderExp exp]
+	(case exp.def
+		((Symbol ident)
+			(let [idx (ident.indexOf ".")]
+				(unless (= -1 idx)
+					(let [parts (ident.split ".")
+							&mut newExp (object pos null def (Symbol (first parts)))]
+						(doFor part (parts.slice 1)
+							(let [safe (StringTools.startsWith part "?")]
+								(when safe (set part (part.substr 1)))
+								(set newExp (object pos null def (FieldExp part newExp safe)))))
+						(set exp.def newExp.def)
+						(return true)))))
+		(never otherwise))
+	false)

src/kiss/Macros.hx

@@ -749,7 +749,9 @@ class Macros {
             return b.let(
                 [gensym, firstValue],
                 [b.callSymbol("if", [
-                    b.callSymbol("Prelude.isNotNull", [gensym]),
+                    gensym,
+                    // Why did I do this?
+                    // b.callSymbol("Prelude.isNotNull", [gensym]),
                     b.callSymbol("case", [
                         gensym,
                         b.call(firstPattern, [

src/test/cases/KissInterp2TestCase.hx

@@ -19,4 +19,16 @@ class KissInterp2TestCase extends Test {
     function testIf() {
         _testIf();
     }
+    function testField() {
+        _testField();
+    }
+    function testCallMethod() {
+        _testCallMethod();
+    }
+    function testPrint() {
+        _testPrint();
+    }
+    function testMapExpression() {
+        _testMapExpression();
+    }
 }

src/test/cases/KissInterp2TestCase.kiss

@@ -1,9 +1,37 @@
+(defMacro assertEval [expected exp]
+	`(interp.evalCC ,exp ->v (Assert.equals ,expected v)))
+
 (function _testEvalGlobal []
 	(let [interp (new Interp)]
 		(dictSet interp.globals "a" 5)
-		(interp.evalCC "a" ->v (Assert.equals 5 v))))
+		(assertEval 5 "a")))
 
 (function _testIf []
 	(let [interp (new Interp)]
-		(interp.evalCC "(if true 5 3)" ->v (Assert.equals 5 v))
-		(interp.evalCC "(if false 5 3)" ->v (Assert.equals 3 v))))
+		(assertEval 5 "(if true 5 3)")
+		(assertEval 3 "(if false 5 3)")))
+
+(function _testField []
+	(let [interp (new Interp)]
+		(dictSet interp.globals "obj" (object a 5 b (object c 3)))
+		(assertEval 5 "obj.a")
+		(assertEval 3 "obj.b.c")))
+
+(function _testCallMethod []
+    (let [interp (new Interp)]
+		(dictSet interp.globals "f" ->[a b] (+ a b))
+		(dictSet interp.globals "o" (object f ->[a b] (- a b)))
+		(assertEval 2 "(f -1 3)")
+		(assertEval 2 "(o.f 5 3)")))
+
+(function _testPrint []
+	(let [interp (new Interp)]
+		(assertEval "testing" "(print \"testing\")")))
+
+                        
+(function _testMapExpression []
+	(let [interp (new Interp)]
+		(interp.evalCC #"[=>"4" 5 =>"6" 7]"# ->[:Map<String,Dynamic> mapVal] {
+			(Assert.equals 5 (dictGet mapVal "4"))
+			(Assert.equals 7 (dictGet mapVal "6"))
+		})))