From b4d0eba7485caf0c6cf58de1193a9114fa273d8b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 30 May 2020 15:19:28 -0400 Subject: Split new-luxc into lux-jvm and lux-r. --- lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux | 549 ++++++++++++++++++ lux-jvm/test/test/luxc/lang/synthesis/loop.lux | 162 ++++++ .../test/test/luxc/lang/synthesis/procedure.lux | 34 ++ lux-jvm/test/test/luxc/lang/translation/js.lux | 160 +++++ lux-jvm/test/test/luxc/lang/translation/jvm.lux | 641 +++++++++++++++++++++ 5 files changed, 1546 insertions(+) create mode 100644 lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux create mode 100644 lux-jvm/test/test/luxc/lang/synthesis/loop.lux create mode 100644 lux-jvm/test/test/luxc/lang/synthesis/procedure.lux create mode 100644 lux-jvm/test/test/luxc/lang/translation/js.lux create mode 100644 lux-jvm/test/test/luxc/lang/translation/jvm.lux (limited to 'lux-jvm/test') diff --git a/lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux b/lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux new file mode 100644 index 000000000..f9905c8bc --- /dev/null +++ b/lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux @@ -0,0 +1,549 @@ +(.module: + [lux #* + [control + [monad (#+ do)] + pipe] + [data + ["e" error] + ["." product] + ["." maybe] + [text ("text/" Equivalence) + format] + [collection + ["." array] + [list ("list/" Fold)] + ["dict" dictionary]]] + [math + ["r" random "r/" Monad]] + ["." type] + [macro (#+ Monad) + ["." code]] + [compiler + ["." default + [".L" init] + [phase + [analysis + [".A" type]] + [extension + [analysis + [".AE" host]]]]]] + test] + [/// + ["_." primitive]]) + +(template [ ] + [(def: ( procedure params output-type) + (-> Text (List Code) Type Bit) + (|> (do Monad + [## runtime-bytecode @runtime.translate + ] + (default.with-scope + (typeA.with-type output-type + (_primitive.analyse (` ((~ (code.text procedure)) (~+ params))))))) + (analysis.with-current-module "") + (macro.run (initL.compiler [])) + (case> (#e.Success _) + + + (#e.Error error) + )))] + + [success #1 #0] + [failure #0 #1] + ) + +(template [ ] + [(def: ( syntax output-type) + (-> Code Type Bit) + (|> (do Monad + [## runtime-bytecode @runtime.translate + ] + (default.with-scope + (typeA.with-type output-type + (_primitive.analyse syntax)))) + (analysis.with-current-module "") + (macro.run (initL.compiler [])) + (case> (#e.Success _) + + + (#e.Error error) + )))] + + [success' #1 #0] + [failure' #0 #1] + ) + +(context: "Conversions [double + float]." + (with-expansions [ (template [ ] + [(test (format " SUCCESS") + (success (list (' ("lux coerce" (+0 (+0)) []))) )) + (test (format " FAILURE") + (failure (list (' [])) ))] + + ["jvm convert double-to-float" "java.lang.Double" hostAE.Float] + ["jvm convert double-to-int" "java.lang.Double" hostAE.Integer] + ["jvm convert double-to-long" "java.lang.Double" hostAE.Long] + ["jvm convert float-to-double" "java.lang.Float" hostAE.Double] + ["jvm convert float-to-int" "java.lang.Float" hostAE.Integer] + ["jvm convert float-to-long" "java.lang.Float" hostAE.Long] + )] + ($_ seq + + ))) + +(context: "Conversions [int]." + (with-expansions [ (template [ ] + [(test (format " SUCCESS") + (success (list (' ("lux coerce" (+0 (+0)) []))) )) + (test (format " FAILURE") + (failure (list (' [])) ))] + + ["jvm convert int-to-byte" "java.lang.Integer" hostAE.Byte] + ["jvm convert int-to-char" "java.lang.Integer" hostAE.Character] + ["jvm convert int-to-double" "java.lang.Integer" hostAE.Double] + ["jvm convert int-to-float" "java.lang.Integer" hostAE.Float] + ["jvm convert int-to-long" "java.lang.Integer" hostAE.Long] + ["jvm convert int-to-short" "java.lang.Integer" hostAE.Short] + )] + ($_ seq + + ))) + +(context: "Conversions [long]." + (with-expansions [ (template [ ] + [(test (format " SUCCESS") + (success (list (' ("lux coerce" (+0 (+0)) []))) )) + (test (format " FAILURE") + (failure (list (' [])) ))] + + ["jvm convert long-to-double" "java.lang.Long" hostAE.Double] + ["jvm convert long-to-float" "java.lang.Long" hostAE.Float] + ["jvm convert long-to-int" "java.lang.Long" hostAE.Integer] + ["jvm convert long-to-short" "java.lang.Long" hostAE.Short] + ["jvm convert long-to-byte" "java.lang.Long" hostAE.Byte] + )] + ($_ seq + + ))) + +(context: "Conversions [char + byte + short]." + (with-expansions [ (template [ ] + [(test (format " SUCCESS") + (success (list (' ("lux coerce" (+0 (+0)) []))) )) + (test (format " FAILURE") + (failure (list (' [])) ))] + + ["jvm convert char-to-byte" "java.lang.Character" hostAE.Byte] + ["jvm convert char-to-short" "java.lang.Character" hostAE.Short] + ["jvm convert char-to-int" "java.lang.Character" hostAE.Integer] + ["jvm convert char-to-long" "java.lang.Character" hostAE.Long] + ["jvm convert byte-to-long" "java.lang.Byte" hostAE.Long] + ["jvm convert short-to-long" "java.lang.Short" hostAE.Long] + )] + ($_ seq + + ))) + +(template [ ] + [(context: (format "Arithmetic " "[" "].") + (with-expansions [ (template [ ] + [(test + (success + (list (' ("lux coerce" (+0 (+0)) [])) + (' ("lux coerce" (+0 (+0)) []))) + ))] + + [(format "jvm " " +") ] + [(format "jvm " " -") ] + [(format "jvm " " *") ] + [(format "jvm " " /") ] + [(format "jvm " " %") ] + )] + ($_ seq + + ))) + + (context: (format "Order " "[" "].") + (with-expansions [ (template [ ] + [(test + (success + (list (' ("lux coerce" (+0 (+0)) [])) + (' ("lux coerce" (+0 (+0)) []))) + ))] + + [(format "jvm " " =") hostAE.Boolean] + [(format "jvm " " <") hostAE.Boolean] + )] + ($_ seq + + ))) + + (context: (format "Bitwise " "[" "].") + (with-expansions [ (template [ ] + [(test + (success + (list (' ("lux coerce" (+0 (+0)) [])) + (' ("lux coerce" (+0 (+0)) []))) + ))] + + [(format "jvm " " and") ] + [(format "jvm " " or") ] + [(format "jvm " " xor") ] + [(format "jvm " " shl") "java.lang.Integer" ] + [(format "jvm " " shr") "java.lang.Integer" ] + [(format "jvm " " ushr") "java.lang.Integer" ] + )] + ($_ seq + + )))] + + + ["int" "java.lang.Integer" hostAE.Integer] + ["long" "java.lang.Long" hostAE.Long] + ) + +(template [ ] + [(context: (format "Arithmetic " "[" "].") + (with-expansions [ (template [ ] + [(test + (success + (list (' ("lux coerce" (+0 (+0)) [])) + (' ("lux coerce" (+0 (+0)) []))) + ))] + + [(format "jvm " " +") ] + [(format "jvm " " -") ] + [(format "jvm " " *") ] + [(format "jvm " " /") ] + [(format "jvm " " %") ] + )] + ($_ seq + + ))) + + (context: (format "Order " "[" "].") + (with-expansions [ (template [ ] + [(test + (success + (list (' ("lux coerce" (+0 (+0)) [])) + (' ("lux coerce" (+0 (+0)) []))) + ))] + + [(format "jvm " " =") hostAE.Boolean] + [(format "jvm " " <") hostAE.Boolean] + )] + ($_ seq + + )))] + + + ["float" "java.lang.Float" hostAE.Float] + ["double" "java.lang.Double" hostAE.Double] + ) + +(template [ ] + [(context: (format "Order " "[" "].") + (with-expansions [ (template [ ] + [(test + (success + (list (' ("lux coerce" (+0 (+0)) [])) + (' ("lux coerce" (+0 (+0)) []))) + ))] + + [(format "jvm " " =") hostAE.Boolean] + [(format "jvm " " <") hostAE.Boolean] + )] + ($_ seq + + )))] + + + ["char" "java.lang.Character" hostAE.Character] + ) + +(def: array-type + (r.Random [Text Text]) + (let [entries (dict.entries hostAE.boxes) + num-entries (list.size entries)] + (do r.Monad + [choice (|> r.nat (:: @ map (n/% (inc num-entries)))) + #let [[unboxed boxed] (: [Text Text] + (|> entries + (list.nth choice) + (maybe.default ["java.lang.Object" "java.lang.Object"])))]] + (wrap [unboxed boxed])))) + +(context: "Array." + (<| (times +100) + (do @ + [#let [cap (|>> (n/% +10) (n/max +1))] + [unboxed boxed] array-type + size (|> r.nat (:: @ map cap)) + idx (|> r.nat (:: @ map (n/% size))) + level (|> r.nat (:: @ map cap)) + #let [unboxedT (#.Primitive unboxed (list)) + arrayT (#.Primitive "#Array" (list unboxedT)) + arrayC (`' ("lux check" (+0 "#Array" (+1 (+0 (~ (code.text unboxed)) (+0)) (+0))) + ("jvm array new" (~ (code.nat size))))) + boxedT (#.Primitive boxed (list)) + boxedTC (` (+0 (~ (code.text boxed)) (+0))) + multi-arrayT (list/fold (function (_ _ innerT) + (|> innerT (list) (#.Primitive "#Array"))) + boxedT + (list.n/range +1 level))]] + ($_ seq + (test "jvm array new" + (success "jvm array new" + (list (code.nat size)) + arrayT)) + (test "jvm array new (no nesting)" + (failure "jvm array new" + (list (code.nat size)) + unboxedT)) + (test "jvm array new (nested/multi-level)" + (success "jvm array new" + (list (code.nat size)) + multi-arrayT)) + (test "jvm array length" + (success "jvm array length" + (list arrayC) + Nat)) + (test "jvm array read" + (success' (` ("jvm object cast" + ("jvm array read" (~ arrayC) (~ (code.nat idx))))) + boxedT)) + (test "jvm array write" + (success "jvm array write" + (list arrayC (code.nat idx) (`' ("lux coerce" (~ boxedTC) []))) + arrayT)) + )))) + +(def: throwables + (List Text) + (list "java.lang.Throwable" + "java.lang.Error" + "java.io.IOError" + "java.lang.VirtualMachineError" + "java.lang.Exception" + "java.io.IOException" + "java.lang.RuntimeException")) + +(context: "Object." + (<| (times +100) + (do @ + [[unboxed boxed] array-type + [!unboxed !boxed] (|> array-type + (r.filter (function (_ [!unboxed !boxed]) + (not (text/= boxed !boxed))))) + #let [boxedT (#.Primitive boxed (list)) + boxedC (`' ("lux check" (+0 (~ (code.text boxed)) (+0)) + ("jvm object null"))) + !boxedC (`' ("lux check" (+0 (~ (code.text !boxed)) (+0)) + ("jvm object null"))) + unboxedC (`' ("lux check" (+0 (~ (code.text unboxed)) (+0)) + ("jvm object null")))] + throwable (|> r.nat + (:: @ map (n/% (inc (list.size throwables)))) + (:: @ map (function (_ idx) + (|> throwables + (list.nth idx) + (maybe.default "java.lang.Object"))))) + #let [throwableC (`' ("lux check" (+0 (~ (code.text throwable)) (+0)) + ("jvm object null")))]] + ($_ seq + (test "jvm object null" + (success "jvm object null" + (list) + (#.Primitive boxed (list)))) + (test "jvm object null (no primitives)" + (or (text/= "java.lang.Object" boxed) + (failure "jvm object null" + (list) + (#.Primitive unboxed (list))))) + (test "jvm object null?" + (success "jvm object null?" + (list boxedC) + Bit)) + (test "jvm object synchronized" + (success "jvm object synchronized" + (list boxedC boxedC) + boxedT)) + (test "jvm object synchronized (no primitives)" + (or (text/= "java.lang.Object" boxed) + (failure "jvm object synchronized" + (list unboxedC boxedC) + boxedT))) + (test "jvm object throw" + (or (text/= "java.lang.Object" throwable) + (success "jvm object throw" + (list throwableC) + Nothing))) + (test "jvm object class" + (success "jvm object class" + (list (code.text boxed)) + (#.Primitive "java.lang.Class" (list boxedT)))) + (test "jvm object instance?" + (success "jvm object instance?" + (list (code.text boxed) + boxedC) + Bit)) + (test "jvm object instance? (lineage)" + (success "jvm object instance?" + (list (' "java.lang.Object") + boxedC) + Bit)) + (test "jvm object instance? (no lineage)" + (or (text/= "java.lang.Object" boxed) + (failure "jvm object instance?" + (list (code.text boxed) + !boxedC) + Bit))) + )))) + +(context: "Member [Static Field]." + ($_ seq + (test "jvm member static get" + (success "jvm member static get" + (list (code.text "java.lang.System") + (code.text "out")) + (#.Primitive "java.io.PrintStream" (list)))) + (test "jvm member static get (inheritance out)" + (success "jvm member static get" + (list (code.text "java.lang.System") + (code.text "out")) + (#.Primitive "java.lang.Object" (list)))) + (test "jvm member static put" + (success "jvm member static put" + (list (code.text "java.awt.datatransfer.DataFlavor") + (code.text "allHtmlFlavor") + (`' ("lux check" (+0 "java.awt.datatransfer.DataFlavor" (+0)) + ("jvm object null")))) + Any)) + (test "jvm member static put (final)" + (failure "jvm member static put" + (list (code.text "java.lang.System") + (code.text "out") + (`' ("lux check" (+0 "java.io.PrintStream" (+0)) + ("jvm object null")))) + Any)) + (test "jvm member static put (inheritance in)" + (success "jvm member static put" + (list (code.text "java.awt.datatransfer.DataFlavor") + (code.text "allHtmlFlavor") + (`' ("jvm object cast" + ("lux check" (+0 "javax.activation.ActivationDataFlavor" (+0)) + ("jvm object null"))))) + Any)) + )) + +(context: "Member [Virtual Field]." + ($_ seq + (test "jvm member virtual get" + (success "jvm member virtual get" + (list (code.text "org.omg.CORBA.ValueMember") + (code.text "id") + (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0)) + ("jvm object null")))) + (#.Primitive "java.lang.String" (list)))) + (test "jvm member virtual get (inheritance out)" + (success "jvm member virtual get" + (list (code.text "org.omg.CORBA.ValueMember") + (code.text "id") + (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0)) + ("jvm object null")))) + (#.Primitive "java.lang.Object" (list)))) + (test "jvm member virtual put" + (success "jvm member virtual put" + (list (code.text "org.omg.CORBA.ValueMember") + (code.text "id") + (`' ("lux check" (+0 "java.lang.String" (+0)) + ("jvm object null"))) + (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0)) + ("jvm object null")))) + (primitive "org.omg.CORBA.ValueMember"))) + (test "jvm member virtual put (final)" + (failure "jvm member virtual put" + (list (code.text "javax.swing.text.html.parser.DTD") + (code.text "applet") + (`' ("lux check" (+0 "javax.swing.text.html.parser.Element" (+0)) + ("jvm object null"))) + (`' ("lux check" (+0 "javax.swing.text.html.parser.DTD" (+0)) + ("jvm object null")))) + (primitive "javax.swing.text.html.parser.DTD"))) + (test "jvm member virtual put (inheritance in)" + (success "jvm member virtual put" + (list (code.text "java.awt.GridBagConstraints") + (code.text "insets") + (`' ("jvm object cast" + ("lux check" (+0 "javax.swing.plaf.InsetsUIResource" (+0)) + ("jvm object null")))) + (`' ("lux check" (+0 "java.awt.GridBagConstraints" (+0)) + ("jvm object null")))) + (primitive "java.awt.GridBagConstraints"))) + )) + +(context: "Boxing/Unboxing." + ($_ seq + (test "jvm member static get" + (success "jvm member static get" + (list (code.text "java.util.GregorianCalendar") + (code.text "AD")) + (#.Primitive "java.lang.Integer" (list)))) + (test "jvm member virtual get" + (success "jvm member virtual get" + (list (code.text "javax.accessibility.AccessibleAttributeSequence") + (code.text "startIndex") + (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0)) + ("jvm object null")))) + (#.Primitive "java.lang.Integer" (list)))) + (test "jvm member virtual put" + (success "jvm member virtual put" + (list (code.text "javax.accessibility.AccessibleAttributeSequence") + (code.text "startIndex") + (`' ("jvm object cast" + ("lux check" (+0 "java.lang.Integer" (+0)) + ("jvm object null")))) + (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0)) + ("jvm object null")))) + (primitive "javax.accessibility.AccessibleAttributeSequence"))) + )) + +(context: "Member [Method]." + (let [longC (' ("lux coerce" (+0 "java.lang.Long" (+0)) + +123)) + intC (`' ("jvm convert long-to-int" (~ longC))) + stringC (' ("lux coerce" (+0 "java.lang.String" (+0)) + "YOLO")) + objectC (`' ("lux check" (+0 "java.util.ArrayList" (+1 (+0 "java.lang.Long" (+0)) (+0))) + ("jvm member invoke constructor" "java.util.ArrayList" + ["int" ("jvm object cast" (~ intC))])))] + ($_ seq + (test "jvm member invoke static" + (success' (` ("jvm member invoke static" + "java.lang.Long" "decode" + ["java.lang.String" (~ stringC)])) + (#.Primitive "java.lang.Long" (list)))) + (test "jvm member invoke virtual" + (success' (` ("jvm object cast" + ("jvm member invoke virtual" + "java.lang.Object" "equals" + ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))]))) + (#.Primitive "java.lang.Boolean" (list)))) + (test "jvm member invoke special" + (success' (` ("jvm object cast" + ("jvm member invoke special" + "java.lang.Long" "equals" + ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))]))) + (#.Primitive "java.lang.Boolean" (list)))) + (test "jvm member invoke interface" + (success' (` ("jvm object cast" + ("jvm member invoke interface" + "java.util.Collection" "add" + ("jvm object cast" (~ objectC)) ["java.lang.Object" ("jvm object cast" (~ longC))]))) + (#.Primitive "java.lang.Boolean" (list)))) + (test "jvm member invoke constructor" + (success' (` ("jvm member invoke constructor" + "java.util.ArrayList" + ["int" ("jvm object cast" (~ intC))])) + (All [a] (#.Primitive "java.util.ArrayList" (list a))))) + ))) diff --git a/lux-jvm/test/test/luxc/lang/synthesis/loop.lux b/lux-jvm/test/test/luxc/lang/synthesis/loop.lux new file mode 100644 index 000000000..c6efa7dbf --- /dev/null +++ b/lux-jvm/test/test/luxc/lang/synthesis/loop.lux @@ -0,0 +1,162 @@ +(.module: + lux + (lux [io] + (control [monad #+ do]) + (data [bit "bit/" Eq] + [number] + (coll [list "list/" Functor Fold] + (set ["set" unordered])) + text/format) + (macro [code]) + ["r" math/random "r/" Monad] + test) + (luxc (lang ["la" analysis] + ["ls" synthesis] + (synthesis [".S" expression] + [".S" loop]) + [".L" extension])) + (// common)) + +(def: (does-recursion? arity exprS) + (-> ls.Arity ls.Synthesis Bit) + (loop [exprS exprS] + (case exprS + (^ [_ (#.Form (list [_ (#.Text "lux case")] inputS pathS))]) + (loop [pathS pathS] + (case pathS + (^ [_ (#.Form (list [_ (#.Text "lux case alt")] leftS rightS))]) + (or (recur leftS) + (recur rightS)) + + (^ [_ (#.Form (list [_ (#.Text "lux case seq")] leftS rightS))]) + (recur rightS) + + (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))]) + (does-recursion? arity bodyS) + + _ + #0)) + + (^ [_ (#.Form (list& [_ (#.Text "lux recur")] argsS))]) + (n/= arity (list.size argsS)) + + (^ [_ (#.Form (list [_ (#.Text "lux let")] register inputS bodyS))]) + (recur bodyS) + + (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))]) + (or (recur thenS) + (recur elseS)) + + _ + #0 + ))) + +(def: (gen-body arity output) + (-> Nat la.Analysis (r.Random la.Analysis)) + (r.either (r.either (r/wrap output) + (do r.Monad + [inputA (|> r.nat (:: @ map code.nat)) + num-cases (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1)))) + tests (|> (r.set number.Hash num-cases r.nat) + (:: @ map (|>> set.to-list (list/map code.nat)))) + #let [bad-bodies (list.repeat num-cases (' []))] + good-body (gen-body arity output) + where-to-set (|> r.nat (:: @ map (n/% num-cases))) + #let [bodies (list.concat (list (list.take where-to-set bad-bodies) + (list good-body) + (list.drop (n/inc where-to-set) bad-bodies)))]] + (wrap (` ("lux case" (~ inputA) + (~ (code.record (list.zip2 tests bodies)))))))) + (r.either (do r.Monad + [valueS r.bit + output' (gen-body (n/inc arity) output)] + (wrap (` ("lux case" (~ (code.bit valueS)) + {("lux case bind" (~ (code.nat arity))) (~ output')})))) + (do r.Monad + [valueS r.bit + then|else r.bit + output' (gen-body arity output) + #let [thenA (if then|else output' (' [])) + elseA (if (not then|else) output' (' []))]] + (wrap (` ("lux case" (~ (code.bit valueS)) + {(~ (code.bit then|else)) (~ thenA) + (~ (code.bit (not then|else))) (~ elseA)}))))) + )) + +(def: (make-function arity body) + (-> ls.Arity la.Analysis la.Analysis) + (case arity + +0 body + _ (` ("lux function" [] (~ (make-function (n/dec arity) body)))))) + +(def: gen-recursion + (r.Random [Bit Nat la.Analysis]) + (do r.Monad + [arity (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1)))) + recur? r.bit + outputS (if recur? + (wrap (la.apply (list.repeat arity (' [])) (la.var 0))) + (do @ + [plus-or-minus? r.bit + how-much (|> r.nat (:: @ map (|>> (n/% arity) (n/max +1)))) + #let [shift (if plus-or-minus? n/+ n/-)]] + (wrap (la.apply (list.repeat (shift how-much arity) (' [])) (la.var 0))))) + bodyS (gen-body arity outputS)] + (wrap [recur? arity (make-function arity bodyS)]))) + +(def: gen-loop + (r.Random [Bit Nat la.Analysis]) + (do r.Monad + [arity (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1)))) + recur? r.bit + self-ref? r.bit + #let [selfA (la.var 0) + argA (if self-ref? selfA (' []))] + outputS (if recur? + (wrap (la.apply (list.repeat arity argA) selfA)) + (do @ + [plus-or-minus? r.bit + how-much (|> r.nat (:: @ map (|>> (n/% arity) (n/max +1)))) + #let [shift (if plus-or-minus? n/+ n/-)]] + (wrap (la.apply (list.repeat (shift how-much arity) (' [])) selfA)))) + bodyS (gen-body arity outputS)] + (wrap [(and recur? (not self-ref?)) + arity + (make-function arity bodyS)]))) + +(context: "Recursion." + (<| (times +100) + (do @ + [[prediction arity analysis] gen-recursion] + ($_ seq + (test "Can accurately identify (and then reify) tail recursion." + (case (expressionS.synthesize extensionL.no-syntheses + analysis) + (^ [_ (#.Form (list [_ (#.Text "lux function")] [_ (#.Nat _arity)] [_ (#.Tuple _env)] _body))]) + (|> _body + (does-recursion? arity) + (bit/= prediction) + (and (n/= arity _arity))) + + _ + #0)))))) + +(context: "Loop." + (<| (times +100) + (do @ + [[prediction arity analysis] gen-recursion] + ($_ seq + (test "Can reify loops." + (case (expressionS.synthesize extensionL.no-syntheses + (la.apply (list.repeat arity (' [])) analysis)) + (^ [_ (#.Form (list [_ (#.Text "lux loop")] [_ (#.Nat in_register)] [_ (#.Tuple _inits)] _body))]) + (and (n/= arity (list.size _inits)) + (not (loopS.contains-self-reference? _body))) + + (^ [_ (#.Form (list& [_ (#.Text "lux call")] + [_ (#.Form (list [_ (#.Text "lux function")] _arity _env _bodyS))] + argsS))]) + (loopS.contains-self-reference? _bodyS) + + _ + #0)))))) diff --git a/lux-jvm/test/test/luxc/lang/synthesis/procedure.lux b/lux-jvm/test/test/luxc/lang/synthesis/procedure.lux new file mode 100644 index 000000000..ab6c9de6f --- /dev/null +++ b/lux-jvm/test/test/luxc/lang/synthesis/procedure.lux @@ -0,0 +1,34 @@ +(.module: + lux + (lux [io] + (control [monad #+ do] + pipe) + (data [text "text/" Eq] + [product] + (coll [list])) + ["r" math/random "r/" Monad] + test) + (luxc (lang ["la" analysis] + ["ls" synthesis] + (synthesis [".S" expression]) + [".L" extension])) + (// common)) + +(context: "Procedures" + (<| (times +100) + (do @ + [num-args (|> r.nat (:: @ map (n/% +10))) + nameA (r.text +5) + argsA (r.list num-args gen-primitive)] + ($_ seq + (test "Can synthesize procedure calls." + (|> (expressionS.synthesize extensionL.no-syntheses + (la.procedure nameA argsA)) + (case> (^ [_ (#.Form (list& [_ (#.Text procedure)] argsS))]) + (and (text/= nameA procedure) + (list.every? (product.uncurry corresponds?) + (list.zip2 argsA argsS))) + + _ + #0))) + )))) diff --git a/lux-jvm/test/test/luxc/lang/translation/js.lux b/lux-jvm/test/test/luxc/lang/translation/js.lux new file mode 100644 index 000000000..83108c594 --- /dev/null +++ b/lux-jvm/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] + [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 map (|>> (n/% +91) (n/max +65))))) + +(def: (test-primitive-identity synthesis) + (-> Synthesis Bit) + (|> (run-js (` ("lux is" (~ synthesis) (~ synthesis)))) + (case> (#e.Success valueV) + (:coerce Bit valueV) + + _ + #0))) + +(type: Check (-> (e.Error Any) Bit)) + +(template [ 
 <=>]
+  [(def: ( angle)
+     (->  Check)
+     (|>> (case> (#e.Success valueV)
+                 (<=> (
 angle) (:coerce  valueV))
+                 
+                 (#e.Error error)
+                 #0)))]
+
+  [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)
+                                     [(:coerce (Maybe Int) valueV) #.None])
+                             #1
+
+                             _
+                             #0)))
+            (test "Can get fields from objects."
+                  (|> (run-js (` ("js object get" (~ field) (~ object))))
+                      (case> (^multi (#e.Success valueV)
+                                     [(:coerce (Maybe Int) valueV) (#.Some valueV)])
+                             (i/= value (:coerce Int valueV))
+
+                             _
+                             #0)))
+            (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)
+                                     [(:coerce (Maybe Int) valueV) #.None])
+                             #1
+
+                             _
+                             #0)))
+            (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 (:coerce Frac valueV))
+
+                               (#e.Error error)
+                               #0))))
+            (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 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) (:coerce (Maybe Nat) elemV)]
+                                      [(#.Some reference) (#.Some sample)]])
+                             (n/= reference sample)
+
+                             _
+                             #0)))
+            (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)
+                                       [(:coerce (Maybe Nat) elemV)
+                                        (#.Some sample)])
+                               (n/= overwrite sample)
+
+                               _
+                               #0))))
+            (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)
+                                            [(:coerce (Maybe Nat) elemV)
+                                             #.None])
+                                    #1
+
+                                    _
+                                    #0))
+                         )))
+            ))))
diff --git a/lux-jvm/test/test/luxc/lang/translation/jvm.lux b/lux-jvm/test/test/luxc/lang/translation/jvm.lux
new file mode 100644
index 000000000..7c97b1e78
--- /dev/null
+++ b/lux-jvm/test/test/luxc/lang/translation/jvm.lux
@@ -0,0 +1,641 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data [maybe]
+             ["e" error]
+             [bit]
+             [bit "bit/" Eq]
+             [number "int/" Number Codec]
+             [text "text/" Eq]
+             text/format
+             (coll [list]))
+       ["r" math/random "r/" Monad]
+       [macro]
+       (macro [code])
+       [host]
+       test)
+  (luxc [lang]
+        (lang [".L" host]
+              ["ls" synthesis]
+              (translation (jvm [".T" expression]
+                                [".T" eval]
+                                [".T" runtime]))))
+  (test/luxc common))
+
+(context: "Conversions [Part 1]"
+  (<| (times +100)
+      (do @
+        [int-sample (|> r.int (:: @ map (i/% 128)))
+         #let [frac-sample (int-to-frac int-sample)]]
+        (with-expansions [<2step> (template [     ]
+                                    [(test (format  " / " )
+                                           (|> (do macro.Monad
+                                                 [sampleI (expressionT.translate (|> (~ ( ))   (`)))]
+                                                 (evalT.eval sampleI))
+                                               (lang.with-current-module "")
+                                               (macro.run (io.run init-jvm))
+                                               (case> (#e.Success valueT)
+                                                      (  (:coerce  valueT))
+
+                                                      (#e.Error error)
+                                                      #0)))]
+
+                                    ["jvm convert double-to-float" "jvm convert float-to-double" code.frac frac-sample Frac f/=]
+                                    ["jvm convert double-to-int"   "jvm convert int-to-double" code.frac frac-sample Frac f/=]
+                                    ["jvm convert double-to-long"  "jvm convert long-to-double" code.frac frac-sample Frac f/=]
+
+                                    ["jvm convert long-to-float" "jvm convert float-to-long" code.int int-sample Int i/=]
+                                    ["jvm convert long-to-int" "jvm convert int-to-long" code.int int-sample Int i/=]
+                                    ["jvm convert long-to-short" "jvm convert short-to-long" code.int int-sample Int i/=]
+                                    ["jvm convert long-to-byte" "jvm convert byte-to-long" code.int int-sample Int i/=]
+                                    )]
+          ($_ seq
+              <2step>
+              )))))
+
+(context: "Conversions [Part 2]"
+  (<| (times +100)
+      (do @
+        [int-sample (|> r.int (:: @ map (|>> (i/% 128) int/abs)))
+         #let [frac-sample (int-to-frac int-sample)]]
+        (`` ($_ seq
+                (~~ (template [      ]
+                      [(test (format  " / "  " / " )
+                             (|> (do macro.Monad
+                                   [sampleI (expressionT.translate (|> (~ ( ))    (`)))]
+                                   (evalT.eval sampleI))
+                                 (lang.with-current-module "")
+                                 (macro.run (io.run init-jvm))
+                                 (case> (#e.Success valueT)
+                                        (  (:coerce  valueT))
+
+                                        (#e.Error error)
+                                        #0)))]
+
+                      ["jvm convert long-to-int"   "jvm convert int-to-char"  "jvm convert char-to-long"  code.int int-sample Int i/=]
+                      ["jvm convert long-to-int"   "jvm convert int-to-byte"  "jvm convert byte-to-long"  code.int int-sample Int i/=]
+                      ["jvm convert long-to-int"   "jvm convert int-to-short" "jvm convert short-to-long" code.int int-sample Int i/=]
+                      ["jvm convert long-to-float" "jvm convert float-to-int" "jvm convert int-to-long"   code.int int-sample Int i/=]
+                      ["jvm convert long-to-int"   "jvm convert int-to-float" "jvm convert float-to-long" code.int int-sample Int i/=]
+                      ))
+                )))))
+
+(context: "Conversions [Part 3]"
+  (<| (times +100)
+      (do @
+        [int-sample (|> r.int (:: @ map (|>> (i/% 128) int/abs)))
+         #let [frac-sample (int-to-frac int-sample)]]
+        (`` ($_ seq
+                (~~ (template [       ]
+                      [(test (format  " / "  " / " )
+                             (|> (do macro.Monad
+                                   [sampleI (expressionT.translate (|> (~ ( ))     (`)))]
+                                   (evalT.eval sampleI))
+                                 (lang.with-current-module "")
+                                 (macro.run (io.run init-jvm))
+                                 (case> (#e.Success valueT)
+                                        (  (:coerce  valueT))
+
+                                        (#e.Error error)
+                                        #0)))]
+
+                      ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-byte" "jvm convert byte-to-long" code.int int-sample Int i/=]
+                      ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-short" "jvm convert short-to-long" code.int int-sample Int i/=]
+                      ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-int" "jvm convert int-to-long" code.int int-sample Int i/=]
+                      ))
+                )))))
+
+(def: gen-nat
+  (r.Random Nat)
+  (|> r.nat
+      (r/map (n/% +128))
+      (r.filter (|>> (n/= +0) not))))
+
+(def: gen-int
+  (r.Random Int)
+  (|> gen-nat (r/map nat-to-int)))
+
+(def: gen-frac
+  (r.Random Frac)
+  (|> gen-int (r/map int-to-frac)))
+
+(template [      <+> <-> <*>  <%> 
 ]
+  [(context: (format "Arithmetic ["  "]")
+     (<| (times +100)
+         (do @
+           [param 
+            #let [subject ( param)]]
+           (with-expansions [ (template [ ]
+                                       [(test 
+                                              (|> (do macro.Monad
+                                                    [sampleI (expressionT.translate ( ((code.text )
+                                                                                             (
 ( subject))
+                                                                                             (
 ( param)))))]
+                                                    (evalT.eval sampleI))
+                                                  (lang.with-current-module "")
+                                                  (macro.run (io.run init-jvm))
+                                                  (case> (#e.Success valueT)
+                                                         ( ( param subject)
+                                                                 (:coerce  valueT))
+
+                                                         (#e.Error error)
+                                                         #0)))]
+
+                                       [(format "jvm "  " +") <+>]
+                                       [(format "jvm "  " -") <->]
+                                       [(format "jvm "  " *") <*>]
+                                       [(format "jvm "  " /") ]
+                                       [(format "jvm "  " %") <%>]
+                                       )]
+             ($_ seq
+                 
+                 )))))]
+
+  ["int" gen-int code.int Int i/= (i/* 10) i/+ i/- i/* i// i/% "jvm convert long-to-int" "jvm convert int-to-long"]
+  ["long" gen-int code.int Int i/= (i/* 10) i/+ i/- i/* i// i/% id id]
+  ["float" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% "jvm convert double-to-float" "jvm convert float-to-double"]
+  ["double" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% id id]
+  )
+
+(template [  ]
+  [(context: (format "Bit-wise ["  "] { Combiners ]")
+     (<| (times +100)
+         (do @
+           [param gen-nat
+            subject gen-nat]
+           (`` ($_ seq
+                   (~~ (template [ ]
+                         [(test 
+                                (|> (do macro.Monad
+                                      [sampleI (expressionT.translate ( ((code.text )
+                                                                               ( (code.nat subject))
+                                                                               ( (code.nat param)))))]
+                                      (evalT.eval sampleI))
+                                    (lang.with-current-module "")
+                                    (macro.run (io.run init-jvm))
+                                    (case> (#e.Success valueT)
+                                           (n/= ( param subject)
+                                                (:coerce Nat valueT))
+
+                                           (#e.Error error)
+                                           #0)))]
+
+                         [(format "jvm "  " and") bit.and]
+                         [(format "jvm "  " or") bit.or]
+                         [(format "jvm "  " xor") bit.xor]
+                         ))
+                   )))))]
+
+  ["int" "jvm convert int-to-long" "jvm convert long-to-int"]
+  ["long" id id]
+  )
+
+(template [  ]
+  [(context: (format "Bit-wise ["  "] { Shifters }")
+     (<| (times +100)
+         (do @
+           [param gen-nat
+            subject gen-nat
+            #let [shift (n/% +10 param)]]
+           (`` ($_ seq
+                   (~~ (template [     
]
+                         [(test 
+                                (|> (do macro.Monad
+                                      [sampleI (expressionT.translate ( ((code.text )
+                                                                               ( (
 subject))
+                                                                               ("jvm convert long-to-int" (code.nat shift)))))]
+                                      (evalT.eval sampleI))
+                                    (lang.with-current-module "")
+                                    (macro.run (io.run init-jvm))
+                                    (case> (#e.Success valueT)
+                                           ( ( shift ( subject))
+                                                   (:coerce  valueT))
+
+                                           (#e.Error error)
+                                           #0)))]
+
+                         [(format "jvm "  " shl") bit.left-shift Nat n/= id code.nat]
+                         [(format "jvm "  " shr") bit.arithmetic-right-shift Int i/= nat-to-int (|>> nat-to-int code.int)]
+                         [(format "jvm "  " ushr") bit.logical-right-shift Nat n/= id code.nat]
+                         ))
+                   )))))]
+
+  ["int" "jvm convert int-to-long" "jvm convert long-to-int"]
+  ["long" id id]
+  )
+
+(template [   <=> <<> 
]
+  [(context: (format "Order ["  "]")
+     (<| (times +100)
+         (do @
+           [param 
+            subject ]
+           (with-expansions [ (template [ ]
+                                       [(test 
+                                              (|> (do macro.Monad
+                                                    [sampleI (expressionT.translate ((code.text )
+                                                                                     (
 ( subject))
+                                                                                     (
 ( param))))]
+                                                    (evalT.eval sampleI))
+                                                  (lang.with-current-module "")
+                                                  (macro.run (io.run init-jvm))
+                                                  (case> (#e.Success valueT)
+                                                         (bit/= ( param subject)
+                                                                (:coerce Bit valueT))
+
+                                                         (#e.Error error)
+                                                         #0)))]
+
+                                       [(format "jvm "  " =") <=>]
+                                       [(format "jvm "  " <") <<>]
+                                       )]
+             ($_ seq
+                 
+                 )))))]
+
+  ["int" gen-int code.int i/= i/< "jvm convert long-to-int"]
+  ["long" gen-int code.int i/= i/< id]
+  ["float" gen-frac code.frac f/= f/< "jvm convert double-to-float"]
+  ["double" gen-frac code.frac f/= f/< id]
+  ["char" gen-int code.int i/= i/< "jvm convert long-to-char"]
+  )
+
+(def: (jvm//array//new dimension class size)
+  (-> Nat Text Nat ls.Synthesis)
+  (` ("jvm array new" (~ (code.nat dimension)) (~ (code.text class)) (~ (code.nat size)))))
+
+(def: (jvm//array//write class idx inputS arrayS)
+  (-> Text Nat ls.Synthesis ls.Synthesis ls.Synthesis)
+  (` ("jvm array write" (~ (code.text class)) (~ (code.nat idx)) (~ inputS) (~ arrayS))))
+
+(def: (jvm//array//read class idx arrayS)
+  (-> Text Nat ls.Synthesis ls.Synthesis)
+  (` ("jvm array read" (~ (code.text class)) (~ (code.nat idx)) (~ arrayS))))
+
+(context: "Array [Part 1]"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+         idx (|> r.nat (:: @ map (n/% size)))
+         valueZ r.bit
+         valueB gen-int
+         valueS gen-int
+         valueI gen-int
+         valueL r.int
+         valueF gen-frac
+         valueD r.frac
+         valueC gen-int]
+        (with-expansions [ (template [     ]
+                                    [(test 
+                                           (|> (do macro.Monad
+                                                 [sampleI (expressionT.translate (|> (jvm//array//new +0  size)
+                                                                                     (jvm//array//write  idx )
+                                                                                     (jvm//array//read  idx)
+                                                                                     ))]
+                                                 (evalT.eval sampleI))
+                                               (lang.with-current-module "")
+                                               (macro.run (io.run init-jvm))
+                                               (case> (#e.Success outputZ)
+                                                      (  (:coerce  outputZ))
+
+                                                      (#e.Error error)
+                                                      #0)))]
+
+                                    ["boolean" Bit valueZ bit/= (code.bit valueZ)
+                                     id]
+                                    ["byte" Int valueB i/= (|> (code.int valueB) (~) "jvm convert long-to-byte" (`))
+                                     "jvm convert byte-to-long"]
+                                    ["short" Int valueS i/= (|> (code.int valueS) (~) "jvm convert long-to-short" (`))
+                                     "jvm convert short-to-long"]
+                                    ["int" Int valueI i/= (|> (code.int valueI) (~) "jvm convert long-to-int" (`))
+                                     "jvm convert int-to-long"]
+                                    ["long" Int valueL i/= (code.int valueL)
+                                     id]
+                                    ["float" Frac valueF f/= (|> (code.frac valueF) (~) "jvm convert double-to-float" (`))
+                                     "jvm convert float-to-double"]
+                                    ["double" Frac valueD f/= (code.frac valueD)
+                                     id]
+                                    )]
+          ($_ seq
+              
+              )))))
+
+(context: "Array [Part 2]"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+         idx (|> r.nat (:: @ map (n/% size)))
+         valueZ r.bit
+         valueB gen-int
+         valueS gen-int
+         valueI gen-int
+         valueL r.int
+         valueF gen-frac
+         valueD r.frac
+         valueC gen-int]
+        (with-expansions [ (template [     ]
+                                    [(test 
+                                           (|> (do macro.Monad
+                                                 [sampleI (expressionT.translate (|> (jvm//array//new +0  size)
+                                                                                     (jvm//array//write  idx )
+                                                                                     (jvm//array//read  idx)
+                                                                                     ))]
+                                                 (evalT.eval sampleI))
+                                               (lang.with-current-module "")
+                                               (macro.run (io.run init-jvm))
+                                               (case> (#e.Success outputT)
+                                                      (  (:coerce  outputT))
+
+                                                      (#e.Error error)
+                                                      #0)))]
+
+                                    ["char" Int valueC i/=
+                                     (|> (code.int valueC) (~) "jvm convert long-to-int" "jvm convert int-to-char" (`))
+                                     "jvm convert char-to-long"]
+                                    ["java.lang.Long" Int valueL i/=
+                                     (code.int valueL)
+                                     id]
+                                    )]
+          ($_ seq
+              
+              (test "java.lang.Double (level 1)"
+                    (|> (do macro.Monad
+                          [#let [inner (|> ("jvm array new" +0 "java.lang.Double" (~ (code.nat size)))
+                                           ("jvm array write" "java.lang.Double" (~ (code.nat idx)) (~ (code.frac valueD)))
+                                           (`))]
+                           sampleI (expressionT.translate (|> ("jvm array new" +1 "java.lang.Double" (~ (code.nat size)))
+                                                              ("jvm array write" "#Array" (~ (code.nat idx)) (~ inner))
+                                                              ("jvm array read" "#Array" (~ (code.nat idx)))
+                                                              ("jvm array read" "java.lang.Double" (~ (code.nat idx)))
+                                                              (`)))]
+                          (evalT.eval sampleI))
+                        (lang.with-current-module "")
+                        (macro.run (io.run init-jvm))
+                        (case> (#e.Success outputT)
+                               (f/= valueD (:coerce Frac outputT))
+
+                               (#e.Error error)
+                               #0)))
+              (test "jvm array length"
+                    (|> (do macro.Monad
+                          [sampleI (expressionT.translate (` ("jvm array length" ("jvm array new" +0 "java.lang.Object" (~ (code.nat size))))))]
+                          (evalT.eval sampleI))
+                        (lang.with-current-module "")
+                        (macro.run (io.run init-jvm))
+                        (case> (#e.Success outputT)
+                               (n/= size (:coerce Nat outputT))
+
+                               (#e.Error error)
+                               #0)))
+              )))))
+
+(host.import: java/lang/Class
+  (getName [] String))
+
+(def: classes
+  (List Text)
+  (list "java.lang.Object" "java.lang.Class"
+        "java.lang.String" "java.lang.Number"))
+
+(def: instances
+  (List [Text (r.Random ls.Synthesis)])
+  (let [gen-boolean (|> r.bit (:: r.Functor map code.bit))
+        gen-integer (|> r.int (:: r.Functor map code.int))
+        gen-double (|> r.frac (:: r.Functor map code.frac))
+        gen-string (|> (r.text +5) (:: r.Functor map code.text))]
+    (list ["java.lang.Boolean" gen-boolean]
+          ["java.lang.Long" gen-integer]
+          ["java.lang.Double" gen-double]
+          ["java.lang.String" gen-string]
+          ["java.lang.Object" (r.either (r.either gen-boolean
+                                                  gen-integer)
+                                        (r.either gen-double
+                                                  gen-string))])))
+
+(context: "Object."
+  (<| (times +100)
+      (do @
+        [#let [num-classes (list.size classes)]
+         #let [num-instances (list.size instances)]
+         class-idx (|> r.nat (:: @ map (n/% num-classes)))
+         instance-idx (|> r.nat (:: @ map (n/% num-instances)))
+         exception-message (r.text +5)
+         #let [class (maybe.assume (list.nth class-idx classes))
+               [instance-class instance-gen] (maybe.assume (list.nth instance-idx instances))
+               exception-message$ (` ["java.lang.String" (~ (code.text exception-message))])]
+         sample r.int
+         monitor r.int
+         instance instance-gen]
+        ($_ seq
+            (test "jvm object null"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm object null?" ("jvm object null"))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (:coerce Bit outputT)
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm object null?"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm object null?" (~ (code.int sample)))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (not (:coerce Bit outputT))
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm object synchronized"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm object synchronized" (~ (code.int monitor)) (~ (code.int sample)))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (i/= sample (:coerce Int outputT))
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm object throw"
+                  (|> (do macro.Monad
+                        [_ runtimeT.translate
+                         sampleI (expressionT.translate (` ("lux try" ("lux function" +1 []
+                                                                       ("jvm object throw" ("jvm member invoke constructor"
+                                                                                            "java.lang.Throwable"
+                                                                                            (~ exception-message$)))))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (case (:coerce (e.Error Any) outputT)
+                               (#e.Error error)
+                               (text.contains? exception-message error)
+
+                               (#e.Success outputT)
+                               #0)
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm object class"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm object class" (~ (code.text class)))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (|> outputT (:coerce Class) (Class::getName []) (text/= class))
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm object instance?"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm object instance?" (~ (code.text instance-class)) (~ instance))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (:coerce Bit outputT)
+
+                             (#e.Error error)
+                             #0)))
+            ))))
+
+(host.import: java/util/GregorianCalendar
+  (#static AD int))
+
+(context: "Member [Field]"
+  (<| (times +100)
+      (do @
+        [sample-short (|> r.int (:: @ map (|>> int/abs (i/% 100))))
+         sample-string (r.text +5)
+         other-sample-string (r.text +5)
+         #let [shortS (` ["short" ("jvm object cast" "java.lang.Short" "short"
+                                   ("jvm convert long-to-short" (~ (code.int sample-short))))])
+               stringS (` ["java.lang.String" (~ (code.text sample-string))])
+               type-codeS (` ["org.omg.CORBA.TypeCode" ("jvm object null")])
+               idl-typeS (` ["org.omg.CORBA.IDLType" ("jvm object null")])
+               value-memberS (` ("jvm member invoke constructor"
+                                 "org.omg.CORBA.ValueMember"
+                                 (~ stringS) (~ stringS) (~ stringS) (~ stringS)
+                                 (~ type-codeS) (~ idl-typeS) (~ shortS)))]]
+        ($_ seq
+            (test "jvm member static get"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm convert int-to-long" ("jvm member static get" "java.util.GregorianCalendar" "AD" "int"))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (i/= GregorianCalendar::AD (:coerce Int outputT))
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm member static put"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm member static put" "java.awt.datatransfer.DataFlavor" "allHtmlFlavor" "java.awt.datatransfer.DataFlavor"
+                                                            ("jvm member static get" "java.awt.datatransfer.DataFlavor" "allHtmlFlavor" "java.awt.datatransfer.DataFlavor"))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (is? hostL.unit (:coerce Text outputT))
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm member virtual get"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm member virtual get" "org.omg.CORBA.ValueMember" "name" "java.lang.String" (~ value-memberS))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (text/= sample-string (:coerce Text outputT))
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm member virtual put"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm member virtual get" "org.omg.CORBA.ValueMember" "name" "java.lang.String"
+                                                            ("jvm member virtual put" "org.omg.CORBA.ValueMember" "name" "java.lang.String"
+                                                             (~ (code.text other-sample-string)) (~ value-memberS)))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (text/= other-sample-string (:coerce Text outputT))
+
+                             (#e.Error error)
+                             #0)))
+            ))))
+
+(host.import: java/lang/Object)
+
+(host.import: (java/util/ArrayList a))
+
+(context: "Member [Method]"
+  (<| (times +100)
+      (do @
+        [sample (|> r.int (:: @ map (|>> int/abs (i/% 100))))
+         #let [object-longS (` ["java.lang.Object" (~ (code.int sample))])
+               intS (` ["int" ("jvm object cast" "java.lang.Integer" "int"
+                               ("jvm convert long-to-int" (~ (code.int sample))))])
+               coded-intS (` ["java.lang.String" (~ (code.text (int/encode sample)))])
+               array-listS (` ("jvm member invoke constructor" "java.util.ArrayList" (~ intS)))]]
+        ($_ seq
+            (test "jvm member invoke static"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm member invoke static" "java.lang.Long"
+                                                            "decode" "java.lang.Long"
+                                                            (~ coded-intS))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (i/= sample (:coerce Int outputT))
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm member invoke virtual"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm object cast" "boolean" "java.lang.Boolean"
+                                                            ("jvm member invoke virtual" "java.lang.Object" "equals" "boolean"
+                                                             (~ (code.int sample)) (~ object-longS)))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (:coerce Bit outputT)
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm member invoke interface"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm object cast" "boolean" "java.lang.Boolean"
+                                                            ("jvm member invoke interface" "java.util.Collection" "add" "boolean"
+                                                             (~ array-listS) (~ object-longS)))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (:coerce Bit outputT)
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm member invoke constructor"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate array-listS)]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (host.instance? ArrayList (:coerce Object outputT))
+
+                             (#e.Error error)
+                             #0)))
+            ))))
-- 
cgit v1.2.3