From 8cd810a5df994d9bcef8d34605c1ac98900211e6 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 2 Feb 2017 19:18:26 -0400 Subject: - Improved conversions to/from JS. - Improved macro calls. - Improved pattern-matching. --- luxc/src/lux/analyser.clj | 6 ++--- luxc/src/lux/analyser/lux.clj | 21 +++++---------- luxc/src/lux/compiler/js.clj | 11 +++----- luxc/src/lux/compiler/js/base.clj | 43 +++++++++++++++++++------------ luxc/src/lux/compiler/js/lux.clj | 54 +++++++++++++++++++++------------------ luxc/src/lux/compiler/js/rt.clj | 7 ++--- luxc/src/lux/compiler/jvm.clj | 2 +- 7 files changed, 74 insertions(+), 70 deletions(-) (limited to 'luxc') 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]))) -- cgit v1.2.3