- Improved conversions to/from JS.

- Improved macro calls.
- Improved pattern-matching.

7 files changed, 74 insertions, 70 deletions

diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj
index d895b1aaa..b611c1f80 100644
--- a/luxc/src/lux/analyser.clj
+++ b/luxc/src/lux/analyser.clj
@@ -61,7 +61,7 @@
          [cursor token] ?token
          compile-def (aget compilers 0)
          compile-program (aget compilers 1)
-         macro-wrapper (aget compilers 2)]
+         macro-caller (aget compilers 2)]
     (|case token
       ;; Standard special forms
       (&/$BoolS ?value)
@@ -172,7 +172,7 @@
           ;; else
           (&/with-cursor cursor
             (|do [=fn (just-analyse analyse (&/T [command-meta command]))]
-              (&&lux/analyse-apply analyse cursor exo-type macro-wrapper =fn parameters))))
+              (&&lux/analyse-apply analyse cursor exo-type macro-caller =fn parameters))))
 
         (&/$NatS idx)
         (&/with-analysis-meta cursor exo-type
@@ -185,7 +185,7 @@
         _
         (&/with-cursor cursor
           (|do [=fn (just-analyse analyse (&/T [command-meta command]))]
-            (&&lux/analyse-apply analyse cursor exo-type macro-wrapper =fn parameters))))
+            (&&lux/analyse-apply analyse cursor exo-type macro-caller =fn parameters))))
       
       _
       (&/fail-with-loc (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T [(&/T ["" -1 -1]) token])))))
diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj
index b990b738c..af7f0f3f9 100644
--- a/luxc/src/lux/analyser/lux.clj
+++ b/luxc/src/lux/analyser/lux.clj
@@ -375,7 +375,7 @@
                                (&&/$apply =fn =args)
                                )))))
 
-(defn analyse-apply [analyse cursor exo-type macro-wrapper =fn ?args]
+(defn analyse-apply [analyse cursor exo-type macro-caller =fn ?args]
   (|do [loader &/loader
         :let [[[=fn-type =fn-cursor] =fn-form] =fn]]
     (|case =fn-form
@@ -384,25 +384,18 @@
         (|case (&&meta/meta-get &&meta/macro?-tag ?meta)
           (&/$Some _)
           (|do [macro-expansion (fn [state]
-                                  (|case ((macro-wrapper ?value) ?args state)
+                                  (|case (macro-caller ?value ?args state)
                                     (&/$Right state* output)
                                     (&/$Right (&/T [state* output]))
 
                                     (&/$Left error)
                                     ((&/fail-with-loc error) state)))
-                module-name &/get-module-name
+                ;; module-name &/get-module-name
                 ;; :let [[r-prefix r-name] real-name
-                ;;       _ (when (or (= "actor:" r-name)
-                ;;                   ;; (= "|Codec@Json|" r-name)
-                ;;                   ;; (= "|Codec@Json//encode|" r-name)
-                ;;                   ;; (= "|Codec@Json//decode|" r-name)
-                ;;                   ;; (= "derived:" r-name)
-                ;;                   )
-                ;;           (->> (&/|map &/show-ast macro-expansion)
-                ;;                (&/|interpose "\n")
-                ;;                (&/fold str "")
-                ;;                (prn (&/ident->text real-name) module-name)))
-                ;;       ]
+                ;;       _ (->> (&/|map &/show-ast macro-expansion)
+                ;;              (&/|interpose "\n")
+                ;;              (&/fold str "")
+                ;;              (println 'macro-expansion (&/ident->text real-name) "@" module-name))]
                 ]
             (&/flat-map% (partial analyse exo-type) macro-expansion))
 
diff --git a/luxc/src/lux/compiler/js.clj b/luxc/src/lux/compiler/js.clj
index 6334b1d9a..8901bc154 100644
--- a/luxc/src/lux/compiler/js.clj
+++ b/luxc/src/lux/compiler/js.clj
@@ -102,7 +102,7 @@
       ;; (&&host/compile-host compile-expression ?proc-category ?proc-name ?args special-args)
 
       _
-      (assert false (prn-str 'JS=compile-expression| (&/adt->text syntax))))
+      (assert false (prn-str 'JS=compile-expression (&/adt->text syntax))))
     ))
 
 (defn init!
@@ -119,12 +119,9 @@
 (def all-compilers
   (&/T [(partial &&lux/compile-def compile-expression)
         (partial &&lux/compile-program compile-expression)
-        (fn [^ScriptObjectMirror macro]
-          (fn [args state]
-            (let [output (.call macro nil (to-array [(&&/wrap-lux-obj args)
-                                                     (&&/wrap-lux-obj state)]))]
-              (do (prn 'output output)
-                (assert false "Got macros?")))))]))
+        (fn [^ScriptObjectMirror macro args state]
+          (&&/js-to-lux (.call macro nil (to-array [(&&/wrap-lux-obj args)
+                                                    (&&/wrap-lux-obj state)]))))]))
 
 (defn compile-module [source-dirs name]
   (let [file-name (str name ".lux")]
diff --git a/luxc/src/lux/compiler/js/base.clj b/luxc/src/lux/compiler/js/base.clj
index d3746f01c..f89bbb9a2 100644
--- a/luxc/src/lux/compiler/js/base.clj
+++ b/luxc/src/lux/compiler/js/base.clj
@@ -50,7 +50,6 @@
   (reify JSObject
     (isFunction [self] true)
     (call [self this args]
-      (prn '_slice_ (seq args))
       (let [slice (java.util.Arrays/copyOfRange value (aget args 0) (alength value))]
         (wrap-lux-obj slice)))))
 
@@ -62,31 +61,41 @@
       ;; (pr-str this)
       )))
 
+(deftype LuxJsObject [obj]
+  JSObject
+  (isFunction [self] false)
+  (getSlot [self idx]
+    (let [value (aget obj idx)]
+      (if (instance? lux-obj-class value)
+        (new LuxJsObject value)
+        value)))
+  (getMember [self member]
+    (condp = member
+      ;; "valueOf" (_valueOf_ obj)
+      "toString" (_toString_ obj)
+      "length" (alength obj)
+      "slice" (let [wrap-lux-obj #(if (instance? lux-obj-class %)
+                                    (new LuxJsObject %)
+                                    %)]
+                (_slice_ wrap-lux-obj obj))
+      ;; else
+      (assert false (str "wrap-lux-obj#getMember = " member)))))
+
 (defn wrap-lux-obj [obj]
   (if (instance? lux-obj-class obj)
-    (reify JSObject
-      (isFunction [self] false)
-      (getSlot [self idx]
-        (wrap-lux-obj (aget obj idx)))
-      (getMember [self member]
-        (condp = member
-          ;; "valueOf" (_valueOf_ obj)
-          "toString" (_toString_ obj)
-          "length" (alength obj)
-          "slice" (_slice_ wrap-lux-obj obj)
-          ;; else
-          (assert false (str "member = " member)))))
+    (new LuxJsObject obj)
     obj))
 
 (defn js-to-lux [js-object]
-  (cond (instance? java.lang.Integer js-object)
-        (long js-object)
-
-        (or (nil? js-object)
+  (cond (or (nil? js-object)
             (instance? java.lang.Boolean js-object)
+            (instance? java.lang.Integer js-object)
             (instance? java.lang.String js-object))
         js-object
 
+        (instance? LuxJsObject js-object)
+        (.-obj ^LuxJsObject js-object)
+
         ;; (instance? Undefined js-object)
         ;; (assert false "UNDEFINED")
 
diff --git a/luxc/src/lux/compiler/js/lux.clj b/luxc/src/lux/compiler/js/lux.clj
index fe45350b5..3324a83c7 100644
--- a/luxc/src/lux/compiler/js/lux.clj
+++ b/luxc/src/lux/compiler/js/lux.clj
@@ -176,13 +176,14 @@
 ;;               _ (.visitLabel *writer* $end)]]
 ;;     (return nil)))
 
-(def ^:private original "pm_stack_original")
-(def ^:private stack "pm_stack")
-(defn ^:private stack-push [value]
-  (str stack ".push(" value ");"))
-(def ^:private stack-init (str stack " = " original ".slice();"))
-(def ^:private stack-peek (str stack "[" stack ".length - 1]"))
-(def ^:private stack-pop (str stack ".pop();"))
+(def ^:private savepoint "pm_cursor_savepoint")
+(def ^:private cursor "pm_cursor")
+(defn ^:private cursor-push [value]
+  (str cursor ".push(" value ");"))
+(def ^:private cursor-save (str savepoint ".push(" cursor ".slice());"))
+(def ^:private cursor-restore (str cursor " = " savepoint ".pop();"))
+(def ^:private cursor-peek (str cursor "[" cursor ".length - 1]"))
+(def ^:private cursor-pop (str cursor ".pop();"))
 (def ^:private pm-error (.intern (pr-str (str (char 0) "PM-ERROR" (char 0)))))
 (def ^:private pm-fail (str "throw " pm-error ";"))
 
@@ -199,32 +200,32 @@
       (assert false))
 
     (&o/$PopPM)
-    (return stack-pop)
+    (return cursor-pop)
 
     (&o/$BindPM _register)
-    (return (str "var " (register-name _register) " = " stack-peek ";"
-                 stack-pop))
+    (return (str "var " (register-name _register) " = " cursor-peek ";"
+                 cursor-pop))
 
     (&o/$BoolPM _value)
-    (return (str "if(" stack-peek "!== " _value ") { " pm-fail " }"))
+    (return (str "if(" cursor-peek " !== " _value ") { " pm-fail " }"))
 
     (&o/$NatPM _value)
-    (return (str "if(" stack-peek "!== " _value ") { " pm-fail " }"))
+    (return (str "if(" cursor-peek " !== " _value ") { " pm-fail " }"))
 
     (&o/$IntPM _value)
-    (return (str "if(" stack-peek "!== " _value ") { " pm-fail " }"))
+    (return (str "if(" cursor-peek " !== " _value ") { " pm-fail " }"))
 
     (&o/$DegPM _value)
-    (return (str "if(" stack-peek "!== " _value ") { " pm-fail " }"))
+    (return (str "if(" cursor-peek " !== " _value ") { " pm-fail " }"))
 
     (&o/$RealPM _value)
-    (return (str "if(" stack-peek "!== " _value ") { " pm-fail " }"))
+    (return (str "if(" cursor-peek " !== " _value ") { " pm-fail " }"))
 
     (&o/$CharPM _value)
-    (return (str "if(" stack-peek "!== \"" _value "\") { " pm-fail " }"))
+    (return (str "if(" cursor-peek " !== " (pr-str (str _value)) ") { " pm-fail " }"))
 
     (&o/$TextPM _value)
-    (return (str "if(" stack-peek "!== \"" _value "\") { " pm-fail " }"))
+    (return (str "if(" cursor-peek " !== " (pr-str _value) ") { " pm-fail " }"))
 
     (&o/$TuplePM _idx+)
     (|let [[_idx is-tail?] (|case _idx+
@@ -234,7 +235,7 @@
                              (&/$Right _idx)
                              (&/T [_idx true]))
            getter (if is-tail? "product_getRight" "product_getLeft")]
-      (return (str (stack-push (str &&rt/LuxRT "." getter "(" stack-peek "," _idx ")")))))
+      (return (str (cursor-push (str &&rt/LuxRT "." getter "(" cursor-peek "," _idx ")")))))
 
     (&o/$VariantPM _idx+)
     (|let [[_idx is-last] (|case _idx+
@@ -243,10 +244,10 @@
 
                             (&/$Right _idx)
                             (&/T [_idx true]))
-           temp-assignment (str "temp = " &&rt/LuxRT "." "sum_get(" stack-peek "," _idx "," (if is-last "\"\"" "null") ");")]
+           temp-assignment (str "temp = " &&rt/LuxRT "." "sum_get(" cursor-peek "," _idx "," (if is-last "\"\"" "null") ");")]
       (return (str temp-assignment
-                   (str "if(temp) {"
-                        (stack-push "temp")
+                   (str "if(temp !== null) {"
+                        (cursor-push "temp")
                         "}"
                         "else {"
                         pm-fail
@@ -260,10 +261,13 @@
     (&o/$AltPM _left-pm _right-pm)
     (|do [=left (compile-pm* compile _left-pm bodies)
           =right (compile-pm* compile _right-pm bodies)]
-      (return (str "try {" =left "}"
+      (return (str "try {"
+                   cursor-save
+                   =left
+                   "}"
                    "catch(ex) {"
                    "if(ex === " pm-error ") {"
-                   stack-init
+                   cursor-restore
                    =right
                    "}"
                    "else {"
@@ -291,8 +295,8 @@
     (return (str "(function() {"
                  "\"use strict\";"
                  "var temp;"
-                 "var " original " = [" =value "];"
-                 "var " stack-init
+                 "var " cursor " = [" =value "];"
+                 "var " savepoint " = [];"
                  =pm
                  "})()"))))
 
diff --git a/luxc/src/lux/compiler/js/rt.clj b/luxc/src/lux/compiler/js/rt.clj
index c54c9debf..3c9186a1e 100644
--- a/luxc/src/lux/compiler/js/rt.clj
+++ b/luxc/src/lux/compiler/js/rt.clj
@@ -973,12 +973,13 @@
                  ;; Must recurse.
                  "return sum_get(sum[2], (wantedTag - sum[0]), wantsLast);"
                  "}"
-                 ;; Not match.
+                 ;; No match.
                  "else { return null; }"
                  "}"
-                 ;; Not match.
+                 ;; No match.
                  "else { return null; }"
-                 "})")})
+                 "})")
+   })
 
 (def LuxRT "LuxRT")
 
diff --git a/luxc/src/lux/compiler/jvm.clj b/luxc/src/lux/compiler/jvm.clj
index a5c5ee210..5dac1fbbc 100644
--- a/luxc/src/lux/compiler/jvm.clj
+++ b/luxc/src/lux/compiler/jvm.clj
@@ -161,7 +161,7 @@
   (let [compile-expression* (partial compile-expression nil)]
     (&/T [(partial &&lux/compile-def compile-expression)
           (partial &&lux/compile-program compile-expression*)
-          (fn [macro] (fn [args state] (-> macro (.apply args) (.apply state))))
+          (fn [macro args state] (-> macro (.apply args) (.apply state)))
           (partial &&host/compile-jvm-class compile-expression*)
           &&host/compile-jvm-interface])))