From bae39f32cddb816a6123697269c20dbf4a65ac19 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 9 Oct 2020 01:16:47 -0400 Subject: Also using BIPUSH and SIPUSH during JVM generation. --- stdlib/source/lux/target/jvm/bytecode.lux | 6 +- .../source/lux/target/jvm/bytecode/instruction.lux | 40 +++++- stdlib/source/lux/test.lux | 6 +- .../language/lux/phase/generation/jvm/case.lux | 32 ++--- .../jvm/function/field/variable/partial/count.lux | 4 +- .../lux/phase/generation/jvm/primitive.lux | 28 +++- .../language/lux/phase/generation/jvm/runtime.lux | 2 +- .../lux/phase/generation/jvm/structure.lux | 55 +++++--- stdlib/source/lux/world/net.lux | 2 +- stdlib/source/program/aedifex/cli.lux | 49 +++++-- stdlib/source/program/aedifex/profile.lux | 13 -- stdlib/source/program/aedifex/project.lux | 2 +- stdlib/source/test/aedifex.lux | 4 + stdlib/source/test/aedifex/cli.lux | 108 +++++++++++++++ stdlib/source/test/aedifex/parser.lux | 108 +-------------- stdlib/source/test/aedifex/profile.lux | 154 +++++++++++++++++++++ .../source/test/lux/control/parser/synthesis.lux | 148 +++++++++++--------- stdlib/source/test/lux/data.lux | 2 + stdlib/source/test/lux/data/number.lux | 88 ++++++++++++ stdlib/source/test/lux/target/jvm.lux | 10 +- 20 files changed, 607 insertions(+), 254 deletions(-) create mode 100644 stdlib/source/test/aedifex/cli.lux create mode 100644 stdlib/source/test/aedifex/profile.lux create mode 100644 stdlib/source/test/lux/data/number.lux (limited to 'stdlib') diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux index c46b5bf1f..a22b416e4 100644 --- a/stdlib/source/lux/target/jvm/bytecode.lux +++ b/stdlib/source/lux/target/jvm/bytecode.lux @@ -38,7 +38,7 @@ [encoding ["#." name] ["#." unsigned (#+ U1 U2)] - ["#." signed (#+ S4)]] + ["#." signed (#+ S1 S2 S4)]] ["#." constant (#+ UTF8) ["#/." pool (#+ Pool Resource)]] [attribute @@ -431,7 +431,7 @@ ) (def: #export (bipush byte) - (-> U1 (Bytecode Any)) + (-> S1 (Bytecode Any)) (..bytecode $0 $1 @_ _.bipush [byte])) (def: (lift resource) @@ -668,7 +668,7 @@ (..bytecode @_ ))] [$1 $1 newarray _.newarray Primitive-Array-Type] - [$0 $1 sipush _.sipush U2] + [$0 $1 sipush _.sipush S2] ) (exception: #export (unknown-label {label Label}) diff --git a/stdlib/source/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/lux/target/jvm/bytecode/instruction.lux index dcb74b539..fc7e74987 100644 --- a/stdlib/source/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/lux/target/jvm/bytecode/instruction.lux @@ -30,7 +30,7 @@ ["#." constant (#+ Class Reference)] [encoding ["#." unsigned (#+ U1 U2 U4)] - ["#." signed (#+ S4)]] + ["#." signed (#+ S1 S2 S4)]] [type [category (#+ Value Method)]]]]) @@ -95,7 +95,7 @@ ) (template [ ] - [(with-expansions [ (template.identifier [ "'"])] + [(with-expansions [ (template.identifier ["'" ])] (def: ( opcode input0) (-> Opcode Mutation) (function (_ [offset binary]) @@ -120,6 +120,30 @@ [..size/4 jump/4 Big-Jump binary.write/32 ///signed.value] ) +(template [ ] + [(with-expansions [ (template.identifier ["'" ])] + (def: ( opcode input0) + (-> Opcode Mutation) + (function (_ [offset binary]) + [(n.+ (///unsigned.value ) offset) + (try.assume + (do try.monad + [_ (binary.write/8 offset opcode binary)] + ( (n.+ (///unsigned.value ..opcode-size) offset) + (///signed.value input0) + binary)))])) + + (def: + [Estimator (-> Opcode Instruction)] + [(..fixed ) + (function (_ opcode input0 [size mutation]) + [(n.+ (///unsigned.value ) size) + (|>> mutation (( opcode input0)))])]))] + + [..size/1 unary/1' S1 binary.write/8] + [..size/2 unary/2' S2 binary.write/16] + ) + (def: size/11 Size (|> ..opcode-size @@ -503,16 +527,17 @@ ["C3" monitorexit [] []]]] [..unary/1 - [["10" bipush [[byte U1]] [byte]] - ["12" ldc [[index U1]] [index]] + [["12" ldc [[index U1]] [index]] ["A9" ret [[register Register]] [register]] ["BC" newarray [[type Primitive-Array-Type]] [(..code type)]]]] + [..unary/1' + [["10" bipush [[byte S1]] [byte]]]] + [..unary/2 - [["11" sipush [[short U2]] [short]] - ["13" ldc-w/integer [[index (Index ///constant.Integer)]] [(///index.value index)]] + [["13" ldc-w/integer [[index (Index ///constant.Integer)]] [(///index.value index)]] ["13" ldc-w/float [[index (Index ///constant.Float)]] [(///index.value index)]] ["13" ldc-w/string [[index (Index ///constant.String)]] [(///index.value index)]] ["14" ldc2-w/long [[index (Index ///constant.Long)]] [(///index.value index)]] @@ -526,6 +551,9 @@ ["B7" invokespecial [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.value index)]] ["B8" invokestatic [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.value index)]]]] + [..unary/2' + [["11" sipush [[short S2]] [short]]]] + [..jump/2 []] diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 8570823b1..aace53f25 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -174,7 +174,9 @@ (list.sort (:: name.order <)) (exception.enumerate %.name))) expected-definitions-to-cover (set.size (get@ #expected-coverage counters)) - actual-definitions-covered (set.size (get@ #actual-coverage counters)) + unexpected-definitions-covered (set.size unexpected) + actual-definitions-covered (n.- unexpected-definitions-covered + (set.size (get@ #actual-coverage counters))) coverage (case expected-definitions-to-cover 0 "N/A" expected (let [missing-ratio (f./ (n.frac expected) @@ -204,7 +206,7 @@ ["# Actual definitions covered" (%.nat actual-definitions-covered)] ["# Pending definitions to cover" (%.nat (n.- actual-definitions-covered expected-definitions-to-cover))] - ["# Unexpected definitions covered" (%.nat (set.size unexpected))] + ["# Unexpected definitions covered" (%.nat unexpected-definitions-covered)] ["Coverage" coverage] ["Pending definitions to cover" (report missing)] ["Unexpected definitions covered" (report unexpected)]))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux index 889ac0265..a81e9f244 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux @@ -19,6 +19,7 @@ ["#." type] ["#." runtime (#+ Operation Phase Generator)] ["#." value] + ["#." structure] [//// ["." synthesis (#+ Path Synthesis)] ["." generation] @@ -106,8 +107,8 @@ bodyG (_.goto @end)))) - (^template [ ] - (^ ( idx)) + (^template [ ] + (^ ( lefts)) (operation@wrap (do _.monad [@success _.new-label @@ -115,8 +116,8 @@ ($_ _.compose ..peek (_.checkcast //type.variant) - (..int ( idx)) - + (//structure.tag lefts ) + (//structure.flag ) //runtime.case _.dup (_.ifnull @fail) @@ -126,21 +127,18 @@ (_.goto @else) (_.set-label @success) //runtime.push)))) - ([synthesis.side/left //runtime.left-flag function.identity] - [synthesis.side/right //runtime.right-flag .inc]) + ([synthesis.side/left false] + [synthesis.side/right true]) - (^ (synthesis.member/left lefts)) - (operation@wrap ($_ _.compose - ..peek - (..left-projection lefts) - //runtime.push)) + (^template [ ] + (^ ( lefts)) + (operation@wrap ($_ _.compose + ..peek + ( lefts) + //runtime.push))) + ([synthesis.member/left ..left-projection] + [synthesis.member/right ..right-projection]) - (^ (synthesis.member/right lefts)) - (operation@wrap ($_ _.compose - ..peek - (..right-projection lefts) - //runtime.push)) - ## Extra optimization (^ (synthesis.path/seq (synthesis.member/left 0) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial/count.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial/count.lux index 579a63992..2701862f1 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial/count.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial/count.lux @@ -7,7 +7,7 @@ ["_" bytecode (#+ Bytecode)] [encoding [name (#+ External)] - ["." unsigned]] + ["." signed]] ["." type]]]] ["." ///// #_ ["#." abstract]]) @@ -17,7 +17,7 @@ (def: #export initial (Bytecode Any) - (|> 0 unsigned.u1 try.assume _.bipush)) + (|> +0 signed.s1 try.assume _.bipush)) (def: this _.aload-0) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux index 798288768..8f281fb3a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux @@ -6,7 +6,9 @@ [target [jvm ["_" bytecode (#+ Bytecode)] - ["." type]]]] + ["." type] + [encoding + ["." signed]]]]] ["." // #_ ["#." runtime]]) @@ -46,10 +48,26 @@ [+4 _.iconst-4] [+5 _.iconst-5]) - _ - (do _.monad - [_ (|> value .int _.long)] - ..wrap-i64))) + value + (case (signed.s1 value) + (#try.Success value) + (do _.monad + [_ (_.bipush value) + _ _.i2l] + ..wrap-i64) + + (#try.Failure _) + (case (signed.s2 value) + (#try.Success value) + (do _.monad + [_ (_.sipush value) + _ _.i2l] + ..wrap-i64) + + (#try.Failure _) + (do _.monad + [_ (_.long value)] + ..wrap-i64))))) (def: wrap-f64 (_.invokestatic $Double "valueOf" (type.method [(list type.double) $Double (list)]))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index 224fba5b9..679599858 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -177,7 +177,7 @@ (Bytecode Any) ($_ _.compose _.iconst-0 - _.aconst-null + ..left-flag ..unit ..variant)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux index d48874257..79eafb572 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux @@ -10,7 +10,9 @@ [target [jvm ["_" bytecode (#+ Bytecode)] - ["." type]]]] + ["." type] + [encoding + ["." signed]]]]] ["." // #_ ["#." runtime (#+ Operation Phase Generator)] ["#." primitive] @@ -23,15 +25,11 @@ (def: $Object (type.class "java.lang.Object" (list))) -(def: unitG - (Bytecode Any) - (//primitive.text /////synthesis.unit)) - (def: #export (tuple generate archive membersS) (Generator (Tuple Synthesis)) (case membersS #.Nil - (:: phase.monad wrap ..unitG) + (:: phase.monad wrap //runtime.unit) (#.Cons singletonS #.Nil) (generate archive singletonS) @@ -53,29 +51,42 @@ _ (_.anewarray $Object)] (monad.seq @ membersI)))))) -(def: (flagG right?) +(def: #export (tag lefts right?) + (-> Nat Bit (Bytecode Any)) + (case (if right? + (.inc lefts) + lefts) + 0 _.iconst-0 + 1 _.iconst-1 + 2 _.iconst-2 + 3 _.iconst-3 + 4 _.iconst-4 + 5 _.iconst-5 + tag (case (signed.s1 (.int tag)) + (#try.Success value) + (_.bipush value) + + (#try.Failure _) + (case (signed.s2 (.int tag)) + (#try.Success value) + (_.sipush value) + + (#try.Failure _) + (_.int (.i64 tag)))))) + +(def: #export (flag right?) (-> Bit (Bytecode Any)) (if right? - ..unitG - _.aconst-null)) + //runtime.right-flag + //runtime.left-flag)) (def: #export (variant generate archive [lefts right? valueS]) (Generator (Variant Synthesis)) (do phase.monad - [valueI (generate archive valueS) - #let [tagI (case (if right? - (.inc lefts) - lefts) - 0 _.iconst-0 - 1 _.iconst-1 - 2 _.iconst-2 - 3 _.iconst-3 - 4 _.iconst-4 - 5 _.iconst-5 - tag (_.int (.i64 tag)))]] + [valueI (generate archive valueS)] (wrap (do _.monad - [_ tagI - _ (flagG right?) + [_ (..tag lefts right?) + _ (..flag right?) _ valueI] (_.invokestatic //runtime.class "variant" (type.method [(list type.int $Object $Object) diff --git a/stdlib/source/lux/world/net.lux b/stdlib/source/lux/world/net.lux index ca46b72ba..51219b9ea 100644 --- a/stdlib/source/lux/world/net.lux +++ b/stdlib/source/lux/world/net.lux @@ -1,5 +1,5 @@ (.module: - [lux #* + [lux (#- Location) [control [try (#+ Try)] [security diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux index dc64dee6e..666e5a701 100644 --- a/stdlib/source/program/aedifex/cli.lux +++ b/stdlib/source/program/aedifex/cli.lux @@ -1,8 +1,12 @@ (.module: [lux (#- Name) + [abstract + ["." equivalence (#+ Equivalence)]] [control ["<>" parser - ["." cli (#+ Parser)]]]] + ["." cli (#+ Parser)]]] + [data + ["." text]]] [// [upload (#+ User Password)] ["/" profile (#+ Name)]]) @@ -11,12 +15,23 @@ #Build #Test) +(structure: any-equivalence + (Equivalence Any) + + (def: (= reference subject) + true)) + +(def: compilation-equivalence + (Equivalence Compilation) + (equivalence.sum ..any-equivalence + ..any-equivalence)) + (def: compilation (Parser Compilation) (<>.or (cli.this "build") (cli.this "test"))) -(type: #export Operation +(type: #export Command #POM #Dependencies #Install @@ -24,11 +39,27 @@ (#Compilation Compilation) (#Auto Compilation)) -(type: #export Command - [Name Operation]) +(def: #export equivalence + (Equivalence Command) + ($_ equivalence.sum + ## #POM + ..any-equivalence + ## #Dependencies + ..any-equivalence + ## #Install + ..any-equivalence + ## #Deploy + ($_ equivalence.product + text.equivalence + text.equivalence + text.equivalence) + ## #Compilation + ..compilation-equivalence + ## #Auto + ..compilation-equivalence)) -(def: operation - (Parser Operation) +(def: command' + (Parser Command) ($_ <>.or (cli.this "pom") (cli.this "deps") @@ -44,12 +75,12 @@ )) (def: #export command - (Parser Command) + (Parser [Name Command]) ($_ <>.either (<>.after (cli.this "with") ($_ <>.and cli.any - ..operation)) + ..command')) (:: <>.monad map (|>> [/.default]) - ..operation) + ..command') )) diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux index 02ae69ac8..d8ebf9b18 100644 --- a/stdlib/source/program/aedifex/profile.lux +++ b/stdlib/source/program/aedifex/profile.lux @@ -151,19 +151,6 @@ #test (Maybe Module) #deploy-repositories (Dictionary Text dependency.Repository)}) -(def: #export empty - Profile - {#parents (list) - #identity #.None - #info #.None - #repositories (set.new text.hash) - #dependencies (set.new dependency.hash) - #sources (set.new text.hash) - #target #.None - #program #.None - #test #.None - #deploy-repositories (dictionary.new text.hash)}) - (def: #export equivalence (Equivalence Profile) ($_ equivalence.product diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux index 2e205f722..15abd9ee1 100644 --- a/stdlib/source/program/aedifex/project.lux +++ b/stdlib/source/program/aedifex/project.lux @@ -20,7 +20,7 @@ (Dictionary Name Profile)) (def: #export empty - (dictionary.from-list text.hash (list [//.default //.empty]))) + (dictionary.from-list text.hash (list [//.default (:: //.monoid identity)]))) (def: #export equivalence (Equivalence Project) diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 7286aa50a..8699ad8b9 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -6,11 +6,15 @@ [parser [cli (#+ program:)]]]] ["." / #_ + ["#." profile] + ["#." cli] ["#." parser]]) (def: test Test ($_ _.and + /profile.test + /cli.test /parser.test )) diff --git a/stdlib/source/test/aedifex/cli.lux b/stdlib/source/test/aedifex/cli.lux new file mode 100644 index 000000000..dfbf0b7a9 --- /dev/null +++ b/stdlib/source/test/aedifex/cli.lux @@ -0,0 +1,108 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + [pipe (#+ case>)] + ["." try] + [parser + ["." cli]]] + [data + ["." text ("#@." equivalence)]] + [math + ["." random (#+ Random) ("#@." monad)]]] + {#program + ["." / + ["/#" // #_ + ["#" profile] + [upload (#+ User Password)]]]}) + +(def: compilation + (Random /.Compilation) + (random.or (random@wrap []) + (random@wrap []))) + +(def: command + (Random /.Command) + ($_ random.or + ## #POM + (random@wrap []) + ## #Dependencies + (random@wrap []) + ## #Install + (random@wrap []) + ## #Deploy + ($_ random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1) + (random.ascii/alpha 1)) + ## #Compilation + ..compilation + ## #Auto + ..compilation)) + +(def: (format-compilation value) + (-> /.Compilation (List Text)) + (case value + #/.Build (list "build") + #/.Test (list "test"))) + +(def: (format value) + (-> /.Command (List Text)) + (case value + #/.POM (list "pom") + #/.Dependencies (list "deps") + #/.Install (list "install") + (#/.Deploy repository user password) (list "deploy" repository user password) + (#/.Compilation compilation) (..format-compilation compilation) + (#/.Auto compilation) (list& "auto" (..format-compilation compilation)))) + +(def: without-profile + Test + (do random.monad + [expected ..command] + (_.test "Without profile." + (|> expected + ..format + (cli.run /.command) + (case> (#try.Success [name actual]) + (and (text@= //.default name) + (:: /.equivalence = expected actual)) + + (#try.Failure error) + false))))) + +(def: with-profile + Test + (do random.monad + [expected-profile (random.ascii/alpha 1) + expected-command ..command] + (_.test "With profile." + (|> expected-command + ..format + (list& "with" expected-profile) + (cli.run /.command) + (case> (#try.Success [actual-profile actual-command]) + (and (text@= expected-profile actual-profile) + (:: /.equivalence = expected-command actual-command)) + + (#try.Failure error) + false))))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Compilation /.Command] + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..command)) + + (_.with-cover [/.command] + ($_ _.and + ..without-profile + ..with-profile + )))))) diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux index 97895a201..988883779 100644 --- a/stdlib/source/test/aedifex/parser.lux +++ b/stdlib/source/test/aedifex/parser.lux @@ -10,8 +10,7 @@ [parser ["" code]]] [data - ["." text - ["%" format (#+ format)]] + ["." text] [number ["n" nat]] [collection @@ -22,6 +21,8 @@ ["." random (#+ Random) ("#@." monad)]] [macro ["." code]]] + [// + ["_." profile]] {#program ["." / ["/#" // #_ @@ -31,120 +32,25 @@ ["#." dependency (#+ Repository Dependency)] ["#." format]]]}) -(def: distribution - (Random //.Distribution) - (random.or (random@wrap []) - (random@wrap []))) - -(def: license - (Random //.License) - ($_ random.and - (random.ascii/alpha 1) - (random.ascii/alpha 1) - ..distribution)) - -(def: scm - (Random //.SCM) - (random.ascii/alpha 1)) - -(def: organization - (Random //.Organization) - ($_ random.and - (random.ascii/alpha 1) - (random.ascii/alpha 1))) - -(def: email - (Random //.Email) +(def: name + (Random //.Name) (random.ascii/alpha 1)) -(def: developer - (Random //.Developer) - ($_ random.and - (random.ascii/alpha 1) - (random.ascii/alpha 1) - (random.maybe organization))) - -(def: contributor - (Random //.Contributor) - ..developer) - (def: (list-of random) (All [a] (-> (Random a) (Random (List a)))) (do {@ random.monad} [size (:: @ map (n.% 5) random.nat)] (random.list size random))) -(def: (set-of hash random) - (All [a] (-> (Hash a) (Random a) (Random (Set a)))) - (:: random.functor map - (set.from-list hash) - (..list-of random))) - (def: (dictionary-of key-hash key-random value-random) (All [k v] (-> (Hash k) (Random k) (Random v) (Random (Dictionary k v)))) (:: random.functor map (dictionary.from-list key-hash) (..list-of (random.and key-random value-random)))) -(def: info - (Random //.Info) - ($_ random.and - (random.maybe (random.ascii/alpha 1)) - (random.maybe ..scm) - (random.maybe (random.ascii/alpha 1)) - (..list-of ..license) - (random.maybe ..organization) - (..list-of ..developer) - (..list-of ..contributor) - )) - -(def: name - (Random //.Name) - (random.ascii/alpha 1)) - -(def: artifact - (Random Artifact) - ($_ random.and - (random.ascii/alpha 1) - (random.ascii/alpha 1) - (random.ascii/alpha 1))) - -(def: repository - (Random Repository) - (random.ascii/alpha 1)) - -(def: dependency - (Random Dependency) - ($_ random.and - ..artifact - (random.ascii/alpha 1))) - -(def: source - (Random //.Source) - (random.ascii/alpha 1)) - -(def: target - (Random //.Target) - (random.ascii/alpha 1)) - -(def: profile - (Random //.Profile) - ($_ random.and - (..list-of ..name) - (random.maybe ..artifact) - (random.maybe ..info) - (..set-of text.hash ..repository) - (..set-of //dependency.hash ..dependency) - (..set-of text.hash ..source) - (random.maybe ..target) - (random.maybe (random.ascii/alpha 1)) - (random.maybe (random.ascii/alpha 1)) - (..dictionary-of text.hash (random.ascii/alpha 1) ..repository) - )) - (def: project (Random Project) - (..dictionary-of text.hash ..name ..profile)) + (..dictionary-of text.hash ..name _profile.random)) (def: with-default-sources (-> //.Profile //.Profile) @@ -158,7 +64,7 @@ (def: single-profile Test (do random.monad - [expected ..profile] + [expected _profile.random] (_.test "Single profile." (|> expected //format.profile diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux new file mode 100644 index 000000000..3f1e08cc7 --- /dev/null +++ b/stdlib/source/test/aedifex/profile.lux @@ -0,0 +1,154 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + [hash (#+ Hash)] + {[0 #spec] + [/ + ["$." equivalence] + ["$." monoid]]}] + [control + [pipe (#+ case>)] + ["." try] + [parser + ["." cli]]] + [data + ["." text ("#@." equivalence)] + [number + ["n" nat]] + [collection + ["." set (#+ Set)] + ["." dictionary (#+ Dictionary)]]] + [math + ["." random (#+ Random) ("#@." monad)]]] + {#program + ["." / + ["/#" // #_ + ["#." artifact (#+ Artifact)] + ["#." dependency (#+ Repository Dependency)] + ["#." format]]]}) + +(def: distribution + (Random /.Distribution) + (random.or (random@wrap []) + (random@wrap []))) + +(def: license + (Random /.License) + ($_ random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1) + ..distribution)) + +(def: scm + (Random /.SCM) + (random.ascii/alpha 1)) + +(def: organization + (Random /.Organization) + ($_ random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1))) + +(def: email + (Random /.Email) + (random.ascii/alpha 1)) + +(def: developer + (Random /.Developer) + ($_ random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1) + (random.maybe organization))) + +(def: contributor + (Random /.Contributor) + ..developer) + +(def: (list-of random) + (All [a] (-> (Random a) (Random (List a)))) + (do {@ random.monad} + [size (:: @ map (n.% 5) random.nat)] + (random.list size random))) + +(def: (set-of hash random) + (All [a] (-> (Hash a) (Random a) (Random (Set a)))) + (:: random.functor map + (set.from-list hash) + (..list-of random))) + +(def: (dictionary-of key-hash key-random value-random) + (All [k v] (-> (Hash k) (Random k) (Random v) (Random (Dictionary k v)))) + (:: random.functor map + (dictionary.from-list key-hash) + (..list-of (random.and key-random value-random)))) + +(def: info + (Random /.Info) + ($_ random.and + (random.maybe (random.ascii/alpha 1)) + (random.maybe ..scm) + (random.maybe (random.ascii/alpha 1)) + (..list-of ..license) + (random.maybe ..organization) + (..list-of ..developer) + (..list-of ..contributor) + )) + +(def: name + (Random /.Name) + (random.ascii/alpha 1)) + +(def: artifact + (Random Artifact) + ($_ random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1) + (random.ascii/alpha 1))) + +(def: repository + (Random Repository) + (random.ascii/alpha 1)) + +(def: dependency + (Random Dependency) + ($_ random.and + ..artifact + (random.ascii/alpha 1))) + +(def: source + (Random /.Source) + (random.ascii/alpha 1)) + +(def: target + (Random /.Target) + (random.ascii/alpha 1)) + +(def: #export random + (Random /.Profile) + ($_ random.and + (..list-of ..name) + (random.maybe ..artifact) + (random.maybe ..info) + (..set-of text.hash ..repository) + (..set-of //dependency.hash ..dependency) + (..set-of text.hash ..source) + (random.maybe ..target) + (random.maybe (random.ascii/alpha 1)) + (random.maybe (random.ascii/alpha 1)) + (..dictionary-of text.hash (random.ascii/alpha 1) ..repository) + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Distribution /.License /.SCM /.Organization + /.Email /.Developer /.Contributor /.Info + /.Source /.Target /.Name /.Profile] + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.with-cover [/.monoid] + ($monoid.spec /.equivalence /.monoid ..random)) + )))) diff --git a/stdlib/source/test/lux/control/parser/synthesis.lux b/stdlib/source/test/lux/control/parser/synthesis.lux index 1896d4ca4..dc341a44f 100644 --- a/stdlib/source/test/lux/control/parser/synthesis.lux +++ b/stdlib/source/test/lux/control/parser/synthesis.lux @@ -57,6 +57,84 @@ (:: @ map (|>> synthesis.variable)) (random.list size)))) +(def: valid-frac + (Random Frac) + (random.filter (|>> frac.not-a-number? not) random.frac)) + +(def: simple + Test + (`` ($_ _.and + (~~ (template [ ] + [(do {@ random.monad} + [expected + dummy (|> (random.filter (|>> (:: = expected) not)))] + ($_ _.and + (_.cover [] + (|> (/.run (list ( expected))) + (!expect (^multi (#try.Success actual) + (:: = expected actual))))) + (_.cover [] + (and (|> (/.run ( expected) (list ( expected))) + (!expect (#try.Success _))) + (|> (/.run ( expected) (list ( dummy))) + (!expect (^multi (#try.Failure error) + (exception.match? /.cannot-parse error))))))))] + + [/.bit /.bit! random.bit synthesis.bit bit.equivalence] + [/.i64 /.i64! (:: @ map .i64 random.nat) synthesis.i64 i64.equivalence] + [/.f64 /.f64! ..valid-frac synthesis.f64 frac.equivalence] + [/.text /.text! (random.unicode 1) synthesis.text text.equivalence] + [/.local /.local! random.nat synthesis.variable/local n.equivalence] + [/.foreign /.foreign! random.nat synthesis.variable/foreign n.equivalence] + [/.constant /.constant! ..random-constant synthesis.constant name.equivalence] + )) + ))) + +(def: complex + Test + ($_ _.and + (do {@ random.monad} + [expected-bit random.bit + expected-i64 (:: @ map .i64 random.nat) + expected-f64 ..valid-frac + expected-text (random.unicode 1)] + (_.cover [/.tuple] + (and (|> (/.run (/.tuple ($_ <>.and /.bit /.i64 /.f64 /.text)) + (list (synthesis.tuple (list (synthesis.bit expected-bit) + (synthesis.i64 expected-i64) + (synthesis.f64 expected-f64) + (synthesis.text expected-text))))) + (!expect (^multi (#try.Success [actual-bit actual-i64 actual-f64 actual-text]) + (and (:: bit.equivalence = expected-bit actual-bit) + (:: i64.equivalence = expected-i64 actual-i64) + (:: frac.equivalence = expected-f64 actual-f64) + (:: text.equivalence = expected-text actual-text))))) + (|> (/.run (/.tuple ($_ <>.and /.bit /.i64 /.f64 /.text)) + (list (synthesis.text expected-text))) + (!expect (^multi (#try.Failure error) + (exception.match? /.cannot-parse error))))))) + (do {@ random.monad} + [arity random.nat + expected-environment ..random-environment + expected-body (random.unicode 1)] + (_.cover [/.function /.wrong-arity] + (and (|> (/.run (/.function arity /.text) + (list (synthesis.function/abstraction [expected-environment arity (synthesis.text expected-body)]))) + (!expect (^multi (#try.Success [actual-environment actual-body]) + (and (:: (list.equivalence synthesis.equivalence) = + expected-environment + actual-environment) + (:: text.equivalence = expected-body actual-body))))) + (|> (/.run (/.function arity /.text) + (list (synthesis.text expected-body))) + (!expect (^multi (#try.Failure error) + (exception.match? /.cannot-parse error)))) + (|> (/.run (/.function (inc arity) /.text) + (list (synthesis.function/abstraction [expected-environment arity (synthesis.text expected-body)]))) + (!expect (^multi (#try.Failure error) + (exception.match? /.wrong-arity error))))))) + )) + (def: #export test Test (<| (_.covering /._) @@ -94,70 +172,8 @@ (|> (/.run (<>.before /.any /.end?) (list dummy)) (!expect (#try.Success #0)))))) (_.with-cover [/.cannot-parse] - (`` ($_ _.and - (~~ (template [ ] - [(do {@ random.monad} - [expected - dummy (|> (random.filter (|>> (:: = expected) not)))] - ($_ _.and - (_.cover [] - (|> (/.run (list ( expected))) - (!expect (^multi (#try.Success actual) - (:: = expected actual))))) - (_.cover [] - (and (|> (/.run ( expected) (list ( expected))) - (!expect (#try.Success _))) - (|> (/.run ( expected) (list ( dummy))) - (!expect (^multi (#try.Failure error) - (exception.match? /.cannot-parse error))))))))] - - [/.bit /.bit! random.bit synthesis.bit bit.equivalence] - [/.i64 /.i64! (:: @ map .i64 random.nat) synthesis.i64 i64.equivalence] - [/.f64 /.f64! random.frac synthesis.f64 frac.equivalence] - [/.text /.text! (random.unicode 1) synthesis.text text.equivalence] - [/.local /.local! random.nat synthesis.variable/local n.equivalence] - [/.foreign /.foreign! random.nat synthesis.variable/foreign n.equivalence] - [/.constant /.constant! ..random-constant synthesis.constant name.equivalence] - )) - (do {@ random.monad} - [expected-bit random.bit - expected-i64 (:: @ map .i64 random.nat) - expected-f64 random.frac - expected-text (random.unicode 1)] - (_.cover [/.tuple] - (and (|> (/.run (/.tuple ($_ <>.and /.bit /.i64 /.f64 /.text)) - (list (synthesis.tuple (list (synthesis.bit expected-bit) - (synthesis.i64 expected-i64) - (synthesis.f64 expected-f64) - (synthesis.text expected-text))))) - (!expect (^multi (#try.Success [actual-bit actual-i64 actual-f64 actual-text]) - (and (:: bit.equivalence = expected-bit actual-bit) - (:: i64.equivalence = expected-i64 actual-i64) - (:: frac.equivalence = expected-f64 actual-f64) - (:: text.equivalence = expected-text actual-text))))) - (|> (/.run (/.tuple ($_ <>.and /.bit /.i64 /.f64 /.text)) - (list (synthesis.text expected-text))) - (!expect (^multi (#try.Failure error) - (exception.match? /.cannot-parse error))))))) - (do {@ random.monad} - [arity random.nat - expected-environment ..random-environment - expected-body (random.unicode 1)] - (_.cover [/.function /.wrong-arity] - (and (|> (/.run (/.function arity /.text) - (list (synthesis.function/abstraction [expected-environment arity (synthesis.text expected-body)]))) - (!expect (^multi (#try.Success [actual-environment actual-body]) - (and (:: (list.equivalence synthesis.equivalence) = - expected-environment - actual-environment) - (:: text.equivalence = expected-body actual-body))))) - (|> (/.run (/.function arity /.text) - (list (synthesis.text expected-body))) - (!expect (^multi (#try.Failure error) - (exception.match? /.cannot-parse error)))) - (|> (/.run (/.function (inc arity) /.text) - (list (synthesis.function/abstraction [expected-environment arity (synthesis.text expected-body)]))) - (!expect (^multi (#try.Failure error) - (exception.match? /.wrong-arity error))))))) - ))) + ($_ _.and + ..simple + ..complex + )) ))) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 47a79b530..287a93526 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -13,6 +13,7 @@ ["#." lazy] ["#." maybe] ["#." name] + ["#." number] ["#." product] ["#." sum] [number @@ -88,6 +89,7 @@ /lazy.test /maybe.test /name.test + /number.test /product.test) test2 ($_ _.and /sum.test diff --git a/stdlib/source/test/lux/data/number.lux b/stdlib/source/test/lux/data/number.lux new file mode 100644 index 000000000..876cf4c4d --- /dev/null +++ b/stdlib/source/test/lux/data/number.lux @@ -0,0 +1,88 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [control + ["." try]] + [data + ["." text + ["%" format (#+ format)]] + [number + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac]]]] + {1 + ["." /]}) + +(def: clean-commas + (-> Text Text) + (text.replace-all "," "")) + +(def: #export test + Test + (<| (_.covering /._) + ($_ _.and + (_.cover [/.bin] + (`` (and (~~ (template [<=> ] + [(case (:: decode (..clean-commas )) + (#try.Success actual) + (<=> (/.bin ) actual) + + (#try.Failure error) + false)] + + [n.= n.binary "11001001"] + [n.= n.binary "11,00,10,01"] + + [i.= i.binary "+11001001"] + [i.= i.binary "-11,00,10,01"] + + [r.= r.binary ".11001001"] + [r.= r.binary ".11,00,10,01"] + + [f.= f.binary "+1100.1001"] + [f.= f.binary "-11,00.10,01"] + ))))) + (_.cover [/.oct] + (`` (and (~~ (template [<=> ] + [(case (:: decode (..clean-commas )) + (#try.Success actual) + (<=> (/.oct ) actual) + + (#try.Failure error) + false)] + + [n.= n.octal "615243"] + [n.= n.octal "615,243"] + + [i.= i.octal "+615243"] + [i.= i.octal "-615,243"] + + [r.= r.octal ".615243"] + [r.= r.octal ".615,243"] + + [f.= f.octal "+6152.43"] + [f.= f.octal "-61,52.43"] + ))))) + (_.cover [/.hex] + (`` (and (~~ (template [<=> ] + [(case (:: decode (..clean-commas )) + (#try.Success actual) + (<=> (/.hex ) actual) + + (#try.Failure error) + false)] + + [n.= n.hex "deadBEEF"] + [n.= n.hex "dead,BEEF"] + + [i.= i.hex "+deadBEEF"] + [i.= i.hex "-dead,BEEF"] + + [r.= r.hex ".deadBEEF"] + [r.= r.hex ".dead,BEEF"] + + [f.= f.hex "+dead.BEEF"] + [f.= f.hex "-dead,BE.EF"] + ))))) + ))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 511635a2a..26d3cb42f 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -288,7 +288,7 @@ #random ..$String::random #literal ..$String::literal}) -(template [ ] +(template [ ] [(def: Test (do {@ random.monad} @@ -299,11 +299,11 @@ @.jvm (|>> (:coerce ) "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))})) (do /.monad - [_ ( (|> expected try.assume))] + [_ ( (|> expected .int try.assume))] ))))] - [byte 7 java/lang/Byte /.bipush ..$Byte::wrap "BIPUSH" host.byte-to-long /unsigned.u1] - [short 15 java/lang/Short /.sipush ..$Short::wrap "SIPUSH" host.short-to-long /unsigned.u2] + [byte 7 java/lang/Byte /.bipush ..$Byte::wrap "BIPUSH" host.byte-to-long /signed.s1] + [short 15 java/lang/Short /.sipush ..$Short::wrap "SIPUSH" host.short-to-long /signed.s2] ) (template [ ] @@ -1473,7 +1473,7 @@ [@right /.new-label @wrong /.new-label @return /.new-label - _ (/.bipush (|> minimum /signed.value .nat /unsigned.u1 try.assume)) + _ (/.bipush (|> minimum /signed.value .int /signed.s1 try.assume)) _ (/.tableswitch minimum @wrong [@right (list.repeat afterwards @wrong)]) _ (/.set-label @wrong) _ (..$Long::literal dummy) -- cgit v1.2.3