diff --git a/src/kiss/KissInterp2.hx b/src/kiss/KissInterp2.hx index 239d2bb..15a2ddc 100644 --- a/src/kiss/KissInterp2.hx +++ b/src/kiss/KissInterp2.hx @@ -23,7 +23,7 @@ class KissInterp2 { kind: FFun({ args: [], expr: macro { - + specialForms = _specialForms(); } }) }); diff --git a/src/kiss/KissInterp2.kiss b/src/kiss/KissInterp2.kiss index 13bac48..9fd9cb6 100644 --- a/src/kiss/KissInterp2.kiss +++ b/src/kiss/KissInterp2.kiss @@ -2,6 +2,7 @@ (import kiss.Reader) (import kiss.Reader.ReadFunction) (import kiss.Reader.ReadTable) +(import kiss.ReaderExp) (import kiss.ReaderExp.ReaderExpDef) (import kiss.Stream) @@ -11,9 +12,26 @@ (prop &mut :ReadTable endOfFileReadTable (new Map)) (prop &mut :Map identAliases (new Map)) -(prop :Map globals (new Map)) +(prop :Map globals [=>"false" false =>"true" true =>"null" null]) +(prop :Array> localScopes []) + +(prop :Map,Dynamic->Void)->Void> specialForms) + +(method :Map,Dynamic->Void)->Void> _specialForms [] [ + =>"if" + ->[args cc] + (evalCC (first ~args) + ->val + (if val + (evalCC (second args) cc) + (evalCC (third args) cc))) +]) (method :Void evalCC [:Dynamic input :Dynamic->Void cc] + // Std.isOfType can't handle typedefs + (when (and (Reflect.hasField input "pos") (Reflect.hasField input "def")) + (evalCC input.def cc) + (return)) (typeCase [input] ([:String str] (let [stream (Stream.fromString str)] @@ -24,7 +42,19 @@ (throw "Couldn't read valid expression from $s"))) ([:ReaderExpDef def] (case def + ((when (specialForms.exists form) (CallExp (object def (Symbol form)) args)) + ((dictGet specialForms form) args cc)) ((Symbol ident) + // Check for numbers + (let [f (Std.parseFloat ident)] + (unless (Math.isNaN f) + (cc f) + (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 ${input}")))) \ No newline at end of file diff --git a/src/test/cases/KissInterp2TestCase.hx b/src/test/cases/KissInterp2TestCase.hx index 66288f3..40642e4 100644 --- a/src/test/cases/KissInterp2TestCase.hx +++ b/src/test/cases/KissInterp2TestCase.hx @@ -16,4 +16,7 @@ class KissInterp2TestCase extends Test { function testEvalGlobal() { _testEvalGlobal(); } + function testIf() { + _testIf(); + } } \ No newline at end of file diff --git a/src/test/cases/KissInterp2TestCase.kiss b/src/test/cases/KissInterp2TestCase.kiss index d95ec04..660d008 100644 --- a/src/test/cases/KissInterp2TestCase.kiss +++ b/src/test/cases/KissInterp2TestCase.kiss @@ -1,4 +1,9 @@ (function _testEvalGlobal [] (let [interp (new Interp)] (dictSet interp.globals "a" 5) - (interp.evalCC "a" ->v (Assert.equals 5 v)))) \ No newline at end of file + (interp.evalCC "a" ->v (Assert.equals 5 v)))) + +(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)))) \ No newline at end of file