diff options
author | Eduardo Julian | 2020-10-09 01:16:47 -0400 |
---|---|---|
committer | Eduardo Julian | 2020-10-09 01:16:47 -0400 |
commit | bae39f32cddb816a6123697269c20dbf4a65ac19 (patch) | |
tree | d9ee53073ebe0d83e29dbd24e0dda8d5dd95dc47 | |
parent | 79aa92dfd81d569fe6120b8e5c00d41528801153 (diff) |
Also using BIPUSH and SIPUSH during JVM generation.
27 files changed, 697 insertions, 290 deletions
diff --git a/documentation/research/database.md b/documentation/research/database.md index 0c6a9f78e..c8b641bae 100644 --- a/documentation/research/database.md +++ b/documentation/research/database.md @@ -15,6 +15,8 @@ # Query +1. https://calcite.apache.org/ +1. https://juxt.pro/blog/crux-sql 1. https://www.influxdata.com/blog/why-were-building-flux-a-new-data-scripting-and-query-language/ 1. https://crate.io/a/lab-notes-how-we-made-joins-23-thousand-times-faster-part-two/ 1. GC: A Graph Caching System for Subgraph/Supergraph Queries diff --git a/documentation/research/math.md b/documentation/research/math.md index 9825cd8d6..a9fc8c7af 100644 --- a/documentation/research/math.md +++ b/documentation/research/math.md @@ -170,6 +170,7 @@ # Geometric Algebra | Clifford Algebra +1. [Differential geometric algebra foundations: Grassmann.jl Ascend](https://www.youtube.com/watch?v=7hlDRLEhc8o&feature=youtu.be) 1. [Projective Geometric Algebra Done Right](http://terathon.com/blog/projective-geometric-algebra-done-right/) 1. [Siggraph2019 Geometric Algebra](https://www.youtube.com/watch?v=tX4H_ctggYo) 1. [Introduction to Clifford Algebra](https://www.av8n.com/physics/clifford-intro.htm) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux index d77e747fd..eea77aaf0 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux @@ -30,7 +30,8 @@ ["$" jvm (#+ Label Inst Operation Phase Generator) ["_" inst]]]]] ["." // - ["." runtime]]) + ["." runtime] + ["." structure]]) (def: (pop-altI stack-depth) (-> Nat Inst) @@ -151,14 +152,14 @@ bodyI (_.GOTO @end)))) - (^template [<pattern> <flag> <prepare>] - (^ (<pattern> idx)) + (^template [<pattern> <right?>] + (^ (<pattern> lefts)) (operation@wrap (<| _.with-label (function (_ @success)) _.with-label (function (_ @fail)) (|>> peekI (_.CHECKCAST //.$Variant) - (_.int (.int (<prepare> idx))) - <flag> + (structure.tagI lefts <right?>) + (structure.flagI <right?>) (_.INVOKESTATIC //.$Runtime "pm_variant" (type.method [(list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)])) _.DUP (_.IFNULL @fail) @@ -168,8 +169,8 @@ (_.GOTO @else) (_.label @success) pushI)))) - ([synthesis.side/left _.NULL function.identity] - [synthesis.side/right (_.string "") .inc]) + ([synthesis.side/left false] + [synthesis.side/right true]) ## Extra optimization (^template [<path> <projection>] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux index 469e730de..24eeef49e 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux @@ -22,6 +22,14 @@ (function (_ value) (operation@wrap (_.GETSTATIC Boolean (if value "TRUE" "FALSE") Boolean))))) +(import: #long java/lang/Byte + (#static MAX_VALUE byte) + (#static MIN_VALUE byte)) + +(import: #long java/lang/Short + (#static MAX_VALUE short) + (#static MIN_VALUE short)) + (def: #export (i64 value) (-> (I64 Any) (Operation Inst)) (case (.int value) @@ -42,9 +50,18 @@ [+4 _.ICONST_4] [+5 _.ICONST_5]) - _ - (let [loadI (|> value .int _.long)] - (operation@wrap (|>> loadI (_.wrap type.long)))))) + value + (let [constantI (cond (and (i.>= (java/lang/Byte::MIN_VALUE) value) + (i.<= (java/lang/Byte::MAX_VALUE) value)) + (|>> (_.BIPUSH value) _.I2L) + + (and (i.>= (java/lang/Short::MIN_VALUE) value) + (i.<= (java/lang/Short::MAX_VALUE) value)) + (|>> (_.SIPUSH value) _.I2L) + + ## else + (|> value .int _.long))] + (operation@wrap (|>> constantI (_.wrap type.long)))))) (import: #long java/lang/Double (#static doubleToRawLongBits #manual [double] int)) @@ -78,11 +95,11 @@ [+5.0 _.ICONST_5]) _ - (let [loadI (if (i.= ..d0-bits - (java/lang/Double::doubleToRawLongBits (:coerce java/lang/Double value))) - _.DCONST_0 - (_.double value))] - (operation@wrap (|>> loadI (_.wrap type.double)))))) + (let [constantI (if (i.= ..d0-bits + (java/lang/Double::doubleToRawLongBits (:coerce java/lang/Double value))) + _.DCONST_0 + (_.double value))] + (operation@wrap (|>> constantI (_.wrap type.double)))))) (def: #export (text value) (-> Text (Operation Inst)) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux index 049c1549a..c61f96bb8 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux @@ -1,12 +1,14 @@ (.module: [lux (#- Type) + ["." host (#+ import:)] [abstract ["." monad (#+ do)]] [control - ["ex" exception (#+ exception:)]] + ["." exception (#+ exception:)]] [data [number - ["n" nat]] + ["n" nat] + ["i" int]] [text ["%" format (#+ format)]] [collection @@ -34,8 +36,9 @@ ["#." runtime]]) (exception: #export (not-a-tuple {size Nat}) - (ex.report ["Expected size" ">= 2"] - ["Actual size" (%.nat size)])) + (exception.report + ["Expected size" ">= 2"] + ["Actual size" (%.nat size)])) (def: #export (tuple generate archive members) (Generator (List Synthesis)) @@ -57,26 +60,51 @@ (_.array //runtime.$Value) membersI)))) -(def: (flagI right?) +(import: #long java/lang/Byte + (#static MAX_VALUE byte) + (#static MIN_VALUE byte)) + +(import: #long java/lang/Short + (#static MAX_VALUE short) + (#static MIN_VALUE short)) + +(def: #export (tagI lefts right?) + (-> Nat Bit Inst) + (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 (let [tag (.int tag)] + (cond (and (i.>= (java/lang/Byte::MIN_VALUE) tag) + (i.<= (java/lang/Byte::MAX_VALUE) tag)) + (_.BIPUSH tag) + + (and (i.>= (java/lang/Short::MIN_VALUE) tag) + (i.<= (java/lang/Short::MAX_VALUE) tag)) + (_.SIPUSH tag) + + ## else + (_.int tag))))) + +(def: #export leftI _.NULL) +(def: #export rightI (_.string "")) + +(def: #export (flagI right?) (-> Bit Inst) (if right? - (_.string "") - _.NULL)) + ..rightI + ..leftI)) (def: #export (variant generate archive [lefts right? member]) (Generator [Nat Bit Synthesis]) (do phase.monad [memberI (generate archive member) - #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 (.int tag)))]] + #let [tagI (..tagI lefts right?)]] (wrap (|>> tagI (flagI right?) memberI diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index 6ee111724..cc109b0f7 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -1182,7 +1182,7 @@ ;; Based on the LuxRT.decode_rev method (defn decode-rev [^String input] (if (and (.startsWith input ".") - (< (.length input) (inc rev-bits))) + (<= (.length input) (inc rev-bits))) (loop [digits-left (-> input (.substring 1) clean-separators @@ -1199,7 +1199,7 @@ (inc index) ouput))) ouput)) - (throw (str "Bad format for Rev number: " input)))) + (throw (new java.lang.Exception (str "Bad format for Rev number: " input))))) ) (defn show-ast [ast] diff --git a/luxc/src/lux/type/host.clj b/luxc/src/lux/type/host.clj index bddc6829b..36e969046 100644 --- a/luxc/src/lux/type/host.clj +++ b/luxc/src/lux/type/host.clj @@ -282,11 +282,16 @@ (&/fold% (partial raise* existential) (&/T [class params]) lineage)) ;; [Exports] +(defn find-class! [class class-loader] + (try (return (Class/forName class true class-loader)) + (catch java.lang.ClassNotFoundException ex + (&/fail-with-loc (str "[Host Error] Cannot find class: " (pr-str class)))))) + (defn ->super-type "(-> Text Text (List Type) (Lux Type))" [existential class-loader super-class sub-class sub-params] - (let [super-class+ (Class/forName super-class true class-loader) - sub-class+ (Class/forName sub-class true class-loader)] + (|do [^Class super-class+ (find-class! super-class class-loader) + ^Class sub-class+ (find-class! sub-class class-loader)] (if (.isAssignableFrom super-class+ sub-class+) (let [lineage (trace-lineage sub-class+ super-class+)] (|do [[^Class sub-class* sub-params*] (raise existential lineage sub-class+ sub-params)] 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 <consumption> <production> @_ <instruction>))] [$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 [<shift> <name> <inputT> <writer> <unwrap>] - [(with-expansions [<private> (template.identifier [<name> "'"])] + [(with-expansions [<private> (template.identifier ["'" <name>])] (def: (<private> opcode input0) (-> Opcode <inputT> Mutation) (function (_ [offset binary]) @@ -120,6 +120,30 @@ [..size/4 jump/4 Big-Jump binary.write/32 ///signed.value] ) +(template [<shift> <name> <inputT> <writer>] + [(with-expansions [<private> (template.identifier ["'" <name>])] + (def: (<private> opcode input0) + (-> Opcode <inputT> Mutation) + (function (_ [offset binary]) + [(n.+ (///unsigned.value <shift>) offset) + (try.assume + (do try.monad + [_ (binary.write/8 offset opcode binary)] + (<writer> (n.+ (///unsigned.value ..opcode-size) offset) + (///signed.value input0) + binary)))])) + + (def: <name> + [Estimator (-> Opcode <inputT> Instruction)] + [(..fixed <shift>) + (function (_ opcode input0 [size mutation]) + [(n.+ (///unsigned.value <shift>) size) + (|>> mutation ((<private> 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]] <register-loads> <register-stores> ["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 [<jumps>]] 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 [<pattern> <flag> <prepare>] - (^ (<pattern> idx)) + (^template [<pattern> <right?>] + (^ (<pattern> lefts)) (operation@wrap (do _.monad [@success _.new-label @@ -115,8 +116,8 @@ ($_ _.compose ..peek (_.checkcast //type.variant) - (..int (<prepare> idx)) - <flag> + (//structure.tag lefts <right?>) + (//structure.flag <right?>) //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 [<pattern> <projection>] + (^ (<pattern> lefts)) + (operation@wrap ($_ _.compose + ..peek + (<projection> 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 ["<c>" 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 [<query> <check> <random> <synthesis> <equivalence>] + [(do {@ random.monad} + [expected <random> + dummy (|> <random> (random.filter (|>> (:: <equivalence> = expected) not)))] + ($_ _.and + (_.cover [<query>] + (|> (/.run <query> (list (<synthesis> expected))) + (!expect (^multi (#try.Success actual) + (:: <equivalence> = expected actual))))) + (_.cover [<check>] + (and (|> (/.run (<check> expected) (list (<synthesis> expected))) + (!expect (#try.Success _))) + (|> (/.run (<check> expected) (list (<synthesis> 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 [<query> <check> <random> <synthesis> <equivalence>] - [(do {@ random.monad} - [expected <random> - dummy (|> <random> (random.filter (|>> (:: <equivalence> = expected) not)))] - ($_ _.and - (_.cover [<query>] - (|> (/.run <query> (list (<synthesis> expected))) - (!expect (^multi (#try.Success actual) - (:: <equivalence> = expected actual))))) - (_.cover [<check>] - (and (|> (/.run (<check> expected) (list (<synthesis> expected))) - (!expect (#try.Success _))) - (|> (/.run (<check> expected) (list (<synthesis> 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 [<=> <codec> <number>] + [(case (:: <codec> decode (..clean-commas <number>)) + (#try.Success actual) + (<=> (/.bin <number>) 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 [<=> <codec> <number>] + [(case (:: <codec> decode (..clean-commas <number>)) + (#try.Success actual) + (<=> (/.oct <number>) 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 [<=> <codec> <number>] + [(case (:: <codec> decode (..clean-commas <number>)) + (#try.Success actual) + (<=> (/.hex <number>) 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 [<name> <bits> <type> <push> <wrap> <message> <to-long> <unsigned>] +(template [<name> <bits> <type> <push> <wrap> <message> <to-long> <signed>] [(def: <name> Test (do {@ random.monad} @@ -299,11 +299,11 @@ @.jvm (|>> (:coerce <type>) <to-long> "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))})) (do /.monad - [_ (<push> (|> expected <unsigned> try.assume))] + [_ (<push> (|> expected .int <signed> try.assume))] <wrap>))))] - [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 [<name> <type>] @@ -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) |