aboutsummaryrefslogtreecommitdiff
path: root/new-luxc
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux4
-rw-r--r--new-luxc/test/test/luxc/common.lux31
-rw-r--r--new-luxc/test/test/luxc/lang/analysis/common.lux5
-rw-r--r--new-luxc/test/test/luxc/lang/analysis/function.lux12
-rw-r--r--new-luxc/test/test/luxc/lang/analysis/primitive.lux4
-rw-r--r--new-luxc/test/test/luxc/lang/analysis/procedure/common.lux8
-rw-r--r--new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux4
-rw-r--r--new-luxc/test/test/luxc/lang/analysis/reference.lux4
-rw-r--r--new-luxc/test/test/luxc/lang/analysis/structure.lux30
-rw-r--r--new-luxc/test/test/luxc/lang/analysis/type.lux4
-rw-r--r--new-luxc/test/test/luxc/lang/translation/common.lux2
-rw-r--r--new-luxc/test/test/luxc/lang/translation/js.lux160
-rw-r--r--new-luxc/test/tests.lux3
13 files changed, 229 insertions, 42 deletions
diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux
index 7fe3f545c..dc6d48bd8 100644
--- a/new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux
@@ -16,9 +16,9 @@
(do-template [<name> <js>]
[(def: (<name> _) @.Nullary <js>)]
- [js//null "null"]
+ [js//null "null"]
[js//undefined "undefined"]
- [js//object "{}"]
+ [js//object "{}"]
)
(def: (js//global proc translate inputs)
diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux
index c2082dc81..20fb07e03 100644
--- a/new-luxc/test/test/luxc/common.lux
+++ b/new-luxc/test/test/luxc/common.lux
@@ -1,10 +1,20 @@
(.module:
lux
(lux (control [monad #+ do])
- [io #+ IO])
- (luxc (lang ["&." host]
+ [io #+ IO]
+ (data ["e" error])
+ [macro])
+ (luxc [lang]
+ (lang ["&." host]
[".L" init]
- (translation [js]))))
+ [synthesis #+ Synthesis]
+ (translation (jvm [".T_jvm" expression]
+ [".T_jvm" eval]
+ [".T_jvm" runtime])
+ [js]
+ (js [".T_js" expression]
+ [".T_js" eval]
+ [".T_js" runtime])))))
(do-template [<name> <host>]
[(def: #export <name>
@@ -16,3 +26,18 @@
[init-jvm &host.init-host]
[init-js js.init]
)
+
+(def: (run-synthesis translate-runtime translate-expression eval init)
+ (All [a] (-> (Meta Top) (-> Synthesis (Meta a)) (-> a (Meta Top)) (IO Compiler)
+ (-> Synthesis (e.Error Top))))
+ (function [synthesis]
+ (|> (do macro.Monad<Meta>
+ [_ translate-runtime
+ sampleO (translate-expression synthesis)]
+ (eval sampleO))
+ (lang.with-current-module "")
+ (macro.run (io.run init)))))
+
+(def: #export run-jvm (run-synthesis runtimeT_jvm.translate expressionT_jvm.translate evalT_jvm.eval init-jvm))
+
+(def: #export run-js (run-synthesis runtimeT_js.translate expressionT_js.translate evalT_js.eval init-js))
diff --git a/new-luxc/test/test/luxc/lang/analysis/common.lux b/new-luxc/test/test/luxc/lang/analysis/common.lux
index 38c712972..cf213ccef 100644
--- a/new-luxc/test/test/luxc/lang/analysis/common.lux
+++ b/new-luxc/test/test/luxc/lang/analysis/common.lux
@@ -1,6 +1,7 @@
(.module:
lux
- (lux (control pipe)
+ (lux [io]
+ (control pipe)
["r" math/random "r/" Monad<Random>]
(data ["e" error])
[macro]
@@ -40,7 +41,7 @@
[(def: #export (<name> analysis)
(All [a] (-> (Meta a) Bool))
(|> analysis
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success _)
<on-success>
diff --git a/new-luxc/test/test/luxc/lang/analysis/function.lux b/new-luxc/test/test/luxc/lang/analysis/function.lux
index 62d5ad93c..968de53ef 100644
--- a/new-luxc/test/test/luxc/lang/analysis/function.lux
+++ b/new-luxc/test/test/luxc/lang/analysis/function.lux
@@ -55,7 +55,7 @@
(-> Type Nat (Meta la.Analysis) Bool)
(|> analysis
(&.with-type expectedT)
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success applyA)
(let [[funcA argsA] (flatten-apply applyA)]
(n/= num-args (list.size argsA)))
@@ -75,25 +75,25 @@
(test "Can analyse function."
(and (|> (&.with-type (All [a] (-> a outputT))
(@.analyse-function analyse func-name arg-name outputC))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
succeeds?)
(|> (&.with-type (All [a] (-> a a))
(@.analyse-function analyse func-name arg-name g!arg))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
succeeds?)))
(test "Generic functions can always be specialized."
(and (|> (&.with-type (-> inputT outputT)
(@.analyse-function analyse func-name arg-name outputC))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
succeeds?)
(|> (&.with-type (-> inputT inputT)
(@.analyse-function analyse func-name arg-name g!arg))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
succeeds?)))
(test "The function's name is bound to the function's type."
(|> (&.with-type (Rec self (-> inputT self))
(@.analyse-function analyse func-name arg-name (code.local-symbol func-name)))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
succeeds?))
))))
diff --git a/new-luxc/test/test/luxc/lang/analysis/primitive.lux b/new-luxc/test/test/luxc/lang/analysis/primitive.lux
index d8ba4561f..96e2c62f9 100644
--- a/new-luxc/test/test/luxc/lang/analysis/primitive.lux
+++ b/new-luxc/test/test/luxc/lang/analysis/primitive.lux
@@ -32,7 +32,7 @@
(test "Can analyse unit."
(|> (@common.with-unknown-type
@.analyse-unit)
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (^ (#e.Success [_type (^code [])]))
(type/= Unit _type)
@@ -43,7 +43,7 @@
[(test (format "Can analyse " <desc> ".")
(|> (@common.with-unknown-type
(<analyser> <value>))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success [_type [_ (<tag> value)]])
(and (type/= <type> _type)
(is <value> value))
diff --git a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux b/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
index 9701a04b6..f51938046 100644
--- a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
+++ b/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
@@ -29,7 +29,7 @@
(|> (&.with-scope
(&.with-type output-type
(analyse (` ((~ (code.text procedure)) (~+ params))))))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success _)
<success>
@@ -261,7 +261,7 @@
(&scope.with-local [var-name arrayT]
(&.with-type output-type
(analyse code))))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success _)
true
@@ -335,7 +335,7 @@
(&scope.with-local [var-name atomT]
(&.with-type elemT
(analyse (` ("lux atom read" (~ (code.symbol ["" var-name]))))))))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success _)
true
@@ -349,7 +349,7 @@
(~ (code.symbol ["" var-name]))
(~ elemC)
(~ elemC)))))))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success _)
true
diff --git a/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux b/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux
index 7b2b993d2..efc550ff5 100644
--- a/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux
+++ b/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux
@@ -39,7 +39,7 @@
((expressionA.analyser evalL.eval)
(` ((~ (code.text procedure)) (~+ params)))))))
(&.with-current-module "")
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success _)
<success>
@@ -59,7 +59,7 @@
(&.with-type output-type
(expressionA.analyser evalL.eval syntax))))
(&.with-current-module "")
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success _)
<success>
diff --git a/new-luxc/test/test/luxc/lang/analysis/reference.lux b/new-luxc/test/test/luxc/lang/analysis/reference.lux
index 45e1eb0e8..0ab23600b 100644
--- a/new-luxc/test/test/luxc/lang/analysis/reference.lux
+++ b/new-luxc/test/test/luxc/lang/analysis/reference.lux
@@ -30,7 +30,7 @@
(&scope.with-local [var-name ref-type]
(@common.with-unknown-type
(@.analyse-reference ["" var-name]))))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (^ (#e.Success [_type (^code ((~ [_ (#.Int var)])))]))
(type/= ref-type _type)
@@ -43,7 +43,7 @@
[ref-type (' {}) (:! Void [])])]
(@common.with-unknown-type
(@.analyse-reference [module-name var-name])))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success [_type [_ (#.Symbol def-name)]])
(type/= ref-type _type)
diff --git a/new-luxc/test/test/luxc/lang/analysis/structure.lux b/new-luxc/test/test/luxc/lang/analysis/structure.lux
index 42177ebb4..cdef25448 100644
--- a/new-luxc/test/test/luxc/lang/analysis/structure.lux
+++ b/new-luxc/test/test/luxc/lang/analysis/structure.lux
@@ -47,7 +47,7 @@
(|> (&.with-scope
(&.with-type variantT
(@.analyse-sum analyse choice valueC)))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (^multi (#e.Success [_ sumA])
[(la.unfold-variant sumA)
(#.Some [tag last? valueA])])
@@ -64,7 +64,7 @@
(tc.check varT variantT))]
(&.with-type varT
(@.analyse-sum analyse choice valueC))))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (^multi (#e.Success [_ sumA])
[(la.unfold-variant sumA)
(#.Some [tag last? valueA])])
@@ -79,7 +79,7 @@
[[_ varT] (&.with-type-env tc.var)]
(&.with-type varT
(@.analyse-sum analyse choice valueC))))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success _)
false
@@ -89,7 +89,7 @@
(|> (&.with-scope
(&.with-type (type.ex-q +1 +variantT)
(@.analyse-sum analyse +choice +valueC)))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success _)
true
@@ -99,7 +99,7 @@
(|> (&.with-scope
(&.with-type (type.univ-q +1 +variantT)
(@.analyse-sum analyse +choice +valueC)))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success _)
(not (n/= choice +choice))
@@ -123,7 +123,7 @@
(test "Can analyse product."
(|> (&.with-type (type.tuple (list/map product.left primitives))
(@.analyse-product analyse (list/map product.right primitives)))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success tupleA)
(n/= size (list.size (la.unfold-tuple tupleA)))
@@ -132,7 +132,7 @@
(test "Can infer product."
(|> (@common.with-unknown-type
(@.analyse-product analyse (list/map product.right primitives)))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success [_type tupleA])
(and (type/= (type.tuple (list/map product.left primitives))
_type)
@@ -143,7 +143,7 @@
(test "Can analyse pseudo-product (singleton tuple)"
(|> (&.with-type singletonT
(analyse (` [(~ singletonC)])))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success singletonA)
true
@@ -157,7 +157,7 @@
(tc.check varT (type.tuple (list/map product.left primitives))))]
(&.with-type varT
(@.analyse-product analyse (list/map product.right primitives)))))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success [_ tupleA])
(n/= size (list.size (la.unfold-tuple tupleA)))
@@ -167,7 +167,7 @@
(|> (&.with-scope
(&.with-type (type.ex-q +1 +tupleT)
(@.analyse-product analyse (list/map product.right +primitives))))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success _)
true
@@ -177,7 +177,7 @@
(|> (&.with-scope
(&.with-type (type.univ-q +1 +tupleT)
(@.analyse-product analyse (list/map product.right +primitives))))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success _)
false
@@ -189,7 +189,7 @@
(-> Type Nat Nat (Meta [Module Scope la.Analysis]) Bool)
(|> analysis
(&.with-type variantT)
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (^multi (#e.Success [_ _ sumA])
[(la.unfold-variant sumA)
(#.Some [tag last? valueA])])
@@ -202,7 +202,7 @@
(def: (check-record-inference tupleT size analysis)
(-> Type Nat (Meta [Module Scope Type la.Analysis]) Bool)
(|> analysis
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (^multi (#e.Success [_ _ productT productA])
[(la.unfold-tuple productA)
membersA])
@@ -264,7 +264,7 @@
(&.with-scope
(&.with-type variantT
(@.analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC)))))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (^multi (#e.Success [_ _ sumA])
[(la.unfold-variant sumA)
(#.Some [tag last? valueA])])
@@ -320,7 +320,7 @@
(&.with-scope
(&.with-type tupleT
(@.analyse-record analyse recordC)))))
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (^multi (#e.Success [_ _ productA])
[(la.unfold-tuple productA)
membersA])
diff --git a/new-luxc/test/test/luxc/lang/analysis/type.lux b/new-luxc/test/test/luxc/lang/analysis/type.lux
index 4de75b989..3826b1e5d 100644
--- a/new-luxc/test/test/luxc/lang/analysis/type.lux
+++ b/new-luxc/test/test/luxc/lang/analysis/type.lux
@@ -58,7 +58,7 @@
(@common.with-unknown-type
(@.analyse-check analyse eval.eval typeC exprC))))
(&.with-current-module "")
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success [_ [analysisT analysisA]])
(and (type/= codeT analysisT)
(case [exprC analysisA]
@@ -84,7 +84,7 @@
(@common.with-unknown-type
(@.analyse-coerce analyse eval.eval typeC exprC))))
(&.with-current-module "")
- (macro.run (init-compiler []))
+ (macro.run (io.run init-jvm))
(case> (#e.Success [_ [analysisT analysisA]])
(type/= codeT analysisT)
diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux
index 7b7445737..7e46abfda 100644
--- a/new-luxc/test/test/luxc/lang/translation/common.lux
+++ b/new-luxc/test/test/luxc/lang/translation/common.lux
@@ -328,7 +328,7 @@
(frac-spec|1 translate-expression eval translate-runtime init)))
(def: deg-threshold
- {#.doc "1/(2^30)"}
+ {#.doc "~ 1/(2^30)"}
Deg
.000000001)
diff --git a/new-luxc/test/test/luxc/lang/translation/js.lux b/new-luxc/test/test/luxc/lang/translation/js.lux
new file mode 100644
index 000000000..68bc227f2
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/translation/js.lux
@@ -0,0 +1,160 @@
+(.module:
+ lux
+ (lux [io #+ IO]
+ (control [monad #+ do]
+ pipe)
+ (data ["e" error]
+ text/format
+ [number]
+ (coll [list "list/" Functor<List>]
+ [set]))
+ [math]
+ ["r" math/random]
+ (macro [code])
+ test)
+ (luxc (lang [synthesis #+ Synthesis]))
+ (test/luxc common))
+
+(def: upper-alpha-ascii
+ (r.Random Nat)
+ (|> r.nat (:: r.Functor<Random> map (|>> (n/% +91) (n/max +65)))))
+
+(def: (test-primitive-identity synthesis)
+ (-> Synthesis Bool)
+ (|> (run-js (` ("lux is" (~ synthesis) (~ synthesis))))
+ (case> (#e.Success valueV)
+ (:! Bool valueV)
+
+ _
+ false)))
+
+(type: Check (-> (e.Error Top) Bool))
+
+(do-template [<name> <type> <pre> <=>]
+ [(def: (<name> angle)
+ (-> <type> Check)
+ (|>> (case> (#e.Success valueV)
+ (<=> (<pre> angle) (:! <type> valueV))
+
+ (#e.Error error)
+ false)))]
+
+ [sin-check Frac math.sin f/=]
+ [length-check Nat id n/=]
+ )
+
+(context: "[JS] Primitives."
+ ($_ seq
+ (test "Null is equal to itself."
+ (test-primitive-identity (` ("js null"))))
+ (test "Undefined is equal to itself."
+ (test-primitive-identity (` ("js undefined"))))
+ (test "Object comparison is by reference, not by value."
+ (not (test-primitive-identity (` ("js object")))))
+ (test "Values are equal to themselves."
+ (test-primitive-identity (` ("js global" "Math"))))
+ (<| (times +100)
+ (do @
+ [value r.int
+ #let [frac-value (int-to-frac value)]]
+ (test "Can call primitive functions."
+ (|> (run-js (` ("js call" ("js global" "Math.sin") (~ (code.text (%f frac-value))))))
+ (sin-check frac-value)))))
+ ))
+
+(context: "[JS] Objects."
+ (<| (times +100)
+ (do @
+ [field (:: @ map code.text (r.text' upper-alpha-ascii +5))
+ value r.int
+ #let [empty-object (` ("js object"))
+ object (` ("js object set" (~ field) (~ (code.int value)) (~ empty-object)))
+ frac-value (int-to-frac value)]]
+ ($_ seq
+ (test "Cannot get non-existing fields from objects."
+ (|> (run-js (` ("js object get" (~ field) (~ empty-object))))
+ (case> (^multi (#e.Success valueV)
+ [(:! (Maybe Int) valueV) #.None])
+ true
+
+ _
+ false)))
+ (test "Can get fields from objects."
+ (|> (run-js (` ("js object get" (~ field) (~ object))))
+ (case> (^multi (#e.Success valueV)
+ [(:! (Maybe Int) valueV) (#.Some valueV)])
+ (i/= value (:! Int valueV))
+
+ _
+ false)))
+ (test "Can delete fields from objects."
+ (|> (run-js (let [post-delete (` ("js object delete" (~ field) (~ object)))]
+ (` ("js object get" (~ field) (~ post-delete)))))
+ (case> (^multi (#e.Success valueV)
+ [(:! (Maybe Int) valueV) #.None])
+ true
+
+ _
+ false)))
+ (test "Can instance new objects."
+ (let [base (` ("js object new" ("js global" "Number") (~ (code.text (%f frac-value)))))]
+ (|> (run-js (` ("lux frac +" (~ base) 0.0)))
+ (case> (#e.Success valueV)
+ (f/= frac-value (:! Frac valueV))
+
+ (#e.Error error)
+ false))))
+ (test "Can call methods on objects."
+ (|> (run-js (` ("js object call" ("js global" "Math") "sin" (~ (code.text (%f frac-value))))))
+ (sin-check frac-value)))
+ ))))
+
+(context: "[JS] Arrays."
+ (<| (times +100)
+ (do @
+ [length (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+ idx (|> r.nat (:: @ map (n/% length)))
+ overwrite r.nat
+ elems (|> (r.set number.Hash<Nat> length r.nat)
+ (:: @ map set.to-list))
+ #let [arrayS (` ("js array literal" (~+ (list/map code.nat elems))))]]
+ ($_ seq
+ (test "Can get the length of an array."
+ (|> (run-js (` ("js array length" (~ arrayS))))
+ (length-check length)))
+ (test "Can get an element from an array."
+ (|> (run-js (` ("js array read" (~ (code.nat idx)) (~ arrayS))))
+ (case> (^multi (#e.Success elemV)
+ [[(list.nth idx elems) (:! (Maybe Nat) elemV)]
+ [(#.Some reference) (#.Some sample)]])
+ (n/= reference sample)
+
+ _
+ false)))
+ (test "Can write an element into an array."
+ (let [idxS (code.nat idx)
+ overwriteS (code.nat overwrite)]
+ (|> (run-js (` ("js array read" (~ idxS)
+ ("js array write" (~ idxS) (~ overwriteS) (~ arrayS)))))
+ (case> (^multi (#e.Success elemV)
+ [(:! (Maybe Nat) elemV)
+ (#.Some sample)])
+ (n/= overwrite sample)
+
+ _
+ false))))
+ (test "Can delete an element from an array."
+ (let [idxS (code.nat idx)
+ deleteS (` ("js array delete" (~ idxS) (~ arrayS)))]
+ (and (|> (run-js (` ("js array length" (~ deleteS))))
+ (length-check length))
+ (|> (run-js (` ("js array read" (~ idxS) (~ deleteS))))
+ (case> (^multi (#e.Success elemV)
+ [(:! (Maybe Nat) elemV)
+ #.None])
+ true
+
+ _
+ false))
+ )))
+ ))))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index d33bcebd8..9268e492c 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -25,7 +25,8 @@
["_.T" case]
["_.T" function]
["_.T" common]
- ["_.T" jvm]))
+ ["_.T" jvm]
+ ["_.T" js]))
)))
(program: args
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 08:13:34 +0000