diff options
author | Eduardo Julian | 2020-05-30 15:19:28 -0400 |
---|---|---|
committer | Eduardo Julian | 2020-05-30 15:19:28 -0400 |
commit | b4d0eba7485caf0c6cf58de1193a9114fa273d8b (patch) | |
tree | f6f7fa2967bb5923347db1ed1d4c9b08e56bf8c6 /new-luxc/test | |
parent | 6eaa3b57f3f1ea2ce13b942bdb4ef502fc1729bc (diff) |
Split new-luxc into lux-jvm and lux-r.
Diffstat (limited to 'new-luxc/test')
-rw-r--r-- | new-luxc/test/test/luxc/lang/analysis/host.jvm.lux | 549 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/lang/synthesis/loop.lux | 162 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/lang/synthesis/procedure.lux | 34 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/lang/translation/js.lux | 160 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/lang/translation/jvm.lux | 641 |
5 files changed, 0 insertions, 1546 deletions
diff --git a/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux b/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux deleted file mode 100644 index f9905c8bc..000000000 --- a/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux +++ /dev/null @@ -1,549 +0,0 @@ -(.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/new-luxc/test/test/luxc/lang/synthesis/loop.lux b/new-luxc/test/test/luxc/lang/synthesis/loop.lux deleted file mode 100644 index c6efa7dbf..000000000 --- a/new-luxc/test/test/luxc/lang/synthesis/loop.lux +++ /dev/null @@ -1,162 +0,0 @@ -(.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/new-luxc/test/test/luxc/lang/synthesis/procedure.lux b/new-luxc/test/test/luxc/lang/synthesis/procedure.lux deleted file mode 100644 index ab6c9de6f..000000000 --- a/new-luxc/test/test/luxc/lang/synthesis/procedure.lux +++ /dev/null @@ -1,34 +0,0 @@ -(.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/new-luxc/test/test/luxc/lang/translation/js.lux b/new-luxc/test/test/luxc/lang/translation/js.lux deleted file mode 100644 index 83108c594..000000000 --- a/new-luxc/test/test/luxc/lang/translation/js.lux +++ /dev/null @@ -1,160 +0,0 @@ -(.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/new-luxc/test/test/luxc/lang/translation/jvm.lux b/new-luxc/test/test/luxc/lang/translation/jvm.lux deleted file mode 100644 index 7c97b1e78..000000000 --- a/new-luxc/test/test/luxc/lang/translation/jvm.lux +++ /dev/null @@ -1,641 +0,0 @@ -(.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))) - )))) |