aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2022-01-10 16:41:27 -0400
committerEduardo Julian2022-01-10 16:41:27 -0400
commit0613deddeb934b523dd59ef0a2c6303716883a0c (patch)
tree41e89c8a041fdaef5c8fc3ad8153f553d064d863
parentb7873d4b68ffc041f9ff134c52a32b54c20febf9 (diff)
Fixes for the pure-Lux JVM compiler machinery. [Part 5]
-rw-r--r--documentation/bookmark/game/mechanic/crafting.md1
-rw-r--r--documentation/bookmark/game/mechanic/relationship.md1
-rw-r--r--documentation/bookmark/game/mechanic/travel.md4
-rw-r--r--lux-jvm/commands.md4
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux18
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux16
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/primitive.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux55
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux66
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux13
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux17
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux9
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux26
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux54
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux43
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux43
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux10
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux49
-rw-r--r--stdlib/source/test/lux/target/ruby.lux32
-rw-r--r--stdlib/source/test/lux/tool.lux4
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux106
22 files changed, 378 insertions, 197 deletions
diff --git a/documentation/bookmark/game/mechanic/crafting.md b/documentation/bookmark/game/mechanic/crafting.md
index b2c89efa8..ed5a8b130 100644
--- a/documentation/bookmark/game/mechanic/crafting.md
+++ b/documentation/bookmark/game/mechanic/crafting.md
@@ -1,4 +1,5 @@
# Reference
+0. [Real-World Herbalism for DnD Campaigns](https://www.youtube.com/watch?v=g2KZlOwDFmE)
0. [Building Better Crafting Systems](https://www.youtube.com/watch?v=Nj7EaryBgak)
diff --git a/documentation/bookmark/game/mechanic/relationship.md b/documentation/bookmark/game/mechanic/relationship.md
index f6b0c7874..39166ebdc 100644
--- a/documentation/bookmark/game/mechanic/relationship.md
+++ b/documentation/bookmark/game/mechanic/relationship.md
@@ -1,4 +1,5 @@
# Reference
+0. [Homebrew Wizard's Familiars || D&D with Dael Kingsmill](https://www.youtube.com/watch?v=qgKVm3q9vcI)
0. [Brenda Romero - Dynamic Relationships and Traits in Empire of Sin](https://www.youtube.com/watch?v=_vf3HO3wn20)
diff --git a/documentation/bookmark/game/mechanic/travel.md b/documentation/bookmark/game/mechanic/travel.md
new file mode 100644
index 000000000..a5c6c1faf
--- /dev/null
+++ b/documentation/bookmark/game/mechanic/travel.md
@@ -0,0 +1,4 @@
+# Reference
+
+0. [Travel VS Exploration || D&D with Dael Kingsmill](https://www.youtube.com/watch?v=DiMiug0T93s)
+
diff --git a/lux-jvm/commands.md b/lux-jvm/commands.md
index a4644f915..aa3299ac9 100644
--- a/lux-jvm/commands.md
+++ b/lux-jvm/commands.md
@@ -32,7 +32,7 @@ cd ~/lux/stdlib/ \
## Use new JVM compiler to compile tests for the Standard Library
cd ~/lux/stdlib/ \
&& lein clean \
-&& java -jar ~/lux/lux-jvm/target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux \
+&& java -jar ~/lux/lux-jvm/target/program.jar build --host_dependency ~/.m2/repository/com/github/luxlang/lux-jvm-function/0.6.5/lux-jvm-function-0.6.5.jar --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux \
&& java -jar ~/lux/stdlib/target/program.jar
```
@@ -40,7 +40,7 @@ cd ~/lux/stdlib/ \
```
cd ~/lux/lux-jvm/ \
-&& mvn install:install-file -Dfile=target/program.jar -DgroupId=com.github.luxlang -DartifactId=lux-jvm -Dversion=0.7.0 -Dpackaging=jar
+&& mvn install:install-file -Dfile=target/program.jar -DgroupId=com.github.luxlang -DartifactId=lux-jvm -Dversion=0.6.6 -Dpackaging=jar
cd ~/lux/lux-jvm/ && mvn deploy:deploy-file \
-Durl=https://USERNAME:PASSWORD@oss.sonatype.org/content/repositories/snapshots/ \
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux
index 888a7a5a5..20f3fdf7a 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux
@@ -54,11 +54,6 @@
{try.#Failure error}
(phase.except extension.invalid_syntax [extension_name %synthesis input]))))
-(import: java/lang/Double
- ["[1]::[0]"
- ("static" MIN_VALUE java/lang/Double)
- ("static" MAX_VALUE java/lang/Double)])
-
(def: $String (type.class "java.lang.String" (list)))
(def: $CharSequence (type.class "java.lang.CharSequence" (list)))
(def: $System (type.class "java.lang.System" (list)))
@@ -160,16 +155,6 @@
[i64::right_shift _.LUSHR]
)
-(template [<name> <const> <type>]
- [(def: (<name> _)
- (Nullary Inst)
- (|>> <const> (_.wrap <type>)))]
-
- [f64::smallest (_.double (java/lang/Double::MIN_VALUE)) type.double]
- [f64::min (_.double (f.* -1.0 (java/lang/Double::MAX_VALUE))) type.double]
- [f64::max (_.double (java/lang/Double::MAX_VALUE)) type.double]
- )
-
(template [<name> <type> <op>]
[(def: (<name> [paramI subjectI])
(Binary Inst)
@@ -341,9 +326,6 @@
(bundle.install "%" (binary f64::%))
(bundle.install "=" (binary f64::=))
(bundle.install "<" (binary f64::<))
- (bundle.install "smallest" (nullary f64::smallest))
- (bundle.install "min" (nullary f64::min))
- (bundle.install "max" (nullary f64::max))
(bundle.install "i64" (unary f64::i64))
(bundle.install "encode" (unary f64::encode))
(bundle.install "decode" (unary f64::decode)))))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
index 17165b434..dc806c8d0 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
@@ -130,26 +130,32 @@
[_.D2F conversion::double_to_float]
[_.D2I conversion::double_to_int]
[_.D2L conversion::double_to_long]
+
[_.F2D conversion::float_to_double]
[_.F2I conversion::float_to_int]
[_.F2L conversion::float_to_long]
+
[_.I2B conversion::int_to_byte]
[_.I2C conversion::int_to_char]
[_.I2D conversion::int_to_double]
[_.I2F conversion::int_to_float]
[_.I2L conversion::int_to_long]
[_.I2S conversion::int_to_short]
+
[_.L2D conversion::long_to_double]
[_.L2F conversion::long_to_float]
[_.L2I conversion::long_to_int]
[..L2S conversion::long_to_short]
[..L2B conversion::long_to_byte]
[..L2C conversion::long_to_char]
+
[_.I2B conversion::char_to_byte]
[_.I2S conversion::char_to_short]
[_.NOP conversion::char_to_int]
[_.I2L conversion::char_to_long]
+
[_.I2L conversion::byte_to_long]
+
[_.I2L conversion::short_to_long]
)
@@ -160,33 +166,39 @@
(bundle.install "double-to-float" (unary conversion::double_to_float))
(bundle.install "double-to-int" (unary conversion::double_to_int))
(bundle.install "double-to-long" (unary conversion::double_to_long))
+
(bundle.install "float-to-double" (unary conversion::float_to_double))
(bundle.install "float-to-int" (unary conversion::float_to_int))
(bundle.install "float-to-long" (unary conversion::float_to_long))
+
(bundle.install "int-to-byte" (unary conversion::int_to_byte))
(bundle.install "int-to-char" (unary conversion::int_to_char))
(bundle.install "int-to-double" (unary conversion::int_to_double))
(bundle.install "int-to-float" (unary conversion::int_to_float))
(bundle.install "int-to-long" (unary conversion::int_to_long))
(bundle.install "int-to-short" (unary conversion::int_to_short))
+
(bundle.install "long-to-double" (unary conversion::long_to_double))
(bundle.install "long-to-float" (unary conversion::long_to_float))
(bundle.install "long-to-int" (unary conversion::long_to_int))
(bundle.install "long-to-short" (unary conversion::long_to_short))
(bundle.install "long-to-byte" (unary conversion::long_to_byte))
(bundle.install "long-to-char" (unary conversion::long_to_char))
+
(bundle.install "char-to-byte" (unary conversion::char_to_byte))
(bundle.install "char-to-short" (unary conversion::char_to_short))
(bundle.install "char-to-int" (unary conversion::char_to_int))
(bundle.install "char-to-long" (unary conversion::char_to_long))
+
(bundle.install "byte-to-long" (unary conversion::byte_to_long))
+
(bundle.install "short-to-long" (unary conversion::short_to_long))
)))
(template [<name> <op>]
- [(def: (<name> [parameterI subject1])
+ [(def: (<name> [parameterI subjectI])
(Binary Inst)
- (|>> subject1
+ (|>> subjectI
parameterI
<op>))]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux
index d3e69daec..0f2b64f9f 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux
@@ -93,7 +93,7 @@
([-1.0 _.ICONST_M1]
... [+0.0 _.ICONST_0]
... [+1.0 _.ICONST_1]
- [+2.0 _.ICONST_2]
+ ... [+2.0 _.ICONST_2]
[+3.0 _.ICONST_3]
[+4.0 _.ICONST_4]
[+5.0 _.ICONST_5])
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux
index 0096a259a..cc373b65b 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux
@@ -28,6 +28,7 @@
["[0]" / "_"
["[1][0]" primitive {"+" Primitive}]
["[1][0]" composite {"+" Tuple Variant Composite}]
+ ["[1][0]" pattern {"+" Pattern}]
[//
[phase
["[0]" extension {"+" Extension}]]
@@ -38,13 +39,6 @@
["[0]" reference {"+" Reference}
["[0]" variable {"+" Register Variable}]]]]])
-(type: .public Pattern
- (Rec Pattern
- (.Variant
- {#Simple Primitive}
- {#Complex (Composite Pattern)}
- {#Bind Register})))
-
(type: .public (Branch' e)
(Record
[#when Pattern
@@ -73,28 +67,11 @@
(type: .public Match
(Match' Analysis))
-(implementation: pattern_equivalence
- (Equivalence Pattern)
-
- (def: (= reference sample)
- (case [reference sample]
- [{#Simple reference} {#Simple sample}]
- (# /primitive.equivalence = reference sample)
-
- [{#Complex reference} {#Complex sample}]
- (# (/composite.equivalence =) = reference sample)
-
- [{#Bind reference} {#Bind sample}]
- (n.= reference sample)
-
- _
- false)))
-
(implementation: (branch_equivalence equivalence)
(-> (Equivalence Analysis) (Equivalence Branch))
(def: (= [reference_pattern reference_body] [sample_pattern sample_body])
- (and (# pattern_equivalence = reference_pattern sample_pattern)
+ (and (# /pattern.equivalence = reference_pattern sample_pattern)
(# equivalence = reference_body sample_body))))
(implementation: .public equivalence
@@ -201,16 +178,6 @@
(template [<name> <tag>]
[(template: .public (<name> content)
- [(.<| {..#Complex}
- <tag>
- content)])]
-
- [pattern/variant {/composite.#Variant}]
- [pattern/tuple {/composite.#Tuple}]
- )
-
-(template [<name> <tag>]
- [(template: .public (<name> content)
[(.<| {..#Structure}
{<tag>}
content)])]
@@ -219,24 +186,6 @@
[tuple /composite.#Tuple]
)
-(template: .public (pattern/unit)
- [{..#Simple {/primitive.#Unit}}])
-
-(template [<name> <tag>]
- [(template: .public (<name> content)
- [{..#Simple {<tag> content}}])]
-
- [pattern/bit /primitive.#Bit]
- [pattern/nat /primitive.#Nat]
- [pattern/int /primitive.#Int]
- [pattern/rev /primitive.#Rev]
- [pattern/frac /primitive.#Frac]
- [pattern/text /primitive.#Text]
- )
-
-(template: .public (pattern/bind register)
- [{..#Bind register}])
-
(def: .public (%analysis analysis)
(Format Analysis)
(case analysis
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux
new file mode 100644
index 000000000..d2b57321f
--- /dev/null
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux
@@ -0,0 +1,66 @@
+(.using
+ [library
+ [lux {"-" Primitive nat int rev}
+ [abstract
+ [equivalence {"+" Equivalence}]]
+ [math
+ [number
+ ["n" nat]]]]]
+ ["[0]" // "_"
+ ["[1][0]" primitive {"+" Primitive}]
+ ["[1][0]" composite {"+" Composite}]
+ [////
+ [reference
+ [variable {"+" Register}]]]])
+
+(type: .public Pattern
+ (Rec Pattern
+ (.Variant
+ {#Simple Primitive}
+ {#Complex (Composite Pattern)}
+ {#Bind Register})))
+
+(implementation: .public equivalence
+ (Equivalence Pattern)
+
+ (def: (= reference sample)
+ (case [reference sample]
+ [{#Simple reference} {#Simple sample}]
+ (# //primitive.equivalence = reference sample)
+
+ [{#Complex reference} {#Complex sample}]
+ (# (//composite.equivalence =) = reference sample)
+
+ [{#Bind reference} {#Bind sample}]
+ (n.= reference sample)
+
+ _
+ false)))
+
+(template [<name> <tag>]
+ [(template: .public (<name> content)
+ [(.<| {..#Complex}
+ <tag>
+ content)])]
+
+ [variant {//composite.#Variant}]
+ [tuple {//composite.#Tuple}]
+ )
+
+(template: .public (unit)
+ [{..#Simple {//primitive.#Unit}}])
+
+(template [<name> <tag>]
+ [(template: .public (<name> content)
+ [{..#Simple {<tag> content}}])]
+
+ [bit //primitive.#Bit]
+ [nat //primitive.#Nat]
+ [int //primitive.#Int]
+ [rev //primitive.#Rev]
+ [frac //primitive.#Frac]
+ [text //primitive.#Text]
+ )
+
+(template: .public (bind register)
+ [{..#Bind register}])
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
index c6e389f6a..4bca0ffcd 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
@@ -30,9 +30,10 @@
["/[1]" // "_"
["[1][0]" extension]
[//
- ["/" analysis {"+" Pattern Analysis Operation Phase}
+ ["/" analysis {"+" Analysis Operation Phase}
["[1][0]" primitive]
- ["[1][0]" composite]]
+ ["[1][0]" composite]
+ ["[1][0]" pattern {"+" Pattern}]]
[///
["[1]" phase]]]]]])
@@ -199,7 +200,7 @@
[nextA next]
(in [(list) nextA]))
matches)]
- (in [(/.pattern/tuple memberP+)
+ (in [(/pattern.tuple memberP+)
thenA])))
_
@@ -230,11 +231,11 @@
[outputA (//scope.with_local [name inputT]
next)
idx //scope.next_local]
- (in [{/.#Bind idx} outputA])))
+ (in [{/pattern.#Bind idx} outputA])))
(^template [<type> <input> <output>]
[[location <input>]
- (analyse_primitive <type> inputT location {/.#Simple <output>} next)])
+ (analyse_primitive <type> inputT location {/pattern.#Simple <output>} next)])
([Bit {.#Bit pattern_value} {/primitive.#Bit pattern_value}]
[Nat {.#Nat pattern_value} {/primitive.#Nat pattern_value}]
[Int {.#Int pattern_value} {/primitive.#Int pattern_value}]
@@ -298,7 +299,7 @@
(` [(~+ values)])
next)
(analyse_pattern {.#None} caseT (` [(~+ values)]) next))]
- (in [(/.pattern/variant [lefts right? testP])
+ (in [(/pattern.variant [lefts right? testP])
nextA]))
_
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux
index 9306b1c20..15bb062a4 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux
@@ -24,9 +24,10 @@
["f" frac]]]]]
["[0]" //// "_"
[//
- ["/" analysis {"+" Pattern Operation}
+ ["/" analysis {"+" Operation}
["[1][0]" primitive]
- ["[1][0]" composite]]
+ ["[1][0]" composite]
+ ["[1][0]" pattern {"+" Pattern}]]
[///
["[1]" phase ("[1]#[0]" monad)]]]])
@@ -116,14 +117,14 @@
(def: .public (determine pattern)
(-> Pattern (Operation Coverage))
(case pattern
- (^or {/.#Simple {/primitive.#Unit}}
- {/.#Bind _})
+ (^or {/pattern.#Simple {/primitive.#Unit}}
+ {/pattern.#Bind _})
(////#in {#Exhaustive})
... Primitive patterns always have partial coverage because there
... are too many possibilities as far as values go.
(^template [<from> <to> <hash>]
- [{/.#Simple {<from> it}}
+ [{/pattern.#Simple {<from> it}}
(////#in {<to> (set.of_list <hash> (list it))})])
([/primitive.#Nat #Nat n.hash]
[/primitive.#Int #Int i.hash]
@@ -134,12 +135,12 @@
... Bits are the exception, since there is only "#1" and
... "#0", which means it is possible for bit
... pattern-matching to become exhaustive if complementary parts meet.
- {/.#Simple {/primitive.#Bit value}}
+ {/pattern.#Simple {/primitive.#Bit value}}
(////#in {#Bit value})
... Tuple patterns can be exhaustive if there is exhaustiveness for all of
... their sub-patterns.
- {/.#Complex {/composite.#Tuple membersP+}}
+ {/pattern.#Complex {/composite.#Tuple membersP+}}
(case (list.reversed membersP+)
(^or {.#End} {.#Item _ {.#End}})
(/.except ..invalid_tuple_pattern [])
@@ -161,7 +162,7 @@
... Variant patterns can be shown to be exhaustive if all the possible
... cases are handled exhaustively.
- {/.#Complex {/composite.#Variant [lefts right? value]}}
+ {/pattern.#Complex {/composite.#Variant [lefts right? value]}}
(do ////.monad
[value_coverage (determine value)
.let [idx (if right?
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
index 49a9758bd..db5642a25 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -51,7 +51,8 @@
["[0]" scope]]
["/[1]" // "_"
["[1][0]" analysis {"+" Analysis Operation Phase Handler Bundle}
- ["[1]/[0]" composite]]
+ ["[1]/[0]" composite]
+ ["[1]/[0]" pattern]]
["[1][0]" synthesis]
[///
["[0]" phase ("[1]#[0]" monad)]
@@ -1971,7 +1972,7 @@
2
{/////analysis.#Case (/////analysis.unit)
[[/////analysis.#when
- {/////analysis.#Bind 2}
+ {/////analysis/pattern.#Bind 2}
/////analysis.#then
bodyA]
@@ -1980,11 +1981,11 @@
_
{/////analysis.#Case (/////analysis.unit)
[[/////analysis.#when
- {/////analysis.#Complex
+ {/////analysis/pattern.#Complex
{/////analysis/composite.#Tuple
(|> arity
list.indices
- (list#each (|>> (n.+ 2) {/////analysis.#Bind})))}}
+ (list#each (|>> (n.+ 2) {/////analysis/pattern.#Bind})))}}
/////analysis.#then
bodyA]
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux
index 1538e19ae..25e88f063 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux
@@ -78,10 +78,6 @@
(///value.unwrap type.long)
_.l2i))
-(def: ensure_string
- (Bytecode Any)
- (_.checkcast $String))
-
(def: (predicate bytecode)
(-> (-> Label (Bytecode Any))
(Bytecode Any))
@@ -262,7 +258,7 @@
(..::toString ..$Double type.double)]
[f64::decode
- ..ensure_string
+ (_.checkcast $String)
///runtime.decode_frac]
)
@@ -304,7 +300,7 @@
(Unary (Bytecode Any))
($_ _.composite
inputG
- ..ensure_string
+ (_.checkcast $String)
(_.invokevirtual ..$String "length" (type.method [(list) (list) type.int (list)]))
..lux_int))
@@ -321,10 +317,10 @@
[text::= ..no_op ..no_op
(_.invokevirtual ..$Object "equals" (type.method [(list) (list ..$Object) type.boolean (list)]))
(///value.wrap type.boolean)]
- [text::< ..ensure_string ..ensure_string
+ [text::< (_.checkcast $String) (_.checkcast $String)
(_.invokevirtual ..$String "compareTo" (type.method [(list) (list ..$String) type.int (list)]))
(..predicate _.iflt)]
- [text::char ..ensure_string ..jvm_int
+ [text::char (_.checkcast $String) ..jvm_int
(_.invokevirtual ..$String "charAt" (type.method [(list) (list type.int) type.char (list)]))
..lux_int]
)
@@ -332,14 +328,14 @@
(def: (text::concat [leftG rightG])
(Binary (Bytecode Any))
($_ _.composite
- leftG ..ensure_string
- rightG ..ensure_string
+ leftG (_.checkcast $String)
+ rightG (_.checkcast $String)
(_.invokevirtual ..$String "concat" (type.method [(list) (list ..$String) ..$String (list)]))))
(def: (text::clip [offset! length! subject!])
(Trinary (Bytecode Any))
($_ _.composite
- subject! ..ensure_string
+ subject! (_.checkcast $String)
offset! ..jvm_int
_.dup
length! ..jvm_int
@@ -353,8 +349,8 @@
[@not_found _.new_label
@end _.new_label]
($_ _.composite
- textG ..ensure_string
- partG ..ensure_string
+ textG (_.checkcast $String)
+ partG (_.checkcast $String)
startG ..jvm_int
(_.invokevirtual ..$String "indexOf" index_method)
_.dup
@@ -386,7 +382,7 @@
($_ _.composite
(_.getstatic ..$System "out" ..$PrintStream)
messageG
- ..ensure_string
+ (_.checkcast $String)
(_.invokevirtual ..$PrintStream "println" ..string_method)
///runtime.unit))
@@ -396,7 +392,7 @@
(_.new ..$Error)
_.dup
messageG
- ..ensure_string
+ (_.checkcast $String)
(_.invokespecial ..$Error "<init>" ..string_method)
_.athrow))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
index dd3816d77..9f461699f 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
@@ -74,16 +74,16 @@
["[0]" artifact]
["[0]" dependency]]]]]]])
-(template [<name> <0> <1>]
+(template [<name> <0>]
[(def: <name>
(Bytecode Any)
($_ _.composite
- <0>
- <1>))]
+ _.l2i
+ <0>))]
- [l2s _.l2i _.i2s]
- [l2b _.l2i _.i2b]
- [l2c _.l2i _.i2c]
+ [l2s _.i2s]
+ [l2b _.i2b]
+ [l2c _.i2c]
)
(template [<conversion> <name>]
@@ -98,26 +98,32 @@
[_.d2f conversion::double_to_float]
[_.d2i conversion::double_to_int]
[_.d2l conversion::double_to_long]
+
[_.f2d conversion::float_to_double]
[_.f2i conversion::float_to_int]
[_.f2l conversion::float_to_long]
+
[_.i2b conversion::int_to_byte]
[_.i2c conversion::int_to_char]
[_.i2d conversion::int_to_double]
[_.i2f conversion::int_to_float]
[_.i2l conversion::int_to_long]
[_.i2s conversion::int_to_short]
+
[_.l2d conversion::long_to_double]
[_.l2f conversion::long_to_float]
[_.l2i conversion::long_to_int]
[..l2s conversion::long_to_short]
[..l2b conversion::long_to_byte]
[..l2c conversion::long_to_char]
+
[_.i2b conversion::char_to_byte]
[_.i2s conversion::char_to_short]
[_.nop conversion::char_to_int]
[_.i2l conversion::char_to_long]
+
[_.i2l conversion::byte_to_long]
+
[_.i2l conversion::short_to_long]
)
@@ -128,35 +134,41 @@
(/////bundle.install "double-to-float" (unary conversion::double_to_float))
(/////bundle.install "double-to-int" (unary conversion::double_to_int))
(/////bundle.install "double-to-long" (unary conversion::double_to_long))
+
(/////bundle.install "float-to-double" (unary conversion::float_to_double))
(/////bundle.install "float-to-int" (unary conversion::float_to_int))
(/////bundle.install "float-to-long" (unary conversion::float_to_long))
+
(/////bundle.install "int-to-byte" (unary conversion::int_to_byte))
(/////bundle.install "int-to-char" (unary conversion::int_to_char))
(/////bundle.install "int-to-double" (unary conversion::int_to_double))
(/////bundle.install "int-to-float" (unary conversion::int_to_float))
(/////bundle.install "int-to-long" (unary conversion::int_to_long))
(/////bundle.install "int-to-short" (unary conversion::int_to_short))
+
(/////bundle.install "long-to-double" (unary conversion::long_to_double))
(/////bundle.install "long-to-float" (unary conversion::long_to_float))
(/////bundle.install "long-to-int" (unary conversion::long_to_int))
(/////bundle.install "long-to-short" (unary conversion::long_to_short))
(/////bundle.install "long-to-byte" (unary conversion::long_to_byte))
(/////bundle.install "long-to-char" (unary conversion::long_to_char))
+
(/////bundle.install "char-to-byte" (unary conversion::char_to_byte))
(/////bundle.install "char-to-short" (unary conversion::char_to_short))
(/////bundle.install "char-to-int" (unary conversion::char_to_int))
(/////bundle.install "char-to-long" (unary conversion::char_to_long))
+
(/////bundle.install "byte-to-long" (unary conversion::byte_to_long))
+
(/////bundle.install "short-to-long" (unary conversion::short_to_long))
)))
(template [<name> <op>]
- [(def: (<name> [xG yG])
+ [(def: (<name> [parameter! subject!])
(Binary (Bytecode Any))
($_ _.composite
- xG
- yG
+ subject!
+ parameter!
<op>))]
[int::+ _.iadd]
@@ -201,14 +213,14 @@
(def: trueG (_.getstatic ..$Boolean "TRUE" ..$Boolean))
(template [<name> <op>]
- [(def: (<name> [xG yG])
+ [(def: (<name> [reference subject])
(Binary (Bytecode Any))
(do _.monad
[@then _.new_label
@end _.new_label]
($_ _.composite
- xG
- yG
+ subject
+ reference
(<op> @then)
falseG
(_.goto @end)
@@ -224,14 +236,14 @@
)
(template [<name> <op> <reference>]
- [(def: (<name> [xG yG])
+ [(def: (<name> [reference subject])
(Binary (Bytecode Any))
(do _.monad
[@then _.new_label
@end _.new_label]
($_ _.composite
- xG
- yG
+ subject
+ reference
<op>
(_.int (i32.i32 (.i64 <reference>)))
(_.if_icmpeq @then)
@@ -571,7 +583,7 @@
(in ($_ _.composite
objectG
(_.instanceof (type.class class (list)))
- (_.invokestatic ..$Boolean "valueOf" (type.method [(list) (list type.boolean) ..$Boolean (list)]))))))]))
+ (///value.wrap type.boolean)))))]))
(def: reflection
(All (_ category)
@@ -593,17 +605,15 @@
(let [$<object> (type.class <object> (list))]
($_ _.composite
valueG
- (_.invokestatic $<object> "valueOf" (type.method [(list) (list <type>) $<object> (list)]))))
+ (///value.wrap <type>)))
(and (text#= <object>
from)
(text#= (..reflection <type>)
to))
- (let [$<object> (type.class <object> (list))]
- ($_ _.composite
- valueG
- (_.checkcast $<object>)
- (_.invokevirtual $<object> <unwrap> (type.method [(list) (list) <type> (list)]))))]
+ ($_ _.composite
+ valueG
+ (///value.unwrap <type>))]
[box.boolean type.boolean "booleanValue"]
[box.byte type.byte "byteValue"]
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux
index 44200c2d2..27cba044c 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux
@@ -113,7 +113,7 @@
([-1.0 _.iconst_m1]
... [+0.0 _.iconst_0]
... [+1.0 _.iconst_1]
- [+2.0 _.iconst_2]
+ ... [+2.0 _.iconst_2]
[+3.0 _.iconst_3]
[+4.0 _.iconst_4]
[+5.0 _.iconst_5])
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux
index d788e3526..d8ab2d2d6 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux
@@ -58,7 +58,7 @@
class.final
))
-(def: nil
+(def: list:end
//runtime.none_injection)
(def: amount_of_inputs
@@ -86,21 +86,28 @@
(def: pair
(Bytecode Any)
- ($_ _.composite
- _.iconst_2
- (_.anewarray ^Object)
- _.dup_x1
- _.swap
- _.iconst_0
- _.swap
- _.aastore
- _.dup_x1
- _.swap
- _.iconst_1
- _.swap
- _.aastore))
+ (let [empty_pair ($_ _.composite
+ _.iconst_2
+ (_.anewarray ^Object)
+ )
+ set_side! (: (-> (Bytecode Any) (Bytecode Any))
+ (function (_ index)
+ ($_ _.composite
+ ... ?P
+ _.dup_x1 ... P?P
+ _.swap ... PP?
+ index ... PP?I
+ _.swap ... PPI?
+ _.aastore ... P
+ )))]
+ ($_ _.composite
+ ... RL
+ empty_pair ... RLP
+ (set_side! _.iconst_0) ... RP
+ (set_side! _.iconst_1) ... P
+ )))
-(def: cons //runtime.right_injection)
+(def: list:item //runtime.right_injection)
(def: input_list
(Bytecode Any)
@@ -108,7 +115,7 @@
[@loop _.new_label
@end _.new_label]
($_ _.composite
- ..nil
+ ..list:end
..amount_of_inputs
(_.set_label @loop)
..decrease
@@ -116,7 +123,7 @@
(_.iflt @end)
..head
..pair
- ..cons
+ ..list:item
_.swap
(_.goto @loop)
(_.set_label @end)
@@ -129,7 +136,7 @@
(Bytecode Any)
($_ _.composite
(_.checkcast //function/abstract.class)
- _.aconst_null
+ //runtime.unit
//runtime.apply))
(def: .public (program artifact_name context program)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
index d71b1817a..ece1fa89e 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
@@ -379,12 +379,15 @@
[(Resource Method) (Resource Method)]
(let [$tuple _.aload_0
$tuple::size ($_ _.composite
- $tuple _.arraylength)
+ $tuple
+ _.arraylength)
$lefts _.iload_1
$last_right ($_ _.composite
- $tuple::size _.iconst_1 _.isub)
+ $tuple::size
+ _.iconst_1
+ _.isub)
update_$lefts ($_ _.composite
$lefts $last_right _.isub
@@ -407,7 +410,8 @@
[@loop _.new_label
@recursive _.new_label
.let [::left ($_ _.composite
- $lefts _.aaload)]]
+ $lefts
+ _.aaload)]]
($_ _.composite
(_.set_label @loop)
$lefts $last_right (_.if_icmpge @recursive)
@@ -430,7 +434,9 @@
_.iconst_1
_.iadd)
$::nested ($_ _.composite
- $tuple _.swap _.aaload)
+ $tuple
+ _.swap
+ _.aaload)
super_nested ($_ _.composite
$tuple
$right
@@ -478,7 +484,6 @@
[@try _.new_label
@handler _.new_label
.let [$unsafe ..this
- unit _.aconst_null
^StringWriter (type.class "java.io.StringWriter" (list))
string_writer ($_ _.composite
@@ -495,19 +500,29 @@
..true ... WTPPWZ
(_.invokespecial ^PrintWriter "<init>" (type.method [(list) (list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)]))
... WTP
- )]]
+ )
+ unsafe_application ($_ _.composite
+ $unsafe
+ ..unit
+ ..apply)
+ stack_trace ($_ _.composite
+ ... T
+ string_writer ... TW
+ _.dup_x1 ... WTW
+ print_writer ... WTP
+ (_.invokevirtual //type.error "printStackTrace" (type.method [(list) (list ^PrintWriter) type.void (list)])) ... W
+ (_.invokevirtual ^StringWriter "toString" (type.method [(list) (list) //type.text (list)])) ... S
+ )]]
($_ _.composite
(_.try @try @handler @handler //type.error)
(_.set_label @try)
- $unsafe unit ..apply
- ..right_injection _.areturn
+ unsafe_application
+ ..right_injection
+ _.areturn
(_.set_label @handler) ... T
- string_writer ... TW
- _.dup_x1 ... WTW
- print_writer ... WTP
- (_.invokevirtual //type.error "printStackTrace" (type.method [(list) (list ^PrintWriter) type.void (list)])) ... W
- (_.invokevirtual ^StringWriter "toString" (type.method [(list) (list) //type.text (list)])) ... S
- ..left_injection _.areturn
+ stack_trace ... S
+ ..left_injection
+ _.areturn
))}))
(def: reflection
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux
index 7827fee86..e7cfad2c2 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux
@@ -18,6 +18,7 @@
[encoding
["[0]" signed]]]]]]
["[0]" // "_"
+ ["[1][0]" type]
["[1][0]" runtime {"+" Operation Phase Generator}]
["[1][0]" primitive]
["///[1]" //// "_"
@@ -27,9 +28,6 @@
[///
["[0]" phase]]]])
-(def: $Object
- (type.class "java.lang.Object" (list)))
-
(def: .public (tuple phase archive membersS)
(Generator (Tuple Synthesis))
(case membersS
@@ -53,7 +51,7 @@
_.aastore))))))]
(in (do [! _.monad]
[_ (_.int (.i64 (list.size membersS)))
- _ (_.anewarray $Object)]
+ _ (_.anewarray //type.value)]
(monad.all ! membersI))))))
(def: .public (lefts lefts)
@@ -93,6 +91,6 @@
_ valueI]
(_.invokestatic //runtime.class "variant"
(type.method [(list)
- (list type.int $Object $Object)
- (type.array $Object)
+ (list //type.lefts //type.right? //type.value)
+ //type.variant
(list)]))))))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux
index 10d71f730..47d9fbe79 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux
@@ -21,9 +21,10 @@
["[0]" /// "_"
[//
["/" synthesis {"+" Path Synthesis Operation Phase}]
- ["[1][0]" analysis {"+" Pattern Match Analysis}
+ ["[1][0]" analysis {"+" Match Analysis}
["[2][0]" primitive]
- ["[2][0]" composite]]
+ ["[2][0]" composite]
+ ["[2][0]" pattern {"+" Pattern}]]
[///
["[1]" phase ("[1]#[0]" monad)]
["[1][0]" reference
@@ -38,7 +39,7 @@
(def: (path' pattern end? thenC)
(-> Pattern Bit (Operation Path) (Operation Path))
(case pattern
- {///analysis.#Simple simple}
+ {///pattern.#Simple simple}
(case simple
{///primitive.#Unit}
thenC
@@ -59,12 +60,12 @@
[///primitive.#Frac /.#F64_Fork |>]
[///primitive.#Text /.#Text_Fork |>]))
- {///analysis.#Bind register}
+ {///pattern.#Bind register}
(<| (# ///.monad each (|>> {/.#Seq {/.#Bind register}}))
/.with_new_local
thenC)
- {///analysis.#Complex {///composite.#Variant [lefts right? value_pattern]}}
+ {///pattern.#Complex {///composite.#Variant [lefts right? value_pattern]}}
(<| (///#each (|>> {/.#Seq {/.#Access {/.#Side (if right?
{.#Right lefts}
{.#Left lefts})}}}))
@@ -72,11 +73,11 @@
(when> [(new> (not end?) [])] [(///#each ..clean_up)])
thenC)
- {///analysis.#Complex {///composite.#Tuple tuple}}
+ {///pattern.#Complex {///composite.#Tuple tuple}}
(let [tuple::last (-- (list.size tuple))]
(list#mix (function (_ [tuple::lefts tuple::member] nextC)
(.case tuple::member
- {///analysis.#Simple {///primitive.#Unit}}
+ {///pattern.#Simple {///primitive.#Unit}}
nextC
_
@@ -193,7 +194,7 @@
<default>)))
(def: (get patterns @selection)
- (-> (///composite.Tuple ///analysis.Pattern) Register (List /.Member))
+ (-> (///composite.Tuple Pattern) Register (List /.Member))
(loop [lefts 0
patterns patterns]
(with_expansions [<failure> (as_is (list))
@@ -208,15 +209,15 @@
{.#Item head tail}
(case head
- {///analysis.#Simple {///primitive.#Unit}}
+ {///pattern.#Simple {///primitive.#Unit}}
<continue>
- {///analysis.#Bind register}
+ {///pattern.#Bind register}
(if (n.= @selection register)
(list <member>)
<continue>)
- {///analysis.#Complex {///composite.#Tuple sub_patterns}}
+ {///pattern.#Complex {///composite.#Tuple sub_patterns}}
(case (get sub_patterns @selection)
{.#End}
<continue>
@@ -235,7 +236,7 @@
(in (/.branch/case [input (list#mix weave headSP tailSP+)]))))
(template: (!masking <variable> <output>)
- [[[{///analysis.#Bind <variable>}
+ [[[{///pattern.#Bind <variable>}
{///analysis.#Reference (///reference.local <output>)}]
(list)]])
@@ -260,12 +261,12 @@
(in (/.branch/if [test then else]))))
(template: (!get <patterns> <output>)
- [[[(///analysis.pattern/tuple <patterns>)
+ [[[(///pattern.tuple <patterns>)
{///analysis.#Reference (///reference.local <output>)}]
(.list)]])
(def: .public (synthesize_get synthesize archive input patterns @member)
- (-> Phase Archive Synthesis (///composite.Tuple ///analysis.Pattern) Register (Operation Synthesis))
+ (-> Phase Archive Synthesis (///composite.Tuple Pattern) Register (Operation Synthesis))
(case (..get patterns @member)
{.#End}
(..synthesize_case synthesize archive input (!get patterns @member))
@@ -286,19 +287,19 @@
(^ (!masking @variable @output))
(..synthesize_masking synthesize^ archive inputS @variable @output)
- [[{///analysis.#Bind @variable} body]
+ [[{///pattern.#Bind @variable} body]
{.#End}]
(..synthesize_let synthesize^ archive inputS @variable body)
- (^or (^ [[(///analysis.pattern/bit #1) then]
- (list [(///analysis.pattern/bit #0) else])])
- (^ [[(///analysis.pattern/bit #1) then]
- (list [(///analysis.pattern/unit) else])])
-
- (^ [[(///analysis.pattern/bit #0) else]
- (list [(///analysis.pattern/bit #1) then])])
- (^ [[(///analysis.pattern/bit #0) else]
- (list [(///analysis.pattern/unit) then])]))
+ (^or (^ [[(///pattern.bit #1) then]
+ (list [(///pattern.bit #0) else])])
+ (^ [[(///pattern.bit #1) then]
+ (list [(///pattern.unit) else])])
+
+ (^ [[(///pattern.bit #0) else]
+ (list [(///pattern.bit #1) then])])
+ (^ [[(///pattern.bit #0) else]
+ (list [(///pattern.unit) then])]))
(..synthesize_if synthesize^ archive inputS then else)
(^ (!get patterns @member))
diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux
index 7723cd776..61fb1197e 100644
--- a/stdlib/source/test/lux/target/ruby.lux
+++ b/stdlib/source/test/lux/target/ruby.lux
@@ -16,7 +16,8 @@
["[0]" text ("[1]#[0]" equivalence)
["%" format {"+" format}]]
[collection
- ["[0]" list ("[1]#[0]" functor)]]]
+ ["[0]" list ("[1]#[0]" functor)]
+ ["[0]" set]]]
["[0]" math
["[0]" random {"+" Random} ("[1]#[0]" monad)]
[number
@@ -299,7 +300,16 @@
(do [! random.monad]
[float/0 random.safe_frac
$foreign (# ! each /.local (random.ascii/lower 10))
- field (# ! each /.string (random.ascii/upper 10))]
+ field (# ! each /.string (random.ascii/upper 10))
+
+ $inputs (# ! each /.local (random.ascii/lower 10))
+ arity (# ! each (n.% 10) random.nat)
+ vals (|> random.int
+ (# ! each /.int)
+ (random.list arity))
+ keys (|> (random.ascii/lower 1)
+ (random.set text.hash arity)
+ (# ! each (|>> set.list (list#each /.string))))]
($_ _.and
(<| (_.for [/.Var])
($_ _.and
@@ -310,6 +320,24 @@
(/.return $foreign))
[(list $foreign)] (/.lambda {.#None})
(/.apply_lambda/* (list (/.float float/0))))))
+ (<| (_.for [/.LVar*])
+ ($_ _.and
+ (_.cover [/.variadic]
+ (expression (|>> (:as Int) .nat (n.= arity))
+ (|> (/.return (/.the "length" $inputs))
+ [(list (/.variadic $inputs))] (/.lambda {.#None})
+ (/.apply_lambda/* vals))))
+ (_.cover [/.splat]
+ (expression (|>> (:as Int) .nat (n.= arity))
+ (|> (/.return (/.the "length" (/.array (list (/.splat $inputs)))))
+ [(list (/.variadic $inputs))] (/.lambda {.#None})
+ (/.apply_lambda/* vals))))))
+ (<| (_.for [/.LVar**])
+ (_.cover [/.variadic_kv /.double_splat]
+ (expression (|>> (:as Int) .nat (n.= arity))
+ (|> (/.return (/.the "length" $inputs))
+ [(list (/.variadic_kv $inputs))] (/.lambda {.#None})
+ (/.apply_lambda/* (list (/.double_splat (/.hash (list.zipped/2 keys vals)))))))))
))
(_.cover [/.Access]
(and (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0)))
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index df128f232..761192245 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -12,7 +12,8 @@
... ["[1][0]" syntax]
["[1][0]" analysis "_"
["[1]/[0]" primitive]
- ["[1]/[0]" composite]]
+ ["[1]/[0]" composite]
+ ["[1]/[0]" pattern]]
... [phase
... ["[1][0]" analysis]
... ["[1][0]" synthesis]]
@@ -30,6 +31,7 @@
/reference.test
/analysis/primitive.test
/analysis/composite.test
+ /analysis/pattern.test
/meta/archive/signature.test
... /syntax.test
... /analysis.test
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux
new file mode 100644
index 000000000..b4ee9e9c8
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux
@@ -0,0 +1,106 @@
+(.using
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ [abstract
+ [monad {"+" do}]
+ [\\specification
+ ["$[0]" equivalence]]]
+ [data
+ ["[0]" bit ("[1]#[0]" equivalence)]
+ ["[0]" text ("[1]#[0]" equivalence)]]
+ [math
+ ["[0]" random {"+" Random} ("[1]#[0]" monad)]
+ [number
+ ["f" frac]]]]]
+ [\\library
+ ["[0]" /]]
+ ["[0]" // "_"
+ ["[1][0]" primitive]
+ ["[1][0]" composite]])
+
+(def: .public random
+ (Random /.Pattern)
+ (random.rec
+ (function (_ random)
+ ($_ random.or
+ //primitive.random
+ (//composite.random 4 random)
+ random.nat
+ ))))
+
+(def: .public test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Pattern])
+ (do random.monad
+ [expected_register random.nat
+ expected_bit random.bit
+ expected_nat random.nat
+ expected_int random.int
+ expected_rev random.rev
+ expected_frac random.frac
+ expected_text (random.ascii/lower 2)
+
+ expected_lefts random.nat
+ expected_right? random.bit])
+ (`` ($_ _.and
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence ..random))
+
+ (_.cover [/.unit]
+ (case (/.unit)
+ (^ (/.unit))
+ true
+
+ _
+ false))
+ (~~ (template [<tag> <value>]
+ [(_.cover [<tag>]
+ (case (<tag> <value>)
+ (^ (<tag> actual))
+ (same? <value> actual)
+
+ _
+ false))]
+
+ [/.bind expected_register]
+ [/.bit expected_bit]
+ [/.nat expected_nat]
+ [/.int expected_int]
+ [/.rev expected_rev]
+ [/.frac expected_frac]
+ [/.text expected_text]
+ ))
+ (_.cover [/.variant]
+ (case (/.variant [expected_lefts expected_right? (/.text expected_text)])
+ (^ (/.variant [actual_lefts actual_right? (/.text actual_text)]))
+ (and (same? expected_lefts actual_lefts)
+ (same? expected_right? actual_right?)
+ (same? expected_text actual_text))
+
+ _
+ false))
+ (_.cover [/.tuple]
+ (case (/.tuple (list (/.bit expected_bit)
+ (/.nat expected_nat)
+ (/.int expected_int)
+ (/.rev expected_rev)
+ (/.frac expected_frac)
+ (/.text expected_text)))
+ (^ (/.tuple (list (/.bit actual_bit)
+ (/.nat actual_nat)
+ (/.int actual_int)
+ (/.rev actual_rev)
+ (/.frac actual_frac)
+ (/.text actual_text))))
+ (and (same? expected_bit actual_bit)
+ (same? expected_nat actual_nat)
+ (same? expected_int actual_int)
+ (same? expected_rev actual_rev)
+ (same? expected_frac actual_frac)
+ (same? expected_text actual_text))
+
+ _
+ false))
+ ))))