aboutsummaryrefslogtreecommitdiff
path: root/lux-jvm/test
diff options
context:
space:
mode:
Diffstat (limited to 'lux-jvm/test')
-rw-r--r--lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux549
-rw-r--r--lux-jvm/test/test/luxc/lang/synthesis/loop.lux162
-rw-r--r--lux-jvm/test/test/luxc/lang/synthesis/procedure.lux34
-rw-r--r--lux-jvm/test/test/luxc/lang/translation/js.lux160
-rw-r--r--lux-jvm/test/test/luxc/lang/translation/jvm.lux641
5 files changed, 1546 insertions, 0 deletions
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<Text>)
+ format]
+ [collection
+ ["." array]
+ [list ("list/" Fold<List>)]
+ ["dict" dictionary]]]
+ [math
+ ["r" random "r/" Monad<Random>]]
+ ["." type]
+ [macro (#+ Monad<Meta>)
+ ["." code]]
+ [compiler
+ ["." default
+ [".L" init]
+ [phase
+ [analysis
+ [".A" type]]
+ [extension
+ [analysis
+ [".AE" host]]]]]]
+ test]
+ [///
+ ["_." primitive]])
+
+(template [<name> <success> <failure>]
+ [(def: (<name> procedure params output-type)
+ (-> Text (List Code) Type Bit)
+ (|> (do Monad<Meta>
+ [## 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 _)
+ <success>
+
+ (#e.Error error)
+ <failure>)))]
+
+ [success #1 #0]
+ [failure #0 #1]
+ )
+
+(template [<name> <success> <failure>]
+ [(def: (<name> syntax output-type)
+ (-> Code Type Bit)
+ (|> (do Monad<Meta>
+ [## 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 _)
+ <success>
+
+ (#e.Error error)
+ <failure>)))]
+
+ [success' #1 #0]
+ [failure' #0 #1]
+ )
+
+(context: "Conversions [double + float]."
+ (with-expansions [<conversions> (template [<procedure> <from> <to>]
+ [(test (format <procedure> " SUCCESS")
+ (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
+ (test (format <procedure> " FAILURE")
+ (failure <procedure> (list (' [])) <to>))]
+
+ ["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
+ <conversions>
+ )))
+
+(context: "Conversions [int]."
+ (with-expansions [<conversions> (template [<procedure> <from> <to>]
+ [(test (format <procedure> " SUCCESS")
+ (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
+ (test (format <procedure> " FAILURE")
+ (failure <procedure> (list (' [])) <to>))]
+
+ ["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
+ <conversions>
+ )))
+
+(context: "Conversions [long]."
+ (with-expansions [<conversions> (template [<procedure> <from> <to>]
+ [(test (format <procedure> " SUCCESS")
+ (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
+ (test (format <procedure> " FAILURE")
+ (failure <procedure> (list (' [])) <to>))]
+
+ ["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
+ <conversions>
+ )))
+
+(context: "Conversions [char + byte + short]."
+ (with-expansions [<conversions> (template [<procedure> <from> <to>]
+ [(test (format <procedure> " SUCCESS")
+ (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
+ (test (format <procedure> " FAILURE")
+ (failure <procedure> (list (' [])) <to>))]
+
+ ["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
+ <conversions>
+ )))
+
+(template [<domain> <boxed> <type>]
+ [(context: (format "Arithmetic " "[" <domain> "].")
+ (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>]
+ [(test <procedure>
+ (success <procedure>
+ (list (' ("lux coerce" (+0 <subject> (+0)) []))
+ (' ("lux coerce" (+0 <param> (+0)) [])))
+ <output>))]
+
+ [(format "jvm " <domain> " +") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " -") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " *") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " /") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " %") <boxed> <boxed> <type>]
+ )]
+ ($_ seq
+ <instructions>
+ )))
+
+ (context: (format "Order " "[" <domain> "].")
+ (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>]
+ [(test <procedure>
+ (success <procedure>
+ (list (' ("lux coerce" (+0 <subject> (+0)) []))
+ (' ("lux coerce" (+0 <param> (+0)) [])))
+ <output>))]
+
+ [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean]
+ [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean]
+ )]
+ ($_ seq
+ <instructions>
+ )))
+
+ (context: (format "Bitwise " "[" <domain> "].")
+ (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>]
+ [(test <procedure>
+ (success <procedure>
+ (list (' ("lux coerce" (+0 <subject> (+0)) []))
+ (' ("lux coerce" (+0 <param> (+0)) [])))
+ <output>))]
+
+ [(format "jvm " <domain> " and") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " or") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " xor") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " shl") <boxed> "java.lang.Integer" <type>]
+ [(format "jvm " <domain> " shr") <boxed> "java.lang.Integer" <type>]
+ [(format "jvm " <domain> " ushr") <boxed> "java.lang.Integer" <type>]
+ )]
+ ($_ seq
+ <instructions>
+ )))]
+
+
+ ["int" "java.lang.Integer" hostAE.Integer]
+ ["long" "java.lang.Long" hostAE.Long]
+ )
+
+(template [<domain> <boxed> <type>]
+ [(context: (format "Arithmetic " "[" <domain> "].")
+ (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>]
+ [(test <procedure>
+ (success <procedure>
+ (list (' ("lux coerce" (+0 <subject> (+0)) []))
+ (' ("lux coerce" (+0 <param> (+0)) [])))
+ <output>))]
+
+ [(format "jvm " <domain> " +") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " -") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " *") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " /") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " %") <boxed> <boxed> <type>]
+ )]
+ ($_ seq
+ <instructions>
+ )))
+
+ (context: (format "Order " "[" <domain> "].")
+ (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>]
+ [(test <procedure>
+ (success <procedure>
+ (list (' ("lux coerce" (+0 <subject> (+0)) []))
+ (' ("lux coerce" (+0 <param> (+0)) [])))
+ <output>))]
+
+ [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean]
+ [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean]
+ )]
+ ($_ seq
+ <instructions>
+ )))]
+
+
+ ["float" "java.lang.Float" hostAE.Float]
+ ["double" "java.lang.Double" hostAE.Double]
+ )
+
+(template [<domain> <boxed> <type>]
+ [(context: (format "Order " "[" <domain> "].")
+ (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>]
+ [(test <procedure>
+ (success <procedure>
+ (list (' ("lux coerce" (+0 <subject> (+0)) []))
+ (' ("lux coerce" (+0 <param> (+0)) [])))
+ <output>))]
+
+ [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean]
+ [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean]
+ )]
+ ($_ seq
+ <instructions>
+ )))]
+
+
+ ["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<Random>
+ [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<Bit>]
+ [number]
+ (coll [list "list/" Functor<List> Fold<List>]
+ (set ["set" unordered]))
+ text/format)
+ (macro [code])
+ ["r" math/random "r/" Monad<Random>]
+ 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<Random>
+ [inputA (|> r.nat (:: @ map code.nat))
+ num-cases (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+ tests (|> (r.set number.Hash<Nat> 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<Random>
+ [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<Random>
+ [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<Random>
+ [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<Random>
+ [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<Text>]
+ [product]
+ (coll [list]))
+ ["r" math/random "r/" Monad<Random>]
+ 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<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 Bit)
+ (|> (run-js (` ("lux is" (~ synthesis) (~ synthesis))))
+ (case> (#e.Success valueV)
+ (:coerce Bit valueV)
+
+ _
+ #0)))
+
+(type: Check (-> (e.Error Any) Bit))
+
+(template [<name> <type> <pre> <=>]
+ [(def: (<name> angle)
+ (-> <type> Check)
+ (|>> (case> (#e.Success valueV)
+ (<=> (<pre> angle) (:coerce <type> 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<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) (: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<Bit>]
+ [number "int/" Number<Int> Codec<Text,Int>]
+ [text "text/" Eq<Text>]
+ text/format
+ (coll [list]))
+ ["r" math/random "r/" Monad<Random>]
+ [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 [<step1> <step2> <tag> <sample> <cast> <test>]
+ [(test (format <step1> " / " <step2>)
+ (|> (do macro.Monad<Meta>
+ [sampleI (expressionT.translate (|> (~ (<tag> <sample>)) <step1> <step2> (`)))]
+ (evalT.eval sampleI))
+ (lang.with-current-module "")
+ (macro.run (io.run init-jvm))
+ (case> (#e.Success valueT)
+ (<test> <sample> (:coerce <cast> 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 [<step1> <step2> <step3> <tag> <sample> <cast> <test>]
+ [(test (format <step1> " / " <step2> " / " <step3>)
+ (|> (do macro.Monad<Meta>
+ [sampleI (expressionT.translate (|> (~ (<tag> <sample>)) <step1> <step2> <step3> (`)))]
+ (evalT.eval sampleI))
+ (lang.with-current-module "")
+ (macro.run (io.run init-jvm))
+ (case> (#e.Success valueT)
+ (<test> <sample> (:coerce <cast> 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 [<step1> <step2> <step3> <step4> <tag> <sample> <cast> <test>]
+ [(test (format <step1> " / " <step2> " / " <step3>)
+ (|> (do macro.Monad<Meta>
+ [sampleI (expressionT.translate (|> (~ (<tag> <sample>)) <step1> <step2> <step3> <step4> (`)))]
+ (evalT.eval sampleI))
+ (lang.with-current-module "")
+ (macro.run (io.run init-jvm))
+ (case> (#e.Success valueT)
+ (<test> <sample> (:coerce <cast> 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 [<domain> <generator> <tag> <type> <test> <augmentation> <+> <-> <*> </> <%> <pre> <post>]
+ [(context: (format "Arithmetic [" <domain> "]")
+ (<| (times +100)
+ (do @
+ [param <generator>
+ #let [subject (<augmentation> param)]]
+ (with-expansions [<tests> (template [<procedure> <reference>]
+ [(test <procedure>
+ (|> (do macro.Monad<Meta>
+ [sampleI (expressionT.translate (<post> ((code.text <procedure>)
+ (<pre> (<tag> subject))
+ (<pre> (<tag> param)))))]
+ (evalT.eval sampleI))
+ (lang.with-current-module "")
+ (macro.run (io.run init-jvm))
+ (case> (#e.Success valueT)
+ (<test> (<reference> param subject)
+ (:coerce <type> valueT))
+
+ (#e.Error error)
+ #0)))]
+
+ [(format "jvm " <domain> " +") <+>]
+ [(format "jvm " <domain> " -") <->]
+ [(format "jvm " <domain> " *") <*>]
+ [(format "jvm " <domain> " /") </>]
+ [(format "jvm " <domain> " %") <%>]
+ )]
+ ($_ seq
+ <tests>
+ )))))]
+
+ ["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 [<domain> <post> <convert>]
+ [(context: (format "Bit-wise [" <domain> "] { Combiners ]")
+ (<| (times +100)
+ (do @
+ [param gen-nat
+ subject gen-nat]
+ (`` ($_ seq
+ (~~ (template [<procedure> <reference>]
+ [(test <procedure>
+ (|> (do macro.Monad<Meta>
+ [sampleI (expressionT.translate (<post> ((code.text <procedure>)
+ (<convert> (code.nat subject))
+ (<convert> (code.nat param)))))]
+ (evalT.eval sampleI))
+ (lang.with-current-module "")
+ (macro.run (io.run init-jvm))
+ (case> (#e.Success valueT)
+ (n/= (<reference> param subject)
+ (:coerce Nat valueT))
+
+ (#e.Error error)
+ #0)))]
+
+ [(format "jvm " <domain> " and") bit.and]
+ [(format "jvm " <domain> " or") bit.or]
+ [(format "jvm " <domain> " xor") bit.xor]
+ ))
+ )))))]
+
+ ["int" "jvm convert int-to-long" "jvm convert long-to-int"]
+ ["long" id id]
+ )
+
+(template [<domain> <post> <convert>]
+ [(context: (format "Bit-wise [" <domain> "] { Shifters }")
+ (<| (times +100)
+ (do @
+ [param gen-nat
+ subject gen-nat
+ #let [shift (n/% +10 param)]]
+ (`` ($_ seq
+ (~~ (template [<procedure> <reference> <type> <test> <pre-subject> <pre>]
+ [(test <procedure>
+ (|> (do macro.Monad<Meta>
+ [sampleI (expressionT.translate (<post> ((code.text <procedure>)
+ (<convert> (<pre> 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)
+ (<test> (<reference> shift (<pre-subject> subject))
+ (:coerce <type> valueT))
+
+ (#e.Error error)
+ #0)))]
+
+ [(format "jvm " <domain> " shl") bit.left-shift Nat n/= id code.nat]
+ [(format "jvm " <domain> " shr") bit.arithmetic-right-shift Int i/= nat-to-int (|>> nat-to-int code.int)]
+ [(format "jvm " <domain> " 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 [<domain> <generator> <tag> <=> <<> <pre>]
+ [(context: (format "Order [" <domain> "]")
+ (<| (times +100)
+ (do @
+ [param <generator>
+ subject <generator>]
+ (with-expansions [<tests> (template [<procedure> <reference>]
+ [(test <procedure>
+ (|> (do macro.Monad<Meta>
+ [sampleI (expressionT.translate ((code.text <procedure>)
+ (<pre> (<tag> subject))
+ (<pre> (<tag> param))))]
+ (evalT.eval sampleI))
+ (lang.with-current-module "")
+ (macro.run (io.run init-jvm))
+ (case> (#e.Success valueT)
+ (bit/= (<reference> param subject)
+ (:coerce Bit valueT))
+
+ (#e.Error error)
+ #0)))]
+
+ [(format "jvm " <domain> " =") <=>]
+ [(format "jvm " <domain> " <") <<>]
+ )]
+ ($_ seq
+ <tests>
+ )))))]
+
+ ["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 [<array> (template [<class> <type> <value> <test> <input> <post>]
+ [(test <class>
+ (|> (do macro.Monad<Meta>
+ [sampleI (expressionT.translate (|> (jvm//array//new +0 <class> size)
+ (jvm//array//write <class> idx <input>)
+ (jvm//array//read <class> idx)
+ <post>))]
+ (evalT.eval sampleI))
+ (lang.with-current-module "")
+ (macro.run (io.run init-jvm))
+ (case> (#e.Success outputZ)
+ (<test> <value> (:coerce <type> 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
+ <array>
+ )))))
+
+(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 [<array> (template [<class> <type> <value> <test> <input> <post>]
+ [(test <class>
+ (|> (do macro.Monad<Meta>
+ [sampleI (expressionT.translate (|> (jvm//array//new +0 <class> size)
+ (jvm//array//write <class> idx <input>)
+ (jvm//array//read <class> idx)
+ <post>))]
+ (evalT.eval sampleI))
+ (lang.with-current-module "")
+ (macro.run (io.run init-jvm))
+ (case> (#e.Success outputT)
+ (<test> <value> (:coerce <type> 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
+ <array>
+ (test "java.lang.Double (level 1)"
+ (|> (do macro.Monad<Meta>
+ [#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<Meta>
+ [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<Random> map code.bit))
+ gen-integer (|> r.int (:: r.Functor<Random> map code.int))
+ gen-double (|> r.frac (:: r.Functor<Random> map code.frac))
+ gen-string (|> (r.text +5) (:: r.Functor<Random> 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<Meta>
+ [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<Meta>
+ [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<Meta>
+ [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<Meta>
+ [_ 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<Meta>
+ [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<Meta>
+ [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<Meta>
+ [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<Meta>
+ [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<Meta>
+ [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<Meta>
+ [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<Meta>
+ [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<Meta>
+ [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<Meta>
+ [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<Meta>
+ [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)))
+ ))))