diff options
-rw-r--r-- | luxc/src/lux/analyser.clj | 6 | ||||
-rw-r--r-- | luxc/src/lux/analyser/proc/js.clj | 93 | ||||
-rw-r--r-- | luxc/src/lux/compiler/js.clj | 5 | ||||
-rw-r--r-- | luxc/src/lux/compiler/js/proc/host.clj | 86 | ||||
-rw-r--r-- | luxc/src/lux/compiler/js/rt.clj | 17 | ||||
-rw-r--r-- | luxc/src/lux/compiler/jvm/proc/host.clj | 1 | ||||
-rw-r--r-- | stdlib/source/lux/host.js.lux | 83 | ||||
-rw-r--r-- | stdlib/source/lux/host.jvm.lux (renamed from stdlib/source/lux/host.lux) | 0 | ||||
-rw-r--r-- | stdlib/test/test/lux/host.js.lux | 32 | ||||
-rw-r--r-- | stdlib/test/test/lux/host.jvm.lux (renamed from stdlib/test/test/lux/host.lux) | 0 |
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 |