- Implemented custom JS host procedures.

10 files changed, 317 insertions, 6 deletions

diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj
index 5f35d3c25..aaf441713 100644
--- a/luxc/src/lux/analyser.clj
+++ b/luxc/src/lux/analyser.clj
@@ -12,7 +12,8 @@
                           [module :as &&module]
                           [parser :as &&a-parser])
             (lux.analyser.proc [common :as &&common]
-                               [jvm :as &&jvm])))
+                               [jvm :as &&jvm]
+                               [js :as &&js])))
 
 ;; [Utils]
 (defn analyse-variant+ [analyse exo-type ident values]
@@ -136,7 +137,8 @@
               (case ?category
                 "jvm" (|do [_ &/jvm-host]
                         (&&jvm/analyse-host analyse exo-type compilers ?proc ?args))
-                ;; "js"
+                "js" (|do [_ &/js-host]
+                       (&&js/analyse-host analyse exo-type ?proc ?args))
                 ;; common
                 (&&common/analyse-proc analyse exo-type ?category ?proc ?args))
               ))
diff --git a/luxc/src/lux/analyser/proc/js.clj b/luxc/src/lux/analyser/proc/js.clj
new file mode 100644
index 000000000..2d36dd0d9
--- /dev/null
+++ b/luxc/src/lux/analyser/proc/js.clj
@@ -0,0 +1,93 @@
+(ns lux.analyser.proc.js
+  (:require (clojure [template :refer [do-template]]
+                     [string :as string])
+            clojure.core.match
+            clojure.core.match.array
+            (lux [base :as & :refer [|let |do return* return |case assert!]]
+                 [type :as &type])
+            (lux.analyser [base :as &&])))
+
+(do-template [<name> <proc>]
+  (defn <name> [analyse exo-type ?values]
+    (|do [:let [(&/$Cons ?function ?args) ?values]
+          =function (&&/analyse-1 analyse (&/$HostT "function" &/$Nil) ?function)
+          =args (&/map% (partial &&/analyse-1+ analyse) ?args)
+          _ (&type/check exo-type (&/$HostT "object" &/$Nil))
+          _cursor &/cursor]
+      (return (&/|list (&&/|meta exo-type _cursor
+                                 (&&/$proc (&/T ["js" <proc>]) (&/$Cons =function =args) (&/|list)))))))
+
+  ^:private analyse-js-new  "new"
+  ^:private analyse-js-call "call"
+  )
+
+(defn ^:private analyse-js-object-call [analyse exo-type ?values]
+  (|do [:let [(&/$Cons ?object (&/$Cons ?field ?args)) ?values]
+        =object (&&/analyse-1 analyse (&/$HostT "object" &/$Nil) ?object)
+        =field (&&/analyse-1 analyse &type/Text ?field)
+        =args (&/map% (partial &&/analyse-1+ analyse) ?args)
+        _ (&type/check exo-type (&/$HostT "object" &/$Nil))
+        _cursor &/cursor]
+    (return (&/|list (&&/|meta exo-type _cursor
+                               (&&/$proc (&/T ["js" "object-call"]) (&/$Cons =object (&/$Cons =field =args)) (&/|list)))))))
+
+(defn ^:private analyse-js-ref [analyse exo-type ?values]
+  (|do [:let [(&/$Cons [_ (&/$TextS ?ref-name)] (&/$Nil)) ?values]
+        _ (&type/check exo-type (&/$HostT "object" &/$Nil))
+        _cursor &/cursor]
+    (return (&/|list (&&/|meta exo-type _cursor
+                               (&&/$proc (&/T ["js" "ref"]) (&/|list) (&/|list ?ref-name)))))))
+
+(do-template [<name> <proc>]
+  (defn <name> [analyse exo-type ?values]
+    (|do [:let [(&/$Cons ?object (&/$Cons ?field (&/$Nil))) ?values]
+          =object (&&/analyse-1 analyse (&/$HostT "object" &/$Nil) ?object)
+          =field (&&/analyse-1 analyse &type/Text ?field)
+          _ (&type/check exo-type (&/$HostT "object" &/$Nil))
+          _cursor &/cursor]
+      (return (&/|list (&&/|meta exo-type _cursor
+                                 (&&/$proc (&/T ["js" <proc>]) (&/|list =object =field) (&/|list)))))))
+
+  ^:private analyse-js-get-field    "get-field"
+  ^:private analyse-js-delete-field "delete-field"
+  )
+
+(defn ^:private analyse-js-set-field [analyse exo-type ?values]
+  (|do [:let [(&/$Cons ?object (&/$Cons ?field (&/$Cons ?value (&/$Nil)))) ?values]
+        =object (&&/analyse-1 analyse (&/$HostT "object" &/$Nil) ?object)
+        =field (&&/analyse-1 analyse &type/Text ?field)
+        =value (&&/analyse-1+ analyse ?value)
+        _ (&type/check exo-type (&/$HostT "object" &/$Nil))
+        _cursor &/cursor]
+    (return (&/|list (&&/|meta exo-type _cursor
+                               (&&/$proc (&/T ["js" "set-field"]) (&/|list =object =field =value) (&/|list)))))))
+
+(do-template [<name> <proc> <type>]
+  (defn <name> [analyse exo-type ?values]
+    (|do [:let [(&/$Nil) ?values]
+          :let [output-type (&/$HostT <type> &/$Nil)]
+          _ (&type/check exo-type output-type)
+          _cursor &/cursor]
+      (return (&/|list (&&/|meta exo-type _cursor
+                                 (&&/$proc (&/T ["js" <proc>]) (&/|list) (&/|list)))))))
+
+  ^:private analyse-js-object    "object"    "object"
+  ^:private analyse-js-null      "null"      "object"
+  ^:private analyse-js-undefined "undefined" "undefined"
+  )
+
+(defn analyse-host [analyse exo-type proc ?values]
+  (case proc
+    "new"          (analyse-js-new analyse exo-type ?values)
+    "call"         (analyse-js-call analyse exo-type ?values)
+    "object-call"  (analyse-js-object-call analyse exo-type ?values)
+    "ref"          (analyse-js-ref analyse exo-type ?values)
+    "object"       (analyse-js-object analyse exo-type ?values)
+    "get-field"    (analyse-js-get-field analyse exo-type ?values)
+    "set-field"    (analyse-js-set-field analyse exo-type ?values)
+    "delete-field" (analyse-js-delete-field analyse exo-type ?values)
+    "null"         (analyse-js-null analyse exo-type ?values)
+    "undefined"    (analyse-js-undefined analyse exo-type ?values)
+    ;; else
+    (&/fail-with-loc (str "[Analyser Error] Unknown JS procedure: " proc)))
+  )
diff --git a/luxc/src/lux/compiler/js.clj b/luxc/src/lux/compiler/js.clj
index 4f0546bf0..1537bb7de 100644
--- a/luxc/src/lux/compiler/js.clj
+++ b/luxc/src/lux/compiler/js.clj
@@ -23,7 +23,8 @@
                              [lux :as &&lux]
                              [rt :as &&rt]
                              [cache :as &&js-cache])
-            (lux.compiler.js.proc [common :as &&common])
+            (lux.compiler.js.proc [common :as &&common]
+                                  [host :as &&host])
             )
   (:import (jdk.nashorn.api.scripting NashornScriptEngineFactory
                                       NashornScriptEngine
@@ -100,7 +101,7 @@
 
       (&o/$proc [?proc-category ?proc-name] ?args special-args)
       (case ?proc-category
-        ;; "js" ...
+        "js" (&&host/compile-proc compile-expression ?proc-name ?args special-args)
         ;; common
         (&&common/compile-proc compile-expression ?proc-category ?proc-name ?args special-args))
 
diff --git a/luxc/src/lux/compiler/js/proc/host.clj b/luxc/src/lux/compiler/js/proc/host.clj
new file mode 100644
index 000000000..3c0392a6b
--- /dev/null
+++ b/luxc/src/lux/compiler/js/proc/host.clj
@@ -0,0 +1,86 @@
+(ns lux.compiler.js.proc.host
+  (:require (clojure [template :refer [do-template]])
+            clojure.core.match
+            clojure.core.match.array
+            (lux [base :as & :refer [|do return* return |let |case]])))
+
+(defn ^:private compile-js-ref [compile ?values special-args]
+  (|do [:let [(&/$Cons ?name (&/$Nil)) special-args]]
+    (return ?name)))
+
+(defn ^:private compile-js-new [compile ?values special-args]
+  (|do [:let [(&/$Cons ?function ?args) ?values]
+        =function (compile ?function)
+        =args (&/map% compile ?args)]
+    (return (str "new (" =function ")("
+                 (->> =args
+                      (&/|interpose ",")
+                      (&/fold str ""))
+                 ")"))))
+
+(defn ^:private compile-js-call [compile ?values special-args]
+  (|do [:let [(&/$Cons ?function ?args) ?values]
+        =function (compile ?function)
+        =args (&/map% compile ?args)]
+    (return (str "(" =function ")("
+                 (->> =args
+                      (&/|interpose ",")
+                      (&/fold str ""))
+                 ")"))))
+
+(defn ^:private compile-js-object-call [compile ?values special-args]
+  (|do [:let [(&/$Cons ?object (&/$Cons ?field ?args)) ?values]
+        =object (compile ?object)
+        =field (compile ?field)
+        =args (&/map% compile ?args)]
+    (return (str "LuxRT." "jsObjectCall"
+                 "(" =object
+                 "," =field
+                 "," (str "[" (->> =args (&/|interpose ",") (&/fold str "")) "]")
+                 ")"))))
+
+(defn ^:private compile-js-object [compile ?values special-args]
+  (|do [:let [(&/$Nil) ?values]]
+    (return "{}")))
+
+(defn ^:private compile-js-get-field [compile ?values special-args]
+  (|do [:let [(&/$Cons ?object (&/$Cons ?field (&/$Nil))) ?values]
+        =object (compile ?object)
+        =field (compile ?field)]
+    (return (str "(" =object ")" "[" =field "]"))))
+
+(defn ^:private compile-js-set-field [compile ?values special-args]
+  (|do [:let [(&/$Cons ?object (&/$Cons ?field (&/$Cons ?input (&/$Nil)))) ?values]
+        =object (compile ?object)
+        =field (compile ?field)
+        =input (compile ?input)]
+    (return (str "LuxRT." "jsSetField" "(" =object "," =field "," =input ")"))))
+
+(defn ^:private compile-js-delete-field [compile ?values special-args]
+  (|do [:let [(&/$Cons ?object (&/$Cons ?field (&/$Nil))) ?values]
+        =object (compile ?object)
+        =field (compile ?field)]
+    (return (str "LuxRT." "jsDeleteField" "(" =object "," =field ")"))))
+
+(do-template [<name> <value>]
+  (defn <name> [compile ?values special-args]
+    (return <value>))
+
+  ^:private compile-js-null      "null"
+  ^:private compile-js-undefined "undefined"
+  )
+
+(defn compile-proc [compile proc-name ?values special-args]
+  (case proc-name
+    "new"             (compile-js-new compile ?values special-args)
+    "call"            (compile-js-call compile ?values special-args)
+    "object-call"     (compile-js-object-call compile ?values special-args)
+    "ref"             (compile-js-ref compile ?values special-args)
+    "object"          (compile-js-object compile ?values special-args)
+    "get-field"       (compile-js-get-field compile ?values special-args)
+    "set-field"       (compile-js-set-field compile ?values special-args)
+    "delete-field"    (compile-js-delete-field compile ?values special-args)
+    "null"            (compile-js-null compile ?values special-args)
+    "undefined"       (compile-js-undefined compile ?values special-args)
+    ;; else
+    (&/fail-with-loc (str "[Compiler Error] Unknown host procedure: " ["js" proc-name]))))
diff --git a/luxc/src/lux/compiler/js/rt.clj b/luxc/src/lux/compiler/js/rt.clj
index c2b3cba01..cdd83883d 100644
--- a/luxc/src/lux/compiler/js/rt.clj
+++ b/luxc/src/lux/compiler/js/rt.clj
@@ -755,6 +755,20 @@
                       "})")
    })
 
+(def ^:private js-methods
+  {"jsSetField" (str "(function jsSetField(object, field, input) {"
+                     "object[field] = input;"
+                     "return object;"
+                     "})")
+   "jsDeleteField" (str "(function jsDeleteField(object, field) {"
+                        "delete object[field];"
+                        "return object;"
+                        "})")
+   "jsObjectCall" (str "(function jsObjectCall(object, method, args) {"
+                       "return object[method].apply(object, args);"
+                       "})")
+   })
+
 (def LuxRT "LuxRT")
 
 (def compile-LuxRT
@@ -766,7 +780,8 @@
                                              text-methods
                                              array-methods
                                              bit-methods
-                                             io-methods)
+                                             io-methods
+                                             js-methods)
                                       (map (fn [[key val]]
                                              (str key ":" val)))
                                       (interpose ",")
diff --git a/luxc/src/lux/compiler/jvm/proc/host.clj b/luxc/src/lux/compiler/jvm/proc/host.clj
index 0e299f123..365a26937 100644
--- a/luxc/src/lux/compiler/jvm/proc/host.clj
+++ b/luxc/src/lux/compiler/jvm/proc/host.clj
@@ -1042,7 +1042,6 @@
     (return nil)))
 
 (defn compile-proc [compile proc-name ?values special-args]
-  "jvm"
   (case proc-name
     "synchronized"    (compile-jvm-synchronized compile ?values special-args)
     "load-class"      (compile-jvm-load-class compile ?values special-args)
diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux
new file mode 100644
index 000000000..f935dc8d6
--- /dev/null
+++ b/stdlib/source/lux/host.js.lux
@@ -0,0 +1,83 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data (coll [list #* "L/" Fold<List>]))
+       [compiler #+ with-gensyms]
+       (macro [ast]
+              ["s" syntax #+ syntax: Syntax])
+       ))
+
+(do-template [<name> <type>]
+  [(type: #export <name> (#;HostT <type> #;Nil))]
+
+  [Object    "object"]
+  [Function  "function"]
+  [Symbol    "symbol"]
+  [Undefined "undefined"]
+  )
+
+(do-template [<name> <type>]
+  [(type: #export <name> <type>)]
+
+  [String  Text]
+  [Number  Real]
+  [Boolean Bool]
+  )
+
+## [Syntax]
+(syntax: #export (set! field-name field-value object)
+  {#;doc (doc "A way to set fields from objects."
+              (set! "foo" 1234 some-object))}
+  (wrap (list (` (;_lux_proc ["js" "set-field"] [(~ object) (~ field-name) (~ field-value)])))))
+
+(syntax: #export (delete! field-name object)
+  {#;doc (doc "A way to delete fields from objects."
+              (delete! "foo" some-object))}
+  (wrap (list (` (;_lux_proc ["js" "delete-field"] [(~ object) (~ field-name)])))))
+
+(syntax: #export (get field-name type object)
+  {#;doc (doc "A way to get fields from objects."
+              (get "ceil" (ref "Math"))
+              (get "ceil" (-> Real Real) (ref "Math")))}
+  (wrap (list (` (:! (~ type)
+                     (;_lux_proc ["js" "get-field"] [(~ object) (~ field-name)]))))))
+
+(syntax: #export (object [kvs (s;some (s;seq s;any s;any))])
+  {#;doc (doc "A way to create JavaScript objects."
+              (object)
+              (object "foo" foo "bar" (inc bar)))}
+  (wrap (list (L/fold (lambda [[k v] object]
+                        (` (set! (~ k) (~ v) (~ object))))
+                      (` (;_lux_proc ["js" "object"] []))
+                      kvs))))
+
+(syntax: #export (ref [name s;text] [type (s;opt s;any)])
+  {#;doc (doc "A way to refer to JavaScript variables."
+              (ref "document")
+              (ref "Math.ceil" (-> Real Real)))}
+  (wrap (list (` (:! (~ (default (' ;;Object) type))
+                     (;_lux_proc ["js" "ref"] [(~ (ast;text name))]))))))
+
+(do-template [<name> <proc> <doc>]
+  [(syntax: #export (<name>)
+     {#;doc (doc <doc>
+                 (<name>))}
+     (wrap (list (` (;_lux_proc ["js" <proc>] [])))))]
+
+  [null  "null"      "Null object reference."]
+  [undef "undefined" "Undefined."]
+  )
+
+(syntax: #export (call! [shape (s;alt ($_ s;seq s;any (s;tuple (s;some s;any)) (s;opt s;any))
+                                      ($_ s;seq s;any s;text (s;tuple (s;some s;any)) (s;opt s;any)))])
+  {#;doc (doc "A way to call JavaScript functions and methods."
+              (call! (ref "Math.ceil") [123.45])
+              (call! (ref "Math") "ceil" [123.45]))}
+  (case shape
+    (#;Left [function args ?type])
+    (wrap (list (` (:! (~ (default (' ;;Object) ?type))
+                       (;_lux_proc ["js" "call"] [(~ function) (~@ args)])))))
+    
+    (#;Right [object field args ?type])
+    (wrap (list (` (:! (~ (default (' ;;Object) ?type))
+                       (;_lux_proc ["js" "object-call"] [(~ object) (~ (ast;text field)) (~@ args)])))))))
diff --git a/stdlib/source/lux/host.lux b/stdlib/source/lux/host.jvm.lux
index 41d567165..41d567165 100644
--- a/stdlib/source/lux/host.lux
+++ b/stdlib/source/lux/host.jvm.lux
diff --git a/stdlib/test/test/lux/host.js.lux b/stdlib/test/test/lux/host.js.lux
new file mode 100644
index 000000000..4c2b55485
--- /dev/null
+++ b/stdlib/test/test/lux/host.js.lux
@@ -0,0 +1,32 @@
+(;module:
+  lux
+  (lux [io]
+       (control monad)
+       (data text/format)
+       ["&" host]
+       ["R" random]
+       pipe)
+  lux/test)
+
+(test: "JavaScript operations"
+  ($_ seq
+      (assert "Null equals itself."
+              (is (&;null) (&;null)))
+
+      (assert "Undefined equals itself."
+              (is (&;undef) (&;undef)))
+
+      (assert "Can reference JavaScript objects."
+              (is (&;ref "Math") (&;ref "Math")))
+
+      (assert "Can create objects and access their fields."
+              (|> (&;object "foo" "BAR")
+                  (&;get "foo" Text)
+                  (is "BAR")))
+
+      (assert "Can call JavaScript functions"
+              (and (is 124.0
+                       (&;call! (&;ref "Math.ceil" &;Function) [123.45] Real))
+                   (is 124.0
+                       (&;call! (&;ref "Math") "ceil" [123.45] Real))))
+      ))
diff --git a/stdlib/test/test/lux/host.lux b/stdlib/test/test/lux/host.jvm.lux
index 54e6cf4b9..54e6cf4b9 100644
--- a/stdlib/test/test/lux/host.lux
+++ b/stdlib/test/test/lux/host.jvm.lux