From 6f554dc5a4172cd2afd7bde30b5edcaf0266f63d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 15 Mar 2017 00:04:09 -0400 Subject: - Implemented custom JS host procedures. --- luxc/src/lux/analyser.clj | 6 ++- luxc/src/lux/analyser/proc/js.clj | 93 +++++++++++++++++++++++++++++++++ luxc/src/lux/compiler/js.clj | 5 +- luxc/src/lux/compiler/js/proc/host.clj | 86 ++++++++++++++++++++++++++++++ luxc/src/lux/compiler/js/rt.clj | 17 +++++- luxc/src/lux/compiler/jvm/proc/host.clj | 1 - 6 files changed, 202 insertions(+), 6 deletions(-) create mode 100644 luxc/src/lux/analyser/proc/js.clj create mode 100644 luxc/src/lux/compiler/js/proc/host.clj (limited to 'luxc/src') 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 [ ] + (defn [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" ]) (&/$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 [ ] + (defn [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" ]) (&/|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 [ ] + (defn [analyse exo-type ?values] + (|do [:let [(&/$Nil) ?values] + :let [output-type (&/$HostT &/$Nil)] + _ (&type/check exo-type output-type) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["js" ]) (&/|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 [ ] + (defn [compile ?values special-args] + (return )) + + ^: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) -- cgit v1.2.3