aboutsummaryrefslogtreecommitdiff
path: root/luxc
diff options
context:
space:
mode:
Diffstat (limited to 'luxc')
-rw-r--r--luxc/src/lux/analyser.clj6
-rw-r--r--luxc/src/lux/analyser/lux.clj21
-rw-r--r--luxc/src/lux/compiler/js.clj11
-rw-r--r--luxc/src/lux/compiler/js/base.clj43
-rw-r--r--luxc/src/lux/compiler/js/lux.clj54
-rw-r--r--luxc/src/lux/compiler/js/rt.clj7
-rw-r--r--luxc/src/lux/compiler/jvm.clj2
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])))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 17:59:24 +0000