aboutsummaryrefslogtreecommitdiff
path: root/luxc
diff options
context:
space:
mode:
Diffstat (limited to 'luxc')
-rw-r--r--luxc/src/lux/analyser.clj13
-rw-r--r--luxc/src/lux/analyser/proc/common.clj (renamed from luxc/src/lux/analyser/proc.clj)133
-rw-r--r--luxc/src/lux/analyser/proc/jvm.clj (renamed from luxc/src/lux/analyser/jvm.clj)568
-rw-r--r--luxc/src/lux/base.clj10
-rw-r--r--luxc/src/lux/compiler/js.clj14
-rw-r--r--luxc/src/lux/compiler/js/base.clj56
-rw-r--r--luxc/src/lux/compiler/js/lux.clj6
-rw-r--r--luxc/src/lux/compiler/js/proc/common.clj (renamed from luxc/src/lux/compiler/js/proc.clj)83
-rw-r--r--luxc/src/lux/compiler/js/rt.clj173
-rw-r--r--luxc/src/lux/type.clj16
10 files changed, 465 insertions, 607 deletions
diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj
index 977911c28..f5a200cad 100644
--- a/luxc/src/lux/analyser.clj
+++ b/luxc/src/lux/analyser.clj
@@ -9,10 +9,10 @@
[host :as &host])
(lux.analyser [base :as &&]
[lux :as &&lux]
- [jvm :as &&jvm]
- [proc :as &&proc]
[module :as &&module]
- [parser :as &&a-parser])))
+ [parser :as &&a-parser])
+ (lux.analyser.proc [common :as &&common]
+ [jvm :as &&jvm])))
;; [Utils]
(defn analyse-variant+ [analyse exo-type ident values]
@@ -133,8 +133,11 @@
(&/$Cons [_ (&/$TupleS ?args)]
(&/$Nil))) parameters]
(&/with-analysis-meta cursor exo-type
- (&&jvm/analyse-host analyse exo-type compilers ?category ?proc ?args)
- ;; (&&proc/analyse-proc analyse exo-type ?category ?proc ?args)
+ (case ?category
+ "jvm" (&&jvm/analyse-host analyse exo-type compilers ?category ?proc ?args)
+ ;; "js"
+ ;; common
+ (&&common/analyse-proc analyse exo-type ?category ?proc ?args))
))
"_lux_:"
diff --git a/luxc/src/lux/analyser/proc.clj b/luxc/src/lux/analyser/proc/common.clj
index a71a1a9e5..f6d1eef8e 100644
--- a/luxc/src/lux/analyser/proc.clj
+++ b/luxc/src/lux/analyser/proc/common.clj
@@ -1,4 +1,4 @@
-(ns lux.analyser.proc
+(ns lux.analyser.proc.common
(:require (clojure [template :refer [do-template]])
clojure.core.match
clojure.core.match.array
@@ -31,43 +31,43 @@
^:private analyse-text-append ["text" "append"] &type/Text &type/Text
)
-;; (do-template [<name> <op>]
-;; (defn <name> [analyse exo-type ?values]
-;; (|do [:let [(&/$Cons input (&/$Cons mask (&/$Nil))) ?values]
-;; =mask (&&/analyse-1 analyse &type/Nat mask)
-;; =input (&&/analyse-1 analyse &type/Nat input)
-;; _ (&type/check exo-type &type/Nat)
-;; _cursor &/cursor]
-;; (return (&/|list (&&/|meta exo-type _cursor
-;; (&&/$proc (&/T ["bit" <op>]) (&/|list =input =mask) (&/|list)))))))
-
-;; ^:private analyse-bit-and "and"
-;; ^:private analyse-bit-or "or"
-;; ^:private analyse-bit-xor "xor"
-;; )
-
-;; (defn ^:private analyse-bit-count [analyse exo-type ?values]
-;; (|do [:let [(&/$Cons input (&/$Nil)) ?values]
-;; =input (&&/analyse-1 analyse &type/Nat input)
-;; _ (&type/check exo-type &type/Nat)
-;; _cursor &/cursor]
-;; (return (&/|list (&&/|meta exo-type _cursor
-;; (&&/$proc (&/T ["bit" "count"]) (&/|list =input) (&/|list)))))))
-
-;; (do-template [<name> <op> <type>]
-;; (defn <name> [analyse exo-type ?values]
-;; (|do [:let [(&/$Cons input (&/$Cons shift (&/$Nil))) ?values]
-;; =shift (&&/analyse-1 analyse &type/Nat shift)
-;; =input (&&/analyse-1 analyse <type> input)
-;; _ (&type/check exo-type <type>)
-;; _cursor &/cursor]
-;; (return (&/|list (&&/|meta exo-type _cursor
-;; (&&/$proc (&/T ["bit" <op>]) (&/|list =input =shift) (&/|list)))))))
-
-;; ^:private analyse-bit-shift-left "shift-left" &type/Nat
-;; ^:private analyse-bit-shift-right "shift-right" &type/Int
-;; ^:private analyse-bit-unsigned-shift-right "unsigned-shift-right" &type/Nat
-;; )
+(do-template [<name> <op>]
+ (defn <name> [analyse exo-type ?values]
+ (|do [:let [(&/$Cons input (&/$Cons mask (&/$Nil))) ?values]
+ =mask (&&/analyse-1 analyse &type/Nat mask)
+ =input (&&/analyse-1 analyse &type/Nat input)
+ _ (&type/check exo-type &type/Nat)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$proc (&/T ["bit" <op>]) (&/|list =input =mask) (&/|list)))))))
+
+ ^:private analyse-bit-and "and"
+ ^:private analyse-bit-or "or"
+ ^:private analyse-bit-xor "xor"
+ )
+
+(defn ^:private analyse-bit-count [analyse exo-type ?values]
+ (|do [:let [(&/$Cons input (&/$Nil)) ?values]
+ =input (&&/analyse-1 analyse &type/Nat input)
+ _ (&type/check exo-type &type/Nat)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$proc (&/T ["bit" "count"]) (&/|list =input) (&/|list)))))))
+
+(do-template [<name> <op> <type>]
+ (defn <name> [analyse exo-type ?values]
+ (|do [:let [(&/$Cons input (&/$Cons shift (&/$Nil))) ?values]
+ =shift (&&/analyse-1 analyse &type/Nat shift)
+ =input (&&/analyse-1 analyse <type> input)
+ _ (&type/check exo-type <type>)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$proc (&/T ["bit" <op>]) (&/|list =input =shift) (&/|list)))))))
+
+ ^:private analyse-bit-shift-left "shift-left" &type/Nat
+ ^:private analyse-bit-shift-right "shift-right" &type/Int
+ ^:private analyse-bit-unsigned-shift-right "unsigned-shift-right" &type/Nat
+ )
(do-template [<name> <proc> <input-type> <output-type>]
(defn <name> [analyse exo-type ?values]
@@ -161,6 +161,9 @@
^:private analyse-deg-min-value &type/Deg ["deg" "min-value"]
^:private analyse-deg-max-value &type/Deg ["deg" "max-value"]
+
+ ^:private analyse-real-min-value &type/Real ["real" "min-value"]
+ ^:private analyse-real-max-value &type/Real ["real" "max-value"]
)
(do-template [<name> <from-type> <to-type> <op>]
@@ -183,24 +186,24 @@
(defn analyse-proc [analyse exo-type category proc ?values]
(case category
- ;; "lux"
- ;; (case proc
- ;; "==" (analyse-lux-== analyse exo-type ?values))
+ "lux"
+ (case proc
+ "==" (analyse-lux-== analyse exo-type ?values))
"text"
(case proc
"=" (analyse-text-eq analyse exo-type ?values)
"append" (analyse-text-append analyse exo-type ?values))
- ;; "bit"
- ;; (case proc
- ;; "count" (analyse-bit-count analyse exo-type ?values)
- ;; "and" (analyse-bit-and analyse exo-type ?values)
- ;; "or" (analyse-bit-or analyse exo-type ?values)
- ;; "xor" (analyse-bit-xor analyse exo-type ?values)
- ;; "shift-left" (analyse-bit-shift-left analyse exo-type ?values)
- ;; "shift-right" (analyse-bit-shift-right analyse exo-type ?values)
- ;; "unsigned-shift-right" (analyse-bit-unsigned-shift-right analyse exo-type ?values))
+ "bit"
+ (case proc
+ "count" (analyse-bit-count analyse exo-type ?values)
+ "and" (analyse-bit-and analyse exo-type ?values)
+ "or" (analyse-bit-or analyse exo-type ?values)
+ "xor" (analyse-bit-xor analyse exo-type ?values)
+ "shift-left" (analyse-bit-shift-left analyse exo-type ?values)
+ "shift-right" (analyse-bit-shift-right analyse exo-type ?values)
+ "unsigned-shift-right" (analyse-bit-unsigned-shift-right analyse exo-type ?values))
;; "array"
;; (case proc
@@ -208,7 +211,7 @@
;; "get" (analyse-array-get analyse exo-type ?values)
;; "put" (analyse-jvm-aastore analyse exo-type ?values)
;; "remove" (analyse-array-remove analyse exo-type ?values)
- ;; "size" (analyse-jvm-arraylength analyse exo-type ?values))
+ ;; "size" (analyse-array-size analyse exo-type ?values))
"nat"
(case proc
@@ -252,12 +255,12 @@
"%" (analyse-deg-rem analyse exo-type ?values)
"=" (analyse-deg-eq analyse exo-type ?values)
"<" (analyse-deg-lt analyse exo-type ?values)
- ;; "encode" (analyse-deg-encode analyse exo-type ?values)
- ;; "decode" (analyse-deg-decode analyse exo-type ?values)
- ;; "min-value" (analyse-deg-min-value analyse exo-type ?values)
- ;; "max-value" (analyse-deg-max-value analyse exo-type ?values)
- ;; "to-real" (analyse-deg-to-real analyse exo-type ?values)
- ;; "scale" (analyse-deg-scale analyse exo-type ?values)
+ "encode" (analyse-deg-encode analyse exo-type ?values)
+ "decode" (analyse-deg-decode analyse exo-type ?values)
+ "min-value" (analyse-deg-min-value analyse exo-type ?values)
+ "max-value" (analyse-deg-max-value analyse exo-type ?values)
+ "to-real" (analyse-deg-to-real analyse exo-type ?values)
+ "scale" (analyse-deg-scale analyse exo-type ?values)
)
"real"
@@ -270,16 +273,16 @@
"=" (analyse-real-eq analyse exo-type ?values)
"<" (analyse-real-lt analyse exo-type ?values)
"encode" (analyse-real-encode analyse exo-type ?values)
- ;; "decode" (analyse-real-decode analyse exo-type ?values)
- ;; "min-value" (analyse-real-min-value analyse exo-type ?values)
- ;; "max-value" (analyse-real-max-value analyse exo-type ?values)
- ;; "to-deg" (analyse-real-to-real analyse exo-type ?values)
+ "decode" (analyse-real-decode analyse exo-type ?values)
+ "min-value" (analyse-real-min-value analyse exo-type ?values)
+ "max-value" (analyse-real-max-value analyse exo-type ?values)
+ "to-deg" (analyse-real-to-deg analyse exo-type ?values)
)
- ;; "char"
- ;; (case proc
- ;; "to-nat" (analyse-char-to-nat analyse exo-type ?values)
- ;; )
+ "char"
+ (case proc
+ "to-nat" (analyse-char-to-nat analyse exo-type ?values)
+ )
;; else
(&/fail-with-loc (str "[Analyser Error] Unknown host procedure: " [category proc]))))
diff --git a/luxc/src/lux/analyser/jvm.clj b/luxc/src/lux/analyser/proc/jvm.clj
index 6146551ef..480cb341a 100644
--- a/luxc/src/lux/analyser/jvm.clj
+++ b/luxc/src/lux/analyser/proc/jvm.clj
@@ -1,4 +1,4 @@
-(ns lux.analyser.jvm
+(ns lux.analyser.proc.jvm
(:require (clojure [template :refer [do-template]]
[string :as string])
clojure.core.match
@@ -1001,432 +1001,144 @@
)))
))))
-(do-template [<name> <op>]
- (defn <name> [analyse exo-type ?values]
- (|do [:let [(&/$Cons input (&/$Cons mask (&/$Nil))) ?values]
- =mask (&&/analyse-1 analyse &type/Nat mask)
- =input (&&/analyse-1 analyse &type/Nat input)
- _ (&type/check exo-type &type/Nat)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&&/$proc (&/T ["bit" <op>]) (&/|list =input =mask) (&/|list)))))))
-
- ^:private analyse-bit-and "and"
- ^:private analyse-bit-or "or"
- ^:private analyse-bit-xor "xor"
- )
-
-(defn ^:private analyse-bit-count [analyse exo-type ?values]
- (|do [:let [(&/$Cons input (&/$Nil)) ?values]
- =input (&&/analyse-1 analyse &type/Nat input)
- _ (&type/check exo-type &type/Nat)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&&/$proc (&/T ["bit" "count"]) (&/|list =input) (&/|list)))))))
-
-(do-template [<name> <op> <type>]
- (defn <name> [analyse exo-type ?values]
- (|do [:let [(&/$Cons input (&/$Cons shift (&/$Nil))) ?values]
- =shift (&&/analyse-1 analyse &type/Nat shift)
- =input (&&/analyse-1 analyse <type> input)
- _ (&type/check exo-type <type>)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&&/$proc (&/T ["bit" <op>]) (&/|list =input =shift) (&/|list)))))))
-
- ^:private analyse-bit-shift-left "shift-left" &type/Nat
- ^:private analyse-bit-shift-right "shift-right" &type/Int
- ^:private analyse-bit-unsigned-shift-right "unsigned-shift-right" &type/Nat
- )
-
-(defn ^:private analyse-lux-== [analyse exo-type ?values]
- (&type/with-var
- (fn [$var]
- (|do [:let [(&/$Cons left (&/$Cons right (&/$Nil))) ?values]
- =left (&&/analyse-1 analyse $var left)
- =right (&&/analyse-1 analyse $var right)
- _ (&type/check exo-type &type/Bool)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&&/$proc (&/T ["lux" "=="]) (&/|list =left =right) (&/|list)))))))))
-
-(do-template [<name> <proc> <input-type> <output-type>]
- (defn <name> [analyse exo-type ?values]
- (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values]
- =x (&&/analyse-1 analyse <input-type> x)
- =y (&&/analyse-1 analyse <input-type> y)
- _ (&type/check exo-type <output-type>)
- _cursor &/cursor]
- (return (&/|list (&&/|meta <output-type> _cursor
- (&&/$proc (&/T <proc>) (&/|list =x =y) (&/|list)))))))
-
- ^:private analyse-nat-add ["nat" "+"] &type/Nat &type/Nat
- ^:private analyse-nat-sub ["nat" "-"] &type/Nat &type/Nat
- ^:private analyse-nat-mul ["nat" "*"] &type/Nat &type/Nat
- ^:private analyse-nat-div ["nat" "/"] &type/Nat &type/Nat
- ^:private analyse-nat-rem ["nat" "%"] &type/Nat &type/Nat
- ^:private analyse-nat-eq ["nat" "="] &type/Nat &type/Bool
- ^:private analyse-nat-lt ["nat" "<"] &type/Nat &type/Bool
-
- ;; TODO: USE COMMON PROC ANALYSIS
- ^:private analyse-int-add ["int" "+"] &type/Int &type/Int
- ^:private analyse-int-sub ["int" "-"] &type/Int &type/Int
- ^:private analyse-int-mul ["int" "*"] &type/Int &type/Int
- ^:private analyse-int-div ["int" "/"] &type/Int &type/Int
- ^:private analyse-int-rem ["int" "%"] &type/Int &type/Int
- ^:private analyse-int-eq ["int" "="] &type/Int &type/Bool
- ^:private analyse-int-lt ["int" "<"] &type/Int &type/Bool
-
- ^:private analyse-deg-add ["deg" "+"] &type/Deg &type/Deg
- ^:private analyse-deg-sub ["deg" "-"] &type/Deg &type/Deg
- ^:private analyse-deg-mul ["deg" "*"] &type/Deg &type/Deg
- ^:private analyse-deg-div ["deg" "/"] &type/Deg &type/Deg
- ^:private analyse-deg-rem ["deg" "%"] &type/Deg &type/Deg
- ^:private analyse-deg-eq ["deg" "="] &type/Deg &type/Bool
- ^:private analyse-deg-lt ["deg" "<"] &type/Deg &type/Bool
-
- ;; TODO: USE COMMON PROC ANALYSIS
- ^:private analyse-real-add ["real" "+"] &type/Real &type/Real
- ^:private analyse-real-sub ["real" "-"] &type/Real &type/Real
- ^:private analyse-real-mul ["real" "*"] &type/Real &type/Real
- ^:private analyse-real-div ["real" "/"] &type/Real &type/Real
- ^:private analyse-real-rem ["real" "%"] &type/Real &type/Real
- ^:private analyse-real-eq ["real" "="] &type/Real &type/Bool
- ^:private analyse-real-lt ["real" "<"] &type/Real &type/Bool
- )
-
-(defn ^:private analyse-deg-scale [analyse exo-type ?values]
- (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values]
- =x (&&/analyse-1 analyse &type/Deg x)
- =y (&&/analyse-1 analyse &type/Nat y)
- _ (&type/check exo-type &type/Deg)
- _cursor &/cursor]
- (return (&/|list (&&/|meta &type/Deg _cursor
- (&&/$proc (&/T ["deg" "scale"]) (&/|list =x =y) (&/|list)))))))
-
-(do-template [<encode> <encode-op> <decode> <decode-op> <type>]
- (do (defn <encode> [analyse exo-type ?values]
- (|do [:let [(&/$Cons x (&/$Nil)) ?values]
- =x (&&/analyse-1 analyse <type> x)
- _ (&type/check exo-type &type/Text)
- _cursor &/cursor]
- (return (&/|list (&&/|meta &type/Text _cursor
- (&&/$proc (&/T <encode-op>) (&/|list =x) (&/|list)))))))
-
- (let [decode-type (&/$AppT &type/Maybe <type>)]
- (defn <decode> [analyse exo-type ?values]
- (|do [:let [(&/$Cons x (&/$Nil)) ?values]
- =x (&&/analyse-1 analyse &type/Text x)
- _ (&type/check exo-type decode-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta decode-type _cursor
- (&&/$proc (&/T <decode-op>) (&/|list =x) (&/|list)))))))))
-
- ^:private analyse-nat-encode ["nat" "encode"] ^:private analyse-nat-decode ["nat" "decode"] &type/Nat
- ;; TODO: USE COMMON PROC ANALYSIS
- ^:private analyse-int-encode ["int" "encode"] ^:private analyse-int-decode ["int" "decode"] &type/Int
- ^:private analyse-deg-encode ["deg" "encode"] ^:private analyse-deg-decode ["deg" "decode"] &type/Deg
- ;; TODO: USE COMMON PROC ANALYSIS
- ^:private analyse-real-encode ["real" "encode"] ^:private analyse-real-decode ["real" "decode"] &type/Real
- )
-
-(do-template [<name> <type> <op>]
- (defn <name> [analyse exo-type ?values]
- (|do [:let [(&/$Nil) ?values]
- _ (&type/check exo-type <type>)
- _cursor &/cursor]
- (return (&/|list (&&/|meta <type> _cursor
- (&&/$proc (&/T <op>) (&/|list) (&/|list)))))))
-
- ^:private analyse-nat-min-value &type/Nat ["nat" "min-value"]
- ^:private analyse-nat-max-value &type/Nat ["nat" "max-value"]
-
- ;; TODO: USE COMMON PROC ANALYSIS
- ^:private analyse-int-min-value &type/Int ["int" "min-value"]
- ^:private analyse-int-max-value &type/Int ["int" "max-value"]
-
- ^:private analyse-deg-min-value &type/Deg ["deg" "min-value"]
- ^:private analyse-deg-max-value &type/Deg ["deg" "max-value"]
-
- ;; TODO: USE COMMON PROC ANALYSIS
- ^:private analyse-real-min-value &type/Real ["real" "min-value"]
- ^:private analyse-real-max-value &type/Real ["real" "max-value"]
- )
-
-(do-template [<name> <from-type> <to-type> <op>]
- (defn <name> [analyse exo-type ?values]
- (|do [:let [(&/$Cons x (&/$Nil)) ?values]
- =x (&&/analyse-1 analyse <from-type> x)
- _ (&type/check exo-type <to-type>)
- _cursor &/cursor]
- (return (&/|list (&&/|meta <to-type> _cursor
- (&&/$proc (&/T <op>) (&/|list =x) (&/|list)))))))
-
- ^:private analyse-nat-to-int &type/Nat &type/Int ["nat" "to-int"]
- ^:private analyse-nat-to-char &type/Nat &type/Char ["nat" "to-char"]
- ^:private analyse-int-to-nat &type/Int &type/Nat ["int" "to-nat"]
- ^:private analyse-char-to-nat &type/Char &type/Nat ["char" "to-nat"]
-
- ^:private analyse-deg-to-real &type/Deg &type/Real ["deg" "to-real"]
- ^:private analyse-real-to-deg &type/Real &type/Deg ["real" "to-deg"]
- )
-
-;; TODO: USE COMMON PROC ANALYSIS
-(do-template [<name> <proc> <input-type> <output-type>]
- (defn <name> [analyse exo-type ?values]
- (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values]
- =x (&&/analyse-1 analyse <input-type> x)
- =y (&&/analyse-1 analyse <input-type> y)
- _ (&type/check exo-type <output-type>)
- _cursor &/cursor]
- (return (&/|list (&&/|meta <output-type> _cursor
- (&&/$proc (&/T <proc>) (&/|list =x =y) (&/|list)))))))
-
- ^:private analyse-text-eq ["text" "="] &type/Text &type/Bool
- ^:private analyse-text-append ["text" "append"] &type/Text &type/Text
- )
-;; TODO: USE COMMON PROC ANALYSIS
-
-(defn analyse-host [analyse exo-type compilers category proc ?values]
+(defn analyse-host [analyse exo-type compilers proc ?values]
(|let [[_ _ _ compile-class compile-interface] compilers]
- (case category
- "lux"
- (case proc
- "==" (analyse-lux-== analyse exo-type ?values))
-
- "text"
- (case proc
- "=" (analyse-text-eq analyse exo-type ?values)
- "append" (analyse-text-append analyse exo-type ?values))
-
- "bit"
- (case proc
- "count" (analyse-bit-count analyse exo-type ?values)
- "and" (analyse-bit-and analyse exo-type ?values)
- "or" (analyse-bit-or analyse exo-type ?values)
- "xor" (analyse-bit-xor analyse exo-type ?values)
- "shift-left" (analyse-bit-shift-left analyse exo-type ?values)
- "shift-right" (analyse-bit-shift-right analyse exo-type ?values)
- "unsigned-shift-right" (analyse-bit-unsigned-shift-right analyse exo-type ?values))
-
- "array"
- (case proc
- "new" (analyse-array-new analyse exo-type ?values)
- "get" (analyse-array-get analyse exo-type ?values)
- "put" (analyse-jvm-aastore analyse exo-type ?values)
- "remove" (analyse-array-remove analyse exo-type ?values)
- "size" (analyse-jvm-arraylength analyse exo-type ?values))
-
- "nat"
- (case proc
- "+" (analyse-nat-add analyse exo-type ?values)
- "-" (analyse-nat-sub analyse exo-type ?values)
- "*" (analyse-nat-mul analyse exo-type ?values)
- "/" (analyse-nat-div analyse exo-type ?values)
- "%" (analyse-nat-rem analyse exo-type ?values)
- "=" (analyse-nat-eq analyse exo-type ?values)
- "<" (analyse-nat-lt analyse exo-type ?values)
- "encode" (analyse-nat-encode analyse exo-type ?values)
- "decode" (analyse-nat-decode analyse exo-type ?values)
- "min-value" (analyse-nat-min-value analyse exo-type ?values)
- "max-value" (analyse-nat-max-value analyse exo-type ?values)
- "to-int" (analyse-nat-to-int analyse exo-type ?values)
- "to-char" (analyse-nat-to-char analyse exo-type ?values)
- )
-
- "deg"
- (case proc
- "+" (analyse-deg-add analyse exo-type ?values)
- "-" (analyse-deg-sub analyse exo-type ?values)
- "*" (analyse-deg-mul analyse exo-type ?values)
- "/" (analyse-deg-div analyse exo-type ?values)
- "%" (analyse-deg-rem analyse exo-type ?values)
- "=" (analyse-deg-eq analyse exo-type ?values)
- "<" (analyse-deg-lt analyse exo-type ?values)
- "encode" (analyse-deg-encode analyse exo-type ?values)
- "decode" (analyse-deg-decode analyse exo-type ?values)
- "min-value" (analyse-deg-min-value analyse exo-type ?values)
- "max-value" (analyse-deg-max-value analyse exo-type ?values)
- "to-real" (analyse-deg-to-real analyse exo-type ?values)
- "scale" (analyse-deg-scale analyse exo-type ?values)
- )
-
- "int"
- (case proc
- "+" (analyse-int-add analyse exo-type ?values)
- "-" (analyse-int-sub analyse exo-type ?values)
- "*" (analyse-int-mul analyse exo-type ?values)
- "/" (analyse-int-div analyse exo-type ?values)
- "%" (analyse-int-rem analyse exo-type ?values)
- "=" (analyse-int-eq analyse exo-type ?values)
- "<" (analyse-int-lt analyse exo-type ?values)
- "encode" (analyse-int-encode analyse exo-type ?values)
- "decode" (analyse-int-decode analyse exo-type ?values)
- "min-value" (analyse-int-min-value analyse exo-type ?values)
- "max-value" (analyse-int-max-value analyse exo-type ?values)
- "to-nat" (analyse-int-to-nat analyse exo-type ?values)
- )
-
- "real"
- (case proc
- "+" (analyse-real-add analyse exo-type ?values)
- "-" (analyse-real-sub analyse exo-type ?values)
- "*" (analyse-real-mul analyse exo-type ?values)
- "/" (analyse-real-div analyse exo-type ?values)
- "%" (analyse-real-rem analyse exo-type ?values)
- "=" (analyse-real-eq analyse exo-type ?values)
- "<" (analyse-real-lt analyse exo-type ?values)
- "encode" (analyse-real-encode analyse exo-type ?values)
- "decode" (analyse-real-decode analyse exo-type ?values)
- "min-value" (analyse-real-min-value analyse exo-type ?values)
- "max-value" (analyse-real-max-value analyse exo-type ?values)
- "to-deg" (analyse-real-to-deg analyse exo-type ?values)
- )
-
- "char"
- (case proc
- "to-nat" (analyse-char-to-nat analyse exo-type ?values)
- )
-
- "jvm"
- (case proc
- "synchronized" (analyse-jvm-synchronized analyse exo-type ?values)
- "load-class" (analyse-jvm-load-class analyse exo-type ?values)
- "try" (analyse-jvm-try analyse exo-type ?values)
- "throw" (analyse-jvm-throw analyse exo-type ?values)
- "null?" (analyse-jvm-null? analyse exo-type ?values)
- "null" (analyse-jvm-null analyse exo-type ?values)
- "anewarray" (analyse-jvm-anewarray analyse exo-type ?values)
- "aaload" (analyse-jvm-aaload analyse exo-type ?values)
- "aastore" (analyse-jvm-aastore analyse exo-type ?values)
- "arraylength" (analyse-jvm-arraylength analyse exo-type ?values)
- "znewarray" (analyse-jvm-znewarray analyse exo-type ?values)
- "bnewarray" (analyse-jvm-bnewarray analyse exo-type ?values)
- "snewarray" (analyse-jvm-snewarray analyse exo-type ?values)
- "inewarray" (analyse-jvm-inewarray analyse exo-type ?values)
- "lnewarray" (analyse-jvm-lnewarray analyse exo-type ?values)
- "fnewarray" (analyse-jvm-fnewarray analyse exo-type ?values)
- "dnewarray" (analyse-jvm-dnewarray analyse exo-type ?values)
- "cnewarray" (analyse-jvm-cnewarray analyse exo-type ?values)
- "iadd" (analyse-jvm-iadd analyse exo-type ?values)
- "isub" (analyse-jvm-isub analyse exo-type ?values)
- "imul" (analyse-jvm-imul analyse exo-type ?values)
- "idiv" (analyse-jvm-idiv analyse exo-type ?values)
- "irem" (analyse-jvm-irem analyse exo-type ?values)
- "ieq" (analyse-jvm-ieq analyse exo-type ?values)
- "ilt" (analyse-jvm-ilt analyse exo-type ?values)
- "igt" (analyse-jvm-igt analyse exo-type ?values)
- "ceq" (analyse-jvm-ceq analyse exo-type ?values)
- "clt" (analyse-jvm-clt analyse exo-type ?values)
- "cgt" (analyse-jvm-cgt analyse exo-type ?values)
- "ladd" (analyse-jvm-ladd analyse exo-type ?values)
- "lsub" (analyse-jvm-lsub analyse exo-type ?values)
- "lmul" (analyse-jvm-lmul analyse exo-type ?values)
- "ldiv" (analyse-jvm-ldiv analyse exo-type ?values)
- "lrem" (analyse-jvm-lrem analyse exo-type ?values)
- "leq" (analyse-jvm-leq analyse exo-type ?values)
- "llt" (analyse-jvm-llt analyse exo-type ?values)
- "lgt" (analyse-jvm-lgt analyse exo-type ?values)
- "fadd" (analyse-jvm-fadd analyse exo-type ?values)
- "fsub" (analyse-jvm-fsub analyse exo-type ?values)
- "fmul" (analyse-jvm-fmul analyse exo-type ?values)
- "fdiv" (analyse-jvm-fdiv analyse exo-type ?values)
- "frem" (analyse-jvm-frem analyse exo-type ?values)
- "feq" (analyse-jvm-feq analyse exo-type ?values)
- "flt" (analyse-jvm-flt analyse exo-type ?values)
- "fgt" (analyse-jvm-fgt analyse exo-type ?values)
- "dadd" (analyse-jvm-dadd analyse exo-type ?values)
- "dsub" (analyse-jvm-dsub analyse exo-type ?values)
- "dmul" (analyse-jvm-dmul analyse exo-type ?values)
- "ddiv" (analyse-jvm-ddiv analyse exo-type ?values)
- "drem" (analyse-jvm-drem analyse exo-type ?values)
- "deq" (analyse-jvm-deq analyse exo-type ?values)
- "dlt" (analyse-jvm-dlt analyse exo-type ?values)
- "dgt" (analyse-jvm-dgt analyse exo-type ?values)
- "iand" (analyse-jvm-iand analyse exo-type ?values)
- "ior" (analyse-jvm-ior analyse exo-type ?values)
- "ixor" (analyse-jvm-ixor analyse exo-type ?values)
- "ishl" (analyse-jvm-ishl analyse exo-type ?values)
- "ishr" (analyse-jvm-ishr analyse exo-type ?values)
- "iushr" (analyse-jvm-iushr analyse exo-type ?values)
- "land" (analyse-jvm-land analyse exo-type ?values)
- "lor" (analyse-jvm-lor analyse exo-type ?values)
- "lxor" (analyse-jvm-lxor analyse exo-type ?values)
- "lshl" (analyse-jvm-lshl analyse exo-type ?values)
- "lshr" (analyse-jvm-lshr analyse exo-type ?values)
- "lushr" (analyse-jvm-lushr analyse exo-type ?values)
- "d2f" (analyse-jvm-d2f analyse exo-type ?values)
- "d2i" (analyse-jvm-d2i analyse exo-type ?values)
- "d2l" (analyse-jvm-d2l analyse exo-type ?values)
- "f2d" (analyse-jvm-f2d analyse exo-type ?values)
- "f2i" (analyse-jvm-f2i analyse exo-type ?values)
- "f2l" (analyse-jvm-f2l analyse exo-type ?values)
- "i2b" (analyse-jvm-i2b analyse exo-type ?values)
- "i2c" (analyse-jvm-i2c analyse exo-type ?values)
- "i2d" (analyse-jvm-i2d analyse exo-type ?values)
- "i2f" (analyse-jvm-i2f analyse exo-type ?values)
- "i2l" (analyse-jvm-i2l analyse exo-type ?values)
- "i2s" (analyse-jvm-i2s analyse exo-type ?values)
- "l2d" (analyse-jvm-l2d analyse exo-type ?values)
- "l2f" (analyse-jvm-l2f analyse exo-type ?values)
- "l2i" (analyse-jvm-l2i analyse exo-type ?values)
- "l2s" (analyse-jvm-l2s analyse exo-type ?values)
- "l2b" (analyse-jvm-l2b analyse exo-type ?values)
- "c2b" (analyse-jvm-c2b analyse exo-type ?values)
- "c2s" (analyse-jvm-c2s analyse exo-type ?values)
- "c2i" (analyse-jvm-c2i analyse exo-type ?values)
- "c2l" (analyse-jvm-c2l analyse exo-type ?values)
- "b2l" (analyse-jvm-b2l analyse exo-type ?values)
- "s2l" (analyse-jvm-s2l analyse exo-type ?values)
- ;; else
- (->> (&/fail-with-loc (str "[Analyser Error] Unknown host procedure: " [category proc]))
- (if-let [[_ _def-code] (re-find #"^interface:(.*)$" proc)]
- (|do [[_module _line _column] &/cursor]
- (&reader/with-source (str "interface@" "(" _module "," _line "," _column ")") _def-code
- (|do [[=gclass-decl =supers =anns =methods] &&a-parser/parse-interface-def]
- (analyse-jvm-interface analyse compile-interface =gclass-decl =supers =anns =methods)))))
-
- (if-let [[_ _def-code] (re-find #"^class:(.*)$" proc)]
- (|do [[_module _line _column] &/cursor]
- (&reader/with-source (str "class@" "(" _module "," _line "," _column ")") _def-code
- (|do [[=gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods] &&a-parser/parse-class-def]
- (analyse-jvm-class analyse compile-class =gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods)))))
-
- (if-let [[_ _def-code] (re-find #"^anon-class:(.*)$" proc)]
- (|do [[_module _line _column] &/cursor]
- (&reader/with-source (str "anon-class@" "(" _module "," _line "," _column ")") _def-code
- (|do [[=super-class =interfaces =ctor-args =methods] &&a-parser/parse-anon-class-def]
- (analyse-jvm-anon-class analyse compile-class exo-type =super-class =interfaces =ctor-args =methods)))))
-
- (if-let [[_ _class] (re-find #"^instanceof:([^:]+)$" proc)]
- (analyse-jvm-instanceof analyse exo-type _class ?values))
-
- (if-let [[_ _class _arg-classes] (re-find #"^new:([^:]+):([^:]*)$" proc)]
- (analyse-jvm-new analyse exo-type _class (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
-
- (if-let [[_ _class _method _arg-classes] (re-find #"^invokestatic:([^:]+):([^:]+):([^:]*)$" proc)]
- (analyse-jvm-invokestatic analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
-
- (if-let [[_ _class _method _arg-classes] (re-find #"^invokeinterface:([^:]+):([^:]+):([^:]*)$" proc)]
- (analyse-jvm-invokeinterface analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
-
- (if-let [[_ _class _method _arg-classes] (re-find #"^invokevirtual:([^:]+):([^:]+):([^:]*)$" proc)]
- (analyse-jvm-invokevirtual analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
-
- (if-let [[_ _class _method _arg-classes] (re-find #"^invokespecial:([^:]+):([^:]+):([^:]*)$" proc)]
- (analyse-jvm-invokespecial analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
-
- (if-let [[_ _class _field] (re-find #"^getstatic:([^:]+):([^:]+)$" proc)]
- (analyse-jvm-getstatic analyse exo-type _class _field ?values))
-
- (if-let [[_ _class _field] (re-find #"^getfield:([^:]+):([^:]+)$" proc)]
- (analyse-jvm-getfield analyse exo-type _class _field ?values))
-
- (if-let [[_ _class _field] (re-find #"^putstatic:([^:]+):([^:]+)$" proc)]
- (analyse-jvm-putstatic analyse exo-type _class _field ?values))
-
- (if-let [[_ _class _field] (re-find #"^putfield:([^:]+):([^:]+)$" proc)]
- (analyse-jvm-putfield analyse exo-type _class _field ?values))))
-
+ (case proc
+ "synchronized" (analyse-jvm-synchronized analyse exo-type ?values)
+ "load-class" (analyse-jvm-load-class analyse exo-type ?values)
+ "try" (analyse-jvm-try analyse exo-type ?values)
+ "throw" (analyse-jvm-throw analyse exo-type ?values)
+ "null?" (analyse-jvm-null? analyse exo-type ?values)
+ "null" (analyse-jvm-null analyse exo-type ?values)
+ "anewarray" (analyse-jvm-anewarray analyse exo-type ?values)
+ "aaload" (analyse-jvm-aaload analyse exo-type ?values)
+ "aastore" (analyse-jvm-aastore analyse exo-type ?values)
+ "arraylength" (analyse-jvm-arraylength analyse exo-type ?values)
+ "znewarray" (analyse-jvm-znewarray analyse exo-type ?values)
+ "bnewarray" (analyse-jvm-bnewarray analyse exo-type ?values)
+ "snewarray" (analyse-jvm-snewarray analyse exo-type ?values)
+ "inewarray" (analyse-jvm-inewarray analyse exo-type ?values)
+ "lnewarray" (analyse-jvm-lnewarray analyse exo-type ?values)
+ "fnewarray" (analyse-jvm-fnewarray analyse exo-type ?values)
+ "dnewarray" (analyse-jvm-dnewarray analyse exo-type ?values)
+ "cnewarray" (analyse-jvm-cnewarray analyse exo-type ?values)
+ "iadd" (analyse-jvm-iadd analyse exo-type ?values)
+ "isub" (analyse-jvm-isub analyse exo-type ?values)
+ "imul" (analyse-jvm-imul analyse exo-type ?values)
+ "idiv" (analyse-jvm-idiv analyse exo-type ?values)
+ "irem" (analyse-jvm-irem analyse exo-type ?values)
+ "ieq" (analyse-jvm-ieq analyse exo-type ?values)
+ "ilt" (analyse-jvm-ilt analyse exo-type ?values)
+ "igt" (analyse-jvm-igt analyse exo-type ?values)
+ "ceq" (analyse-jvm-ceq analyse exo-type ?values)
+ "clt" (analyse-jvm-clt analyse exo-type ?values)
+ "cgt" (analyse-jvm-cgt analyse exo-type ?values)
+ "ladd" (analyse-jvm-ladd analyse exo-type ?values)
+ "lsub" (analyse-jvm-lsub analyse exo-type ?values)
+ "lmul" (analyse-jvm-lmul analyse exo-type ?values)
+ "ldiv" (analyse-jvm-ldiv analyse exo-type ?values)
+ "lrem" (analyse-jvm-lrem analyse exo-type ?values)
+ "leq" (analyse-jvm-leq analyse exo-type ?values)
+ "llt" (analyse-jvm-llt analyse exo-type ?values)
+ "lgt" (analyse-jvm-lgt analyse exo-type ?values)
+ "fadd" (analyse-jvm-fadd analyse exo-type ?values)
+ "fsub" (analyse-jvm-fsub analyse exo-type ?values)
+ "fmul" (analyse-jvm-fmul analyse exo-type ?values)
+ "fdiv" (analyse-jvm-fdiv analyse exo-type ?values)
+ "frem" (analyse-jvm-frem analyse exo-type ?values)
+ "feq" (analyse-jvm-feq analyse exo-type ?values)
+ "flt" (analyse-jvm-flt analyse exo-type ?values)
+ "fgt" (analyse-jvm-fgt analyse exo-type ?values)
+ "dadd" (analyse-jvm-dadd analyse exo-type ?values)
+ "dsub" (analyse-jvm-dsub analyse exo-type ?values)
+ "dmul" (analyse-jvm-dmul analyse exo-type ?values)
+ "ddiv" (analyse-jvm-ddiv analyse exo-type ?values)
+ "drem" (analyse-jvm-drem analyse exo-type ?values)
+ "deq" (analyse-jvm-deq analyse exo-type ?values)
+ "dlt" (analyse-jvm-dlt analyse exo-type ?values)
+ "dgt" (analyse-jvm-dgt analyse exo-type ?values)
+ "iand" (analyse-jvm-iand analyse exo-type ?values)
+ "ior" (analyse-jvm-ior analyse exo-type ?values)
+ "ixor" (analyse-jvm-ixor analyse exo-type ?values)
+ "ishl" (analyse-jvm-ishl analyse exo-type ?values)
+ "ishr" (analyse-jvm-ishr analyse exo-type ?values)
+ "iushr" (analyse-jvm-iushr analyse exo-type ?values)
+ "land" (analyse-jvm-land analyse exo-type ?values)
+ "lor" (analyse-jvm-lor analyse exo-type ?values)
+ "lxor" (analyse-jvm-lxor analyse exo-type ?values)
+ "lshl" (analyse-jvm-lshl analyse exo-type ?values)
+ "lshr" (analyse-jvm-lshr analyse exo-type ?values)
+ "lushr" (analyse-jvm-lushr analyse exo-type ?values)
+ "d2f" (analyse-jvm-d2f analyse exo-type ?values)
+ "d2i" (analyse-jvm-d2i analyse exo-type ?values)
+ "d2l" (analyse-jvm-d2l analyse exo-type ?values)
+ "f2d" (analyse-jvm-f2d analyse exo-type ?values)
+ "f2i" (analyse-jvm-f2i analyse exo-type ?values)
+ "f2l" (analyse-jvm-f2l analyse exo-type ?values)
+ "i2b" (analyse-jvm-i2b analyse exo-type ?values)
+ "i2c" (analyse-jvm-i2c analyse exo-type ?values)
+ "i2d" (analyse-jvm-i2d analyse exo-type ?values)
+ "i2f" (analyse-jvm-i2f analyse exo-type ?values)
+ "i2l" (analyse-jvm-i2l analyse exo-type ?values)
+ "i2s" (analyse-jvm-i2s analyse exo-type ?values)
+ "l2d" (analyse-jvm-l2d analyse exo-type ?values)
+ "l2f" (analyse-jvm-l2f analyse exo-type ?values)
+ "l2i" (analyse-jvm-l2i analyse exo-type ?values)
+ "l2s" (analyse-jvm-l2s analyse exo-type ?values)
+ "l2b" (analyse-jvm-l2b analyse exo-type ?values)
+ "c2b" (analyse-jvm-c2b analyse exo-type ?values)
+ "c2s" (analyse-jvm-c2s analyse exo-type ?values)
+ "c2i" (analyse-jvm-c2i analyse exo-type ?values)
+ "c2l" (analyse-jvm-c2l analyse exo-type ?values)
+ "b2l" (analyse-jvm-b2l analyse exo-type ?values)
+ "s2l" (analyse-jvm-s2l analyse exo-type ?values)
;; else
- (&/fail-with-loc (str "[Analyser Error] Unknown host procedure: " [category proc])))))
+ (->> (&/fail-with-loc (str "[Analyser Error] Unknown JVM procedure: " proc))
+ (if-let [[_ _def-code] (re-find #"^interface:(.*)$" proc)]
+ (|do [[_module _line _column] &/cursor]
+ (&reader/with-source (str "interface@" "(" _module "," _line "," _column ")") _def-code
+ (|do [[=gclass-decl =supers =anns =methods] &&a-parser/parse-interface-def]
+ (analyse-jvm-interface analyse compile-interface =gclass-decl =supers =anns =methods)))))
+
+ (if-let [[_ _def-code] (re-find #"^class:(.*)$" proc)]
+ (|do [[_module _line _column] &/cursor]
+ (&reader/with-source (str "class@" "(" _module "," _line "," _column ")") _def-code
+ (|do [[=gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods] &&a-parser/parse-class-def]
+ (analyse-jvm-class analyse compile-class =gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods)))))
+
+ (if-let [[_ _def-code] (re-find #"^anon-class:(.*)$" proc)]
+ (|do [[_module _line _column] &/cursor]
+ (&reader/with-source (str "anon-class@" "(" _module "," _line "," _column ")") _def-code
+ (|do [[=super-class =interfaces =ctor-args =methods] &&a-parser/parse-anon-class-def]
+ (analyse-jvm-anon-class analyse compile-class exo-type =super-class =interfaces =ctor-args =methods)))))
+
+ (if-let [[_ _class] (re-find #"^instanceof:([^:]+)$" proc)]
+ (analyse-jvm-instanceof analyse exo-type _class ?values))
+
+ (if-let [[_ _class _arg-classes] (re-find #"^new:([^:]+):([^:]*)$" proc)]
+ (analyse-jvm-new analyse exo-type _class (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
+
+ (if-let [[_ _class _method _arg-classes] (re-find #"^invokestatic:([^:]+):([^:]+):([^:]*)$" proc)]
+ (analyse-jvm-invokestatic analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
+
+ (if-let [[_ _class _method _arg-classes] (re-find #"^invokeinterface:([^:]+):([^:]+):([^:]*)$" proc)]
+ (analyse-jvm-invokeinterface analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
+
+ (if-let [[_ _class _method _arg-classes] (re-find #"^invokevirtual:([^:]+):([^:]+):([^:]*)$" proc)]
+ (analyse-jvm-invokevirtual analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
+
+ (if-let [[_ _class _method _arg-classes] (re-find #"^invokespecial:([^:]+):([^:]+):([^:]*)$" proc)]
+ (analyse-jvm-invokespecial analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
+
+ (if-let [[_ _class _field] (re-find #"^getstatic:([^:]+):([^:]+)$" proc)]
+ (analyse-jvm-getstatic analyse exo-type _class _field ?values))
+
+ (if-let [[_ _class _field] (re-find #"^getfield:([^:]+):([^:]+)$" proc)]
+ (analyse-jvm-getfield analyse exo-type _class _field ?values))
+
+ (if-let [[_ _class _field] (re-find #"^putstatic:([^:]+):([^:]+)$" proc)]
+ (analyse-jvm-putstatic analyse exo-type _class _field ?values))
+
+ (if-let [[_ _class _field] (re-find #"^putfield:([^:]+):([^:]+)$" proc)]
+ (analyse-jvm-putfield analyse exo-type _class _field ?values))))
+ ))
diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj
index 1c34926aa..f449a7b3c 100644
--- a/luxc/src/lux/base.clj
+++ b/luxc/src/lux/base.clj
@@ -308,7 +308,7 @@
nil
($Cons [k v] table*)
- (if (.equals ^Object k slot)
+ (if (= k slot)
v
(recur slot table*))))
@@ -318,7 +318,7 @@
($Cons (T [slot value]) $Nil)
($Cons [k v] table*)
- (if (.equals ^Object k slot)
+ (if (= k slot)
($Cons (T [slot value]) table*)
($Cons (T [k v]) (|put slot value table*)))
))
@@ -329,7 +329,7 @@
table
($Cons [k v] table*)
- (if (.equals ^Object k slot)
+ (if (= k slot)
table*
($Cons (T [k v]) (|remove slot table*)))))
@@ -339,7 +339,7 @@
table
($Cons [k* v] table*)
- (if (.equals ^Object k k*)
+ (if (= k k*)
($Cons (T [k* (f v)]) table*)
($Cons (T [k* v]) (|update k f table*)))))
@@ -465,7 +465,7 @@
false
($Cons [k* _] table*)
- (or (.equals ^Object k k*)
+ (or (= k k*)
(|contains? k table*))))
(defn |member? [x xs]
diff --git a/luxc/src/lux/compiler/js.clj b/luxc/src/lux/compiler/js.clj
index 6aa5d5915..a60afbc23 100644
--- a/luxc/src/lux/compiler/js.clj
+++ b/luxc/src/lux/compiler/js.clj
@@ -22,8 +22,8 @@
;; [cache :as &&cache]
[lux :as &&lux]
[rt :as &&rt]
- [proc :as &&proc]
)
+ (lux.compiler.js.proc [common :as &&common])
)
(:import (jdk.nashorn.api.scripting NashornScriptEngineFactory
NashornScriptEngine
@@ -99,7 +99,10 @@
(compile-expression ?value-ex)
(&o/$proc [?proc-category ?proc-name] ?args special-args)
- (&&proc/compile-proc compile-expression ?proc-category ?proc-name ?args special-args)
+ (case ?proc-category
+ ;; "js" ...
+ ;; common
+ (&&common/compile-proc compile-expression ?proc-category ?proc-name ?args special-args))
_
(assert false (prn-str 'JS=compile-expression (&/adt->text syntax))))
@@ -174,6 +177,7 @@
(&/$Left ?message)
(binding [*out* !err!]
(do (println (str "Compilation failed:\n" ?message))
- ;; (flush)
- ;; (System/exit 1)
- )))))))
+ (flush)
+ (System/exit 1)
+ ))
+ )))))
diff --git a/luxc/src/lux/compiler/js/base.clj b/luxc/src/lux/compiler/js/base.clj
index b88d4dc00..62d440d6d 100644
--- a/luxc/src/lux/compiler/js/base.clj
+++ b/luxc/src/lux/compiler/js/base.clj
@@ -40,12 +40,6 @@
(def ^:private lux-obj-class (Class/forName "[Ljava.lang.Object;"))
-(defn ^:private _valueOf_ [value]
- (reify JSObject
- (isFunction [self] true)
- (call [self this args]
- value)))
-
(defn ^:private _slice_ [wrap-lux-obj value]
(reify JSObject
(isFunction [self] true)
@@ -58,25 +52,43 @@
(isFunction [self] true)
(call [self this args]
(&/adt->text obj)
- ;; (pr-str this)
)))
+(def ^:private i64-mask (dec (bit-shift-left 1 32)))
+(defn ^:private to-i64 [value]
+ (reify JSObject
+ (getMember [self member]
+ (condp = member
+ "H" (-> value (unsigned-bit-shift-right 32) (bit-and i64-mask) int)
+ "L" (-> value (bit-and i64-mask) int)
+ ;; else
+ (assert false (str "to-i64#getMember = " member))))))
+
(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)))
+ (cond (instance? lux-obj-class value)
+ (new LuxJsObject value)
+
+ (instance? java.lang.Long value)
+ (to-i64 value)
+
+ :else
+ 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" (let [wrap-lux-obj #(cond (instance? lux-obj-class %)
+ (new LuxJsObject %)
+
+ (instance? java.lang.Long %)
+ (to-i64 %)
+
+ :else
+ %)]
(_slice_ wrap-lux-obj obj))
;; else
(assert false (str "wrap-lux-obj#getMember = " member)))))
@@ -86,6 +98,17 @@
(new LuxJsObject obj)
obj))
+(defn ^:private int64? [^ScriptObjectMirror js-object]
+ (and (.hasMember js-object "H")
+ (.hasMember js-object "L")))
+
+(defn ^:private parse-int64 [^ScriptObjectMirror js-object]
+ (+ (-> (.getMember js-object "H")
+ long
+ (bit-shift-left 32))
+ (-> (.getMember js-object "L")
+ long)))
+
(defn js-to-lux [js-object]
(cond (or (nil? js-object)
(instance? java.lang.Boolean js-object)
@@ -94,7 +117,7 @@
js-object
(instance? java.lang.Number js-object)
- (long js-object)
+ (double js-object)
(instance? LuxJsObject js-object)
(.-obj ^LuxJsObject js-object)
@@ -123,6 +146,9 @@
(.isFunction js-object)
js-object
+ (int64? js-object)
+ (parse-int64 js-object)
+
:else
(assert false (str "Unknown kind of JS object: " js-object))))
diff --git a/luxc/src/lux/compiler/js/lux.clj b/luxc/src/lux/compiler/js/lux.clj
index 578eb74f8..a7b1217f0 100644
--- a/luxc/src/lux/compiler/js/lux.clj
+++ b/luxc/src/lux/compiler/js/lux.clj
@@ -32,9 +32,13 @@
(defn compile-bool [?value]
(return (str ?value)))
+(def mask-4b (dec (bit-shift-left 1 32)))
+
(do-template [<name>]
(defn <name> [value]
- (return (str "(" value "|0)")))
+ (let [high (-> value (unsigned-bit-shift-right 32) (bit-and mask-4b))
+ low (-> value (bit-and mask-4b))]
+ (return (str &&rt/LuxRT "." "makeI64" "(" high "," low ")"))))
compile-nat
compile-int
diff --git a/luxc/src/lux/compiler/js/proc.clj b/luxc/src/lux/compiler/js/proc/common.clj
index 95e6950da..7e052892b 100644
--- a/luxc/src/lux/compiler/js/proc.clj
+++ b/luxc/src/lux/compiler/js/proc/common.clj
@@ -1,4 +1,4 @@
-(ns lux.compiler.js.proc
+(ns lux.compiler.js.proc.common
(:require (clojure [string :as string]
[set :as set]
[template :refer [do-template]])
@@ -9,7 +9,8 @@
[analyser :as &analyser]
[optimizer :as &o])
[lux.analyser.base :as &a]
- [lux.compiler.js.base :as &&]))
+ (lux.compiler.js [base :as &&]
+ [rt :as &&rt])))
;; [Resources]
;; (do-template [<name> <op>]
@@ -78,6 +79,39 @@
;; (.visitLabel $end))]]
;; (return nil)))
+(do-template [<name> <method>]
+ (defn <name> [compile ?values special-args]
+ (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
+ =x (compile ?x)
+ =y (compile ?y)]
+ (return (str &&rt/LuxRT "." <method> "(" =x "," =y ")"))))
+
+ ^:private compile-nat-add "addI64"
+ ^:private compile-nat-sub "subI64"
+ ^:private compile-nat-mul "mulI64"
+ ;; ^:private compile-nat-div "/"
+ ;; ^:private compile-nat-rem "%"
+ ^:private compile-nat-eq "eqI64"
+ ;; ^:private compile-nat-lt "<"
+
+ ^:private compile-int-add "addI64"
+ ^:private compile-int-sub "subI64"
+ ^:private compile-int-mul "mulI64"
+ ;; ^:private compile-int-div "/"
+ ;; ^:private compile-int-rem "%"
+ ^:private compile-int-eq "eqI64"
+ ;; ^:private compile-int-lt "<"
+
+ ^:private compile-deg-add "addI64"
+ ^:private compile-deg-sub "subI64"
+ ;; ^:private compile-deg-mul "*"
+ ;; ^:private compile-deg-div "/"
+ ^:private compile-deg-rem "subI64"
+ ^:private compile-deg-eq "eqI64"
+ ;; ^:private compile-deg-lt "<"
+ ^:private compile-deg-scale "mulI64"
+ )
+
(do-template [<name> <opcode>]
(defn <name> [compile ?values special-args]
(|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
@@ -85,31 +119,6 @@
=y (compile ?y)]
(return (str "(" =x " " <opcode> " " =y ")"))))
- ^:private compile-nat-add "+"
- ^:private compile-nat-sub "-"
- ^:private compile-nat-mul "*"
- ^:private compile-nat-div "/"
- ^:private compile-nat-rem "%"
- ^:private compile-nat-eq "==="
- ^:private compile-nat-lt "<"
-
- ^:private compile-int-add "+"
- ^:private compile-int-sub "-"
- ^:private compile-int-mul "*"
- ^:private compile-int-div "/"
- ^:private compile-int-rem "%"
- ^:private compile-int-eq "==="
- ^:private compile-int-lt "<"
-
- ^:private compile-deg-add "+"
- ^:private compile-deg-sub "-"
- ^:private compile-deg-mul "*"
- ^:private compile-deg-div "/"
- ^:private compile-deg-rem "%"
- ^:private compile-deg-eq "==="
- ^:private compile-deg-lt "<"
- ^:private compile-deg-scale "*"
-
^:private compile-real-add "+"
^:private compile-real-sub "-"
^:private compile-real-mul "*"
@@ -294,10 +303,10 @@
"+" (compile-nat-add compile ?values special-args)
"-" (compile-nat-sub compile ?values special-args)
"*" (compile-nat-mul compile ?values special-args)
- "/" (compile-nat-div compile ?values special-args)
- "%" (compile-nat-rem compile ?values special-args)
+ ;; "/" (compile-nat-div compile ?values special-args)
+ ;; "%" (compile-nat-rem compile ?values special-args)
"=" (compile-nat-eq compile ?values special-args)
- "<" (compile-nat-lt compile ?values special-args)
+ ;; "<" (compile-nat-lt compile ?values special-args)
;; "encode" (compile-nat-encode compile ?values special-args)
;; "decode" (compile-nat-decode compile ?values special-args)
;; "max-value" (compile-nat-max-value compile ?values special-args)
@@ -311,11 +320,11 @@
"+" (compile-int-add compile ?values special-args)
"-" (compile-int-sub compile ?values special-args)
"*" (compile-int-mul compile ?values special-args)
- "/" (compile-int-div compile ?values special-args)
- "%" (compile-int-rem compile ?values special-args)
+ ;; "/" (compile-int-div compile ?values special-args)
+ ;; "%" (compile-int-rem compile ?values special-args)
"=" (compile-int-eq compile ?values special-args)
- "<" (compile-int-lt compile ?values special-args)
- "encode" (compile-int-encode compile ?values special-args)
+ ;; "<" (compile-int-lt compile ?values special-args)
+ ;; "encode" (compile-int-encode compile ?values special-args)
;; "decode" (compile-int-decode compile ?values special-args)
;; "max-value" (compile-int-max-value compile ?values special-args)
;; "min-value" (compile-int-min-value compile ?values special-args)
@@ -326,11 +335,11 @@
(case proc-name
"+" (compile-deg-add compile ?values special-args)
"-" (compile-deg-sub compile ?values special-args)
- "*" (compile-deg-mul compile ?values special-args)
- "/" (compile-deg-div compile ?values special-args)
+ ;; "*" (compile-deg-mul compile ?values special-args)
+ ;; "/" (compile-deg-div compile ?values special-args)
"%" (compile-deg-rem compile ?values special-args)
"=" (compile-deg-eq compile ?values special-args)
- "<" (compile-deg-lt compile ?values special-args)
+ ;; "<" (compile-deg-lt compile ?values special-args)
;; "encode" (compile-deg-encode compile ?values special-args)
;; "decode" (compile-deg-decode compile ?values special-args)
;; "max-value" (compile-deg-max-value compile ?values special-args)
diff --git a/luxc/src/lux/compiler/js/rt.clj b/luxc/src/lux/compiler/js/rt.clj
index 3c9186a1e..194248f10 100644
--- a/luxc/src/lux/compiler/js/rt.clj
+++ b/luxc/src/lux/compiler/js/rt.clj
@@ -936,58 +936,155 @@
;; (.visitEnd)))]
;; nil)))
+(def ^:private i64-methods
+ {"makeI64" (str "(function makeI64(high,low) {"
+ "return { H: (high|0), L: (low|0)};"
+ "})")
+ "notI64" (str "(function notI64(i64) {"
+ "return LuxRT.makeI64(~i64.H,~i64.L);"
+ "})")
+ "negateI64" (str "(function negateI64(i64) {"
+ "return LuxRT.addI64(LuxRT.notI64(i64),LuxRT.makeI64(0,1));"
+ "})")
+ "eqI64" (str "(function eqI64(l,r) {"
+ "return (l.H === r.H) && (l.L === r.L);"
+ "})")
+ "addI64" (str "(function addI64(l,r) {"
+ "var l48 = l.H >>> 16;"
+ "var l32 = l.H & 0xFFFF;"
+ "var l16 = l.L >>> 16;"
+ "var l00 = l.L & 0xFFFF;"
+
+ "var r48 = r.H >>> 16;"
+ "var r32 = r.H & 0xFFFF;"
+ "var r16 = r.L >>> 16;"
+ "var r00 = r.L & 0xFFFF;"
+
+ "var x48 = 0, x32 = 0, x16 = 0, x00 = 0;"
+ "x00 += l00 + r00;"
+ "x16 += x00 >>> 16;"
+ "x00 &= 0xFFFF;"
+ "x16 += l16 + r16;"
+ "x32 += x16 >>> 16;"
+ "x16 &= 0xFFFF;"
+ "x32 += l32 + r32;"
+ "x48 += x32 >>> 16;"
+ "x32 &= 0xFFFF;"
+ "x48 += l48 + r48;"
+ "x48 &= 0xFFFF;"
+
+ "return LuxRT.makeI64((x48 << 16) | x32, (x16 << 16) | x00);"
+ "})")
+ "subI64" (str "(function subI64(l,r) {"
+ "return LuxRT.addI64(l,LuxRT.negateI64(r));"
+ "})")
+ "mulI64" (str "(function mulI64(l,r) {"
+ "if (l.H < 0) {"
+ (str "if (r.H < 0) {"
+ ;; Both are negative
+ "return mulI64(LuxRT.negateI64(l),LuxRT.negateI64(r));"
+ "}"
+ "else {"
+ ;; Left is negative
+ "return LuxRT.negateI64(mulI64(LuxRT.negateI64(l),r));"
+ "}")
+ "}"
+ "else if (r.H < 0) {"
+ ;; Right is negative
+ "return LuxRT.negateI64(mulI64(l,LuxRT.negateI64(r)));"
+ "}"
+ ;; Both are positive
+ "else {"
+ "var l48 = l.H >>> 16;"
+ "var l32 = l.H & 0xFFFF;"
+ "var l16 = l.L >>> 16;"
+ "var l00 = l.L & 0xFFFF;"
+
+ "var r48 = r.H >>> 16;"
+ "var r32 = r.H & 0xFFFF;"
+ "var r16 = r.L >>> 16;"
+ "var r00 = r.L & 0xFFFF;"
+
+ "var x48 = 0, x32 = 0, x16 = 0, x00 = 0;"
+ "x00 += l00 * r00;"
+ "x16 += x00 >>> 16;"
+ "x00 &= 0xFFFF;"
+ "x16 += l16 * r00;"
+ "x32 += x16 >>> 16;"
+ "x16 &= 0xFFFF;"
+ "x16 += l00 * r16;"
+ "x32 += x16 >>> 16;"
+ "x16 &= 0xFFFF;"
+ "x32 += l32 * r00;"
+ "x48 += x32 >>> 16;"
+ "x32 &= 0xFFFF;"
+ "x32 += l16 * r16;"
+ "x48 += x32 >>> 16;"
+ "x32 &= 0xFFFF;"
+ "x32 += l00 * r32;"
+ "x48 += x32 >>> 16;"
+ "x32 &= 0xFFFF;"
+ "x48 += (l48 * r00) + (l32 * r16) + (l16 * r32) + (l00 * r48);"
+ "x48 &= 0xFFFF;"
+
+ "return LuxRT.makeI64((x48 << 16) | x32, (x16 << 16) | x00);"
+ "}"
+ "})")
+ })
+
(def ^:private adt-methods
- {:product_getLeft (str "(function product_getLeft(product,index) {"
- "var index_min_length = (index+1);"
- "if(product.length > index_min_length) {"
- ;; No need for recursion
- "return product[index];"
- "}"
- "else {"
- ;; Needs recursion
- "return product_getLeft(product[product.length - 1], (index_min_length - product.length));"
- "}"
- "})")
- :product_getRight (str "(function product_getRight(product,index) {"
+ {"product_getLeft" (str "(function product_getLeft(product,index) {"
"var index_min_length = (index+1);"
- "if(product.length === index_min_length) {"
- ;; Last element.
+ "if(product.length > index_min_length) {"
+ ;; No need for recursion
"return product[index];"
"}"
- "else if(product.length < index_min_length) {"
- ;; Needs recursion
- "return product_getRight(product[product.length - 1], (index_min_length - product.length));"
- "}"
"else {"
- ;; Must slice
- "return product.slice(index);"
+ ;; Needs recursion
+ "return product_getLeft(product[product.length - 1], (index_min_length - product.length));"
"}"
"})")
- :sum_get (str "(function sum_get(sum,wantedTag,wantsLast) {"
- "if(sum[0] === wantedTag && sum[1] === wantsLast) {"
- ;; Exact match.
- "return sum[2];"
- "}"
- "else if(sum[0] < wantedTag || sum[1] !== wantsLast) {"
- "if(sum[1]) {"
- ;; Must recurse.
- "return sum_get(sum[2], (wantedTag - sum[0]), wantsLast);"
- "}"
- ;; No match.
- "else { return null; }"
- "}"
- ;; No match.
- "else { return null; }"
- "})")
+ "product_getRight" (str "(function product_getRight(product,index) {"
+ "var index_min_length = (index+1);"
+ "if(product.length === index_min_length) {"
+ ;; Last element.
+ "return product[index];"
+ "}"
+ "else if(product.length < index_min_length) {"
+ ;; Needs recursion
+ "return product_getRight(product[product.length - 1], (index_min_length - product.length));"
+ "}"
+ "else {"
+ ;; Must slice
+ "return product.slice(index);"
+ "}"
+ "})")
+ "sum_get" (str "(function sum_get(sum,wantedTag,wantsLast) {"
+ "if(sum[0] === wantedTag && sum[1] === wantsLast) {"
+ ;; Exact match.
+ "return sum[2];"
+ "}"
+ "else if(sum[0] < wantedTag || sum[1] !== wantsLast) {"
+ "if(sum[1]) {"
+ ;; Must recurse.
+ "return sum_get(sum[2], (wantedTag - sum[0]), wantsLast);"
+ "}"
+ ;; No match.
+ "else { return null; }"
+ "}"
+ ;; No match.
+ "else { return null; }"
+ "})")
})
(def LuxRT "LuxRT")
(def compile-LuxRT
(|do [_ (return nil)
- :let [rt-object (str "{" (->> adt-methods
+ :let [rt-object (str "{" (->> (merge adt-methods
+ i64-methods)
(map (fn [[key val]]
- (str (name key) ":" val)))
+ (str key ":" val)))
(interpose ",")
(reduce str ""))
"}")]]
diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj
index cebe60d9c..d37a061f8 100644
--- a/luxc/src/lux/type.clj
+++ b/luxc/src/lux/type.clj
@@ -254,7 +254,7 @@
(fn [state]
((|do [mappings* (&/map% (fn [binding]
(|let [[?id ?type] binding]
- (if (.equals ^Object id ?id)
+ (if (= id ?id)
(return binding)
(|case ?type
(&/$None)
@@ -263,7 +263,7 @@
(&/$Some ?type*)
(|case ?type*
(&/$VarT ?id*)
- (if (.equals ^Object id ?id*)
+ (if (= id ?id*)
(return (&/T [?id &/$None]))
(return binding))
@@ -287,7 +287,7 @@
(defn clean* [?tid type]
(|case type
(&/$VarT ?id)
- (if (.equals ^Object ?tid ?id)
+ (if (= ?tid ?id)
(|do [? (bound? ?id)]
(if ?
(deref ?id)
@@ -298,7 +298,7 @@
==type (clean* ?tid =type)]
(|case ==type
(&/$VarT =id)
- (if (.equals ^Object ?tid =id)
+ (if (= ?tid =id)
(|do [_ (unset-var ?id)]
(return type))
(|do [_ (reset-var ?id ==type)]
@@ -503,13 +503,13 @@
(type= xoutput youtput))
[(&/$VarT xid) (&/$VarT yid)]
- (.equals ^Object xid yid)
+ (= xid yid)
[(&/$BoundT xidx) (&/$BoundT yidx)]
(= xidx yidx)
[(&/$ExT xid) (&/$ExT yid)]
- (.equals ^Object xid yid)
+ (= xid yid)
[(&/$AppT xlambda xparam) (&/$AppT ylambda yparam)]
(and (type= xlambda ylambda) (type= xparam yparam))
@@ -652,7 +652,7 @@
(&/with-attempt
(|case [expected actual]
[(&/$VarT ?eid) (&/$VarT ?aid)]
- (if (.equals ^Object ?eid ?aid)
+ (if (= ?eid ?aid)
(return fixpoints)
(|do [ebound (fn [state]
(|case ((deref ?eid) state)
@@ -834,7 +834,7 @@
(check* class-loader fixpoints* invariant?? eR aR))
[(&/$ExT e!id) (&/$ExT a!id)]
- (if (.equals ^Object e!id a!id)
+ (if (= e!id a!id)
(return fixpoints)
(check-error "" expected actual))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 14:24:09 +0000