aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2022-01-27 04:41:30 -0400
committerEduardo Julian2022-01-27 04:41:30 -0400
commitfe0d9fc74740f1b51e2f498d4516579d3e48ed02 (patch)
tree262915912719c6bb300c13f6a7047f9210778309
parentf7d06f791e618aed285b0ed92057f2270d622f8a (diff)
Fixes for the pure-Lux JVM compiler machinery. [Part 11]
Diffstat (limited to '')
-rw-r--r--documentation/bookmark/artificial_intelligence/differentiable_programming.md16
-rw-r--r--documentation/bookmark/artificial_intelligence/machine_learning.md78
-rw-r--r--documentation/bookmark/back_end/c++.md1
-rw-r--r--documentation/bookmark/machine_learning.md93
-rw-r--r--stdlib/source/library/lux/control/concurrency/thread.lux105
-rw-r--r--stdlib/source/library/lux/target/jvm/field.lux58
-rw-r--r--stdlib/source/library/lux/target/ruby.lux10
-rw-r--r--stdlib/source/library/lux/tool/compiler/default/init.lux6
-rw-r--r--stdlib/source/library/lux/tool/compiler/default/platform.lux7
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux.lux35
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux (renamed from stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux)65
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux62
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux144
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux11
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux8
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux21
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/script.lux7
-rw-r--r--stdlib/source/test/lux/program.lux42
-rw-r--r--stdlib/source/test/lux/target/jvm.lux4
-rw-r--r--stdlib/source/test/lux/target/ruby.lux146
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux2
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux341
25 files changed, 869 insertions, 399 deletions
diff --git a/documentation/bookmark/artificial_intelligence/differentiable_programming.md b/documentation/bookmark/artificial_intelligence/differentiable_programming.md
new file mode 100644
index 000000000..9bfd27186
--- /dev/null
+++ b/documentation/bookmark/artificial_intelligence/differentiable_programming.md
@@ -0,0 +1,16 @@
+# Reference
+
+0. [Differentiable Programming in C++ - Vassil Vassilev & William Moses - CppCon 2021](https://www.youtube.com/watch?v=1QQj1mAV-eY)
+0. [Demystifying Differentiable Programming: Shift/Reset the Penultimate Backpropagator](https://arxiv.org/abs/1803.10228)
+0. [The Taichi Programming Language](http://taichi.graphics/)
+0. [The principles behind Differentiable Programming - Erik Meijer](https://www.youtube.com/watch?v=lk0PhtSHE38)
+0. [Kotlin∇: Type-safe Symbolic Differentiation for Kotlin](https://github.com/breandan/kotlingrad)
+0. [Differentiable Programming Manifesto](https://github.com/apple/swift/blob/master/docs/DifferentiableProgramming.md)
+0. [Backpropagation in the Simply Typed Lambda-calculus with Linear Negation](https://arxiv.org/abs/1909.13768)
+0. [One-and-a-Half Simple Differential Programming Languages](https://pages.cpsc.ucalgary.ca/~robin/FMCS/FMCS2019/slides/GordonPlotkin-FMCS2019.pdf)
+0. [Differentiable Programming Mega-Proposal](https://forums.swift.org/t/differentiable-programming-mega-proposal/28547)
+0. https://fluxml.ai/2019/02/07/what-is-differentiable-programming.html
+0. https://github.com/breandan/kotlingrad
+0. https://colinraffel.com/blog/you-don-t-know-jax.html
+0. https://github.com/tensorflow/mlir
+
diff --git a/documentation/bookmark/artificial_intelligence/machine_learning.md b/documentation/bookmark/artificial_intelligence/machine_learning.md
new file mode 100644
index 000000000..a998c7aaa
--- /dev/null
+++ b/documentation/bookmark/artificial_intelligence/machine_learning.md
@@ -0,0 +1,78 @@
+# Transformer
+
+0. [Transformers from scratch](http://www.peterbloem.nl/blog/transformers)
+
+# Exemplar
+
+0. https://ml5js.org/
+0. https://www.csie.ntu.edu.tw/~cjlin/libsvm/
+0. http://halide-lang.org/
+
+# Reference
+
+0. [Why are ML Compilers so Hard?](https://petewarden.com/2021/12/24/why-are-ml-compilers-so-hard/)
+0. ["Multi-Level Intermediate Representation" Compiler Infrastructure](https://github.com/tensorflow/mlir)
+0. [Sampling can be faster than optimization](https://www.pnas.org/content/116/42/20881)
+0. [Layer rotation: a surprisingly powerful indicator of generalization in deep networks](https://arxiv.org/abs/1806.01603v2)
+0. https://nostalgebraist.tumblr.com/post/185326092369/the-transformer-explained
+0. [HyperE: Hyperbolic Embeddings for Entities](https://hazyresearch.github.io/hyperE/)
+0. https://www.samcoope.com/posts/playing_around_with_noise_as_targets
+0. https://lobste.rs/s/hgejxf/why_is_machine_learning_most_often
+0. https://boingboing.net/2018/11/12/local-optima-r-us.html/amp
+0. https://crazyoscarchang.github.io/2019/02/16/seven-myths-in-machine-learning-research/
+0. https://www.c4ml.org/
+0. https://medium.com/@l2k/why-are-machine-learning-projects-so-hard-to-manage-8e9b9cf49641
+0. https://github.com/MikeInnes/diff-zoo
+0. https://cloud.google.com/blog/products/ai-machine-learning/introducing-feast-an-open-source-feature-store-for-machine-learning
+0. https://towardsdatascience.com/introducing-manifold-db9e90f20347
+0. http://snap.stanford.edu/graphsage/
+0. https://heartbeat.fritz.ai/capsule-networks-a-new-and-attractive-ai-architecture-bd1198cc8ad4
+0. http://super-ms.mit.edu/rum.html
+
+# Inductive logic programming
+
+0. [Inductive logic programming at 30: a new introduction](https://arxiv.org/abs/2008.07912)
+
+# Deep learning
+
+0. [GAME2020 4. Dr. Vincent Nozick Geometric Neurons](https://www.youtube.com/watch?v=KC3c_Mdj1dk)
+0. [Evolution Strategies](https://lilianweng.github.io/lil-log/2019/09/05/evolution-strategies.html)
+0. [Monadic Deep Learning: Performing monadic automatic differentiation in parallel](https://deeplearning.thoughtworks.school/assets/paper.pdf)
+0. https://github.com/microsoft/tensorwatch
+0. https://d2l.ai/
+0. https://hadrienj.github.io/posts/Deep-Learning-Book-Series-Introduction/
+0. http://nlp.seas.harvard.edu/NamedTensor
+0. https://tvm.ai/
+0. https://machinelearningmastery.com/framework-for-better-deep-learning/
+0. [Geometric Understanding of Deep Learning](https://arxiv.org/abs/1805.10451)
+0. https://towardsdatascience.com/what-is-geometric-deep-learning-b2adb662d91d
+0. https://deeplearning4j.org/
+0. [Deep(er) learning](http://www.jneurosci.org/content/early/2018/07/13/JNEUROSCI.0153-18.2018?versioned=true)
+
+# Neural network
+
+0. https://github.com/BrainJS/brain.js
+0. https://blog.jle.im/entry/practical-dependent-types-in-haskell-1.html
+0. https://matloff.wordpress.com/2018/06/20/neural-networks-are-essentially-polynomial-regression/
+0. https://www.quantamagazine.org/foundations-built-for-a-general-theory-of-neural-networks-20190131#AI
+0. https://rkevingibson.github.io/blog/neural-networks-as-ordinary-differential-equations/
+
+# Tensor
+
+0. http://nlp.seas.harvard.edu/NamedTensor.html
+0. http://nlp.seas.harvard.edu/NamedTensor2
+
+# Meta-learning
+
+0. https://blog.fastforwardlabs.com/2019/05/22/metalearners-learning-how-to-learn.html
+0. https://www.bayeswatch.com/2018/11/30/HTYM/
+0. https://bender.dreem.com/
+
+# Model
+
+0. http://onnx.ai/
+
+# Training
+
+0. https://ai.googleblog.com/2019/03/introducing-gpipe-open-source-library.html
+
diff --git a/documentation/bookmark/back_end/c++.md b/documentation/bookmark/back_end/c++.md
index e9e684c4e..21664d692 100644
--- a/documentation/bookmark/back_end/c++.md
+++ b/documentation/bookmark/back_end/c++.md
@@ -1,5 +1,6 @@
# Reference
+0. [Back to Basics: Move Semantics - Nicolai Josuttis - CppCon 2021](https://www.youtube.com/watch?v=Bt3zcJZIalk)
0. [Type-and-resource Safety in Modern C++ - Bjarne Stroustrup - CppCon 2021](https://www.youtube.com/watch?v=l3rvjWfBzZI)
0. [Exceptional C++ - Victor Ciura - CppCon 2021](https://www.youtube.com/watch?v=SjlfhyZn2yA)
diff --git a/documentation/bookmark/machine_learning.md b/documentation/bookmark/machine_learning.md
deleted file mode 100644
index 6d11d7ca0..000000000
--- a/documentation/bookmark/machine_learning.md
+++ /dev/null
@@ -1,93 +0,0 @@
-# Transformer
-
-1. [Transformers from scratch](http://www.peterbloem.nl/blog/transformers)
-
-# Exemplar
-
-1. https://ml5js.org/
-1. https://www.csie.ntu.edu.tw/~cjlin/libsvm/
-1. http://halide-lang.org/
-
-# Reference
-
-1. [Why are ML Compilers so Hard?](https://petewarden.com/2021/12/24/why-are-ml-compilers-so-hard/)
-1. ["Multi-Level Intermediate Representation" Compiler Infrastructure](https://github.com/tensorflow/mlir)
-1. [Sampling can be faster than optimization](https://www.pnas.org/content/116/42/20881)
-1. [Layer rotation: a surprisingly powerful indicator of generalization in deep networks](https://arxiv.org/abs/1806.01603v2)
-1. https://nostalgebraist.tumblr.com/post/185326092369/the-transformer-explained
-1. [HyperE: Hyperbolic Embeddings for Entities](https://hazyresearch.github.io/hyperE/)
-1. https://www.samcoope.com/posts/playing_around_with_noise_as_targets
-1. https://lobste.rs/s/hgejxf/why_is_machine_learning_most_often
-1. https://boingboing.net/2018/11/12/local-optima-r-us.html/amp
-1. https://crazyoscarchang.github.io/2019/02/16/seven-myths-in-machine-learning-research/
-1. https://www.c4ml.org/
-1. https://medium.com/@l2k/why-are-machine-learning-projects-so-hard-to-manage-8e9b9cf49641
-1. https://github.com/MikeInnes/diff-zoo
-1. https://cloud.google.com/blog/products/ai-machine-learning/introducing-feast-an-open-source-feature-store-for-machine-learning
-1. https://towardsdatascience.com/introducing-manifold-db9e90f20347
-1. http://snap.stanford.edu/graphsage/
-1. https://heartbeat.fritz.ai/capsule-networks-a-new-and-attractive-ai-architecture-bd1198cc8ad4
-1. http://super-ms.mit.edu/rum.html
-
-# Inductive logic programming
-
-1. [Inductive logic programming at 30: a new introduction](https://arxiv.org/abs/2008.07912)
-
-# Deep learning
-
-1. [GAME2020 4. Dr. Vincent Nozick Geometric Neurons](https://www.youtube.com/watch?v=KC3c_Mdj1dk)
-1. [Evolution Strategies](https://lilianweng.github.io/lil-log/2019/09/05/evolution-strategies.html)
-1. [Monadic Deep Learning: Performing monadic automatic differentiation in parallel](https://deeplearning.thoughtworks.school/assets/paper.pdf)
-1. [Demystifying Differentiable Programming: Shift/Reset the Penultimate Backpropagator](https://arxiv.org/abs/1803.10228)
-1. https://github.com/microsoft/tensorwatch
-1. https://d2l.ai/
-1. https://hadrienj.github.io/posts/Deep-Learning-Book-Series-Introduction/
-1. http://nlp.seas.harvard.edu/NamedTensor
-1. https://tvm.ai/
-1. https://machinelearningmastery.com/framework-for-better-deep-learning/
-1. [Geometric Understanding of Deep Learning](https://arxiv.org/abs/1805.10451)
-1. https://towardsdatascience.com/what-is-geometric-deep-learning-b2adb662d91d
-1. https://deeplearning4j.org/
-1. [Deep(er) learning](http://www.jneurosci.org/content/early/2018/07/13/JNEUROSCI.0153-18.2018?versioned=true)
-
-# Neural network
-
-1. https://github.com/BrainJS/brain.js
-1. https://blog.jle.im/entry/practical-dependent-types-in-haskell-1.html
-1. https://matloff.wordpress.com/2018/06/20/neural-networks-are-essentially-polynomial-regression/
-1. https://www.quantamagazine.org/foundations-built-for-a-general-theory-of-neural-networks-20190131#AI
-1. https://rkevingibson.github.io/blog/neural-networks-as-ordinary-differential-equations/
-
-# Tensor
-
-1. http://nlp.seas.harvard.edu/NamedTensor.html
-1. http://nlp.seas.harvard.edu/NamedTensor2
-
-# Meta-learning
-
-1. https://blog.fastforwardlabs.com/2019/05/22/metalearners-learning-how-to-learn.html
-1. https://www.bayeswatch.com/2018/11/30/HTYM/
-1. https://bender.dreem.com/
-
-# Model
-
-1. http://onnx.ai/
-
-# Training
-
-1. https://ai.googleblog.com/2019/03/introducing-gpipe-open-source-library.html
-
-# Differentiable programming
-
-1. [The Taichi Programming Language](http://taichi.graphics/)
-1. [The principles behind Differentiable Programming - Erik Meijer](https://www.youtube.com/watch?v=lk0PhtSHE38)
-1. [Kotlin∇: Type-safe Symbolic Differentiation for Kotlin](https://github.com/breandan/kotlingrad)
-1. [Differentiable Programming Manifesto](https://github.com/apple/swift/blob/master/docs/DifferentiableProgramming.md)
-1. [Backpropagation in the Simply Typed Lambda-calculus with Linear Negation](https://arxiv.org/abs/1909.13768)
-1. [One-and-a-Half Simple Differential Programming Languages](https://pages.cpsc.ucalgary.ca/~robin/FMCS/FMCS2019/slides/GordonPlotkin-FMCS2019.pdf)
-1. [Differentiable Programming Mega-Proposal](https://forums.swift.org/t/differentiable-programming-mega-proposal/28547)
-1. https://fluxml.ai/2019/02/07/what-is-differentiable-programming.html
-1. https://github.com/breandan/kotlingrad
-1. https://colinraffel.com/blog/you-don-t-know-jax.html
-1. https://github.com/tensorflow/mlir
-
diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux
index a43bc47a5..9d91b6ee8 100644
--- a/stdlib/source/library/lux/control/concurrency/thread.lux
+++ b/stdlib/source/library/lux/control/concurrency/thread.lux
@@ -1,26 +1,26 @@
(.using
- [library
- [lux "*"
- ["@" target]
- ["[0]" ffi]
- [abstract
- ["[0]" monad {"+" do}]]
- [control
- ["[0]" try]
- ["[0]" exception {"+" exception:}]
- ["[0]" io {"+" IO io}]]
- [data
- ["[0]" text]
- [collection
- ["[0]" list]]]
- [math
- [number
- ["n" nat]
- ["f" frac]]]
- [time
- ["[0]" instant]]]]
- [//
- ["[0]" atom {"+" Atom}]])
+ [library
+ [lux "*"
+ ["@" target]
+ ["[0]" ffi]
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [control
+ ["[0]" try]
+ ["[0]" exception {"+" exception:}]
+ ["[0]" io {"+" IO io}]]
+ [data
+ ["[0]" text]
+ [collection
+ ["[0]" list]]]
+ [math
+ [number
+ ["n" nat]
+ ["f" frac]]]
+ [time
+ ["[0]" instant]]]]
+ [//
+ ["[0]" atom {"+" Atom}]])
(with_expansions [<jvm> (as_is (ffi.import: java/lang/Object)
@@ -84,9 +84,12 @@
@.python (as_is)]
... Default
- (def: runner
- (Atom (List Thread))
- (atom.atom (list)))))
+ (as_is (def: started?
+ (Atom Bit)
+ (atom.atom false))
+ (def: runner
+ (Atom (List Thread))
+ (atom.atom (list))))))
(def: (execute! action)
(-> (IO Any) Any)
@@ -147,27 +150,33 @@
... Starts the event-loop.
(def: .public run!
(IO Any)
- (loop [_ []]
- (do [! io.monad]
- [threads (atom.read! ..runner)]
- (case threads
- ... And... we're done!
- {.#End}
- (in [])
-
- _
- (do !
- [now (# ! each (|>> instant.millis .nat) instant.now)
- .let [[ready pending] (list.partition (function (_ thread)
- (|> (value@ #creation thread)
- (n.+ (value@ #delay thread))
- (n.<= now)))
- threads)]
- swapped? (atom.compare_and_swap! threads pending ..runner)]
- (if swapped?
- (do !
- [_ (monad.each ! (|>> (value@ #action) ..execute! io.io) ready)]
- (again []))
- (panic! (exception.error ..cannot_continue_running_threads []))))
- ))))
+ (do [! io.monad]
+ [started? (atom.read! ..started?)]
+ (if started?
+ (in [])
+ (do !
+ [_ (atom.write! true ..started?)]
+ (loop [_ []]
+ (do !
+ [threads (atom.read! ..runner)]
+ (case threads
+ ... And... we're done!
+ {.#End}
+ (in [])
+
+ _
+ (do !
+ [now (# ! each (|>> instant.millis .nat) instant.now)
+ .let [[ready pending] (list.partition (function (_ thread)
+ (|> (value@ #creation thread)
+ (n.+ (value@ #delay thread))
+ (n.<= now)))
+ threads)]
+ swapped? (atom.compare_and_swap! threads pending ..runner)]
+ (if swapped?
+ (do !
+ [_ (monad.each ! (|>> (value@ #action) ..execute! io.io) ready)]
+ (again []))
+ (panic! (exception.error ..cannot_continue_running_threads []))))
+ )))))))
))
diff --git a/stdlib/source/library/lux/target/jvm/field.lux b/stdlib/source/library/lux/target/jvm/field.lux
index 31b302954..ee6daa975 100644
--- a/stdlib/source/library/lux/target/jvm/field.lux
+++ b/stdlib/source/library/lux/target/jvm/field.lux
@@ -1,24 +1,24 @@
(.using
- [library
- [lux {"-" Type static public private}
- [abstract
- [equivalence {"+" Equivalence}]
- ["[0]" monad {"+" do}]]
- [data
- ["[0]" product]
- [format
- ["[0]F" binary {"+" Writer} ("[1]#[0]" monoid)]]
- [collection
- ["[0]" sequence {"+" Sequence}]]]]]
- ["[0]" // "_"
- ["[0]" modifier {"+" Modifier modifiers:}]
- ["[1][0]" constant {"+" UTF8}
- ["[1]/[0]" pool {"+" Pool Resource}]]
- ["[1][0]" index {"+" Index}]
- ["[1][0]" attribute {"+" Attribute}]
- ["[1][0]" type {"+" Type}
- [category {"+" Value}]
- [descriptor {"+" Descriptor}]]])
+ [library
+ [lux {"-" Type static public private}
+ [abstract
+ [equivalence {"+" Equivalence}]
+ ["[0]" monad {"+" do}]]
+ [data
+ ["[0]" product]
+ [format
+ ["[0]F" binary {"+" Writer} ("[1]#[0]" monoid)]]
+ [collection
+ ["[0]" sequence {"+" Sequence}]]]]]
+ ["[0]" // "_"
+ ["[0]" modifier {"+" Modifier modifiers:}]
+ ["[1][0]" constant {"+" UTF8}
+ ["[1]/[0]" pool {"+" Pool Resource}]]
+ ["[1][0]" index {"+" Index}]
+ ["[1][0]" attribute {"+" Attribute}]
+ ["[1][0]" type {"+" Type}
+ [category {"+" Value}]
+ [descriptor {"+" Descriptor}]]])
(type: .public Field
(Rec Field
@@ -60,13 +60,21 @@
[(binaryF.sequence/16 //attribute.writer) #attributes]))
)))
-(def: .public (field modifier name type attributes)
- (-> (Modifier Field) UTF8 (Type Value) (Sequence Attribute)
+(def: .public (field modifier name type with_signature? attributes)
+ (-> (Modifier Field) UTF8 (Type Value) Bit (Sequence Attribute)
(Resource Field))
- (do //constant/pool.monad
+ (do [! //constant/pool.monad]
[@name (//constant/pool.utf8 name)
- @descriptor (//constant/pool.descriptor (//type.descriptor type))]
+ @descriptor (//constant/pool.descriptor (//type.descriptor type))
+ @signature (if with_signature?
+ (# ! each (|>> {.#Some}) (//attribute.signature (//type.signature type)))
+ (in {.#None}))]
(in [#modifier modifier
#name @name
#descriptor @descriptor
- #attributes attributes])))
+ #attributes (case @signature
+ {.#Some @signature}
+ (sequence.suffix @signature attributes)
+
+ {.#None}
+ attributes)])))
diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux
index edc4d44f8..05b1bf768 100644
--- a/stdlib/source/library/lux/target/ruby.lux
+++ b/stdlib/source/library/lux/target/ruby.lux
@@ -130,6 +130,7 @@
["?" exit_status]
["stdout" stdout]
+ ["stdin" stdin]
)
(template [<ruby_name> <lux_name>]
@@ -463,6 +464,11 @@
(|> (..manual "Class")
(..new (list) {.#Some definition})))
+(def: .public (module definition)
+ (-> Block Computation)
+ (|> (..manual "Module")
+ (..new (list) {.#Some definition})))
+
(def: .public (apply_lambda/* args lambda)
(-> (List Expression) Expression Computation)
(|> lambda
@@ -490,9 +496,13 @@
<definitions>))]
+ [0
+ [["gets"]]]
+
[1
[["print"]
["include"]
+ ["extend"]
["require"]
["defined?"]]]
diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux
index c44dd5e7e..ebdddd347 100644
--- a/stdlib/source/library/lux/tool/compiler/default/init.lux
+++ b/stdlib/source/library/lux/tool/compiler/default/init.lux
@@ -33,12 +33,12 @@
["[1][0]" generation]
["[1][0]" analysis
[macro {"+" Expander}]
- ["[1]/[0]" evaluation]]
+ ["[1]/[0]" evaluation]
+ ["[0]A" module]]
[phase
+ ["[0]P" analysis]
["[0]P" synthesis]
["[0]P" directive]
- ["[0]P" analysis
- ["[0]A" module]]
["[0]" extension {"+" Extender}
["[0]E" analysis]
["[0]E" synthesis]
diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux
index 96c638d52..d20a1b7d7 100644
--- a/stdlib/source/library/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux
@@ -41,14 +41,13 @@
["[1][0]" version]
["[0]" syntax]
["[1][0]" analysis
- [macro {"+" Expander}]]
+ [macro {"+" Expander}]
+ ["[0]A" module]]
["[1][0]" synthesis]
["[1][0]" generation {"+" Buffer}]
["[1][0]" directive]
[phase
- ["[0]" extension {"+" Extender}]
- [analysis
- ["[0]A" module]]]]]
+ ["[0]" extension {"+" Extender}]]]]
[meta
["[0]" archive {"+" Output Archive}
["[0]" registry {"+" Registry}]
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux.lux
index ae38fc2de..566a7afa9 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux.lux
@@ -1,22 +1,21 @@
(.using
- [library
- [lux "*"
- [control
- ["<>" parser
- ["<b>" binary {"+" Parser}]]]
- [data
- [format
- ["_" binary {"+" Writer}]]]]]
- ["[0]" / "_"
- ["[1][0]" version]
- [phase
- [analysis
- ["[0]" module]]]
- [///
- [meta
- [archive
- ["[0]" signature]
- ["[0]" key {"+" Key}]]]]])
+ [library
+ [lux "*"
+ [control
+ ["<>" parser
+ ["<b>" binary {"+" Parser}]]]
+ [data
+ [format
+ ["_" binary {"+" Writer}]]]]]
+ ["[0]" / "_"
+ ["[1][0]" version]
+ [analysis
+ ["[0]" module]]
+ [///
+ [meta
+ [archive
+ ["[0]" signature]
+ ["[0]" key {"+" Key}]]]]])
... TODO: Remove #module_hash, #imports & #module_state ASAP.
... TODO: Not just from this parser, but from the lux.Module type.
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux
index 3ca157f38..e0798d438 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux
@@ -1,6 +1,6 @@
(.using
[library
- [lux "*"
+ [lux {"-" Label}
[abstract
["[0]" monad {"+" do}]]
[control
@@ -15,28 +15,29 @@
[dictionary
["[0]" plist]]]]
["[0]" meta]]]
- ["[0]" /// "_"
- ["[1][0]" extension]
- [//
- ["/" analysis {"+" Operation}]
+ ["/" // {"+" Operation}
+ ["//[1]" // "_"
+ [phase
+ ["[1][0]" extension]]
[///
["[1]" phase]]]])
-(type: .public Tag Text)
+(type: .public Label
+ Text)
(exception: .public (unknown_module [module Text])
(exception.report
["Module" module]))
(template [<name>]
- [(exception: .public (<name> [tags (List Text)
+ [(exception: .public (<name> [labels (List Label)
owner Type])
(exception.report
- ["Tags" (text.interposed " " tags)]
+ ["Labels" (text.interposed " " labels)]
["Type" (%.type owner)]))]
- [cannot_declare_tags_for_unnamed_type]
- [cannot_declare_tags_for_foreign_type]
+ [cannot_declare_labels_for_anonymous_type]
+ [cannot_declare_labels_for_foreign_type]
)
(exception: .public (cannot_define_more_than_once [name Symbol
@@ -70,11 +71,11 @@
(def: .public (empty hash)
(-> Nat Module)
- [.#module_hash hash
- .#module_aliases (list)
- .#definitions (list)
- .#imports (list)
- .#module_state {.#Active}])
+ [.#module_hash hash
+ .#module_aliases (list)
+ .#definitions (list)
+ .#imports (list)
+ .#module_state {.#Active}])
(def: .public (import module)
(-> Text (Operation Any))
@@ -147,7 +148,7 @@
(def: .public (with_module hash name action)
(All (_ a) (-> Nat Text (Operation a) (Operation [Module a])))
(do ///.monad
- [_ (create hash name)
+ [_ (..create hash name)
output (/.with_current_module name
action)
module (///extension.lifted (meta.module name))]
@@ -168,11 +169,11 @@
(plist.has module_name (with@ .#module_state {<tag>} module))
state)
[]]}
- ((///extension.up (/.except can_only_change_state_of_active_module [module_name {<tag>}]))
+ ((///extension.up (/.except ..can_only_change_state_of_active_module [module_name {<tag>}]))
state)))
{.#None}
- ((///extension.up (/.except unknown_module module_name))
+ ((///extension.up (/.except ..unknown_module module_name))
state)))))
(def: .public (<asker> module_name)
@@ -187,7 +188,7 @@
_ #0)]}
{.#None}
- ((///extension.up (/.except unknown_module module_name))
+ ((///extension.up (/.except ..unknown_module module_name))
state)))))]
[set_active active? .#Active]
@@ -195,20 +196,8 @@
[set_cached cached? .#Cached]
)
-(def: (hash module_name)
- (-> Text (Operation Nat))
- (///extension.lifted
- (function (_ state)
- (case (|> state (value@ .#modules) (plist.value module_name))
- {.#Some module}
- {try.#Success [state (value@ .#module_hash module)]}
-
- {.#None}
- ((///extension.up (/.except unknown_module module_name))
- state)))))
-
-(def: .public (declare_tags record? tags exported? type)
- (-> Bit (List Tag) Bit Type (Operation Any))
+(def: .public (declare_labels record? labels exported? type)
+ (-> Bit (List Label) Bit Type (Operation Any))
(do [! ///.monad]
[self_name (///extension.lifted meta.current_module_name)
[type_module type_name] (case type
@@ -216,12 +205,12 @@
(in type_name)
_
- (/.except ..cannot_declare_tags_for_unnamed_type [tags type]))
- _ (///.assertion cannot_declare_tags_for_foreign_type [tags type]
+ (/.except ..cannot_declare_labels_for_anonymous_type [labels type]))
+ _ (///.assertion ..cannot_declare_labels_for_foreign_type [labels type]
(text#= self_name type_module))]
(monad.each ! (function (_ [index short])
(..define short
(if record?
- {.#Slot [exported? type tags index]}
- {.#Tag [exported? type tags index]})))
- (list.enumeration tags))))
+ {.#Slot [exported? type labels index]}
+ {.#Tag [exported? type labels index]})))
+ (list.enumeration labels))))
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 be1e560ca..2bc7d831e 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
@@ -1679,12 +1679,62 @@
{#Protected} ..protected_tag
{#Default} ..default_tag)))
+(type: Exception
+ (Type Class))
+
+(type: .public (Abstract_Method a)
+ [Text
+ Visibility
+ (List (Annotation a))
+ (List (Type Var))
+ (List Argument)
+ (Type Return)
+ (List Exception)])
+
+(def: abstract_tag "abstract")
+
+(def: .public abstract_method_definition
+ (Parser (Abstract_Method Code))
+ (<| <code>.form
+ (<>.after (<code>.text! ..abstract_tag))
+ ($_ <>.and
+ <code>.text
+ ..visibility
+ (<code>.tuple (<>.some ..annotation))
+ (<code>.tuple (<>.some ..var))
+ (<code>.tuple (<>.some ..argument))
+ ..return
+ (<code>.tuple (<>.some ..class)))))
+
+(def: .public (analyse_abstract_method analyse archive method)
+ (-> Phase Archive (Abstract_Method Code) (Operation Analysis))
+ (let [[method_name visibility annotations vars arguments return exceptions] method]
+ (do [! phase.monad]
+ [annotationsA (monad.each ! (function (_ [name parameters])
+ (do !
+ [parametersA (monad.each ! (function (_ [name value])
+ (do !
+ [valueA (analyse archive value)]
+ (in [name valueA])))
+ parameters)]
+ (in [name parametersA])))
+ annotations)]
+ (in (/////analysis.tuple (list (/////analysis.text ..abstract_tag)
+ (/////analysis.text method_name)
+ (visibility_analysis visibility)
+ (/////analysis.tuple (list#each annotation_analysis annotationsA))
+ (/////analysis.tuple (list#each var_analysis vars))
+ (/////analysis.tuple (list#each ..argument_analysis arguments))
+ (return_analysis return)
+ (/////analysis.tuple (list#each class_analysis exceptions))
+ ))))))
+
(type: .public (Constructor a)
[Visibility
Strictness
(List (Annotation a))
(List (Type Var))
- (List (Type Class)) ... Exceptions
+ (List Exception)
Text
(List Argument)
(List (Typed a))
@@ -1766,7 +1816,7 @@
Text
(List Argument)
(Type Return)
- (List (Type Class)) ... Exceptions
+ (List Exception)
a])
(def: virtual_tag "virtual")
@@ -1861,9 +1911,9 @@
Strictness
(List (Annotation a))
(List (Type Var))
- (List (Type Class)) ... Exceptions
(List Argument)
(Type Return)
+ (List Exception)
a])
(def: .public static_tag "static")
@@ -1878,16 +1928,16 @@
<code>.bit
(<code>.tuple (<>.some ..annotation))
(<code>.tuple (<>.some ..var))
- (<code>.tuple (<>.some ..class))
(<code>.tuple (<>.some ..argument))
..return
+ (<code>.tuple (<>.some ..class))
<code>.any)))
(def: .public (analyse_static_method analyse archive mapping method)
(-> Phase Archive Mapping (Static_Method Code) (Operation Analysis))
(let [[method_name visibility
- strict_fp? annotations vars exceptions
- arguments return
+ strict_fp? annotations vars
+ arguments return exceptions
body] method]
(do [! phase.monad]
[annotationsA (monad.each ! (function (_ [name parameters])
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
index bdf4d3e11..872b224b4 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
@@ -43,6 +43,7 @@
[category {"+" Void Value Return Primitive Object Class Array Var Parameter}]
["[0]T" lux {"+" Mapping}]
["[0]" signature]
+ ["[0]" reflection]
["[0]" descriptor {"+" Descriptor}]
["[0]" parser]]]]
[tool
@@ -53,13 +54,12 @@
["[0]" artifact]]]
[language
[lux
- ["[0]" analysis]
["[0]" synthesis]
["[0]" generation]
["[0]" directive {"+" Handler Bundle}]
+ ["[0]" analysis
+ ["[0]A" type]]
[phase
- [analysis
- ["[0]A" type]]
[generation
[jvm
["[0]" runtime {"+" Anchor Definition Extender}]]]
@@ -76,6 +76,7 @@
(directive.Operation Anchor (Bytecode Any) Definition))
(def: signature (|>> type.signature signature.signature))
+(def: reflection (|>> type.reflection reflection.reflection))
(type: Declaration
[Text (List (Type Var))])
@@ -178,7 +179,8 @@
{#Constructor (jvm.Constructor Code)}
{#Virtual_Method (jvm.Virtual_Method Code)}
{#Static_Method (jvm.Static_Method Code)}
- {#Overriden_Method (jvm.Overriden_Method Code)}))
+ {#Overriden_Method (jvm.Overriden_Method Code)}
+ {#Abstract_Method (jvm.Abstract_Method Code)}))
(def: method
(Parser Method_Definition)
@@ -187,6 +189,7 @@
jvm.virtual_method_definition
jvm.static_method_definition
jvm.overriden_method_definition
+ jvm.abstract_method_definition
))
(def: $Object
@@ -211,7 +214,7 @@
(do pool.monad
[constant (`` (|> value (~~ (template.spliced <constant>))))
attribute (attribute.constant constant)]
- (field.field ..constant::modifier name <type> (sequence.sequence attribute)))])
+ (field.field ..constant::modifier name <type> true (sequence.sequence attribute)))])
([.#Bit type.boolean [(case> #0 +0 #1 +1) .i64 i32.i32 constant.integer pool.integer]]
[.#Int type.byte [.i64 i32.i32 constant.integer pool.integer]]
[.#Int type.short [.i64 i32.i32 constant.integer pool.integer]]
@@ -230,7 +233,7 @@
... TODO: Handle annotations.
{#Variable [name visibility state annotations type]}
(field.field (modifier#composite visibility state)
- name type sequence.empty)))
+ name type true sequence.empty)))
(def: (method_definition archive supers [mapping selfT] [analyse synthesize generate])
(-> Archive
@@ -255,16 +258,21 @@
(jvm.analyse_static_method analyse archive mapping method)
{#Overriden_Method method}
- (jvm.analyse_overriden_method analyse archive selfT mapping supers method))))]
+ (jvm.analyse_overriden_method analyse archive selfT mapping supers method)
+
+ {#Abstract_Method method}
+ (jvm.analyse_abstract_method analyse archive method))))]
(directive.lifted_synthesis
(synthesize archive methodA)))))
+(def: class_name
+ (|>> parser.read_class product.left name.internal))
+
(def: (mock_class [name parameters] super interfaces fields methods modifier)
(-> Declaration (Type Class) (List (Type Class))
(List (Resource field.Field)) (List (Resource method.Method)) (Modifier class.Class)
(Try [External Binary]))
- (let [class_name (|>> parser.read_class product.left name.internal)
- signature (signature.inheritance (list#each type.signature parameters)
+ (let [signature (signature.inheritance (list#each type.signature parameters)
(type.signature super)
(list#each type.signature interfaces))]
(try#each (|>> (format.result class.writer)
@@ -275,22 +283,12 @@
modifier)
(name.internal name)
{.#Some signature}
- (class_name super)
- (list#each class_name interfaces)
+ (..class_name super)
+ (list#each ..class_name interfaces)
fields
methods
sequence.empty))))
-(def: (mock_field it)
- (-> ..Field (Resource field.Field))
- (case it
- ... TODO: Handle constants
- {#Constant [name annotations type term]}
- (undefined)
-
- {#Variable [name visibility state annotations type]}
- (field.field ($_ modifier#composite visibility state) name type sequence.empty)))
-
(def: (mock_value valueT)
(-> (Type Value) (Bytecode Any))
(case (type.primitive? valueT)
@@ -393,7 +391,7 @@
{.#Some (..mock_return return)})
{#Static_Method [name privacy strict_floating_point? annotations
- variables exceptions arguments return
+ variables arguments return exceptions
body]}
(method.method ($_ modifier#composite
method.static
@@ -406,15 +404,15 @@
(list)
{.#Some (..mock_return return)})
- ... {#Abstract [name privacy annotations
- ... variables arguments return exceptions]}
- ... (method.method ($_ modifier#composite
- ... method.abstract
- ... (..method_privacy privacy))
- ... name
- ... (type.method [variables (list#each product.right arguments) return exceptions])
- ... (list)
- ... {.#None})
+ {#Abstract_Method [name privacy annotations
+ variables arguments return exceptions]}
+ (method.method ($_ modifier#composite
+ method.abstract
+ (..method_privacy privacy))
+ name
+ (type.method [variables (list#each product.right arguments) return exceptions])
+ (list)
+ {.#None})
))
(def: (mock declaration super interfaces inheritance fields methods)
@@ -423,7 +421,7 @@
(Modifier class.Class) (List ..Field) (List ..Method_Definition)
(Try [External Binary]))
(mock_class declaration super interfaces
- (list#each ..mock_field fields)
+ (list#each ..field_definition fields)
(list#each (..mock_method super) methods)
inheritance))
@@ -437,6 +435,17 @@
[class_declaration [External (List (Type Var))] parser.declaration']
)
+(def: (save_class! name bytecode)
+ (-> Text Binary (Operation Any))
+ (directive.lifted_generation
+ (do [! phase.monad]
+ [.let [artifact [name bytecode]]
+ artifact_id (generation.learn_custom name artifact.no_dependencies)
+ _ (generation.execute! artifact)
+ _ (generation.save! artifact_id {.#Some name} artifact)
+ _ (generation.log! (format "JVM Class " name))]
+ (in []))))
+
(def: jvm::class
(Handler Anchor (Bytecode Any) Definition)
(/.custom
@@ -458,7 +467,10 @@
fields
methods])
(do [! phase.monad]
- [.let [[name parameters] class_declaration]
+ [.let [[name parameters] class_declaration
+ type_declaration (signature.inheritance (list#each type.signature parameters)
+ (type.signature super)
+ (list#each type.signature interfaces))]
mock (<| phase.lifted
(..mock class_declaration
super
@@ -470,50 +482,47 @@
_ (directive.lifted_generation
(generation.execute! mock))
parameters (directive.lifted_analysis
- (typeA.with_env
- (jvm.parameter_types parameters)))
+ (typeA.check (jvm.parameter_types parameters)))
.let [mapping (list#mix (function (_ [parameterJ parameterT] mapping)
(dictionary.has (parser.name parameterJ) parameterT mapping))
luxT.fresh
parameters)]
superT (directive.lifted_analysis
- (typeA.with_env
- (luxT.check (luxT.class mapping) (..signature super))))
+ (typeA.check (luxT.check (luxT.class mapping) (..signature super))))
interfaceT+ (directive.lifted_analysis
- (typeA.with_env
- (monad.each check.monad
- (|>> ..signature (luxT.check (luxT.class mapping)))
- interfaces)))
- .let [selfT (jvm.inheritance_relationship_type {.#Primitive name (list#each product.right parameters)}
- superT
- interfaceT+)]
+ (typeA.check (monad.each check.monad
+ (|>> ..signature (luxT.check (luxT.class mapping)))
+ interfaces)))
state (extension.lifted phase.state)
- .let [analyse (value@ [directive.#analysis directive.#phase] state)
- synthesize (value@ [directive.#synthesis directive.#phase] state)
- generate (value@ [directive.#generation directive.#phase] state)]
- methods (monad.each ! (..method_definition archive (list& super interfaces) [mapping selfT] [analyse synthesize generate])
+ .let [selfT {.#Primitive name (list#each product.right parameters)}]
+ methods (monad.each ! (..method_definition archive (list& super interfaces) [mapping selfT]
+ [(value@ [directive.#analysis directive.#phase] state)
+ (value@ [directive.#synthesis directive.#phase] state)
+ (value@ [directive.#generation directive.#phase] state)])
methods)
- ... _ (directive.lifted_generation
- ... (generation.save! true ["" name]
- ... [name
- ... (class.class version.v6_0
- ... (modifier#composite class.public inheritance)
- ... (name.internal name) (list#each (|>> product.left parser.name ..constraint) parameters)
- ... super interfaces
- ... (list#each ..field_definition fields)
- ... (list) ... TODO: Add methods
- ... sequence.empty)]))
- _ (directive.lifted_generation
- (generation.log! (format "JVM Class " name)))]
+ bytecode (<| (# ! each (format.result class.writer))
+ phase.lifted
+ (class.class version.v6_0
+ ($_ modifier#composite
+ class.public
+ inheritance)
+ (name.internal name)
+ {.#Some type_declaration}
+ (..class_name super)
+ (list#each ..class_name interfaces)
+ (list#each ..field_definition fields)
+ (list) ... (list#each ..method_definition methods)
+ sequence.empty))
+ _ (..save_class! name bytecode)]
(in directive.no_requirements)))]))
-(def: (method_declaration (^open "it[0]"))
+(def: (method_declaration (^open "/[0]"))
(-> (jvm.Method_Declaration Code) (Resource Method))
- (let [type (type.method [it#type_variables it#arguments it#return it#exceptions])]
+ (let [type (type.method [/#type_variables /#arguments /#return /#exceptions])]
(method.method ($_ modifier#composite
method.public
method.abstract)
- it#name
+ /#name
type
(list)
{.#None})))
@@ -542,17 +551,12 @@
(type.signature $Object)
(list#each type.signature supers))}
(name.internal "java.lang.Object")
- (list#each (|>> parser.read_class product.left name.internal)
- supers)
+ (list#each ..class_name supers)
(list)
(list#each ..method_declaration method_declarations)
sequence.empty))
- ... module generation.module
- ... module_id (generation.module_id module archive)
artifact_id (generation.learn_custom name artifact.no_dependencies)
- .let [artifact [name
- ... (runtime.class_name [module_id artifact_id])
- bytecode]]
+ .let [artifact [name bytecode]]
_ (generation.execute! artifact)
_ (generation.save! artifact_id {.#Some name} artifact)
_ (generation.log! (format "JVM Interface " (%.text name)))]
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
index 74f526332..73c67165f 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
@@ -32,13 +32,12 @@
["[1][0]" bundle]
["[1][0]" analysis]
["/[1]" // "_"
- [analysis
- ["[0]A" module]]
["/[1]" // "_"
["[1][0]" analysis
[macro {"+" Expander}]
["[1]/[0]" evaluation]
- ["[0]A" type]]
+ ["[0]A" type]
+ ["[0]A" module]]
["[1][0]" synthesis {"+" Synthesis}]
["[1][0]" generation {"+" Context}]
["[1][0]" directive {"+" Import Requirements Phase Operation Handler Bundle}]
@@ -250,14 +249,14 @@
_
(phase.except ///.invalid_syntax [extension_name %.code inputsC+]))))
-(def: (announce_labels! tags owner)
+(def: (announce_labels! labels owner)
(All (_ anchor expression directive)
(-> (List Text) Type (Operation anchor expression directive (List Any))))
(/////directive.lifted_generation
(monad.each phase.monad
(function (_ tag)
(/////generation.log! (format tag " : Tag of " (%.type owner))))
- tags)))
+ labels)))
(def: (def::type_tagged expander host_analysis)
(-> Expander /////analysis.Bundle Handler)
@@ -290,7 +289,7 @@
(moduleA.define short_name {.#Type [exported? (:as .Type value) (if record?
{.#Right labels}
{.#Left labels})]}))
- _ (moduleA.declare_tags record? labels exported? (:as .Type value))]
+ _ (moduleA.declare_labels record? labels exported? (:as .Type value))]
(in labels)))
_ (..refresh expander host_analysis)
_ (..announce_definition! short_name type)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux
index bd7f69e16..10bf59a29 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux
@@ -23,4 +23,4 @@
(def: .public (constant name type)
(-> Text (Type Value) (Resource Field))
- (field.field ..modifier name type (sequence.sequence)))
+ (field.field ..modifier name type false (sequence.sequence)))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux
index b02bde225..cc22b43b9 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux
@@ -46,7 +46,7 @@
(def: .public (variable name type)
(-> Text (Type Value) (Resource Field))
- (field.field ..modifier name type (sequence.sequence)))
+ (field.field ..modifier name type false (sequence.sequence)))
(def: .public (variables naming amount)
(-> (-> Register Text) Nat (List (Resource Field)))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux
index 00b7557af..0b14f240e 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux
@@ -124,7 +124,7 @@
(encoding/name.internal bytecode_name)
{.#None}
(encoding/name.internal "java.lang.Object") (list)
- (list (field.field ..value::modifier ..value::field ..value::type (sequence.sequence)))
+ (list (field.field ..value::modifier ..value::field ..value::type false (sequence.sequence)))
(list (method.method ..init::modifier "<clinit>" ..init::type
(list)
{.#Some
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 57a446860..a812a0c31 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
@@ -560,7 +560,7 @@
right_projection::method
..try::method))
- (sequence.sequence)))]
+ sequence.empty))]
(do ////.monad
[_ (generation.execute! [class bytecode])
_ (generation.save! ..artifact_id {.#None} [class bytecode])]
@@ -608,8 +608,8 @@
partial_count (: (Resource Field)
(field.field (modifier#composite field.public field.final)
//function/count.field
- //function/count.type
- (sequence.sequence)))
+ //function/count.type .false
+ sequence.empty))
bytecode (<| (format.result class.writer)
try.trusted
(class.class jvm/version.v6_0
@@ -619,7 +619,7 @@
(name.internal (..reflection ^Object)) (list)
(list partial_count)
(list& <init>::method apply::method+)
- (sequence.sequence)))]
+ sequence.empty))]
(do ////.monad
[_ (generation.execute! [class bytecode])
... _ (generation.save! //function.artifact_id {.#None} [class bytecode])
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux
index 294e31ecc..3d7854861 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux
@@ -1,6 +1,6 @@
(.using
[library
- [lux {"-" Module}
+ [lux "*"
[type {"+" :sharing}]
[abstract
["[0]" monad {"+" do}]]
@@ -32,8 +32,9 @@
[//
["[0]" archive {"+" Output}
[registry {"+" Registry}]
- ["[0]" descriptor {"+" Module Descriptor}]
["[0]" artifact]
+ ["[0]" module]
+ ["[0]" descriptor]
["[0]" document {"+" Document}]]
["[0]" cache "_"
["[1]/[0]" module {"+" Order}]
@@ -46,7 +47,7 @@
[generation {"+" Context}]]]]]])
(def: (bundle_module module module_id necessary_dependencies output)
- (-> Module archive.ID (Set Context) Output (Try (Maybe _.Statement)))
+ (-> descriptor.Module module.ID (Set Context) Output (Try (Maybe _.Statement)))
(do [! try.monad]
[]
(case (|> output
@@ -76,14 +77,14 @@
(in {.#Some bundle})))))
(def: module_file
- (-> archive.ID file.Path)
+ (-> module.ID file.Path)
(|>> %.nat (text.suffix ".rb")))
(def: (write_module mapping necessary_dependencies [module [module_id entry]] sink)
- (-> (Dictionary Module archive.ID) (Set Context)
- [Module [archive.ID [Descriptor (Document .Module) Output Registry]]]
- (List [archive.ID [Text Binary]])
- (Try (List [archive.ID [Text Binary]])))
+ (-> (Dictionary descriptor.Module module.ID) (Set Context)
+ [descriptor.Module [module.ID (archive.Entry .Module)]]
+ (List [module.ID [Text Binary]])
+ (Try (List [module.ID [Text Binary]])))
(do [! try.monad]
[bundle (: (Try (Maybe _.Statement))
(..bundle_module module module_id necessary_dependencies (value@ archive.#output entry)))]
@@ -104,13 +105,13 @@
"main.rb")
(def: module_id_mapping
- (-> (Order .Module) (Dictionary Module archive.ID))
+ (-> (Order .Module) (Dictionary descriptor.Module module.ID))
(|>> (list#each (function (_ [module [module_id entry]])
[module module_id]))
(dictionary.of_list text.hash)))
(def: included_modules
- (All (_ a) (-> (List [archive.ID a]) (Set archive.ID)))
+ (All (_ a) (-> (List [module.ID a]) (Set module.ID)))
(|>> (list#each product.left)
(list#mix set.has (set.empty nat.hash))))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux
index 0f6007e75..e014c3403 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux
@@ -23,8 +23,9 @@
["[0]" // {"+" Packager}
[//
["[0]" archive {"+" Output}
- ["[0]" descriptor]
- ["[0]" artifact]]
+ ["[0]" artifact]
+ ["[0]" module]
+ ["[0]" descriptor]]
["[0]" cache "_"
["[1]/[0]" module]
["[1]/[0]" artifact]]
@@ -37,7 +38,7 @@
(def: (write_module necessary_dependencies sequence [module_id output] so_far)
(All (_ directive)
- (-> (Set Context) (-> directive directive directive) [archive.ID Output] directive
+ (-> (Set Context) (-> directive directive directive) [module.ID Output] directive
(Try directive)))
(|> output
sequence.list
diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux
index 0899dcb64..e78630278 100644
--- a/stdlib/source/test/lux/program.lux
+++ b/stdlib/source/test/lux/program.lux
@@ -1,25 +1,25 @@
(.using
- [library
- [lux "*"
- ["_" test {"+" Test}]
- [abstract
- [monad {"+" do}]]
- [control
- ["[0]" io]
- ["[0]" try]
- ["<>" parser
- ["<[0]>" code]
- ["<[0]>" cli]]]
- [data
- ["[0]" text]
- [collection
- ["[0]" list]]]
- [macro
- [syntax {"+" syntax:}]]
- [math
- ["[0]" random]]]]
- [\\library
- ["[0]" /]])
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ [abstract
+ [monad {"+" do}]]
+ [control
+ ["[0]" io]
+ ["[0]" try]
+ ["<>" parser
+ ["<[0]>" code]
+ ["<[0]>" cli]]]
+ [data
+ ["[0]" text]
+ [collection
+ ["[0]" list]]]
+ [macro
+ [syntax {"+" syntax:}]]
+ [math
+ ["[0]" random]]]]
+ [\\library
+ ["[0]" /]])
(syntax: (actual_program [actual_program (<| <code>.form
(<>.after (<code>.text! "lux def program"))
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 616f3f1f5..b6762f168 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -857,8 +857,8 @@
{.#None}
(/name.internal "java.lang.Object")
(list)
- (list (/field.field /field.static class_field /type.long (sequence.sequence))
- (/field.field /field.public object_field /type.long (sequence.sequence)))
+ (list (/field.field /field.static class_field /type.long false (sequence.sequence))
+ (/field.field /field.public object_field /type.long false (sequence.sequence)))
(list (/method.method /method.private
constructor
constructor::type
diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux
index 5a52dc1b8..281ffe594 100644
--- a/stdlib/source/test/lux/target/ruby.lux
+++ b/stdlib/source/test/lux/target/ruby.lux
@@ -234,6 +234,8 @@
items (random.list size random.safe_frac)
$class (# ! each (|>> %.nat (format "class_") /.local)
random.nat)
+ $sub_class (# ! each (|>> %.nat (format "sub_class_") /.local)
+ random.nat)
$method/0 (# ! each (|>> %.nat (format "method_") /.local)
random.nat)
$method/1 (|> random.nat
@@ -296,6 +298,32 @@
(/.do (/.code $method/1) (list (/.float single)) {.#None}))))
[(list)] (/.lambda {.#None})
(/.apply_lambda/* (list)))))
+ (_.for [/.module]
+ ($_ _.and
+ (_.cover [/.include/1]
+ (expression (|>> (:as Frac) (f.= (f.+ single single)))
+ (|> ($_ /.then
+ (/.set (list $class) (/.module [/.#parameters (list)
+ /.#body double]))
+ (/.set (list $sub_class) (/.class [/.#parameters (list)
+ /.#body (/.statement (/.include/1 $class))]))
+ (/.return (|> $sub_class
+ (/.new (list) {.#None})
+ (/.do (/.code $method/0) (list (/.float single)) {.#None}))))
+ [(list)] (/.lambda {.#None})
+ (/.apply_lambda/* (list)))))
+ (_.cover [/.extend/1]
+ (expression (|>> (:as Frac) (f.= (f.+ single single)))
+ (|> ($_ /.then
+ (/.set (list $class) (/.module [/.#parameters (list)
+ /.#body double]))
+ (/.set (list $sub_class) (/.class [/.#parameters (list)
+ /.#body (/.statement (/.extend/1 $class))]))
+ (/.return (|> $sub_class
+ (/.do (/.code $method/0) (list (/.float single)) {.#None}))))
+ [(list)] (/.lambda {.#None})
+ (/.apply_lambda/* (list)))))
+ ))
)))
(def: test|io
@@ -305,34 +333,67 @@
right (random.ascii/upper 5)
$old (# ! each /.local (random.ascii/upper 1))
$new (# ! each /.local (random.ascii/upper 2))
+ $it (# ! each /.local (random.ascii/upper 3))
.let [expected (format left right)]])
- (_.for [/.stdout])
($_ _.and
- (_.cover [/.print/1]
- (expression (|>> (:as Text) (text#= expected))
- (|> ($_ /.then
- (/.statement (/.require/1 (/.string "stringio")))
- (/.set (list $old) /.stdout)
- (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO")))
- (/.set (list /.stdout) $new)
- (/.statement (/.print/1 (/.string left)))
- (/.statement (/.print/1 (/.string right)))
- (/.set (list /.stdout) $old)
- (/.return (/.the "string" $new)))
- [(list)] (/.lambda {.#None})
- (/.apply_lambda/* (list)))))
- (_.cover [/.print/2]
- (expression (|>> (:as Text) (text#= expected))
- (|> ($_ /.then
- (/.statement (/.require/1 (/.string "stringio")))
- (/.set (list $old) /.stdout)
- (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO")))
- (/.set (list /.stdout) $new)
- (/.statement (/.print/2 (/.string left) (/.string right)))
- (/.set (list /.stdout) $old)
- (/.return (/.the "string" $new)))
- [(list)] (/.lambda {.#None})
- (/.apply_lambda/* (list)))))
+ (_.for [/.stdout]
+ ($_ _.and
+ (_.cover [/.print/1]
+ (expression (|>> (:as Text) (text#= expected))
+ (|> ($_ /.then
+ (/.statement (/.require/1 (/.string "stringio")))
+ (/.set (list $old) /.stdout)
+ (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO")))
+ (/.set (list /.stdout) $new)
+ (/.statement (/.print/1 (/.string left)))
+ (/.statement (/.print/1 (/.string right)))
+ (/.set (list /.stdout) $old)
+ (/.return (/.the "string" $new)))
+ [(list)] (/.lambda {.#None})
+ (/.apply_lambda/* (list)))))
+ (_.cover [/.print/2]
+ (expression (|>> (:as Text) (text#= expected))
+ (|> ($_ /.then
+ (/.statement (/.require/1 (/.string "stringio")))
+ (/.set (list $old) /.stdout)
+ (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO")))
+ (/.set (list /.stdout) $new)
+ (/.statement (/.print/2 (/.string left) (/.string right)))
+ (/.set (list /.stdout) $old)
+ (/.return (/.the "string" $new)))
+ [(list)] (/.lambda {.#None})
+ (/.apply_lambda/* (list)))))
+ ))
+ (_.for [/.stdin]
+ ($_ _.and
+ (_.cover [/.gets/0]
+ (expression (|>> (:as Text) (text#= (format left text.\n)))
+ (|> ($_ /.then
+ (/.statement (/.require/1 (/.string "stringio")))
+ (/.set (list $old) /.stdin)
+ (/.set (list /.stdin) (/.new (list (/.string (format left text.\n))) {.#None}
+ (/.manual "StringIO")))
+ (/.set (list $it) /.gets/0)
+ (/.set (list /.stdin) $old)
+ (/.return $it))
+ [(list)] (/.lambda {.#None})
+ (/.apply_lambda/* (list)))))
+ (_.cover [/.last_string_read]
+ (expression (|>> (:as Text) (text#= (format right text.\n)))
+ (|> ($_ /.then
+ (/.statement (/.require/1 (/.string "stringio")))
+ (/.set (list $old) /.stdin)
+ (/.set (list /.stdin) (/.new (list (/.string (format right text.\n))) {.#None}
+ (/.manual "StringIO")))
+ (/.set (list $it) /.gets/0)
+ (/.set (list /.stdin) $old)
+ (/.return /.last_string_read))
+ [(list)] (/.lambda {.#None})
+ (/.apply_lambda/* (list)))))
+ (_.cover [/.last_line_number_read]
+ (expression (|>> (:as Nat) (n.= 2))
+ /.last_line_number_read))
+ ))
)))
(def: test|computation
@@ -367,18 +428,6 @@
(/.float then))))
)))
-(def: test|expression
- Test
- (do [! random.monad]
- [dummy random.safe_frac
- expected random.safe_frac]
- (`` ($_ _.and
- (_.for [/.Literal]
- ..test|literal)
- (_.for [/.Computation]
- ..test|computation)
- ))))
-
(def: test|global
Test
(do [! random.monad]
@@ -397,11 +446,6 @@
(|>> (:as Text)
(text.ends_with? file)))
/.script_name))
- (_.cover [/.script_name]
- (expression (let [file (format (# file.default separator) packager.main_file)]
- (|>> (:as Text)
- (text.ends_with? file)))
- /.script_name))
(_.cover [/.input_record_separator]
(expression (|>> (:as Text)
(text#= text.\n))
@@ -635,6 +679,20 @@
))
)))
+(def: test|expression
+ Test
+ (do [! random.monad]
+ [dummy random.safe_frac
+ expected random.safe_frac]
+ (`` ($_ _.and
+ (_.for [/.Literal]
+ ..test|literal)
+ (_.for [/.Computation]
+ ..test|computation)
+ (_.for [/.Location]
+ ..test|location)
+ ))))
+
(def: test|label
Test
(do [! random.monad]
@@ -948,8 +1006,6 @@
..test|loop
(_.for [/.Block]
..test|function)
- (_.for [/.Location]
- ..test|location)
)))
(def: random_expression
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux
index f19111e2d..8f6a7b381 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux
@@ -29,6 +29,7 @@
["[1][0]" pattern]
["[1][0]" macro]
["[1][0]" type]
+ ["[1][0]" module]
[////
["[1][0]" reference
["[2][0]" variable]]
@@ -440,4 +441,5 @@
/pattern.test
/macro.test
/type.test
+ /module.test
))))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux
new file mode 100644
index 000000000..ab07c98b3
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux
@@ -0,0 +1,341 @@
+(.using
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ ["[0]" meta]
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [control
+ [pipe {"+" case>}]
+ ["[0]" try ("[1]#[0]" functor)]
+ ["[0]" exception]]
+ [data
+ ["[0]" bit ("[1]#[0]" equivalence)]
+ ["[0]" text ("[1]#[0]" equivalence)]
+ [collection
+ ["[0]" list]
+ ["[0]" set]]]
+ [math
+ ["[0]" random {"+" Random}]
+ [number
+ ["n" nat]]]]]
+ [\\library
+ ["[0]" /
+ ["/[1]" //
+ [//
+ [phase
+ ["[2][0]" extension]]
+ [///
+ ["[2][0]" phase]]]]]])
+
+(def: random_state
+ (Random Lux)
+ (do random.monad
+ [version random.nat
+ host (random.ascii/lower 1)]
+ (in (//.state (//.info version host)))))
+
+(def: primitive
+ (Random Type)
+ (do random.monad
+ [name (random.ascii/lower 1)]
+ (in {.#Primitive name (list)})))
+
+(def: (new? hash it)
+ (-> Nat .Module Bit)
+ (and (same? hash (value@ .#module_hash it))
+ (list.empty? (value@ .#module_aliases it))
+ (list.empty? (value@ .#definitions it))
+ (list.empty? (value@ .#imports it))
+ (case (value@ .#module_state it)
+ {.#Active}
+ true
+
+ _
+ false)))
+
+(def: test|module
+ Test
+ (do [! random.monad]
+ [lux ..random_state
+ .let [state [/extension.#bundle /extension.empty
+ /extension.#state lux]]
+ name (random.ascii/lower 1)
+ hash random.nat
+ expected_import (random.ascii/lower 2)
+ expected_alias (random.ascii/lower 3)]
+ ($_ _.and
+ (_.cover [/.empty]
+ (..new? hash (/.empty hash)))
+ (_.cover [/.create]
+ (|> (do /phase.monad
+ [_ (/.create hash name)]
+ (/extension.lifted (meta.module name)))
+ (/phase.result state)
+ (try#each (..new? hash))
+ (try.else false)))
+ (_.cover [/.exists?]
+ (|> (do /phase.monad
+ [pre (/.exists? name)
+ _ (/.create hash name)
+ post (/.exists? name)]
+ (in (and (not pre) post)))
+ (/phase.result state)
+ (try.else false)))
+ (_.cover [/.with_module]
+ (|> (do /phase.monad
+ [[it _] (/.with_module hash name
+ (in []))]
+ (in it))
+ (/phase.result state)
+ (try#each (..new? hash))
+ (try.else false)))
+ (_.cover [/.import]
+ (`` (and (~~ (template [<expected>]
+ [(|> (do [! /phase.monad]
+ [_ (/.create hash expected_import)
+ [it ?] (/.with_module hash name
+ (do !
+ [_ (if <expected>
+ (/.import expected_import)
+ (in []))]
+ (/extension.lifted
+ (meta.imported? expected_import))))]
+ (in ?))
+ (/phase.result state)
+ (try#each (bit#= <expected>))
+ (try.else false))]
+
+ [false]
+ [true])))))
+ (_.cover [/.alias]
+ (|> (do [! /phase.monad]
+ [_ (/.create hash expected_import)
+ [it _] (/.with_module hash name
+ (do !
+ [_ (/.import expected_import)]
+ (/.alias expected_alias expected_import)))]
+ (in it))
+ (/phase.result state)
+ (try#each (|>> (value@ .#module_aliases)
+ (case> (^ (list [actual_alias actual_import]))
+ (and (same? expected_alias actual_alias)
+ (same? expected_import actual_import))
+
+ _
+ false)))
+ (try.else false)))
+ )))
+
+(def: test|state
+ Test
+ (do [! random.monad]
+ [lux ..random_state
+ .let [state [/extension.#bundle /extension.empty
+ /extension.#state lux]]
+ name (random.ascii/lower 1)
+ hash random.nat]
+ (`` ($_ _.and
+ (~~ (template [<set> <query> <not/0> <not/1>]
+ [(_.cover [<set> <query>]
+ (|> (do [! /phase.monad]
+ [[it ?] (/.with_module hash name
+ (do !
+ [_ (<set> name)
+ ? (<query> name)
+ ~0 (<not/0> name)
+ ~1 (<not/1> name)]
+ (in (and ? (not ~0) (not ~1)))))]
+ (in ?))
+ (/phase.result state)
+ (try.else false)))]
+
+ [/.set_active /.active? /.compiled? /.cached?]
+ [/.set_compiled /.compiled? /.cached? /.active?]
+ [/.set_cached /.cached? /.active? /.compiled?]
+ ))
+ (_.cover [/.can_only_change_state_of_active_module]
+ (and (~~ (template [<pre> <post>]
+ [(|> (/.with_module hash name
+ (do /phase.monad
+ [_ (<pre> name)]
+ (<post> name)))
+ (/phase.result state)
+ (case> {try.#Success _}
+ false
+
+ {try.#Failure error}
+ (text.contains? (value@ exception.#label /.can_only_change_state_of_active_module) error)))]
+
+ [/.set_compiled /.set_active]
+ [/.set_compiled /.set_compiled]
+ [/.set_compiled /.set_cached]
+ [/.set_cached /.set_active]
+ [/.set_cached /.set_compiled]
+ [/.set_cached /.set_cached]
+ ))))
+ (_.cover [/.unknown_module]
+ (and (~~ (template [<set>]
+ [(|> (<set> name)
+ (/phase.result state)
+ (case> {try.#Success _}
+ false
+
+ {try.#Failure error}
+ (text.contains? (value@ exception.#label /.unknown_module) error)))]
+
+ [/.set_active]
+ [/.set_compiled]
+ [/.set_cached]
+ ))))
+ ))))
+
+(def: test|definition
+ Test
+ (do [! random.monad]
+ [lux ..random_state
+ .let [state [/extension.#bundle /extension.empty
+ /extension.#state lux]]
+ module_name (random.ascii/lower 1)
+ hash random.nat
+ def_name (random.ascii/lower 2)
+ alias_name (random.ascii/lower 3)
+
+ public? random.bit
+ def_type ..primitive
+ arity (# ! each (|>> (n.% 10) ++) random.nat)
+ labels|head (random.ascii/lower 1)
+ labels|tail (|> (random.ascii/lower 1)
+ (random.only (|>> (text#= labels|head) not))
+ (random.set text.hash (-- arity))
+ (# ! each set.list))
+ index (# ! each (n.% arity) random.nat)
+ .let [definition {.#Definition [public? def_type []]}
+ alias {.#Alias [module_name def_name]}]]
+ ($_ _.and
+ (_.cover [/.define]
+ (`` (and (~~ (template [<global>]
+ [(|> (/.with_module hash module_name
+ (/.define def_name <global>))
+ (/phase.result state)
+ (case> {try.#Success _} true
+ {try.#Failure _} false))]
+
+ [definition]
+ [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}]
+ [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}]
+ [{.#Tag [public? def_type (list& labels|head labels|tail) index]}]
+ [{.#Slot [public? def_type (list& labels|head labels|tail) index]}]))
+ (|> (/.with_module hash module_name
+ (do /phase.monad
+ [_ (/.define def_name definition)]
+ (/.define alias_name alias)))
+ (/phase.result state)
+ (case> {try.#Success _} true
+ {try.#Failure _} false)))))
+ (_.cover [/.cannot_define_more_than_once]
+ (`` (and (~~ (template [<global>]
+ [(|> (/.with_module hash module_name
+ (do /phase.monad
+ [_ (/.define def_name <global>)]
+ (/.define def_name <global>)))
+ (/phase.result state)
+ (case> {try.#Success _} false
+ {try.#Failure _} true))]
+
+ [{.#Definition [public? def_type []]}]
+ [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}]
+ [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}]
+ [{.#Tag [public? def_type (list& labels|head labels|tail) index]}]
+ [{.#Slot [public? def_type (list& labels|head labels|tail) index]}]))
+ (|> (/.with_module hash module_name
+ (do /phase.monad
+ [_ (/.define def_name definition)
+ _ (/.define alias_name alias)]
+ (/.define alias_name alias)))
+ (/phase.result state)
+ (case> {try.#Success _} false
+ {try.#Failure _} true)))))
+ )))
+
+(def: test|label
+ Test
+ (do [! random.monad]
+ [lux ..random_state
+ .let [state [/extension.#bundle /extension.empty
+ /extension.#state lux]]
+ module_name (random.ascii/lower 1)
+ hash random.nat
+ def_name (random.ascii/lower 2)
+ foreign_module (random.ascii/lower 3)
+
+ public? random.bit
+ def_type ..primitive
+ arity (# ! each (|>> (n.% 10) ++) random.nat)
+ labels|head (random.ascii/lower 1)
+ labels|tail (|> (random.ascii/lower 1)
+ (random.only (|>> (text#= labels|head) not))
+ (random.set text.hash (-- arity))
+ (# ! each set.list))]
+ ($_ _.and
+ (_.cover [/.declare_labels]
+ (`` (and (~~ (template [<side> <record?> <query> <on_success>]
+ [(|> (/.with_module hash module_name
+ (do [! /phase.monad]
+ [.let [it {.#Named [module_name def_name] def_type}]
+ _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})
+ _ (/.declare_labels <record?> (list& labels|head labels|tail) public? it)]
+ (monad.each ! (|>> [module_name] <query> /extension.lifted)
+ (list& labels|head labels|tail))))
+ (/phase.result state)
+ (case> {try.#Success _} <on_success>
+ {try.#Failure _} (not <on_success>)))]
+
+ [.#Left false meta.tag true]
+ [.#Left false meta.slot false]
+ [.#Right true meta.slot true]
+ [.#Right true meta.tag false])))))
+ (_.cover [/.cannot_declare_labels_for_anonymous_type]
+ (`` (and (~~ (template [<side> <record?>]
+ [(|> (/.with_module hash module_name
+ (do [! /phase.monad]
+ [.let [it def_type]
+ _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})]
+ (/.declare_labels <record?> (list& labels|head labels|tail) public? it)))
+ (/phase.result state)
+ (case> {try.#Success _}
+ false
+
+ {try.#Failure error}
+ (text.contains? (value@ exception.#label /.cannot_declare_labels_for_anonymous_type) error)))]
+
+ [.#Left false]
+ [.#Right true])))))
+ (_.cover [/.cannot_declare_labels_for_foreign_type]
+ (`` (and (~~ (template [<side> <record?>]
+ [(|> (/.with_module hash module_name
+ (do [! /phase.monad]
+ [.let [it {.#Named [foreign_module def_name] def_type}]
+ _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})]
+ (/.declare_labels <record?> (list& labels|head labels|tail) public? it)))
+ (/phase.result state)
+ (case> {try.#Success _}
+ false
+
+ {try.#Failure error}
+ (text.contains? (value@ exception.#label /.cannot_declare_labels_for_foreign_type) error)))]
+
+ [.#Left false]
+ [.#Right true])))))
+ )))
+
+(def: .public test
+ Test
+ (<| (_.covering /._)
+ ($_ _.and
+ ..test|module
+ ..test|state
+ ..test|definition
+ (_.for [/.Label]
+ ..test|label)
+ )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 06:32:00 +0000