diff options
| author | Eduardo Julian | 2021-08-19 04:59:06 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2021-08-19 04:59:06 -0400 |
| commit | d772fe99d5d4990c6774481fb64d12280cdb6aae (patch) | |
| tree | 209a2ce3b8e896be15db40bc58db830a5304b4f9 | |
| parent | e00ba096c8837abe85d366e0c1293c09dbe84d81 (diff) | |
Enabled compile-time code evaluation (i.e. "eval" function).
112 files changed, 3426 insertions, 1035 deletions
diff --git a/documentation/book/the_lux_programming_language/chapter_15.md b/documentation/book/the_lux_programming_language/chapter_15.md index d03014f42..c87494929 100644 --- a/documentation/book/the_lux_programming_language/chapter_15.md +++ b/documentation/book/the_lux_programming_language/chapter_15.md @@ -89,5 +89,5 @@ These data-structures are very easy to use and offer decent performance, so you' The next chapter is going to be slightly different, in that we're going to be learning not how to write programs, but how to test them. -See you in the next chapter! +See you in [the next chapter](chapter_16.md)! diff --git a/documentation/book/the_lux_programming_language/chapter_16.md b/documentation/book/the_lux_programming_language/chapter_16.md new file mode 100644 index 000000000..929188f35 --- /dev/null +++ b/documentation/book/the_lux_programming_language/chapter_16.md @@ -0,0 +1,172 @@ +# Chapter 16: Testing + +_Where you will learn how to avoid annoying bug reports._ + +--- + +Automated testing is a fundamental aspect of modern software development. + +Long gone are the days of manual, ad-hoc testing. + +With modern testing tools and frameworks, it's somewhat easy to increase the quality of programs by implementing comprehensive test suites that can cover large percentages of a program's functionality and behavior. + +Lux doesn't stay behind and includes a testing module as part of its standard library. + +The `library/lux/test` module contains the machinery you need to write unit-testing suites for your programs. + +Not only that, but the _Aedifex_ build tool for Lux also includes a command for testing: `lux test` + +How do you set that up? +Let's take a look at the `project.lux` file for the Lux standard library itself. + +``` +{#identity ["com.github.luxlang" "stdlib" "0.6.0"] + +#deploy_repositories {"snapshots" "https://oss.sonatype.org/content/repositories/snapshots/" + "releases" "https://oss.sonatype.org/service/local/staging/deploy/maven2/"} + +#repositories ["https://oss.sonatype.org/content/repositories/snapshots/" + "https://oss.sonatype.org/service/local/staging/deploy/maven2/"] + +#compiler ["com.github.luxlang" "lux-jvm" "0.6.0" "jar"] +#description "Standard library for the Lux programming language." +#test "test/lux"} +``` + +The `#test` parameter is similar to the `#program` parameter in that it specifies the name of a Lux module. + +Here is a summary of the file: + +``` +(.module: + [library + ["/" lux #* + [program (#+ program:)] + ["_" test (#+ Test)] + [control + ["." io]] + ... + ]]) + +(program: args + (io.io (_.run! (_.times 100 ..test)))) + +``` + +A test suit consists of a `Test` (or a composite of as many `Test`s as you want), which is then `run!`. +The `times` combinator allows you to execute `Test`s several times. +This can be very useful when using random data generation within your tests, as each run of the tests will lead to the generation of different sorts of data. +This will help you cover many possible scenarios within the same test run, and perhaps uncover tricky corner cases you wouldn't have thought of. + +But where do those tests come from? +Nothing is being defined here. + +Let's take a look at the tests defined in a simpler module. + +Well, the run macro, from lux/test pulls in all the tests from the imported modules to run them later once the program starts. + +To know how tests work, let's take a look at one of those modules. + + From `test/lux/data/collection/stack`. + +``` +(.module: + [library + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + [\\specification + ["$." equivalence] + ["$." functor (#+ Injection)]]] + [control + ["." maybe]] + [data + ["." bit ("#\." equivalence)]] + [math + ["." random] + [number + ["n" nat]]]]] + [\\library + ["." /]]) + +(def: (injection value) + (Injection /.Stack) + (/.top value /.empty)) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Stack]) + (do random.monad + [size (\ random.monad map (n.% 100) random.nat) + sample (random.stack size random.nat) + expected_top random.nat] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.stack size random.nat))) + (_.for [/.functor] + ($functor.spec ..injection /.equivalence /.functor)) + + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit\= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.cover [/.empty] + (/.empty? /.empty)) + (_.cover [/.value] + (case (/.value sample) + #.None + (/.empty? sample) + + (#.Some _) + (not (/.empty? sample)))) + (_.cover [/.next] + (case (/.next sample) + #.None + (/.empty? sample) + + (#.Some [top remaining]) + (\ (/.equivalence n.equivalence) = + sample + (/.top top remaining)))) + (_.cover [/.top] + (case (/.next (/.top expected_top sample)) + (#.Some [actual_top actual_sample]) + (and (same? expected_top actual_top) + (same? sample actual_sample)) + + #.None + false)) + )))) + +``` + +There's a lot going on here. + +First of all, by using the `covering` macro, you can tell the test suit to track the coverage that your test suite has of a given module. +That way, if your tests miss some _exported_, the report you'll get after running the tests will tell you, so you can judiciously choose to either expand your coverage, or skip covering them. +The `for` and `cover` macros then signal whenever one or more definitions are being covered by a given test. + +Lux also defines some _specifications_, which are basically parameterizable tests, which implement consistent testing for various interfaces in the standard library. +That way, when testing an implementation of those interfaces, instead of having to copy-paste, or re-invent the testing every time, the specification is imported. +This enables consistent testing of implementations. + +`and` allows you to _sequentially_ compose `Test`s into a larger `Test`. + +You can also see an example of how to use randomness to generate sample data for testing. + +--- + +If you want to learn more about how to write tests, feel free to check out the test-suite for the Lux standard library. +It's very comprehensive and filled with good examples. + +--- + +Without tests, the reliability of programs becomes a matter of faith, not engineering. + +Automated tests can be integrated into processes of continuous delivery and integration to increase the confidence of individuals and teams that real value is being delivered, and that the customer won't be dissatisfied by buggy software. + +Now that you know how to test your programs, you know everything you need to know to be a Lux programmer. + diff --git a/documentation/bookmark/Compilation.md b/documentation/bookmark/Compilation.md deleted file mode 100644 index 2249ebdc3..000000000 --- a/documentation/bookmark/Compilation.md +++ /dev/null @@ -1,4 +0,0 @@ -# Demand-driven - -1. [Queries: demand-driven compilation](https://github.com/rust-lang/rustc-guide/blob/master/src/query.md) - diff --git a/documentation/bookmark/algorithm.md b/documentation/bookmark/algorithm.md new file mode 100644 index 000000000..43d3ad8ae --- /dev/null +++ b/documentation/bookmark/algorithm.md @@ -0,0 +1,4 @@ +# Reference + +1. [There and Back Again](https://www.brics.dk/RS/01/39/BRICS-RS-01-39.pdf) + diff --git a/documentation/bookmark/compilation.md b/documentation/bookmark/compilation.md new file mode 100644 index 000000000..ddd165e6e --- /dev/null +++ b/documentation/bookmark/compilation.md @@ -0,0 +1,8 @@ +# Extensibility & control + +1. [Compilation Strategies as Objects](https://www.researchgate.net/publication/2273387_Compilation_Strategies_as_Objects) + +# Demand-driven + +1. [Queries: demand-driven compilation](https://github.com/rust-lang/rustc-guide/blob/master/src/query.md) + diff --git a/documentation/bookmark/composition.md b/documentation/bookmark/composition.md new file mode 100644 index 000000000..85c6daba3 --- /dev/null +++ b/documentation/bookmark/composition.md @@ -0,0 +1,4 @@ +# Reference + +1. [Open, extensible composition models](http://www.vpri.org/pdf/tr2011002_oecm.pdf) + diff --git a/documentation/bookmark/database.md b/documentation/bookmark/database.md index 3ef227087..0e27f89cf 100644 --- a/documentation/bookmark/database.md +++ b/documentation/bookmark/database.md @@ -90,6 +90,8 @@ # Storage +1. [Database Internals: A deep-dive into how distributed data systems work](https://www.oreilly.com/library/view/database-internals/9781492040330/) +1. [B-Trees: More Than I Thought I'd Want to Know](https://benjamincongdon.me/blog/2021/08/17/B-Trees-More-Than-I-Thought-Id-Want-to-Know/) 1. [Understanding LSM Trees: What Powers Write-Heavy Databases](https://yetanotherdevblog.com/lsm/) 1. http://www.benstopford.com/2015/02/14/log-structured-merge-trees/ 1. A Comparison of Adaptive Radix Trees and Hash Tables diff --git a/documentation/bookmark/database/key_value.md b/documentation/bookmark/database/key_value.md new file mode 100644 index 000000000..3943ad31b --- /dev/null +++ b/documentation/bookmark/database/key_value.md @@ -0,0 +1,4 @@ +# Reference + +1. [Fast key-value stores: An idea whose time has come and gone](https://storage.googleapis.com/pub-tools-public-publication-data/pdf/03de87e2856b06a94ffae7dca218db2d4b9afd39.pdf) + diff --git a/documentation/bookmark/floating_point.md b/documentation/bookmark/floating_point.md index 47527b43e..509990dd1 100644 --- a/documentation/bookmark/floating_point.md +++ b/documentation/bookmark/floating_point.md @@ -30,5 +30,6 @@ # Algorithm +1. [Speeding up atan2f by 50x](https://mazzo.li/posts/vectorized-atan2.html) 1. [Kahan summation algorithm](https://en.wikipedia.org/wiki/Kahan_summation_algorithm) diff --git a/documentation/bookmark/incremental_computing.md b/documentation/bookmark/incremental_computing.md new file mode 100644 index 000000000..9daa63439 --- /dev/null +++ b/documentation/bookmark/incremental_computing.md @@ -0,0 +1,5 @@ +# Reference + +1. [Incremental computing](https://en.wikipedia.org/wiki/Incremental_computing) +1. [A theory of changes for higher-order languages](https://www.researchgate.net/publication/269126515_A_theory_of_changes_for_higher-order_languages) + diff --git a/documentation/bookmark/inspiration.md b/documentation/bookmark/inspiration.md index 5331f9a0b..1a99e455f 100644 --- a/documentation/bookmark/inspiration.md +++ b/documentation/bookmark/inspiration.md @@ -16,6 +16,7 @@ # Tool +1. [Building Developer Tools](https://explog.in/notes/devtools/index.html) 1. [Toward the next generation of programming tools: Programmers have built great tools for others. It’s time they built some for themselves.](https://www.oreilly.com/radar/toward-the-next-generation-of-programming-tools/) # Software engineering diff --git a/documentation/bookmark/specification.md b/documentation/bookmark/specification.md new file mode 100644 index 000000000..cac3f547a --- /dev/null +++ b/documentation/bookmark/specification.md @@ -0,0 +1,4 @@ +# Reference + +1. [Announcing Spectacle – A language for Writing and Checking Formal Specifications in Haskell](https://awakesecurity.com/blog/spectacle-a-language-for-writing-and-checking-formal-specifications-in-haskell/) + diff --git a/documentation/bookmark/spreadsheet.md b/documentation/bookmark/spreadsheet.md new file mode 100644 index 000000000..74bb1311f --- /dev/null +++ b/documentation/bookmark/spreadsheet.md @@ -0,0 +1,4 @@ +# Reference + +1. [HyperFormula](https://handsontable.github.io/hyperformula/) + diff --git a/documentation/bookmark/type_theory/dependent_types.md b/documentation/bookmark/type_theory/dependent_types.md index 6feb91d99..2ba13222b 100644 --- a/documentation/bookmark/type_theory/dependent_types.md +++ b/documentation/bookmark/type_theory/dependent_types.md @@ -5,6 +5,7 @@ # Reference +1. [A Language Agnostic Introduction to Dependent Types](https://www.shuangrimu.com/posts/language-agnostic-intro-to-dependent-types.html) 1. [The Gentle Art of Levitation](http://lambda-the-ultimate.org/node/5526) 1. [Programming up to Congruence](http://www.cs.yale.edu/homes/vilhelm/papers/popl15congruence.pdf) 1. [From Scheme to Dependent Types in 100 lines by Gershom Bazerman (Part 1)](https://vimeo.com/134561872) diff --git a/documentation/bookmark/user_interface/human_computer_interaction.md b/documentation/bookmark/user_interface/human_computer_interaction.md new file mode 100644 index 000000000..1eb2ce86d --- /dev/null +++ b/documentation/bookmark/user_interface/human_computer_interaction.md @@ -0,0 +1,4 @@ +# Reference + +1. [Formality Considered Harmful: Experiences, Emerging Themes, and Directions on the Use of Formal Representations in Interactive Systems](https://andymatuschak.org/files/papers/Shipman%20and%20Marshall%20-%201999%20-%20Formality%20Considered%20Harmful%20Experiences,%20Emergin.pdf) + diff --git a/documentation/bookmark/web_framework.md b/documentation/bookmark/web_framework.md index 7e8a36a48..406a770a2 100644 --- a/documentation/bookmark/web_framework.md +++ b/documentation/bookmark/web_framework.md @@ -152,6 +152,7 @@ # Rendering +1. [The Virtual DOM is slow. Meet the Memoized DOM](https://www.freecodecamp.org/news/the-virtual-dom-is-slow-meet-the-memoized-dom-bb19f546cc52/) 1. [Incrementally Improving The DOM](https://blog.functorial.com/posts/2018-04-08-Incrementally-Improving-The-DOM.html) 1. https://medium.com/@ryansolid/the-fastest-way-to-render-the-dom-e3b226b15ca3 1. https://github.com/Famous/engine diff --git a/lux-bootstrapper/src/lux.clj b/lux-bootstrapper/src/lux.clj index dc6066669..783a25a64 100644 --- a/lux-bootstrapper/src/lux.clj +++ b/lux-bootstrapper/src/lux.clj @@ -7,7 +7,8 @@ :reload-all) (:import (java.io File))) -(def unit-separator (str (char 31))) +(def unit-separator + (str (char 31))) (defn- separate-paths "(-> Text (List Text))" @@ -20,13 +21,13 @@ (defn -main [& args] (|case (&/->list args) - (&/$Cons "release" (&/$Cons program-module (&/$Cons dependencies (&/$Cons source-dirs (&/$Cons target-dir (&/$Nil)))))) + (&/$Item "release" (&/$Item program-module (&/$Item dependencies (&/$Item source-dirs (&/$Item target-dir (&/$End)))))) (&compiler/compile-program &/$Build program-module (separate-paths dependencies) (separate-paths source-dirs) target-dir) - (&/$Cons "repl" (&/$Cons dependencies (&/$Cons source-dirs (&/$Cons target-dir (&/$Nil))))) + (&/$Item "repl" (&/$Item dependencies (&/$Item source-dirs (&/$Item target-dir (&/$End))))) (&repl/repl (separate-paths dependencies) (separate-paths source-dirs) target-dir) diff --git a/lux-bootstrapper/src/lux/analyser.clj b/lux-bootstrapper/src/lux/analyser.clj index 4368e1305..ae16eb42c 100644 --- a/lux-bootstrapper/src/lux/analyser.clj +++ b/lux-bootstrapper/src/lux/analyser.clj @@ -99,75 +99,75 @@ (&/$Tag ?ident) (&/with-analysis-meta location exo-type - (analyse-variant+ analyse exo-type ?ident &/$Nil)) + (analyse-variant+ analyse exo-type ?ident &/$End)) (&/$Identifier ?ident) (&/with-analysis-meta location exo-type (&&lux/analyse-identifier analyse exo-type ?ident)) - (&/$Form (&/$Cons [command-meta command] parameters)) + (&/$Form (&/$Item [command-meta command] parameters)) (|case command (&/$Text ?procedure) (case ?procedure "lux type check" - (|let [(&/$Cons ?type - (&/$Cons ?value - (&/$Nil))) parameters] + (|let [(&/$Item ?type + (&/$Item ?value + (&/$End))) parameters] (&/with-analysis-meta location exo-type (&&lux/analyse-type-check analyse eval! exo-type ?type ?value))) "lux type check type" - (|let [(&/$Cons ?value (&/$Nil)) parameters] + (|let [(&/$Item ?value (&/$End)) parameters] (analyse-ast optimize eval! compile-module compilers &type/Type ?value)) "lux type as" - (|let [(&/$Cons ?type - (&/$Cons ?value - (&/$Nil))) parameters] + (|let [(&/$Item ?type + (&/$Item ?value + (&/$End))) parameters] (&/with-analysis-meta location exo-type (&&lux/analyse-type-as analyse eval! exo-type ?type ?value))) "lux def" - (|let [(&/$Cons [_ (&/$Identifier "" ?name)] - (&/$Cons ?value - (&/$Cons ?meta - (&/$Cons exported? - (&/$Nil))) + (|let [(&/$Item [_ (&/$Identifier "" ?name)] + (&/$Item ?value + (&/$Item ?meta + (&/$Item exported? + (&/$End))) )) parameters] (&/with-location location (&&lux/analyse-def analyse optimize eval! compile-def ?name ?value ?meta exported?))) "lux def alias" - (|let [(&/$Cons [_ (&/$Identifier "" ?alias)] - (&/$Cons [_ (&/$Identifier ?original)] - (&/$Nil) + (|let [(&/$Item [_ (&/$Identifier "" ?alias)] + (&/$Item [_ (&/$Identifier ?original)] + (&/$End) )) parameters] (&/with-location location (&&lux/analyse-def-alias ?alias ?original))) "lux def type tagged" - (|let [(&/$Cons [_ (&/$Identifier "" ?name)] - (&/$Cons ?value - (&/$Cons ?meta - (&/$Cons [_ (&/$Tuple ?tags)] - (&/$Cons exported? - (&/$Nil)))) + (|let [(&/$Item [_ (&/$Identifier "" ?name)] + (&/$Item ?value + (&/$Item ?meta + (&/$Item [_ (&/$Tuple ?tags)] + (&/$Item exported? + (&/$End)))) )) parameters] (&/with-location location (&&lux/analyse-def-type-tagged analyse optimize eval! compile-def ?name ?value ?meta ?tags exported?))) "lux def program" - (|let [(&/$Cons ?program (&/$Nil)) parameters] + (|let [(&/$Item ?program (&/$End)) parameters] (&/with-location location (&&lux/analyse-program analyse optimize compile-program ?program))) "lux def module" - (|let [(&/$Cons ?meta (&/$Cons ?imports (&/$Nil))) parameters] + (|let [(&/$Item ?meta (&/$Item ?imports (&/$End))) parameters] (&/with-location location (&&lux/analyse-module analyse optimize eval! compile-module ?meta ?imports))) "lux in-module" - (|let [(&/$Cons [_ (&/$Text ?module)] (&/$Cons ?expr (&/$Nil))) parameters] + (|let [(&/$Item [_ (&/$Text ?module)] (&/$Item ?expr (&/$End))) parameters] (&/with-location location (&/with-module ?module (analyse exo-type ?expr)))) @@ -182,7 +182,7 @@ (&&common/analyse-proc analyse exo-type ?procedure parameters)))) (&/$Nat idx) - (|let [(&/$Cons [_ (&/$Bit ?right)] parameters*) parameters] + (|let [(&/$Item [_ (&/$Bit ?right)] parameters*) parameters] (&/with-analysis-meta location exo-type (&&lux/analyse-variant analyse (&/$Right exo-type) (if ?right (inc idx) idx) ?right parameters*))) @@ -192,14 +192,14 @@ ;; Pattern-matching syntax. (&/$Record ?pattern-matching) - (|let [(&/$Cons ?input (&/$Nil)) parameters] + (|let [(&/$Item ?input (&/$End)) parameters] (&/with-analysis-meta location exo-type (&&lux/analyse-case analyse exo-type ?input ?pattern-matching))) ;; Function syntax. - (&/$Tuple (&/$Cons [_ (&/$Identifier "" ?self)] - (&/$Cons [_ (&/$Identifier "" ?arg)] (&/$Nil)))) - (|let [(&/$Cons ?body (&/$Nil)) parameters] + (&/$Tuple (&/$Item [_ (&/$Identifier "" ?self)] + (&/$Item [_ (&/$Identifier "" ?arg)] (&/$End)))) + (|let [(&/$Item ?body (&/$End)) parameters] (&/with-analysis-meta location exo-type (&&lux/analyse-function analyse exo-type ?self ?arg ?body))) diff --git a/lux-bootstrapper/src/lux/analyser/base.clj b/lux-bootstrapper/src/lux/analyser/base.clj index e5f47f977..1a61bcfa5 100644 --- a/lux-bootstrapper/src/lux/analyser/base.clj +++ b/lux-bootstrapper/src/lux/analyser/base.clj @@ -52,7 +52,7 @@ (defn cap-1 [action] (|do [result action] (|case result - (&/$Cons x (&/$Nil)) + (&/$Item x (&/$End)) (return x) _ diff --git a/lux-bootstrapper/src/lux/analyser/case.clj b/lux-bootstrapper/src/lux/analyser/case.clj index d059ce189..ba8afd4e8 100644 --- a/lux-bootstrapper/src/lux/analyser/case.clj +++ b/lux-bootstrapper/src/lux/analyser/case.clj @@ -35,7 +35,7 @@ ;; [Utils] (def ^:private unit-tuple - (&/T [(&/T ["" -1 -1]) (&/$Tuple &/$Nil)])) + (&/T [(&/T ["" -1 -1]) (&/$Tuple &/$End)])) (defn ^:private resolve-type [type] (if (&type/type= &type/Any type) @@ -121,7 +121,7 @@ (&/$UnivQ ?local-env ?local-def) (|case ?local-env - (&/$Nil) + (&/$End) (&/$UnivQ ?local-env (beta-reduce! (inc level) env ?local-def)) _ @@ -129,7 +129,7 @@ (&/$ExQ ?local-env ?local-def) (|case ?local-env - (&/$Nil) + (&/$End) (&/$ExQ ?local-env (beta-reduce! (inc level) env ?local-def)) _ @@ -155,14 +155,14 @@ (|case type-fn (&/$UnivQ local-env local-def) (return (beta-reduce! 0 (->> local-env - (&/$Cons param) - (&/$Cons type-fn)) + (&/$Item param) + (&/$Item type-fn)) local-def)) (&/$ExQ local-env local-def) (return (beta-reduce! 0 (->> local-env - (&/$Cons param) - (&/$Cons type-fn)) + (&/$Item param) + (&/$Item type-fn)) local-def)) (&/$Apply A F) @@ -189,7 +189,7 @@ (&type/with-var (fn [$var] (|do [=type (apply-type! type $var) - ==type (adjust-type* (&/$Cons (&/T [_aenv 1 $var]) + ==type (adjust-type* (&/$Item (&/T [_aenv 1 $var]) (&/|map update-up-frame up)) =type)] (&type/clean $var ==type)))) @@ -247,7 +247,7 @@ (defn adjust-type [type] "(-> Type (Lux Type))" - (adjust-type* &/$Nil type)) + (adjust-type* &/$End type)) (defn ^:private analyse-pattern [var?? value-type pattern kont] (|let [[meta pattern*] pattern] @@ -300,12 +300,12 @@ (&/$Tuple ?members) (|case ?members - (&/$Nil) + (&/$End) (|do [_ (&type/check value-type &type/Any) =kont kont] (return (&/T [($TupleTestAC (&/|list)) =kont]))) - (&/$Cons ?member (&/$Nil)) + (&/$Item ?member (&/$End)) (analyse-pattern var?? value-type ?member kont) _ @@ -322,9 +322,9 @@ (|do [[=tests =kont] (&/fold (fn [kont* vm] (|let [[v m] vm] (|do [[=test [=tests =kont]] (analyse-pattern &/$None v m kont*)] - (return (&/T [(&/$Cons =test =tests) =kont]))))) + (return (&/T [(&/$Item =test =tests) =kont]))))) (|do [=kont kont] - (return (&/T [&/$Nil =kont]))) + (return (&/T [&/$End =kont]))) (&/|reverse (&/zip2 _tuple-types ?members)))] (return (&/T [($TupleTestAC =tests) =kont]))) (&/fail-with-loc (str "[Pattern-matching Error] Pattern-matching mismatch. Requires tuple[" (&/|length (&type/flatten-prod value-type*)) "]. Given tuple [" (&/|length ?members) "].\n" @@ -360,7 +360,7 @@ [=test =kont] (analyse-pattern &/$None case-type unit-tuple kont)] (return (&/T [($VariantTestAC (&/T [idx (&/|length group) =test])) =kont]))) - (&/$Form (&/$Cons [_ (&/$Nat idx)] (&/$Cons [_ (&/$Bit right?)] ?values))) + (&/$Form (&/$Item [_ (&/$Nat idx)] (&/$Item [_ (&/$Bit right?)] ?values))) (let [idx (if right? (inc idx) idx)] (|do [value-type* (adjust-type value-type) case-type (&type/sum-at idx value-type*) @@ -371,7 +371,7 @@ (analyse-pattern &/$None case-type (&/T [(&/T ["" -1 -1]) (&/$Tuple ?values)]) kont))] (return (&/T [($VariantTestAC (&/T [idx (&/|length (&type/flatten-sum value-type*)) =test])) =kont])))) - (&/$Form (&/$Cons [_ (&/$Tag ?ident)] ?values)) + (&/$Form (&/$Item [_ (&/$Tag ?ident)] ?values)) (|do [[=module =name] (&&/resolved-ident ?ident) must-infer? (&type/unknown? value-type) variant-type (if must-infer? @@ -398,7 +398,7 @@ (defn ^:private analyse-branch [analyse exo-type var?? value-type pattern body patterns] (|do [pattern+body (analyse-pattern var?? value-type pattern (&&/analyse-1 analyse exo-type body))] - (return (&/$Cons pattern+body patterns)))) + (return (&/$Item pattern+body patterns)))) (defn ^:private merge-total [struct test+body] (|let [[test ?body] test+body] @@ -461,37 +461,37 @@ (return ($BitTotal total? (&/|list ?value))) [($BitTotal total? ?values) ($BitTestAC ?value)] - (return ($BitTotal total? (&/$Cons ?value ?values))) + (return ($BitTotal total? (&/$Item ?value ?values))) [($DefaultTotal total?) ($NatTestAC ?value)] (return ($NatTotal total? (&/|list ?value))) [($NatTotal total? ?values) ($NatTestAC ?value)] - (return ($NatTotal total? (&/$Cons ?value ?values))) + (return ($NatTotal total? (&/$Item ?value ?values))) [($DefaultTotal total?) ($IntTestAC ?value)] (return ($IntTotal total? (&/|list ?value))) [($IntTotal total? ?values) ($IntTestAC ?value)] - (return ($IntTotal total? (&/$Cons ?value ?values))) + (return ($IntTotal total? (&/$Item ?value ?values))) [($DefaultTotal total?) ($RevTestAC ?value)] (return ($RevTotal total? (&/|list ?value))) [($RevTotal total? ?values) ($RevTestAC ?value)] - (return ($RevTotal total? (&/$Cons ?value ?values))) + (return ($RevTotal total? (&/$Item ?value ?values))) [($DefaultTotal total?) ($FracTestAC ?value)] (return ($FracTotal total? (&/|list ?value))) [($FracTotal total? ?values) ($FracTestAC ?value)] - (return ($FracTotal total? (&/$Cons ?value ?values))) + (return ($FracTotal total? (&/$Item ?value ?values))) [($DefaultTotal total?) ($TextTestAC ?value)] (return ($TextTotal total? (&/|list ?value))) [($TextTotal total? ?values) ($TextTestAC ?value)] - (return ($TextTotal total? (&/$Cons ?value ?values))) + (return ($TextTotal total? (&/$Item ?value ?values))) [($DefaultTotal total?) ($TupleTestAC ?tests)] (|do [structs (&/map% (fn [t] @@ -578,7 +578,7 @@ ($TupleTotal ?total ?structs) (|case ?structs - (&/$Nil) + (&/$End) (|do [value-type* (resolve-type value-type)] (if (&type/type= &type/Any value-type*) (return true) @@ -589,7 +589,7 @@ (if unknown? (|do [=structs (&/map% (check-totality+ check-totality) ?structs) _ (&type/check value-type (|case (->> (&/|map &/|second =structs) (&/|reverse)) - (&/$Cons last prevs) + (&/$Item last prevs) (&/fold (fn [right left] (&/$Product left right)) last prevs)))] (return (or ?total @@ -629,7 +629,7 @@ (|do [patterns (&/fold% (fn [patterns branch] (|let [[pattern body] branch] (analyse-branch analyse exo-type var?? value-type pattern body patterns))) - &/$Nil + &/$End branches) struct (&/fold% merge-total ($DefaultTotal false) patterns) ? (check-totality value-type struct) diff --git a/lux-bootstrapper/src/lux/analyser/env.clj b/lux-bootstrapper/src/lux/analyser/env.clj index a2b6e5ad3..c170771ea 100644 --- a/lux-bootstrapper/src/lux/analyser/env.clj +++ b/lux-bootstrapper/src/lux/analyser/env.clj @@ -15,7 +15,7 @@ =return (body (&/update$ &/$scopes (fn [stack] (let [var-analysis (&&/|meta type &/empty-location (&&/$var (&/$Local (->> (&/|head stack) (&/get$ &/$locals) (&/get$ &/$counter)))))] - (&/$Cons (&/update$ &/$locals #(->> % + (&/$Item (&/update$ &/$locals #(->> % (&/update$ &/$counter inc) (&/update$ &/$mappings (fn [m] (&/|put name (&/T [type var-analysis]) m)))) (&/|head stack)) @@ -24,7 +24,7 @@ (|case =return (&/$Right ?state ?value) (return* (&/update$ &/$scopes (fn [stack*] - (&/$Cons (&/update$ &/$locals #(->> % + (&/$Item (&/update$ &/$locals #(->> % (&/update$ &/$counter dec) (&/set$ &/$mappings old-mappings)) (&/|head stack*)) @@ -40,7 +40,7 @@ (let [old-mappings (->> state (&/get$ &/$scopes) &/|head (&/get$ &/$locals) (&/get$ &/$mappings)) =return (body (&/update$ &/$scopes (fn [stack] - (&/$Cons (&/update$ &/$locals #(->> % + (&/$Item (&/update$ &/$locals #(->> % (&/update$ &/$mappings (fn [m] (&/|put name (&/T [(&&/expr-type* var-analysis) var-analysis]) @@ -51,7 +51,7 @@ (|case =return (&/$Right ?state ?value) (return* (&/update$ &/$scopes (fn [stack*] - (&/$Cons (&/update$ &/$locals #(->> % + (&/$Item (&/update$ &/$locals #(->> % (&/set$ &/$mappings old-mappings)) (&/|head stack*)) (&/|tail stack*))) @@ -64,11 +64,11 @@ (def captured-vars (fn [state] (|case (&/get$ &/$scopes state) - (&/$Nil) + (&/$End) ((&/fail-with-loc "[Analyser Error] Cannot obtain captured vars without environments.") state) - (&/$Cons env _) + (&/$Item env _) (return* state (->> env (&/get$ &/$captured) (&/get$ &/$mappings) diff --git a/lux-bootstrapper/src/lux/analyser/lux.clj b/lux-bootstrapper/src/lux/analyser/lux.clj index e71e54f4f..857f65e00 100644 --- a/lux-bootstrapper/src/lux/analyser/lux.clj +++ b/lux-bootstrapper/src/lux/analyser/lux.clj @@ -53,12 +53,12 @@ (defn analyse-tuple [analyse ?exo-type ?elems] (|case ?elems - (&/$Nil) + (&/$End) (analyse-unit analyse (|case ?exo-type (&/$Left exo-type) exo-type (&/$Right exo-type) exo-type)) - (&/$Cons ?elem (&/$Nil)) + (&/$Item ?elem (&/$End)) (analyse (|case ?exo-type (&/$Left exo-type) exo-type (&/$Right exo-type) exo-type) @@ -80,7 +80,7 @@ (|do [:let [=var* (next-parameter-type tuple-type)] _ (&type/set-var iid =var*) tuple-type* (&type/clean $var tuple-type)] - (return (&/$UnivQ &/$Nil tuple-type*))) + (return (&/$UnivQ &/$End tuple-type*))) _ (&type/clean $var tuple-type))] @@ -97,7 +97,7 @@ (return =analysis)) ?elems) _ (&type/check exo-type (|case (->> (&/|map &&/expr-type* =elems) (&/|reverse)) - (&/$Cons last prevs) + (&/$Item last prevs) (&/fold (fn [right left] (&/$Product left right)) last prevs))) _location &/location] @@ -158,16 +158,16 @@ (defn ^:private analyse-variant-body [analyse exo-type ?values] (|do [_location &/location output (|case ?values - (&/$Nil) + (&/$End) (analyse-unit analyse exo-type) - (&/$Cons ?value (&/$Nil)) + (&/$Item ?value (&/$End)) (analyse exo-type ?value) _ (analyse-tuple analyse (&/$Right exo-type) ?values))] (|case output - (&/$Cons x (&/$Nil)) + (&/$Item x (&/$End)) (return x) _ @@ -189,7 +189,7 @@ (|do [:let [=var* (next-parameter-type variant-type)] _ (&type/set-var iid =var*) variant-type* (&type/clean $var variant-type)] - (return (&/$UnivQ &/$Nil variant-type*))) + (return (&/$UnivQ &/$End variant-type*))) _ (&type/clean $var variant-type))] @@ -278,20 +278,20 @@ (->> % (&/get$ &/$captured) (&/get$ &/$mappings) (&/|contains? name) not)) [inner outer] (&/|split-with no-binding? stack)] (|case outer - (&/$Nil) + (&/$End) (&/run-state (|do [module-name &/get-module-name] (analyse-global analyse exo-type module-name name)) state) - (&/$Cons bottom-outer _) + (&/$Item bottom-outer _) (|let [scopes (&/|map #(&/get$ &/$name %) (&/|reverse inner)) [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope] (|let [[register new-inner] register+new-inner [register* frame*] (&&function/close-over in-scope name register frame)] - (&/T [register* (&/$Cons frame* new-inner)]))) + (&/T [register* (&/$Item frame* new-inner)]))) (&/T [(&/|second (or (->> bottom-outer (&/get$ &/$locals) (&/get$ &/$mappings) (&/|get name)) (->> bottom-outer (&/get$ &/$captured) (&/get$ &/$mappings) (&/|get name)))) - &/$Nil]) + &/$End]) (&/|reverse inner) scopes)] ((|do [_ (&type/check exo-type (&&/expr-type* =local))] (return (&/|list =local))) @@ -307,11 +307,11 @@ (defn ^:private analyse-apply* [analyse exo-type fun-type ?args] (|case ?args - (&/$Nil) + (&/$End) (|do [_ (&type/check exo-type fun-type)] - (return (&/T [fun-type &/$Nil]))) + (return (&/T [fun-type &/$End]))) - (&/$Cons ?arg ?args*) + (&/$Item ?arg ?args*) (|do [?fun-type* (&type/actual-type fun-type)] (&/with-attempt (|case ?fun-type* @@ -328,7 +328,7 @@ (&type/clean $var =output-t) (|do [_ (&type/set-var ?id (next-parameter-type =output-t)) cleaned-output* (&type/clean $var =output-t) - :let [cleaned-output (&/$UnivQ &/$Nil cleaned-output*)]] + :let [cleaned-output (&/$UnivQ &/$End cleaned-output*)]] (return cleaned-output))) _ (&type/clean $var exo-type)] (return (&/T [type** ==args]))) @@ -358,7 +358,7 @@ (&&/analyse-1 analyse ?input-t ?arg) (fn [err] (&/fail-with-loc (str err "\n" "[Analyser Error] Argument expected: " (&type/show-type ?input-t)))))] - (return (&/T [=output-t (&/$Cons =arg =args)]))) + (return (&/T [=output-t (&/$Item =arg =args)]))) _ (&/fail-with-loc (str "[Analyser Error] Cannot apply a non-function: " (&type/show-type ?fun-type*)))) @@ -418,7 +418,7 @@ (defn ^:private unravel-inf-appt [type] (|case type (&/$Apply (&/$Var _inf-var) =input+) - (&/$Cons _inf-var (unravel-inf-appt =input+)) + (&/$Item _inf-var (unravel-inf-appt =input+)) _ (&/|list))) @@ -430,7 +430,7 @@ _ (&type/set-var iid =input*) =func* (&type/clean $input =func) =func** (&type/clean $output =func*)] - (return (&/$UnivQ &/$Nil =func**))) + (return (&/$UnivQ &/$End =func**))) (&/$Apply (&/$Var _inf-var) =input+) (&/fold% (fn [_func _inf-var] @@ -547,7 +547,7 @@ (if (= wanted-name source-name) "" (str "\nThis is an alias for " source-name))))) - (return &/$Nil)))) + (return &/$End)))) (defn analyse-def* [analyse optimize eval! compile-def ?name ?value ?meta exported? & [?expected-type]] (|do [_ &/ensure-directive @@ -572,7 +572,7 @@ (defn analyse-def [analyse optimize eval! compile-def ?name ?value ?meta exported?] (|do [_ (analyse-def* analyse optimize eval! compile-def ?name ?value ?meta exported?)] - (return &/$Nil))) + (return &/$End))) (defn analyse-def-type-tagged [analyse optimize eval! compile-def ?name ?value ?meta tags* exported?] (|do [[module-name def-type def-value =exported?] (analyse-def* analyse optimize eval! compile-def ?name ?value ?meta exported? &type/Type) @@ -587,7 +587,7 @@ (&/fail-with-loc "[Analyser Error] Incorrect format for tags."))) tags*) _ (&&module/declare-tags module-name tags =exported? def-value)] - (return &/$Nil))) + (return &/$End))) (defn analyse-def-alias [?alias ?original] (|let [[r-module r-name] ?original] @@ -596,7 +596,7 @@ _ (&&module/find-def r-module r-name) _ (&/without-repl-closure (&&module/define-alias module-name ?alias ?original))] - (return &/$Nil)))) + (return &/$End)))) (defn ^:private merge-module-states "(-> Host Host Host)" @@ -696,7 +696,7 @@ (&/fail ?error))) _compiler =asyncs)] - (return &/$Nil))) + (return &/$End))) (defn ^:private coerce "(-> Type Analysis Analysis)" @@ -728,4 +728,4 @@ (|do [_ &/ensure-directive =program (&&/analyse-1 analyse program-type ?program) _ (compile-program (optimize =program))] - (return &/$Nil)))) + (return &/$End)))) diff --git a/lux-bootstrapper/src/lux/analyser/module.clj b/lux-bootstrapper/src/lux/analyser/module.clj index d41eb73d5..12e6b816a 100644 --- a/lux-bootstrapper/src/lux/analyser/module.clj +++ b/lux-bootstrapper/src/lux/analyser/module.clj @@ -35,7 +35,7 @@ ;; "lux;defs" (&/|table) ;; "lux;imports" - &/$Nil + &/$End ;; "lux;tags" (&/|table) ;; "lux;types" @@ -87,7 +87,7 @@ (return* (&/update$ &/$modules (fn [ms] (&/|update current-module - (fn [m] (&/update$ $imports (partial &/$Cons module) m)) + (fn [m] (&/update$ $imports (partial &/$Item module) m)) ms)) state) nil))))) @@ -108,7 +108,7 @@ (defn define-alias [module name de-aliased] (fn [state] (|case (&/get$ &/$scopes state) - (&/$Cons ?env (&/$Nil)) + (&/$Item ?env (&/$End)) (return* (->> state (&/update$ &/$modules (fn [ms] @@ -127,7 +127,7 @@ (defn define [module name exported? def-type def-meta def-value] (fn [state] (|case (&/get$ &/$scopes state) - (&/$Cons ?env (&/$Nil)) + (&/$Item ?env (&/$End)) (return* (->> state (&/update$ &/$modules (fn [ms] @@ -287,7 +287,7 @@ (fn [state] (return* (->> state (&/update$ &/$modules #(&/|put name (new-module hash) %)) - (&/set$ &/$scopes (&/|list (&/env name &/$Nil))) + (&/set$ &/$scopes (&/|list (&/env name &/$End))) (&/set$ &/$current-module (&/$Some name))) nil))) @@ -406,9 +406,9 @@ [_ (&/$Tuple _parts)] (&/map% (fn [_part] (|case _part - [_ (&/$Tuple (&/$Cons [[_ (&/$Text _module)] - (&/$Cons [[_ (&/$Text _alias)] - (&/$Nil)])]))] + [_ (&/$Tuple (&/$Item [[_ (&/$Text _module)] + (&/$Item [[_ (&/$Text _alias)] + (&/$End)])]))] (return (&/T [_module _alias])) _ diff --git a/lux-bootstrapper/src/lux/analyser/parser.clj b/lux-bootstrapper/src/lux/analyser/parser.clj index 15224573c..cfc26ea2a 100644 --- a/lux-bootstrapper/src/lux/analyser/parser.clj +++ b/lux-bootstrapper/src/lux/analyser/parser.clj @@ -20,23 +20,23 @@ (fn [state] (|case (action state) (&/$Left ^String error) - (&/$Right (&/T [state &/$Nil])) + (&/$Right (&/T [state &/$End])) (&/$Right state* head) ((|do [tail (repeat% action)] - (return (&/$Cons head tail))) + (return (&/$Item head tail))) state*)))) (defn ^:private spaced [action] (fn [state] (|case (action state) (&/$Left ^String error) - (&/$Right (&/T [state &/$Nil])) + (&/$Right (&/T [state &/$End])) (&/$Right state* head) ((&/try-all% (&/|list (|do [_ _space_ tail (spaced action)] - (return (&/$Cons head tail))) + (return (&/$Item head tail))) (return (&/|list head)))) state*)))) @@ -129,7 +129,7 @@ (def ^:private parse-ctor-arg (with-brackets (|do [=class parse-gclass - (&/$Cons =term (&/$Nil)) (with-pre-space + (&/$Item =term (&/$End)) (with-pre-space &parser/parse)] (return (&/T [=class =term]))))) @@ -181,7 +181,7 @@ (|do [[_ _ ?] (&reader/read-text? " ")] (if ? (|do [=tail parse-gvars] - (return (&/$Cons =head =tail))) + (return (&/$Item =head =tail))) (return (&/|list =head)))) (&/$None) @@ -264,7 +264,7 @@ =ctor-args (with-pre-space (with-brackets (spaced parse-ctor-arg))) - (&/$Cons =body (&/$Nil)) (with-pre-space + (&/$Item =body (&/$End)) (with-pre-space &parser/parse)] (return (&/$ConstructorMethodSyntax (&/T [=privacy-modifier =strict =anns =gvars =exceptions =inputs =ctor-args =body]))))) @@ -294,7 +294,7 @@ (spaced parse-arg-decl))) =output (with-pre-space parse-gclass) - (&/$Cons =body (&/$Nil)) (with-pre-space + (&/$Item =body (&/$End)) (with-pre-space &parser/parse)] (return (&/$VirtualMethodSyntax (&/T [=name =privacy-modifier =final? =strict =anns =gvars =exceptions =inputs =output =body]))))) @@ -321,7 +321,7 @@ (spaced parse-arg-decl))) =output (with-pre-space parse-gclass) - (&/$Cons =body (&/$Nil)) (with-pre-space + (&/$Item =body (&/$End)) (with-pre-space &parser/parse)] (return (&/$OverridenMethodSyntax (&/T [=class-decl =name =strict =anns =gvars =exceptions =inputs =output =body]))))) @@ -348,7 +348,7 @@ (spaced parse-arg-decl))) =output (with-pre-space parse-gclass) - (&/$Cons =body (&/$Nil)) (with-pre-space + (&/$Item =body (&/$End)) (with-pre-space &parser/parse)] (return (&/$StaticMethodSyntax (&/T [=name =privacy-modifier =strict =anns =gvars =exceptions =inputs =output =body]))))) @@ -416,7 +416,7 @@ (spaced parse-ann))) =type (with-pre-space parse-gclass) - (&/$Cons =value (&/$Nil)) (with-pre-space + (&/$Item =value (&/$End)) (with-pre-space &parser/parse)] (return (&/$ConstantFieldSyntax =name =anns =type =value))) diff --git a/lux-bootstrapper/src/lux/analyser/proc/common.clj b/lux-bootstrapper/src/lux/analyser/proc/common.clj index 439ad0d10..2d4c0d27e 100644 --- a/lux-bootstrapper/src/lux/analyser/proc/common.clj +++ b/lux-bootstrapper/src/lux/analyser/proc/common.clj @@ -10,7 +10,7 @@ (defn- analyse-lux-is [analyse exo-type ?values] (&type/with-var (fn [$var] - (|do [:let [(&/$Cons reference (&/$Cons sample (&/$Nil))) ?values] + (|do [:let [(&/$Item reference (&/$Item sample (&/$End))) ?values] =reference (&&/analyse-1 analyse $var reference) =sample (&&/analyse-1 analyse $var sample) _ (&type/check exo-type &type/Bit) @@ -21,7 +21,7 @@ (defn- analyse-lux-try [analyse exo-type ?values] (&type/with-var (fn [$var] - (|do [:let [(&/$Cons op (&/$Nil)) ?values] + (|do [:let [(&/$Item op (&/$End)) ?values] =op (&&/analyse-1 analyse (&/$Function &type/Any $var) op) _ (&type/check exo-type (&/$Sum &type/Text ;; lux.Left $var ;; lux.Right @@ -31,7 +31,7 @@ (&&/$proc (&/T ["lux" "try"]) (&/|list =op) (&/|list))))))))) (defn- analyse-lux-macro [analyse exo-type ?values] - (|do [:let [(&/$Cons macro (&/$Nil)) ?values] + (|do [:let [(&/$Item macro (&/$End)) ?values] [_real-name [_exported? _def-type _meta macro-type]] (&&module/find-def! &/prelude "Macro'") [[=macro*-type =location] =macro] (&&/analyse-1 analyse macro-type macro) _ (&type/check exo-type &type/Macro)] @@ -40,7 +40,7 @@ (do-template [<name> <proc> <input-type> <output-type>] (defn- <name> [analyse exo-type ?values] - (|do [:let [(&/$Cons reference (&/$Cons sample (&/$Nil))) ?values] + (|do [:let [(&/$Item reference (&/$Item sample (&/$End))) ?values] =reference (&&/analyse-1 analyse <input-type> reference) =sample (&&/analyse-1 analyse <input-type> sample) _ (&type/check exo-type <output-type>) @@ -53,7 +53,7 @@ ) (defn- analyse-text-concat [analyse exo-type ?values] - (|do [:let [(&/$Cons parameter (&/$Cons subject (&/$Nil))) ?values] + (|do [:let [(&/$Item parameter (&/$Item subject (&/$End))) ?values] =parameter (&&/analyse-1 analyse &type/Text parameter) =subject (&&/analyse-1 analyse &type/Text subject) _ (&type/check exo-type &type/Text) @@ -62,7 +62,7 @@ (&&/$proc (&/T ["text" "concat"]) (&/|list =parameter =subject) (&/|list))))))) (defn- analyse-text-index [analyse exo-type ?values] - (|do [:let [(&/$Cons start (&/$Cons part (&/$Cons text (&/$Nil)))) ?values] + (|do [:let [(&/$Item start (&/$Item part (&/$Item text (&/$End)))) ?values] =start (&&/analyse-1 analyse &type/Nat start) =part (&&/analyse-1 analyse &type/Text part) =text (&&/analyse-1 analyse &type/Text text) @@ -74,7 +74,7 @@ (&/|list))))))) (defn- analyse-text-clip [analyse exo-type ?values] - (|do [:let [(&/$Cons from (&/$Cons to (&/$Cons text (&/$Nil)))) ?values] + (|do [:let [(&/$Item from (&/$Item to (&/$Item text (&/$End)))) ?values] =from (&&/analyse-1 analyse &type/Nat from) =to (&&/analyse-1 analyse &type/Nat to) =text (&&/analyse-1 analyse &type/Text text) @@ -87,7 +87,7 @@ (do-template [<name> <proc>] (defn- <name> [analyse exo-type ?values] - (|do [:let [(&/$Cons text (&/$Nil)) ?values] + (|do [:let [(&/$Item text (&/$End)) ?values] =text (&&/analyse-1 analyse &type/Text text) _ (&type/check exo-type &type/Nat) _location &/location] @@ -100,7 +100,7 @@ ) (defn- analyse-text-char [analyse exo-type ?values] - (|do [:let [(&/$Cons idx (&/$Cons text (&/$Nil))) ?values] + (|do [:let [(&/$Item idx (&/$Item text (&/$End))) ?values] =idx (&&/analyse-1 analyse &type/Nat idx) =text (&&/analyse-1 analyse &type/Text text) _ (&type/check exo-type &type/Nat) @@ -114,7 +114,7 @@ (let [inputT (&/$Apply &type/Any &type/I64) outputT &type/I64] (defn- <name> [analyse exo-type ?values] - (|do [:let [(&/$Cons mask (&/$Cons input (&/$Nil))) ?values] + (|do [:let [(&/$Item mask (&/$Item input (&/$End))) ?values] =mask (&&/analyse-1 analyse inputT mask) =input (&&/analyse-1 analyse inputT input) _ (&type/check exo-type outputT) @@ -131,7 +131,7 @@ (let [inputT (&/$Apply &type/Any &type/I64) outputT &type/I64] (defn- <name> [analyse exo-type ?values] - (|do [:let [(&/$Cons shift (&/$Cons input (&/$Nil))) ?values] + (|do [:let [(&/$Item shift (&/$Item input (&/$End))) ?values] =shift (&&/analyse-1 analyse &type/Nat shift) =input (&&/analyse-1 analyse inputT input) _ (&type/check exo-type outputT) @@ -147,7 +147,7 @@ (let [inputT <input-type> outputT <output-type>] (defn- <name> [analyse exo-type ?values] - (|do [:let [(&/$Cons parameterC (&/$Cons subjectC (&/$Nil))) ?values] + (|do [:let [(&/$Item parameterC (&/$Item subjectC (&/$End))) ?values] parameterA (&&/analyse-1 analyse <input-type> parameterC) subjectA (&&/analyse-1 analyse <input-type> subjectC) _ (&type/check exo-type <output-type>) @@ -175,7 +175,7 @@ (do-template [<encode> <encode-op> <decode> <decode-op> <type>] (do (defn- <encode> [analyse exo-type ?values] - (|do [:let [(&/$Cons x (&/$Nil)) ?values] + (|do [:let [(&/$Item x (&/$End)) ?values] =x (&&/analyse-1 analyse <type> x) _ (&type/check exo-type &type/Text) _location &/location] @@ -184,7 +184,7 @@ (let [decode-type (&/$Apply <type> &type/Maybe)] (defn- <decode> [analyse exo-type ?values] - (|do [:let [(&/$Cons x (&/$Nil)) ?values] + (|do [:let [(&/$Item x (&/$End)) ?values] =x (&&/analyse-1 analyse &type/Text x) _ (&type/check exo-type decode-type) _location &/location] @@ -196,7 +196,7 @@ (do-template [<name> <from-type> <to-type> <op>] (defn- <name> [analyse exo-type ?values] - (|do [:let [(&/$Cons x (&/$Nil)) ?values] + (|do [:let [(&/$Item x (&/$End)) ?values] =x (&&/analyse-1 analyse <from-type> x) _ (&type/check exo-type <to-type>) _location &/location] @@ -212,14 +212,14 @@ ) (defn- analyse-io-current-time [analyse exo-type ?values] - (|do [:let [(&/$Nil) ?values] + (|do [:let [(&/$End) ?values] _ (&type/check exo-type &type/Int) _location &/location] (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["io" "current-time"]) (&/|list) (&/|list))))))) (defn- analyse-syntax-char-case! [analyse exo-type ?values] - (|do [:let [(&/$Cons ?input (&/$Cons [_ (&/$Tuple ?pairs)] (&/$Cons ?else (&/$Nil)))) ?values] + (|do [:let [(&/$Item ?input (&/$Item [_ (&/$Tuple ?pairs)] (&/$Item ?else (&/$End)))) ?values] _location &/location =input (&&/analyse-1 analyse &type/Nat ?input) _ (assert! (even? (&/|length ?pairs)) "The number of matches must be even!") @@ -235,7 +235,7 @@ =else (&&/analyse-1 analyse exo-type ?else)] (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["lux" "syntax char case!"]) - (&/$Cons =input (&/$Cons =else (&/|map &/|second =pairs))) + (&/$Item =input (&/$Item =else (&/|map &/|second =pairs))) (&/|map &/|first =pairs))))))) (defn analyse-proc [analyse exo-type proc ?values] diff --git a/lux-bootstrapper/src/lux/analyser/proc/jvm.clj b/lux-bootstrapper/src/lux/analyser/proc/jvm.clj index 78362601d..38310e60c 100644 --- a/lux-bootstrapper/src/lux/analyser/proc/jvm.clj +++ b/lux-bootstrapper/src/lux/analyser/proc/jvm.clj @@ -93,8 +93,8 @@ (|do [[_ clean-types] (&/fold% (fn [idx+types gtype-var] (|do [:let [[idx types] idx+types] [idx* real-type] (clean-gtype-var idx gtype-var)] - (return (&/T [idx* (&/$Cons real-type types)])))) - (&/T [1 &/$Nil]) + (return (&/T [idx* (&/$Item real-type types)])))) + (&/T [1 &/$End]) gtype-vars)] (return clean-types))) @@ -118,7 +118,7 @@ (|case obj-type (&/$Primitive class targs) (if (= (&/|length targs) (&/|length gvars)) - (|let [gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/$Cons (&/T [(.getName g) t]) m)) + (|let [gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/$Item (&/T [(.getName g) t]) m)) (&/|table) gvars targs)] @@ -191,14 +191,14 @@ (&/$GenericClass name params) (case name - "boolean" (return (&/$Primitive "java.lang.Boolean" &/$Nil)) - "byte" (return (&/$Primitive "java.lang.Byte" &/$Nil)) - "short" (return (&/$Primitive "java.lang.Short" &/$Nil)) - "int" (return (&/$Primitive "java.lang.Integer" &/$Nil)) - "long" (return (&/$Primitive "java.lang.Long" &/$Nil)) - "float" (return (&/$Primitive "java.lang.Float" &/$Nil)) - "double" (return (&/$Primitive "java.lang.Double" &/$Nil)) - "char" (return (&/$Primitive "java.lang.Character" &/$Nil)) + "boolean" (return (&/$Primitive "java.lang.Boolean" &/$End)) + "byte" (return (&/$Primitive "java.lang.Byte" &/$End)) + "short" (return (&/$Primitive "java.lang.Short" &/$End)) + "int" (return (&/$Primitive "java.lang.Integer" &/$End)) + "long" (return (&/$Primitive "java.lang.Long" &/$End)) + "float" (return (&/$Primitive "java.lang.Float" &/$End)) + "double" (return (&/$Primitive "java.lang.Double" &/$End)) + "char" (return (&/$Primitive "java.lang.Character" &/$End)) "void" (return &type/Any) ;; else (|do [=params (&/map% (partial generic-class->type env) params)] @@ -209,7 +209,7 @@ (return (&/$Primitive &host-type/array-data-tag (&/|list =param)))) (&/$GenericWildcard _) - (return (&/$ExQ &/$Nil (&/$Parameter 1))) + (return (&/$ExQ &/$End (&/$Parameter 1))) )) (defn gen-super-env @@ -393,10 +393,10 @@ )) (do-template [<name> <proc> <from-class> <to-class>] - (let [output-type (&/$Primitive <to-class> &/$Nil)] + (let [output-type (&/$Primitive <to-class> &/$End)] (defn- <name> [analyse exo-type _?value] - (|do [:let [(&/$Cons ?value (&/$Nil)) _?value] - =value (&&/analyse-1 analyse (&/$Primitive <from-class> &/$Nil) ?value) + (|do [:let [(&/$Item ?value (&/$End)) _?value] + =value (&&/analyse-1 analyse (&/$Primitive <from-class> &/$End) ?value) _ (&type/check exo-type output-type) _location &/location] (return (&/|list (&&/|meta output-type _location (&&/$proc (&/T ["jvm" <proc>]) (&/|list =value) (&/|list)))))))) @@ -433,11 +433,11 @@ ) (do-template [<name> <proc> <v1-class> <v2-class> <to-class>] - (let [output-type (&/$Primitive <to-class> &/$Nil)] + (let [output-type (&/$Primitive <to-class> &/$End)] (defn- <name> [analyse exo-type ?values] - (|do [:let [(&/$Cons ?value1 (&/$Cons ?value2 (&/$Nil))) ?values] - =value1 (&&/analyse-1 analyse (&/$Primitive <v1-class> &/$Nil) ?value1) - =value2 (&&/analyse-1 analyse (&/$Primitive <v2-class> &/$Nil) ?value2) + (|do [:let [(&/$Item ?value1 (&/$Item ?value2 (&/$End))) ?values] + =value1 (&&/analyse-1 analyse (&/$Primitive <v1-class> &/$End) ?value1) + =value2 (&&/analyse-1 analyse (&/$Primitive <v2-class> &/$End) ?value2) _ (&type/check exo-type output-type) _location &/location] (return (&/|list (&&/|meta output-type _location (&&/$proc (&/T ["jvm" <proc>]) (&/|list =value1 =value2) (&/|list)))))))) @@ -458,10 +458,10 @@ ) (do-template [<name> <proc> <input-class> <output-class>] - (let [input-type (&/$Primitive <input-class> &/$Nil) - output-type (&/$Primitive <output-class> &/$Nil)] + (let [input-type (&/$Primitive <input-class> &/$End) + output-type (&/$Primitive <output-class> &/$End)] (defn- <name> [analyse exo-type ?values] - (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] + (|do [:let [(&/$Item x (&/$Item y (&/$End))) ?values] =x (&&/analyse-1 analyse input-type x) =y (&&/analyse-1 analyse input-type y) _ (&type/check exo-type output-type) @@ -513,10 +513,10 @@ (let [length-type &type/Nat idx-type &type/Nat] (do-template [<elem-class> <array-class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>] - (let [elem-type (&/$Primitive <elem-class> &/$Nil) - array-type (&/$Primitive <array-class> &/$Nil)] + (let [elem-type (&/$Primitive <elem-class> &/$End) + array-type (&/$Primitive <array-class> &/$End)] (defn- <new-name> [analyse exo-type ?values] - (|do [:let [(&/$Cons length (&/$Nil)) ?values] + (|do [:let [(&/$Item length (&/$End)) ?values] =length (&&/analyse-1 analyse length-type length) _ (&type/check exo-type array-type) _location &/location] @@ -524,7 +524,7 @@ (&&/$proc (&/T ["jvm" <new-tag>]) (&/|list =length) (&/|list))))))) (defn- <load-name> [analyse exo-type ?values] - (|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values] + (|do [:let [(&/$Item array (&/$Item idx (&/$End))) ?values] =array (&&/analyse-1 analyse array-type array) =idx (&&/analyse-1 analyse idx-type idx) _ (&type/check exo-type elem-type) @@ -533,7 +533,7 @@ (&&/$proc (&/T ["jvm" <load-tag>]) (&/|list =array =idx) (&/|list))))))) (defn- <store-name> [analyse exo-type ?values] - (|do [:let [(&/$Cons array (&/$Cons idx (&/$Cons elem (&/$Nil)))) ?values] + (|do [:let [(&/$Item array (&/$Item idx (&/$Item elem (&/$End)))) ?values] =array (&&/analyse-1 analyse array-type array) =idx (&&/analyse-1 analyse idx-type idx) =elem (&&/analyse-1 analyse elem-type elem) @@ -563,7 +563,7 @@ (let [length-type &type/Nat idx-type &type/Nat] (defn- analyse-jvm-anewarray [analyse exo-type ?values] - (|do [:let [(&/$Cons [_ (&/$Text _gclass)] (&/$Cons length (&/$Nil))) ?values] + (|do [:let [(&/$Item [_ (&/$Text _gclass)] (&/$Item length (&/$End))) ?values] gclass (&reader/with-source "jvm-anewarray" _gclass &&a-parser/parse-gclass) gtype-env &/get-type-env @@ -576,11 +576,11 @@ (&&/$proc (&/T ["jvm" "anewarray"]) (&/|list =length) (&/|list gclass gtype-env))))))) (defn- analyse-jvm-aaload [analyse exo-type ?values] - (|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values] + (|do [:let [(&/$Item array (&/$Item idx (&/$End))) ?values] =array (&&/analyse-1+ analyse array) [arr-class arr-params] (ensure-object (&&/expr-type* =array)) _ (&/assert! (= &host-type/array-data-tag arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class)) - :let [(&/$Cons inner-arr-type (&/$Nil)) arr-params] + :let [(&/$Item inner-arr-type (&/$End)) arr-params] =idx (&&/analyse-1 analyse idx-type idx) _ (&type/check exo-type inner-arr-type) _location &/location] @@ -588,12 +588,12 @@ (&&/$proc (&/T ["jvm" "aaload"]) (&/|list =array =idx) (&/|list))))))) (defn- analyse-jvm-aastore [analyse exo-type ?values] - (|do [:let [(&/$Cons array (&/$Cons idx (&/$Cons elem (&/$Nil)))) ?values] + (|do [:let [(&/$Item array (&/$Item idx (&/$Item elem (&/$End)))) ?values] =array (&&/analyse-1+ analyse array) :let [array-type (&&/expr-type* =array)] [arr-class arr-params] (ensure-object array-type) _ (&/assert! (= &host-type/array-data-tag arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class)) - :let [(&/$Cons inner-arr-type (&/$Nil)) arr-params] + :let [(&/$Item inner-arr-type (&/$End)) arr-params] =idx (&&/analyse-1 analyse idx-type idx) =elem (&&/analyse-1 analyse inner-arr-type elem) _ (&type/check exo-type array-type) @@ -602,7 +602,7 @@ (&&/$proc (&/T ["jvm" "aastore"]) (&/|list =array =idx =elem) (&/|list)))))))) (defn- analyse-jvm-arraylength [analyse exo-type ?values] - (|do [:let [(&/$Cons array (&/$Nil)) ?values] + (|do [:let [(&/$Item array (&/$End)) ?values] =array (&&/analyse-1+ analyse array) [arr-class arr-params] (ensure-object (&&/expr-type* =array)) _ (&/assert! (array-class? arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class)) @@ -613,7 +613,7 @@ ))))) (defn- analyse-jvm-object-null? [analyse exo-type ?values] - (|do [:let [(&/$Cons object (&/$Nil)) ?values] + (|do [:let [(&/$Item object (&/$End)) ?values] =object (&&/analyse-1+ analyse object) _ (ensure-object (&&/expr-type* =object)) :let [output-type &type/Bit] @@ -623,15 +623,15 @@ (&&/$proc (&/T ["jvm" "object null?"]) (&/|list =object) (&/|list))))))) (defn- analyse-jvm-object-null [analyse exo-type ?values] - (|do [:let [(&/$Nil) ?values] - :let [output-type (&/$Primitive &host-type/null-data-tag &/$Nil)] + (|do [:let [(&/$End) ?values] + :let [output-type (&/$Primitive &host-type/null-data-tag &/$End)] _ (&type/check exo-type output-type) _location &/location] (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "object null"]) (&/|list) (&/|list))))))) (defn analyse-jvm-object-synchronized [analyse exo-type ?values] - (|do [:let [(&/$Cons ?monitor (&/$Cons ?expr (&/$Nil))) ?values] + (|do [:let [(&/$Item ?monitor (&/$Item ?expr (&/$End))) ?values] =monitor (&&/analyse-1+ analyse ?monitor) _ (ensure-object (&&/expr-type* =monitor)) =expr (&&/analyse-1 analyse exo-type ?expr) @@ -640,9 +640,9 @@ (&&/$proc (&/T ["jvm" "object synchronized"]) (&/|list =monitor =expr) (&/|list))))))) (defn- analyse-jvm-throw [analyse exo-type ?values] - (|do [:let [(&/$Cons ?ex (&/$Nil)) ?values] + (|do [:let [(&/$Item ?ex (&/$End)) ?values] =ex (&&/analyse-1+ analyse ?ex) - _ (&type/check (&/$Primitive "java.lang.Throwable" &/$Nil) (&&/expr-type* =ex)) + _ (&type/check (&/$Primitive "java.lang.Throwable" &/$End) (&&/expr-type* =ex)) [throw-class throw-params] (ensure-object (&&/expr-type* =ex)) _location &/location _ (&type/check exo-type &type/Nothing)] @@ -651,10 +651,10 @@ (defn- analyse-jvm-getstatic [analyse exo-type class field ?values] (|do [!class! (&/de-alias-class class) - :let [(&/$Nil) ?values] + :let [(&/$End) ?values] class-loader &/loader [gvars gtype] (&host/lookup-static-field class-loader !class! field) - =type (&host-type/instance-param &type/existential &/$Nil gtype) + =type (&host-type/instance-param &type/existential &/$End gtype) :let [output-type =type] _ (&type/check exo-type output-type) _location &/location] @@ -663,7 +663,7 @@ (defn- analyse-jvm-getfield [analyse exo-type class field ?values] (|do [!class! (&/de-alias-class class) - :let [(&/$Cons object (&/$Nil)) ?values] + :let [(&/$Item object (&/$End)) ?values] class-loader &/loader =object (&&/analyse-1+ analyse object) _ (ensure-object (&&/expr-type* =object)) @@ -677,11 +677,11 @@ (defn- analyse-jvm-putstatic [analyse exo-type class field ?values] (|do [!class! (&/de-alias-class class) - :let [(&/$Cons value (&/$Nil)) ?values] + :let [(&/$Item value (&/$End)) ?values] class-loader &/loader [gvars gtype] (&host/lookup-static-field class-loader !class! field) :let [gclass (&host-type/gtype->gclass gtype)] - =type (&host-type/instance-param &type/existential &/$Nil gtype) + =type (&host-type/instance-param &type/existential &/$End gtype) =value (&&/analyse-1 analyse =type value) :let [output-type &type/Any] _ (&type/check exo-type output-type) @@ -691,7 +691,7 @@ (defn- analyse-jvm-putfield [analyse exo-type class field ?values] (|do [!class! (&/de-alias-class class) - :let [(&/$Cons object (&/$Cons value (&/$Nil))) ?values] + :let [(&/$Item object (&/$Item value (&/$End))) ?values] class-loader &/loader =object (&&/analyse-1+ analyse object) :let [obj-type (&&/expr-type* =object)] @@ -708,7 +708,7 @@ (defn- analyse-method-call-helper [analyse exo-type gret gtype-env gtype-vars gtype-args args] (|case gtype-vars - (&/$Nil) + (&/$End) (|do [arg-types (&/map% (partial &host-type/instance-param &type/existential gtype-env) gtype-args) =arg-types (&/map% &type/show-type+ arg-types) =args (&/map2% (partial &&/analyse-1 analyse) arg-types args) @@ -716,11 +716,11 @@ _ (&type/check exo-type (as-otype+ =gret))] (return (&/T [=gret =args]))) - (&/$Cons ^TypeVariable gtv gtype-vars*) + (&/$Item ^TypeVariable gtv gtype-vars*) (&type/with-var (fn [$var] (|do [:let [(&/$Var _id) $var - gtype-env* (&/$Cons (&/T [(.getName gtv) $var]) gtype-env)] + gtype-env* (&/$Item (&/T [(.getName gtv) $var]) gtype-env)] [=gret =args] (analyse-method-call-helper analyse exo-type gret gtype-env* gtype-vars* gtype-args args) ==gret (&type/clean $var =gret) ==args (&/map% (partial &&/clean-analysis $var) =args)] @@ -733,7 +733,7 @@ !class! sub-class) sub-params)] - (return (&/fold2 (fn [m ^TypeVariable g t] (&/$Cons (&/T [(.getName g) t]) m)) + (return (&/fold2 (fn [m ^TypeVariable g t] (&/$Item (&/T [(.getName g) t]) m)) (&/|table) parent-gvars super-params*)))) @@ -751,20 +751,20 @@ (&/fail-with-loc (str "[Analyser Error] Unknown class: " !class!))))] (return (&/T [!class! class-loader])))) -(let [dummy-type-param (&/$Primitive "java.lang.Object" &/$Nil)] +(let [dummy-type-param (&/$Primitive "java.lang.Object" &/$End)] (do-template [<name> <tag> <only-interface?>] (defn- <name> [analyse exo-type class method classes ?values] - (|do [:let [(&/$Cons object args) ?values] + (|do [:let [(&/$Item object args) ?values] [!class! class-loader] (check-method! <only-interface?> class method) [gret exceptions parent-gvars gvars gargs] (if (= "<init>" method) - (return (&/T [Void/TYPE &/$Nil &/$Nil &/$Nil &/$Nil])) + (return (&/T [Void/TYPE &/$End &/$End &/$End &/$End])) (&host/lookup-virtual-method class-loader !class! method classes)) =object (&&/analyse-1+ analyse object) gtype-env (up-cast class parent-gvars class-loader !class! (&&/expr-type* =object)) [output-type =args] (analyse-method-call-helper analyse exo-type gret gtype-env gvars gargs args) _location &/location] (return (&/|list (&&/|meta exo-type _location - (&&/$proc (&/T ["jvm" <tag>]) (&/$Cons =object =args) (&/|list class method classes output-type gret))))))) + (&&/$proc (&/T ["jvm" <tag>]) (&/$Item =object =args) (&/|list class method classes output-type gret))))))) analyse-jvm-invokevirtual "invokevirtual" false analyse-jvm-invokespecial "invokespecial" false @@ -784,17 +784,17 @@ (defn- analyse-jvm-new-helper [analyse gtype gtype-env gtype-vars gtype-args args] (|case gtype-vars - (&/$Nil) + (&/$End) (|do [arg-types (&/map% (partial &host-type/instance-param &type/existential gtype-env) gtype-args) =args (&/map2% (partial &&/analyse-1 analyse) arg-types args) gtype-vars* (->> gtype-env (&/|map &/|second) (clean-gtype-vars))] (return (&/T [(make-gtype gtype gtype-vars*) =args]))) - (&/$Cons ^TypeVariable gtv gtype-vars*) + (&/$Item ^TypeVariable gtv gtype-vars*) (&type/with-var (fn [$var] - (|do [:let [gtype-env* (&/$Cons (&/T [(.getName gtv) $var]) gtype-env)] + (|do [:let [gtype-env* (&/$Item (&/T [(.getName gtv) $var]) gtype-env)] [=gret =args] (analyse-jvm-new-helper analyse gtype gtype-env* gtype-vars* gtype-args args) ==gret (&type/clean $var =gret) ==args (&/map% (partial &&/clean-analysis $var) =args)] @@ -813,7 +813,7 @@ (&&/$proc (&/T ["jvm" "new"]) =args (&/|list class classes))))))) (defn- analyse-jvm-instanceof [analyse exo-type class ?values] - (|do [:let [(&/$Cons object (&/$Nil)) ?values] + (|do [:let [(&/$Item object (&/$End)) ?values] =object (&&/analyse-1+ analyse object) _ (ensure-object (&&/expr-type* =object)) :let [output-type &type/Bit] @@ -823,7 +823,7 @@ (&&/$proc (&/T ["jvm" "instanceof"]) (&/|list =object) (&/|list class))))))) (defn- analyse-jvm-object-class [analyse exo-type ?values] - (|do [:let [(&/$Cons [_ (&/$Text _class-name)] (&/$Nil)) ?values] + (|do [:let [(&/$Item [_ (&/$Text _class-name)] (&/$End)) ?values] ^ClassLoader class-loader &/loader _ (try (do (.loadClass class-loader _class-name) (return nil)) @@ -849,14 +849,14 @@ :let [[?name ?params] class-decl full-name (str (string/replace module "/" ".") "." ?name) class-decl* (&/T [full-name ?params]) - all-supers (&/$Cons super-class interfaces)] + all-supers (&/$Item super-class interfaces)] class-env (make-type-env ?params) =fields (&/map% (partial analyse-field analyse class-env) ?fields) _ (&host/use-dummy-class class-decl super-class interfaces &/$None =fields methods) =methods (&/map% (partial analyse-method analyse class-decl* class-env all-supers) methods) ;; TODO: Uncomment ;; _ (check-method-completion all-supers =methods) - _ (compile-class class-decl super-class interfaces =inheritance-modifier =anns =fields =methods &/$Nil &/$None) + _ (compile-class class-decl super-class interfaces =inheritance-modifier =anns =fields =methods &/$End &/$None) _ &/pop-dummy-name :let [_ (println 'CLASS full-name)] _location &/location] @@ -869,7 +869,7 @@ source)) (defn- analyse-methods [analyse class-decl all-supers methods] - (|do [=methods (&/map% (partial analyse-method analyse class-decl &/$Nil all-supers) methods) + (|do [=methods (&/map% (partial analyse-method analyse class-decl &/$End all-supers) methods) ;; TODO: Uncomment ;; _ (check-method-completion all-supers =methods) =captured &&env/captured-vars] @@ -883,42 +883,42 @@ (let [default-<init> (fn [ctor-args] (&/$ConstructorMethodSyntax (&/T [&/$PublicPM ;; privacy-modifier false ;; strict - &/$Nil ;; anns - &/$Nil ;; gvars - &/$Nil ;; exceptions - &/$Nil ;; inputs + &/$End ;; anns + &/$End ;; gvars + &/$End ;; exceptions + &/$End ;; inputs ctor-args ;; ctor-args - (&/$Tuple &/$Nil) ;; body + (&/$Tuple &/$End) ;; body ]))) captured-slot-class "java.lang.Object" - captured-slot-type (&/$GenericClass captured-slot-class &/$Nil)] + captured-slot-type (&/$GenericClass captured-slot-class &/$End)] (defn- analyse-jvm-anon-class [analyse compile-class exo-type super-class interfaces ctor-args methods] (&/with-closure (|do [[module scope] (get-names) :let [name (->> scope &/|reverse &/|tail &host/location) - class-decl (&/T [name &/$Nil]) + class-decl (&/T [name &/$End]) anon-class (str (string/replace module "/" ".") "." name) - class-type-decl (&/T [anon-class &/$Nil]) - anon-class-type (&/$Primitive anon-class &/$Nil)] + class-type-decl (&/T [anon-class &/$End]) + anon-class-type (&/$Primitive anon-class &/$End)] =ctor-args (&/map% (fn [ctor-arg] (|let [[arg-type arg-term] ctor-arg] (|do [=arg-term (&&/analyse-1+ analyse arg-term)] (return (&/T [arg-type =arg-term]))))) ctor-args) _ (->> methods - (&/$Cons (default-<init> =ctor-args)) - (&host/use-dummy-class class-decl super-class interfaces (&/$Some =ctor-args) &/$Nil)) - [=methods =captured] (let [all-supers (&/$Cons super-class interfaces)] + (&/$Item (default-<init> =ctor-args)) + (&host/use-dummy-class class-decl super-class interfaces (&/$Some =ctor-args) &/$End)) + [=methods =captured] (let [all-supers (&/$Item super-class interfaces)] (analyse-methods analyse class-type-decl all-supers methods)) _ (let [=fields (&/|map (fn [^objects idx+capt] (|let [[idx _] idx+capt] (&/$VariableFieldAnalysis (str &c!base/closure-prefix idx) &/$PublicPM &/$FinalSM - &/$Nil + &/$End captured-slot-type))) (&/enumerate =captured))] - (compile-class class-decl super-class interfaces &/$DefaultIM &/$Nil =fields =methods =captured (&/$Some =ctor-args))) + (compile-class class-decl super-class interfaces &/$DefaultIM &/$End =fields =methods =captured (&/$Some =ctor-args))) _ &/pop-dummy-name _location &/location] (let [sources (&/|map captured-source =captured)] diff --git a/lux-bootstrapper/src/lux/analyser/record.clj b/lux-bootstrapper/src/lux/analyser/record.clj index 3d3d8169f..53f6c4d5c 100644 --- a/lux-bootstrapper/src/lux/analyser/record.clj +++ b/lux-bootstrapper/src/lux/analyser/record.clj @@ -7,13 +7,14 @@ [module :as &&module]))) ;; [Exports] -(defn order-record [pairs] +(defn order-record "(-> (List (, Syntax Syntax)) (Lux (List Syntax)))" + [pairs] (|do [[tag-group tag-type] (|case pairs - (&/$Nil) - (return (&/T [&/$Nil &type/Any])) + (&/$End) + (return (&/T [&/$End &type/Any])) - (&/$Cons [[_ (&/$Tag tag1)] _] _) + (&/$Item [[_ (&/$Tag tag1)] _] _) (|do [[module name] (&&/resolved-ident tag1) tags (&&module/tag-group module name) type (&&module/tag-type module name)] diff --git a/lux-bootstrapper/src/lux/base.clj b/lux-bootstrapper/src/lux/base.clj index 648b3341c..1367bdc1c 100644 --- a/lux-bootstrapper/src/lux/base.clj +++ b/lux-bootstrapper/src/lux/base.clj @@ -60,8 +60,8 @@ ;; List (defvariant - ("Nil" 0) - ("Cons" 2)) + ("End" 0) + ("Item" 2)) ;; Maybe (defvariant @@ -160,6 +160,7 @@ "seed" "scope-type-vars" "extensions" + "eval" "host"]) (defvariant @@ -285,71 +286,71 @@ (defmacro |list [& elems] (reduce (fn [tail head] - `($Cons ~head ~tail)) - `$Nil + `($Item ~head ~tail)) + `$End (reverse elems))) (defmacro |table [& elems] (reduce (fn [table [k v]] `(|put ~k ~v ~table)) - `$Nil + `$End (reverse (partition 2 elems)))) (defn |get [slot table] (|case table - ($Nil) + ($End) nil - ($Cons [k v] table*) + ($Item [k v] table*) (if (= k slot) v (recur slot table*)))) (defn |put [slot value table] (|case table - ($Nil) - ($Cons (T [slot value]) $Nil) + ($End) + ($Item (T [slot value]) $End) - ($Cons [k v] table*) + ($Item [k v] table*) (if (= k slot) - ($Cons (T [slot value]) table*) - ($Cons (T [k v]) (|put slot value table*))) + ($Item (T [slot value]) table*) + ($Item (T [k v]) (|put slot value table*))) )) (defn |remove [slot table] (|case table - ($Nil) + ($End) table - ($Cons [k v] table*) + ($Item [k v] table*) (if (= k slot) table* - ($Cons (T [k v]) (|remove slot table*))))) + ($Item (T [k v]) (|remove slot table*))))) (defn |update [k f table] (|case table - ($Nil) + ($End) table - ($Cons [k* v] table*) + ($Item [k* v] table*) (if (= k k*) - ($Cons (T [k* (f v)]) table*) - ($Cons (T [k* v]) (|update k f table*))))) + ($Item (T [k* (f v)]) table*) + ($Item (T [k* v]) (|update k f table*))))) (defn |head [xs] (|case xs - ($Nil) + ($End) (assert false (prn-str '|head)) - ($Cons x _) + ($Item x _) x)) (defn |tail [xs] (|case xs - ($Nil) + ($End) (assert false (prn-str '|tail)) - ($Cons _ xs*) + ($Item _ xs*) xs*)) ;; [Resources/Monads] @@ -395,19 +396,19 @@ (defn |++ [xs ys] (|case xs - ($Nil) + ($End) ys - ($Cons x xs*) - ($Cons x (|++ xs* ys)))) + ($Item x xs*) + ($Item x (|++ xs* ys)))) (defn |map [f xs] (|case xs - ($Nil) + ($End) xs - ($Cons x xs*) - ($Cons (f x) (|map f xs*)) + ($Item x xs*) + ($Item (f x) (|map f xs*)) _ (assert false (prn-str '|map f (adt->text xs))))) @@ -416,99 +417,99 @@ "(All [a] (-> (List a) Bit))" [xs] (|case xs - ($Nil) + ($End) true - ($Cons _ _) + ($Item _ _) false)) (defn |filter "(All [a] (-> (-> a Bit) (List a) (List a)))" [p xs] (|case xs - ($Nil) + ($End) xs - ($Cons x xs*) + ($Item x xs*) (if (p x) - ($Cons x (|filter p xs*)) + ($Item x (|filter p xs*)) (|filter p xs*)))) (defn flat-map "(All [a b] (-> (-> a (List b)) (List a) (List b)))" [f xs] (|case xs - ($Nil) + ($End) xs - ($Cons x xs*) + ($Item x xs*) (|++ (f x) (flat-map f xs*)))) (defn |split-with [p xs] (|case xs - ($Nil) + ($End) (T [xs xs]) - ($Cons x xs*) + ($Item x xs*) (if (p x) (|let [[pre post] (|split-with p xs*)] - (T [($Cons x pre) post])) - (T [$Nil xs])))) + (T [($Item x pre) post])) + (T [$End xs])))) (defn |contains? [k table] (|case table - ($Nil) + ($End) false - ($Cons [k* _] table*) + ($Item [k* _] table*) (or (= k k*) (|contains? k table*)))) (defn |member? [x xs] (|case xs - ($Nil) + ($End) false - ($Cons x* xs*) + ($Item x* xs*) (or (= x x*) (|member? x xs*)))) (defn fold [f init xs] (|case xs - ($Nil) + ($End) init - ($Cons x xs*) + ($Item x xs*) (recur f (f init x) xs*))) (defn fold% [f init xs] (|case xs - ($Nil) + ($End) (return init) - ($Cons x xs*) + ($Item x xs*) (|do [init* (f init x)] (fold% f init* xs*)))) (defn folds [f init xs] (|case xs - ($Nil) + ($End) (|list init) - ($Cons x xs*) - ($Cons init (folds f (f init x) xs*)))) + ($Item x xs*) + ($Item init (folds f (f init x) xs*)))) (defn |length [xs] (fold (fn [acc _] (inc acc)) 0 xs)) (defn |range* [from to] (if (<= from to) - ($Cons from (|range* (inc from) to)) - $Nil)) + ($Item from (|range* (inc from) to)) + $End)) (let [|range* (fn |range* [from to] (if (< from to) - ($Cons from (|range* (inc from) to)) - $Nil))] + ($Item from (|range* (inc from) to)) + $End))] (defn |range [n] (|range* 0 n))) @@ -522,68 +523,68 @@ (defn zip2 [xs ys] (|case [xs ys] - [($Cons x xs*) ($Cons y ys*)] - ($Cons (T [x y]) (zip2 xs* ys*)) + [($Item x xs*) ($Item y ys*)] + ($Item (T [x y]) (zip2 xs* ys*)) [_ _] - $Nil)) + $End)) (defn |keys [plist] (|case plist - ($Nil) - $Nil + ($End) + $End - ($Cons [k v] plist*) - ($Cons k (|keys plist*)))) + ($Item [k v] plist*) + ($Item k (|keys plist*)))) (defn |vals [plist] (|case plist - ($Nil) - $Nil + ($End) + $End - ($Cons [k v] plist*) - ($Cons v (|vals plist*)))) + ($Item [k v] plist*) + ($Item v (|vals plist*)))) (defn |interpose [sep xs] (|case xs - ($Nil) + ($End) xs - ($Cons _ ($Nil)) + ($Item _ ($End)) xs - ($Cons x xs*) - ($Cons x ($Cons sep (|interpose sep xs*))))) + ($Item x xs*) + ($Item x ($Item sep (|interpose sep xs*))))) (do-template [<name> <joiner>] (defn <name> [f xs] (|case xs - ($Nil) + ($End) (return xs) - ($Cons x xs*) + ($Item x xs*) (|do [y (f x) ys (<name> f xs*)] (return (<joiner> y ys))))) - map% $Cons + map% $Item flat-map% |++) (defn list-join [xss] - (fold |++ $Nil xss)) + (fold |++ $End xss)) (defn |as-pairs [xs] (|case xs - ($Cons x ($Cons y xs*)) - ($Cons (T [x y]) (|as-pairs xs*)) + ($Item x ($Item y xs*)) + ($Item (T [x y]) (|as-pairs xs*)) _ - $Nil)) + $End)) (defn |reverse [xs] (fold (fn [tail head] - ($Cons head tail)) - $Nil + ($Item head tail)) + $End xs)) (defn add-loc [meta ^String msg] @@ -607,17 +608,17 @@ (defn try-all% [monads] (|case monads - ($Nil) + ($End) (fail "[Error] There are no alternatives to try!") - ($Cons m monads*) + ($Item m monads*) (fn [state] (let [output (m state)] (|case [output monads*] [($Right _) _] output - [_ ($Nil)] + [_ ($End)] output [_ _] @@ -627,17 +628,17 @@ (defn try-all-% [prefix monads] (|case monads - ($Nil) + ($End) (fail "[Error] There are no alternatives to try!") - ($Cons m monads*) + ($Item m monads*) (fn [state] (let [output (m state)] (|case [output monads*] [($Right _) _] output - [_ ($Nil)] + [_ ($End)] output [($Left ^String error) _] @@ -662,10 +663,10 @@ "(All [a b] (-> (-> a (Maybe b)) (List a) (Maybe b)))" [f xs] (|case xs - ($Nil) + ($End) $None - ($Cons x xs*) + ($Item x xs*) (|case (f x) ($None) (|some f xs*) output output) @@ -719,7 +720,7 @@ (defn env [name old-name] (T [;; name - ($Cons name old-name) + ($Item name old-name) ;; inner 0 ;; locals @@ -792,7 +793,7 @@ (with-jvm-host-slot $type-env (partial |++ type-env) body)) (defn push-dummy-name [real-name store-name] - (change-jvm-host-slot $dummy-mappings (partial $Cons (T [real-name store-name])))) + (change-jvm-host-slot $dummy-mappings (partial $Item (T [real-name store-name])))) (def pop-dummy-name (change-jvm-host-slot $dummy-mappings |tail)) @@ -823,7 +824,7 @@ (T [;; "lux;info" (default-info name mode) ;; "lux;source" - $Nil + $End ;; "lux;location" (T ["" -1 -1]) ;; "current-module" @@ -831,7 +832,7 @@ ;; "lux;modules" (|table) ;; "lux;scopes" - $Nil + $End ;; "lux;type-context" +init-type-context+ ;; "lux;expected" @@ -839,9 +840,11 @@ ;; "lux;seed" 0 ;; scope-type-vars - $Nil + $End ;; extensions - nil + "" ;; This is an invalid value. But I don't expect extensions to be used with the bootstrapping compiler. + ;; eval + "" ;; This is an invalid value. But I don't expect eval to be used with the bootstrapping compiler. ;; "lux;host" host-data] )) @@ -903,21 +906,21 @@ (defn ->seq [xs] (|case xs - ($Nil) + ($End) (list) - ($Cons x xs*) + ($Item x xs*) (cons x (->seq xs*)))) (defn ->list [seq] (if (empty? seq) - $Nil - ($Cons (first seq) (->list (rest seq))))) + $End + ($Item (first seq) (->list (rest seq))))) (defn |repeat [n x] (if (> n 0) - ($Cons x (|repeat (dec n) x)) - $Nil)) + ($Item x (|repeat (dec n) x)) + $End)) (def get-module-name (fn [state] @@ -946,7 +949,7 @@ (defn with-scope [name body] (fn [state] (let [old-name (->> state (get$ $scopes) |head (get$ $name)) - output (body (update$ $scopes #($Cons (env name old-name) %) state))] + output (body (update$ $scopes #($Item (env name old-name) %) state))] (|case output ($Right state* datum) (return* (update$ $scopes |tail state*) datum) @@ -962,7 +965,7 @@ (return (->> top (get$ $inner) str)))] (fn [state] (let [body* (with-scope closure-name body)] - (run-state body* (update$ $scopes #($Cons (update$ $inner inc (|head %)) + (run-state body* (update$ $scopes #($Item (update$ $inner inc (|head %)) (|tail %)) state)))))) @@ -974,10 +977,10 @@ (defn |last [xs] (|case xs - ($Cons x ($Nil)) + ($Item x ($End)) x - ($Cons x xs*) + ($Item x xs*) (|last xs*) _ @@ -1263,11 +1266,11 @@ (defn fold2% [f init xs ys] (|case [xs ys] - [($Cons x xs*) ($Cons y ys*)] + [($Item x xs*) ($Item y ys*)] (|do [init* (f init x y)] (fold2% f init* xs* ys*)) - [($Nil) ($Nil)] + [($End) ($End)] (return init) [_ _] @@ -1275,32 +1278,32 @@ (defn map2% [f xs ys] (|case [xs ys] - [($Cons x xs*) ($Cons y ys*)] + [($Item x xs*) ($Item y ys*)] (|do [z (f x y) zs (map2% f xs* ys*)] - (return ($Cons z zs))) + (return ($Item z zs))) - [($Nil) ($Nil)] - (return $Nil) + [($End) ($End)] + (return $End) [_ _] (assert false "Lists do not match in size."))) (defn map2 [f xs ys] (|case [xs ys] - [($Cons x xs*) ($Cons y ys*)] - ($Cons (f x y) (map2 f xs* ys*)) + [($Item x xs*) ($Item y ys*)] + ($Item (f x y) (map2 f xs* ys*)) [_ _] - $Nil)) + $End)) (defn fold2 [f init xs ys] (|case [xs ys] - [($Cons x xs*) ($Cons y ys*)] + [($Item x xs*) ($Item y ys*)] (and init (fold2 f (f init x y) xs* ys*)) - [($Nil) ($Nil)] + [($End) ($End)] init [_ _] @@ -1312,11 +1315,11 @@ "(All [a] (-> Int (List a) (List (, Int a))))" [idx xs] (|case xs - ($Cons x xs*) - ($Cons (T [idx x]) + ($Item x xs*) + ($Item (T [idx x]) (enumerate* (inc idx) xs*)) - ($Nil) + ($End) xs )) @@ -1341,7 +1344,7 @@ "(All [a] (-> Int (List a) (Maybe a)))" [idx xs] (|case xs - ($Cons x xs*) + ($Item x xs*) (cond (< idx 0) $None @@ -1351,7 +1354,7 @@ :else ;; > 1 (|at (dec idx) xs*)) - ($Nil) + ($End) $None)) (defn normalize @@ -1370,15 +1373,15 @@ (defn |list-put [idx val xs] (|case xs - ($Nil) + ($End) $None - ($Cons x xs*) + ($Item x xs*) (if (= idx 0) - ($Some ($Cons val xs*)) + ($Some ($Item val xs*)) (|case (|list-put (dec idx) val xs*) ($None) $None - ($Some xs**) ($Some ($Cons x xs**))) + ($Some xs**) ($Some ($Item x xs**))) ))) (do-template [<name> <default> <op>] @@ -1386,10 +1389,10 @@ "(All [a] (-> (-> a Bit) (List a) Bit))" [p xs] (|case xs - ($Nil) + ($End) <default> - ($Cons x xs*) + ($Item x xs*) (<op> (p x) (<name> p xs*)))) |every? true and @@ -1415,28 +1418,28 @@ (defn |take [n xs] (|case (T [n xs]) - [0 _] $Nil - [_ ($Nil)] $Nil - [_ ($Cons x xs*)] ($Cons x (|take (dec n) xs*)) + [0 _] $End + [_ ($End)] $End + [_ ($Item x xs*)] ($Item x (|take (dec n) xs*)) )) (defn |drop [n xs] (|case (T [n xs]) [0 _] xs - [_ ($Nil)] $Nil - [_ ($Cons x xs*)] (|drop (dec n) xs*) + [_ ($End)] $End + [_ ($Item x xs*)] (|drop (dec n) xs*) )) (defn |but-last [xs] (|case xs - ($Nil) - $Nil + ($End) + $End - ($Cons x ($Nil)) - $Nil + ($Item x ($End)) + $End - ($Cons x xs*) - ($Cons x (|but-last xs*)) + ($Item x xs*) + ($Item x (|but-last xs*)) _ (assert false (adt->text xs)))) @@ -1447,7 +1450,7 @@ (defn with-scope-type-var [id body] (fn [state] (|case (body (set$ $scope-type-vars - ($Cons id (get$ $scope-type-vars state)) + ($Item id (get$ $scope-type-vars state)) state)) ($Right [state* output]) ($Right (T [(set$ $scope-type-vars diff --git a/lux-bootstrapper/src/lux/compiler/cache.clj b/lux-bootstrapper/src/lux/compiler/cache.clj index 01e05c8de..bbe9e7882 100644 --- a/lux-bootstrapper/src/lux/compiler/cache.clj +++ b/lux-bootstrapper/src/lux/compiler/cache.clj @@ -71,7 +71,7 @@ (defn ^:private parse-tag-groups [^String tags-section] (if (= "" tags-section) - &/$Nil + &/$End (-> tags-section (.split &&core/entry-separator) seq @@ -131,7 +131,7 @@ (|do [^String descriptor (&&core/read-module-descriptor! module-name) :let [imports (let [imports (vec (.split ^String _imports-section &&core/entry-separator)) imports (if (= [""] imports) - &/$Nil + &/$End (&/->list imports))] (&/|map #(first (vec (.split ^String % &&core/datum-separator 2))) imports))] cache-table* (&/fold% (fn [cache-table* _module] @@ -150,7 +150,7 @@ [(&/$Some module-anns) _])) def-entries (let [def-entries (vec (.split ^String _defs-section &&core/entry-separator))] (if (= [""] def-entries) - &/$Nil + &/$End (&/->list def-entries)))] (|do [_ (install-all-defs-in-module module-name) _ (install-module load-def-value module-name module-hash diff --git a/lux-bootstrapper/src/lux/compiler/cache/ann.clj b/lux-bootstrapper/src/lux/compiler/cache/ann.clj index 4c08af276..9d5a8e97f 100644 --- a/lux-bootstrapper/src/lux/compiler/cache/ann.clj +++ b/lux-bootstrapper/src/lux/compiler/cache/ann.clj @@ -96,12 +96,12 @@ (defn ^:private deserialize-seq [deserializer ^String input] (cond (.startsWith input nil-signal) - [&/$Nil (.substring input 1)] + [&/$End (.substring input 1)] (.startsWith input cons-signal) (when-let [[head ^String input*] (deserializer (.substring input 1))] (when-let [[tail ^String input*] (deserialize-seq deserializer input*)] - [(&/$Cons head tail) input*])) + [(&/$Item head tail) input*])) )) (defn ^:private deserialize-kv [input] diff --git a/lux-bootstrapper/src/lux/compiler/cache/type.clj b/lux-bootstrapper/src/lux/compiler/cache/type.clj index 7c622d2c4..f4d33edc1 100644 --- a/lux-bootstrapper/src/lux/compiler/cache/type.clj +++ b/lux-bootstrapper/src/lux/compiler/cache/type.clj @@ -64,12 +64,12 @@ (defn ^:private deserialize-list [^String input] (cond (.startsWith input nil-signal) - [&/$Nil (.substring input 1)] + [&/$End (.substring input 1)] (.startsWith input cons-signal) (when-let [[head ^String input*] (deserialize-type (.substring input 1))] (when-let [[tail ^String input*] (deserialize-list input*)] - [(&/$Cons head tail) input*])) + [(&/$Item head tail) input*])) )) (defn ^:private deserialize-type* [^String input] diff --git a/lux-bootstrapper/src/lux/compiler/jvm.clj b/lux-bootstrapper/src/lux/compiler/jvm.clj index e2521fec7..d5c490a97 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm.clj @@ -200,7 +200,8 @@ (&/set$ &/$source (&reader/from name file-content) state)) (&/$Right ?state _) (&/run-state (|do [:let [_ (.visitEnd =class)] - _ (save-module! name file-hash (.toByteArray =class))] + _ (save-module! name file-hash (.toByteArray =class)) + :let [_ (println 'MODULE name)]] (return file-hash)) ?state) diff --git a/lux-bootstrapper/src/lux/compiler/jvm/lux.clj b/lux-bootstrapper/src/lux/compiler/jvm/lux.clj index f5fa88e02..973d0e8c6 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/lux.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/lux.clj @@ -337,7 +337,7 @@ $end (new Label) _ (doto main-writer ;; Tail: Begin - (.visitLdcInsn (->> #'&/$Nil meta ::&/idx int)) ;; I + (.visitLdcInsn (->> #'&/$End meta ::&/idx int)) ;; I (.visitInsn Opcodes/ACONST_NULL) ;; I? (.visitLdcInsn &/unit-tag) ;; I?U (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") ;; V @@ -375,13 +375,13 @@ (.visitInsn Opcodes/SWAP) ;; I22IV (.visitInsn Opcodes/AASTORE) ;; I2 ;; Tuple: End - ;; Cons: Begin - (.visitLdcInsn (->> #'&/$Cons meta ::&/idx int)) ;; I2I + ;; Item: Begin + (.visitLdcInsn (->> #'&/$Item meta ::&/idx int)) ;; I2I (.visitLdcInsn "") ;; I2I? (.visitInsn Opcodes/DUP2_X1) ;; II?2I? (.visitInsn Opcodes/POP2) ;; II?2 (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") ;; IV - ;; Cons: End + ;; Item: End (.visitInsn Opcodes/SWAP) ;; VI (.visitJumpInsn Opcodes/GOTO $loop) ;; Loop: End diff --git a/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj b/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj index cd1b77dee..642bd3427 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj @@ -25,7 +25,7 @@ ;; [Resources] (do-template [<name> <op>] (defn <name> [compile ?values special-args] - (|do [:let [(&/$Cons ?input (&/$Cons ?mask (&/$Nil))) ?values] + (|do [:let [(&/$Item ?input (&/$Item ?mask (&/$End))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?input) :let [_ (&&/unwrap-long *writer*)] @@ -43,7 +43,7 @@ (do-template [<op> <name>] (defn <name> [compile ?values special-args] - (|do [:let [(&/$Cons ?input (&/$Cons ?shift (&/$Nil))) ?values] + (|do [:let [(&/$Item ?input (&/$Item ?shift (&/$End))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?input) :let [_ (&&/unwrap-long *writer*)] @@ -61,7 +61,7 @@ ) (defn ^:private compile-lux-is [compile ?values special-args] - (|do [:let [(&/$Cons ?left (&/$Cons ?right (&/$Nil))) ?values] + (|do [:let [(&/$Item ?left (&/$Item ?right (&/$End))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?left) _ (compile ?right) @@ -78,7 +78,7 @@ (return nil))) (defn ^:private compile-lux-try [compile ?values special-args] - (|do [:let [(&/$Cons ?op (&/$Nil)) ?values] + (|do [:let [(&/$Item ?op (&/$End)) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?op) :let [_ (doto *writer* @@ -88,7 +88,7 @@ (do-template [<name> <opcode> <unwrap> <wrap>] (defn <name> [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] + (|do [:let [(&/$Item ?x (&/$Item ?y (&/$End))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?x) :let [_ (doto *writer* @@ -117,7 +117,7 @@ (do-template [<name> <cmpcode> <cmp-output> <unwrap>] (defn <name> [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] + (|do [:let [(&/$Item ?x (&/$Item ?y (&/$End))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?x) :let [_ (doto *writer* @@ -147,7 +147,7 @@ ) (defn ^:private compile-frac-encode [compile ?values special-args] - (|do [:let [(&/$Cons ?input (&/$Nil)) ?values] + (|do [:let [(&/$Item ?input (&/$End)) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?input) :let [_ (doto *writer* @@ -156,7 +156,7 @@ (return nil))) (defn ^:private compile-frac-decode [compile ?values special-args] - (|do [:let [(&/$Cons ?input (&/$Nil)) ?values] + (|do [:let [(&/$Item ?input (&/$End)) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?input) :let [_ (doto *writer* @@ -165,7 +165,7 @@ (return nil))) (defn ^:private compile-int-char [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] + (|do [:let [(&/$Item ?x (&/$End)) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?x) :let [_ (doto *writer* @@ -177,7 +177,7 @@ (do-template [<name> <unwrap> <op> <wrap>] (defn <name> [compile ?values special-args] - (|do [:let [(&/$Cons ?input (&/$Nil)) ?values] + (|do [:let [(&/$Item ?input (&/$End)) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?input) :let [_ (doto *writer* @@ -191,7 +191,7 @@ ) (defn ^:private compile-text-eq [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] + (|do [:let [(&/$Item ?x (&/$Item ?y (&/$End))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?x) _ (compile ?y) @@ -201,7 +201,7 @@ (return nil))) (defn ^:private compile-text-lt [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] + (|do [:let [(&/$Item ?x (&/$Item ?y (&/$End))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?x) :let [_ (doto *writer* @@ -222,7 +222,7 @@ (return nil))) (defn compile-text-concat [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] + (|do [:let [(&/$Item ?x (&/$Item ?y (&/$End))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?x) :let [_ (doto *writer* @@ -235,7 +235,7 @@ (return nil))) (defn compile-text-clip [compile ?values special-args] - (|do [:let [(&/$Cons ?text (&/$Cons ?offset (&/$Cons ?length (&/$Nil)))) ?values] + (|do [:let [(&/$Item ?text (&/$Item ?offset (&/$Item ?length (&/$End)))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?text) :let [_ (doto *writer* @@ -255,7 +255,7 @@ (return nil))) (defn ^:private compile-text-index [compile ?values special-args] - (|do [:let [(&/$Cons ?text (&/$Cons ?part (&/$Cons ?start (&/$Nil)))) ?values] + (|do [:let [(&/$Item ?text (&/$Item ?part (&/$Item ?start (&/$End)))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?text) :let [_ (doto *writer* @@ -287,7 +287,7 @@ (do-template [<name> <class> <method>] (defn <name> [compile ?values special-args] - (|do [:let [(&/$Cons ?text (&/$Nil)) ?values] + (|do [:let [(&/$Item ?text (&/$End)) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?text) :let [_ (doto *writer* @@ -301,7 +301,7 @@ ) (defn ^:private compile-text-char [compile ?values special-args] - (|do [:let [(&/$Cons ?text (&/$Cons ?idx (&/$Nil))) ?values] + (|do [:let [(&/$Item ?text (&/$Item ?idx (&/$End))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?text) :let [_ (doto *writer* @@ -316,7 +316,7 @@ (return nil))) (defn ^:private compile-io-log [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] + (|do [:let [(&/$Item ?x (&/$End)) ?values] ^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* (.visitFieldInsn Opcodes/GETSTATIC "java/lang/System" "out" "Ljava/io/PrintStream;"))] @@ -327,7 +327,7 @@ (return nil))) (defn ^:private compile-io-error [compile ?values special-args] - (|do [:let [(&/$Cons ?message (&/$Nil)) ?values] + (|do [:let [(&/$Item ?message (&/$End)) ?values] ^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* (.visitTypeInsn Opcodes/NEW "java/lang/Error") @@ -340,7 +340,7 @@ (return nil))) (defn ^:private compile-io-current-time [compile ?values special-args] - (|do [:let [(&/$Nil) ?values] + (|do [:let [(&/$End) ?values] ^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/System" "currentTimeMillis" "()J") @@ -348,7 +348,7 @@ (return nil))) (defn ^:private compile-syntax-char-case! [compile ?values ?patterns] - (|do [:let [(&/$Cons ?input (&/$Cons ?else ?matches)) ?values] + (|do [:let [(&/$Item ?input (&/$Item ?else ?matches)) ?values] ^MethodVisitor *writer* &/get-writer :let [pattern-labels (&/|map (fn [_] (new Label)) ?patterns) matched-patterns (&/fold (fn [matches chars+label] diff --git a/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj b/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj index a1039f0b3..a455be83a 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj @@ -50,28 +50,28 @@ (if (&type/type= &type/Any *type*) (.visitLdcInsn *writer* &/unit-tag) (|case *type* - (&/$Primitive "boolean" (&/$Nil)) + (&/$Primitive "boolean" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name boolean-class) "valueOf" (str "(Z)" (&host-generics/->type-signature boolean-class))) - (&/$Primitive "byte" (&/$Nil)) + (&/$Primitive "byte" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name byte-class) "valueOf" (str "(B)" (&host-generics/->type-signature byte-class))) - (&/$Primitive "short" (&/$Nil)) + (&/$Primitive "short" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name short-class) "valueOf" (str "(S)" (&host-generics/->type-signature short-class))) - (&/$Primitive "int" (&/$Nil)) + (&/$Primitive "int" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name int-class) "valueOf" (str "(I)" (&host-generics/->type-signature int-class))) - (&/$Primitive "long" (&/$Nil)) + (&/$Primitive "long" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name long-class) "valueOf" (str "(J)" (&host-generics/->type-signature long-class))) - (&/$Primitive "float" (&/$Nil)) + (&/$Primitive "float" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name float-class) "valueOf" (str "(F)" (&host-generics/->type-signature float-class))) - (&/$Primitive "double" (&/$Nil)) + (&/$Primitive "double" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name double-class) "valueOf" (str "(D)" (&host-generics/->type-signature double-class))) - (&/$Primitive "char" (&/$Nil)) + (&/$Primitive "char" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name char-class) "valueOf" (str "(C)" (&host-generics/->type-signature char-class))) (&/$Primitive _ _) @@ -122,45 +122,45 @@ (defn ^:private compile-method-return [^MethodVisitor writer output] (|case output - (&/$GenericClass "void" (&/$Nil)) + (&/$GenericClass "void" (&/$End)) (.visitInsn writer Opcodes/RETURN) - (&/$GenericClass "boolean" (&/$Nil)) + (&/$GenericClass "boolean" (&/$End)) (doto writer &&/unwrap-boolean (.visitInsn Opcodes/IRETURN)) - (&/$GenericClass "byte" (&/$Nil)) + (&/$GenericClass "byte" (&/$End)) (doto writer &&/unwrap-byte (.visitInsn Opcodes/IRETURN)) - (&/$GenericClass "short" (&/$Nil)) + (&/$GenericClass "short" (&/$End)) (doto writer &&/unwrap-short (.visitInsn Opcodes/IRETURN)) - (&/$GenericClass "int" (&/$Nil)) + (&/$GenericClass "int" (&/$End)) (doto writer &&/unwrap-int (.visitInsn Opcodes/IRETURN)) - (&/$GenericClass "long" (&/$Nil)) + (&/$GenericClass "long" (&/$End)) (doto writer &&/unwrap-long (.visitInsn Opcodes/LRETURN)) - (&/$GenericClass "float" (&/$Nil)) + (&/$GenericClass "float" (&/$End)) (doto writer &&/unwrap-float (.visitInsn Opcodes/FRETURN)) - (&/$GenericClass "double" (&/$Nil)) + (&/$GenericClass "double" (&/$End)) (doto writer &&/unwrap-double (.visitInsn Opcodes/DRETURN)) - (&/$GenericClass "char" (&/$Nil)) + (&/$GenericClass "char" (&/$End)) (doto writer &&/unwrap-char (.visitInsn Opcodes/IRETURN)) @@ -230,15 +230,15 @@ "(-> Int (List GenericClass) MethodVisitor (Lux (List FrameTag)))" [idx inputs method-visitor] (|case inputs - (&/$Nil) - (return &/$Nil) + (&/$End) + (return &/$End) - (&/$Cons input inputs*) + (&/$Item input inputs*) (|do [[_ outputs*] (&/fold% (fn [idx+outputs input] (|do [:let [[_idx _outputs] idx+outputs] [idx* output] (prepare-method-input _idx input method-visitor)] - (return (&/T [idx* (&/$Cons output _outputs)])))) - (&/T [idx &/$Nil]) + (return (&/T [idx* (&/$Item output _outputs)])))) + (&/T [idx &/$End]) inputs)] (return (&/list-join (&/|reverse outputs*)))) )) @@ -445,7 +445,7 @@ "(-> (List FieldAnalysis) (List [Text GenericClass Analysis]))" [fields] (&/fold &/|++ - &/$Nil + &/$End (&/|map (fn [field] (|case field (&/$ConstantFieldSyntax ?name ?anns ?gclass ?value) @@ -461,7 +461,7 @@ (|do [module &/get-module-name [file-name line column] &/location :let [[?name ?params] class-decl - class-signature (&host-generics/gclass-decl->signature class-decl (&/$Cons ?super-class ?interfaces)) + class-signature (&host-generics/gclass-decl->signature class-decl (&/$Item ?super-class ?interfaces)) full-name (str module "/" ?name) super-class* (&host-generics/->bytecode-class-name (&host-generics/super-class-name ?super-class)) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) @@ -513,7 +513,7 @@ (do-template [<name> <op> <unwrap> <wrap>] (defn <name> [compile _?value special-args] - (|do [:let [(&/$Cons ?value (&/$Nil)) _?value] + (|do [:let [(&/$Item ?value (&/$End)) _?value] ^MethodVisitor *writer* &/get-writer _ (compile ?value) :let [_ (doto *writer* @@ -553,7 +553,7 @@ (do-template [<name> <op> <wrap>] (defn <name> [compile _?value special-args] - (|do [:let [(&/$Cons ?value (&/$Nil)) _?value] + (|do [:let [(&/$Item ?value (&/$End)) _?value] ^MethodVisitor *writer* &/get-writer _ (compile ?value) :let [_ (doto *writer* @@ -569,7 +569,7 @@ (do-template [<name> <op> <unwrap-left> <unwrap-right> <wrap>] (defn <name> [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] + (|do [:let [(&/$Item ?x (&/$Item ?y (&/$End))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?x) :let [_ (doto *writer* @@ -599,7 +599,7 @@ (do-template [<name> <opcode> <unwrap> <wrap>] (defn <name> [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] + (|do [:let [(&/$Item ?x (&/$Item ?y (&/$End))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?x) :let [_ (doto *writer* @@ -639,7 +639,7 @@ (do-template [<name> <opcode> <unwrap>] (defn <name> [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] + (|do [:let [(&/$Item ?x (&/$Item ?y (&/$End))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?x) :let [_ (doto *writer* @@ -669,7 +669,7 @@ (do-template [<name> <cmpcode> <cmp-output> <unwrap>] (defn <name> [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] + (|do [:let [(&/$Item ?x (&/$Item ?y (&/$End))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?x) :let [_ (doto *writer* @@ -705,8 +705,8 @@ (do-template [<prim-type> <array-type> <new-name> <load-name> <load-op> <store-name> <store-op> <wrapper> <unwrapper>] (do (defn <new-name> [compile ?values special-args] - (|do [:let [(&/$Cons ?length (&/$Nil)) ?values - ;; (&/$Nil) special-args + (|do [:let [(&/$Item ?length (&/$End)) ?values + ;; (&/$End) special-args ] ^MethodVisitor *writer* &/get-writer _ (compile ?length) @@ -717,8 +717,8 @@ (return nil))) (defn <load-name> [compile ?values special-args] - (|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Nil))) ?values - ;; (&/$Nil) special-args + (|do [:let [(&/$Item ?array (&/$Item ?idx (&/$End))) ?values + ;; (&/$End) special-args ] ^MethodVisitor *writer* &/get-writer _ (compile ?array) @@ -733,8 +733,8 @@ (return nil))) (defn <store-name> [compile ?values special-args] - (|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil)))) ?values - ;; (&/$Nil) special-args + (|do [:let [(&/$Item ?array (&/$Item ?idx (&/$Item ?elem (&/$End)))) ?values + ;; (&/$End) special-args ] ^MethodVisitor *writer* &/get-writer _ (compile ?array) @@ -762,8 +762,8 @@ ) (defn ^:private compile-jvm-anewarray [compile ?values special-args] - (|do [:let [(&/$Cons ?length (&/$Nil)) ?values - (&/$Cons ?gclass (&/$Cons type-env (&/$Nil))) special-args] + (|do [:let [(&/$Item ?length (&/$End)) ?values + (&/$Item ?gclass (&/$Item type-env (&/$End))) special-args] ^MethodVisitor *writer* &/get-writer _ (compile ?length) :let [_ (doto *writer* @@ -773,8 +773,8 @@ (return nil))) (defn ^:private compile-jvm-aaload [compile ?values special-args] - (|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Nil))) ?values - ;; (&/$Nil) special-args + (|do [:let [(&/$Item ?array (&/$Item ?idx (&/$End))) ?values + ;; (&/$End) special-args ] ^MethodVisitor *writer* &/get-writer array-type (&host/->java-sig (&a/expr-type* ?array)) @@ -788,8 +788,8 @@ (return nil))) (defn ^:private compile-jvm-aastore [compile ?values special-args] - (|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil)))) ?values - ;; (&/$Nil) special-args + (|do [:let [(&/$Item ?array (&/$Item ?idx (&/$Item ?elem (&/$End)))) ?values + ;; (&/$End) special-args ] ^MethodVisitor *writer* &/get-writer array-type (&host/->java-sig (&a/expr-type* ?array)) @@ -805,8 +805,8 @@ (return nil))) (defn ^:private compile-jvm-arraylength [compile ?values special-args] - (|do [:let [(&/$Cons ?array (&/$Nil)) ?values - ;; (&/$Nil) special-args + (|do [:let [(&/$Item ?array (&/$End)) ?values + ;; (&/$End) special-args ] ^MethodVisitor *writer* &/get-writer array-type (&host/->java-sig (&a/expr-type* ?array)) @@ -819,15 +819,15 @@ (return nil))) (defn ^:private compile-jvm-object-null [compile ?values special-args] - (|do [:let [;; (&/$Nil) ?values - (&/$Nil) special-args] + (|do [:let [;; (&/$End) ?values + (&/$End) special-args] ^MethodVisitor *writer* &/get-writer :let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]] (return nil))) (defn ^:private compile-jvm-object-null? [compile ?values special-args] - (|do [:let [(&/$Cons ?object (&/$Nil)) ?values - ;; (&/$Nil) special-args + (|do [:let [(&/$Item ?object (&/$End)) ?values + ;; (&/$End) special-args ] ^MethodVisitor *writer* &/get-writer _ (compile ?object) @@ -843,8 +843,8 @@ (return nil))) (defn compile-jvm-object-synchronized [compile ?values special-args] - (|do [:let [(&/$Cons ?monitor (&/$Cons ?expr (&/$Nil))) ?values - ;; (&/$Nil) special-args + (|do [:let [(&/$Item ?monitor (&/$Item ?expr (&/$End))) ?values + ;; (&/$End) special-args ] ^MethodVisitor *writer* &/get-writer _ (compile ?monitor) @@ -858,8 +858,8 @@ (return nil))) (defn ^:private compile-jvm-throw [compile ?values special-args] - (|do [:let [(&/$Cons ?ex (&/$Nil)) ?values - ;; (&/$Nil) special-args + (|do [:let [(&/$Item ?ex (&/$End)) ?values + ;; (&/$End) special-args ] ^MethodVisitor *writer* &/get-writer _ (compile ?ex) @@ -867,8 +867,8 @@ (return nil))) (defn ^:private compile-jvm-getstatic [compile ?values special-args] - (|do [:let [;; (&/$Nil) ?values - (&/$Cons ?class (&/$Cons ?field (&/$Cons ?output-type (&/$Nil)))) special-args] + (|do [:let [;; (&/$End) ?values + (&/$Item ?class (&/$Item ?field (&/$Item ?output-type (&/$End)))) special-args] ^MethodVisitor *writer* &/get-writer =output-type (&host/->java-sig ?output-type) :let [_ (doto *writer* @@ -877,8 +877,8 @@ (return nil))) (defn ^:private compile-jvm-getfield [compile ?values special-args] - (|do [:let [(&/$Cons ?object (&/$Nil)) ?values - (&/$Cons ?class (&/$Cons ?field (&/$Cons ?output-type (&/$Nil)))) special-args] + (|do [:let [(&/$Item ?object (&/$End)) ?values + (&/$Item ?class (&/$Item ?field (&/$Item ?output-type (&/$End)))) special-args] :let [class* (&host-generics/->bytecode-class-name (&host-type/as-obj ?class))] ^MethodVisitor *writer* &/get-writer _ (compile ?object) @@ -890,8 +890,8 @@ (return nil))) (defn ^:private compile-jvm-putstatic [compile ?values special-args] - (|do [:let [(&/$Cons ?value (&/$Nil)) ?values - (&/$Cons ?class (&/$Cons ?field (&/$Cons input-gclass (&/$Nil)))) special-args] + (|do [:let [(&/$Item ?value (&/$End)) ?values + (&/$Item ?class (&/$Item ?field (&/$Item input-gclass (&/$End)))) special-args] ^MethodVisitor *writer* &/get-writer _ (compile ?value) :let [=input-sig (&host-type/gclass->sig input-gclass) @@ -902,8 +902,8 @@ (return nil))) (defn ^:private compile-jvm-putfield [compile ?values special-args] - (|do [:let [(&/$Cons ?object (&/$Cons ?value (&/$Nil))) ?values - (&/$Cons ?class (&/$Cons ?field (&/$Cons input-gclass (&/$Cons ?input-type (&/$Nil))))) special-args] + (|do [:let [(&/$Item ?object (&/$Item ?value (&/$End))) ?values + (&/$Item ?class (&/$Item ?field (&/$Item input-gclass (&/$Item ?input-type (&/$End))))) special-args] :let [class* (&host-generics/->bytecode-class-name (&host-type/as-obj ?class))] ^MethodVisitor *writer* &/get-writer _ (compile ?object) @@ -918,7 +918,7 @@ (defn ^:private compile-jvm-invokestatic [compile ?values special-args] (|do [:let [?args ?values - (&/$Cons ?class (&/$Cons ?method (&/$Cons ?classes (&/$Cons ?output-type (&/$Cons ?gret (&/$Nil)))))) special-args] + (&/$Item ?class (&/$Item ?method (&/$Item ?classes (&/$Item ?output-type (&/$Item ?gret (&/$End)))))) special-args] ^MethodVisitor *writer* &/get-writer :let [method-sig (str "(" (&/fold str "" (&/|map &host-generics/->type-signature ?classes)) ")" (&host-type/principal-class ?gret))] _ (&/map2% (fn [class-name arg] @@ -933,8 +933,8 @@ (do-template [<name> <op>] (defn <name> [compile ?values special-args] - (|do [:let [(&/$Cons ?object ?args) ?values - (&/$Cons ?class (&/$Cons ?method (&/$Cons ?classes (&/$Cons ?output-type (&/$Cons ?gret (&/$Nil)))))) special-args] + (|do [:let [(&/$Item ?object ?args) ?values + (&/$Item ?class (&/$Item ?method (&/$Item ?classes (&/$Item ?output-type (&/$Item ?gret (&/$End)))))) special-args] :let [?class* (&host-generics/->bytecode-class-name (&host-type/as-obj ?class))] ^MethodVisitor *writer* &/get-writer :let [method-sig (str "(" (&/fold str "" (&/|map &host-generics/->type-signature ?classes)) ")" (&host-type/principal-class ?gret))] @@ -958,7 +958,7 @@ (defn ^:private compile-jvm-new [compile ?values special-args] (|do [:let [?args ?values - (&/$Cons ?class (&/$Cons ?classes (&/$Nil))) special-args] + (&/$Item ?class (&/$Item ?classes (&/$End))) special-args] ^MethodVisitor *writer* &/get-writer :let [init-sig (str "(" (&/fold str "" (&/|map &host-generics/->type-signature ?classes)) ")V") class* (&host-generics/->bytecode-class-name ?class) @@ -976,7 +976,7 @@ (return nil))) (defn ^:private compile-jvm-object-class [compile ?values special-args] - (|do [:let [(&/$Cons _class-name (&/$Cons ?output-type (&/$Nil))) special-args] + (|do [:let [(&/$Item _class-name (&/$Item ?output-type (&/$End))) special-args] ^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* (.visitLdcInsn _class-name) @@ -985,8 +985,8 @@ (return nil))) (defn ^:private compile-jvm-instanceof [compile ?values special-args] - (|do [:let [(&/$Cons object (&/$Nil)) ?values - (&/$Cons class (&/$Nil)) special-args] + (|do [:let [(&/$Item object (&/$End)) ?values + (&/$Item class (&/$End)) special-args] :let [class* (&host-generics/->bytecode-class-name class)] ^MethodVisitor *writer* &/get-writer _ (compile object) diff --git a/lux-bootstrapper/src/lux/host.clj b/lux-bootstrapper/src/lux/host.clj index eb1bcb41c..4d49a6262 100644 --- a/lux-bootstrapper/src/lux/host.clj +++ b/lux-bootstrapper/src/lux/host.clj @@ -42,7 +42,7 @@ "(-> Type (, Int Type))" [type] (|case type - (&/$Primitive "#Array" (&/$Cons param (&/$Nil))) + (&/$Primitive "#Array" (&/$Item param (&/$End))) (|let [[count inner] (unfold-array param)] (&/T [(inc count) inner])) @@ -170,7 +170,7 @@ (str (&/normalize-name name) "_" (Long/toUnsignedString (hash name)))) (defn location [scope] - (let [scope (&/$Cons (def-name (&/|head scope)) + (let [scope (&/$Item (def-name (&/|head scope)) (&/|map &/normalize-name (&/|tail scope)))] (->> scope (&/|interpose "$") @@ -185,35 +185,35 @@ (defn dummy-value [^MethodVisitor writer class] (|case class - (&/$GenericClass "boolean" (&/$Nil)) + (&/$GenericClass "boolean" (&/$End)) (doto writer (.visitLdcInsn false)) - (&/$GenericClass "byte" (&/$Nil)) + (&/$GenericClass "byte" (&/$End)) (doto writer (.visitLdcInsn (byte 0))) - (&/$GenericClass "short" (&/$Nil)) + (&/$GenericClass "short" (&/$End)) (doto writer (.visitLdcInsn (short 0))) - (&/$GenericClass "int" (&/$Nil)) + (&/$GenericClass "int" (&/$End)) (doto writer (.visitLdcInsn (int 0))) - (&/$GenericClass "long" (&/$Nil)) + (&/$GenericClass "long" (&/$End)) (doto writer (.visitLdcInsn (long 0))) - (&/$GenericClass "float" (&/$Nil)) + (&/$GenericClass "float" (&/$End)) (doto writer (.visitLdcInsn (float 0.0))) - (&/$GenericClass "double" (&/$Nil)) + (&/$GenericClass "double" (&/$End)) (doto writer (.visitLdcInsn (double 0.0))) - (&/$GenericClass "char" (&/$Nil)) + (&/$GenericClass "char" (&/$End)) (doto writer (.visitLdcInsn (char 0))) @@ -223,45 +223,45 @@ (defn ^:private dummy-return [^MethodVisitor writer output] (|case output - (&/$GenericClass "void" (&/$Nil)) + (&/$GenericClass "void" (&/$End)) (.visitInsn writer Opcodes/RETURN) - (&/$GenericClass "boolean" (&/$Nil)) + (&/$GenericClass "boolean" (&/$End)) (doto writer (dummy-value output) (.visitInsn Opcodes/IRETURN)) - (&/$GenericClass "byte" (&/$Nil)) + (&/$GenericClass "byte" (&/$End)) (doto writer (dummy-value output) (.visitInsn Opcodes/IRETURN)) - (&/$GenericClass "short" (&/$Nil)) + (&/$GenericClass "short" (&/$End)) (doto writer (dummy-value output) (.visitInsn Opcodes/IRETURN)) - (&/$GenericClass "int" (&/$Nil)) + (&/$GenericClass "int" (&/$End)) (doto writer (dummy-value output) (.visitInsn Opcodes/IRETURN)) - (&/$GenericClass "long" (&/$Nil)) + (&/$GenericClass "long" (&/$End)) (doto writer (dummy-value output) (.visitInsn Opcodes/LRETURN)) - (&/$GenericClass "float" (&/$Nil)) + (&/$GenericClass "float" (&/$End)) (doto writer (dummy-value output) (.visitInsn Opcodes/FRETURN)) - (&/$GenericClass "double" (&/$Nil)) + (&/$GenericClass "double" (&/$End)) (doto writer (dummy-value output) (.visitInsn Opcodes/DRETURN)) - (&/$GenericClass "char" (&/$Nil)) + (&/$GenericClass "char" (&/$End)) (doto writer (dummy-value output) (.visitInsn Opcodes/IRETURN)) @@ -443,7 +443,7 @@ dummy-full-name (str module "/" dummy-name) real-name (str (&host-generics/->class-name module) "." ?name) store-name (str (&host-generics/->class-name module) "." dummy-name) - class-signature (&host-generics/gclass-decl->signature class-decl (&/$Cons super-class interfaces)) + class-signature (&host-generics/gclass-decl->signature class-decl (&/$Item super-class interfaces)) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) dummy-full-name diff --git a/lux-bootstrapper/src/lux/host/generics.clj b/lux-bootstrapper/src/lux/host/generics.clj index 58986c100..a1795bb18 100644 --- a/lux-bootstrapper/src/lux/host/generics.clj +++ b/lux-bootstrapper/src/lux/host/generics.clj @@ -46,7 +46,7 @@ (defn formal-type-parameter->signature [param] (|let [[pname pbounds] param] (|case pbounds - (&/$Nil) + (&/$End) pname _ diff --git a/lux-bootstrapper/src/lux/optimizer.clj b/lux-bootstrapper/src/lux/optimizer.clj index c8c8af02f..5910d98db 100644 --- a/lux-bootstrapper/src/lux/optimizer.clj +++ b/lux-bootstrapper/src/lux/optimizer.clj @@ -209,12 +209,12 @@ (|case _sub-tests ;; An empty tuple corresponds to unit, which cannot be tested in ;; any meaningful way, so it's just popped. - (&/$Nil) + (&/$End) (&/|list $PopPM) ;; A tuple of a single element is equivalent to the element ;; itself, to the element's PM is generated. - (&/$Cons _only-test (&/$Nil)) + (&/$Item _only-test (&/$End)) (transform-pm* _only-test) ;; Single tuple PM features the tests of each tuple member @@ -227,7 +227,7 @@ (|let [tuple-size (&/|length _sub-tests)] (&/|++ (&/flat-map (fn [idx+test*] (|let [[idx test*] idx+test*] - (&/$Cons ($TuplePM (if (< idx (dec tuple-size)) + (&/$Item ($TuplePM (if (< idx (dec tuple-size)) (&/$Left idx) (&/$Right idx))) (transform-pm* test*)))) @@ -246,7 +246,7 @@ ;; This function cleans them all up, to avoid wasteful computation later. (defn ^:private clean-unnecessary-pops [steps] (|case steps - (&/$Cons ($PopPM) _steps) + (&/$Item ($PopPM) _steps) (clean-unnecessary-pops _steps) _ @@ -442,14 +442,14 @@ ;; For example: (2 3 4 5 6 7 8), instead of (8 7 6 5 4 3 2) (defn ^:private adjust-register-indexes* [offset var-table] (|case var-table - (&/$Nil) + (&/$End) (&/|list) - (&/$Cons [_idx _used?] _tail) + (&/$Item [_idx _used?] _tail) (if _used? - (&/$Cons (&/T [_idx (- _idx offset)]) + (&/$Item (&/T [_idx (- _idx offset)]) (adjust-register-indexes* offset _tail)) - (&/$Cons (&/T [_idx -1]) + (&/$Item (&/T [_idx -1]) (adjust-register-indexes* (inc offset) _tail)) ))) @@ -576,10 +576,10 @@ pms (&/|map &/|first pms+bodies) bodies (&/|map &/|second pms+bodies)] (|case (&/|reverse pms) - (&/$Nil) + (&/$End) (assert false) - (&/$Cons _head-pm _tail-pms) + (&/$Item _head-pm _tail-pms) (&/T [(&/fold fuse-pms _head-pm _tail-pms) bodies]) ))) @@ -679,7 +679,7 @@ ($apply [meta-0 ($var (&/$Local 0))] args) (if own-body? (&/T [meta ($apply (&/T [meta-0 ($var (&/$Local 0))]) - (&/$Cons (&/T [meta-0 ($var (&/$Local 1))]) + (&/$Item (&/T [meta-0 ($var (&/$Local 1))]) (&/|map (partial shift-function-body old-scope new-scope own-body?) args)))]) (&/T [meta ($apply (&/T [meta-0 ($var (&/$Local 0))]) (&/|map (partial shift-function-body old-scope new-scope own-body?) args))])) @@ -692,7 +692,7 @@ (if own-body? source (|case scope - (&/$Cons _ (&/$Cons _ (&/$Nil))) + (&/$Item _ (&/$Item _ (&/$End))) source _ @@ -750,10 +750,10 @@ (loop [current-idx 0 pms pms] (|case pms - (&/$Nil) + (&/$End) &/$None - (&/$Cons _pm _pms) + (&/$Item _pm _pms) (|case _pm (&a-case/$NoTestAC) (recur (inc current-idx) @@ -768,7 +768,7 @@ (&a-case/$TupleTestAC _sub-tests) (let [sub-path (record-read-path _sub-tests member-idx)] (if (not (&/|empty? sub-path)) - (&/$Cons (&/T [current-idx (&/|empty? _pms)]) sub-path) + (&/$Item (&/T [current-idx (&/|empty? _pms)]) sub-path) (recur (inc current-idx) _pms) )) @@ -813,10 +813,10 @@ ($ann _value-expr _type-expr) (&/T [meta ($ann (optimize-iter arity _value-expr) _type-expr)]) - ($proc ["lux" "syntax char case!"] (&/$Cons ?input (&/$Cons ?else ?matches)) ?special-args) + ($proc ["lux" "syntax char case!"] (&/$Item ?input (&/$Item ?else ?matches)) ?special-args) (&/T [meta ($proc (&/T ["lux" "syntax char case!"]) - (&/$Cons ?input - (&/$Cons (optimize-iter arity ?else) + (&/$Item ?input + (&/$Item (optimize-iter arity ?else) (&/|map (partial optimize-iter arity) ?matches))) ?special-args)]) @@ -858,7 +858,7 @@ (or (contains-self-reference? func) (&/fold stepwise-test false args)) - ($proc ["lux" "syntax char case!"] (&/$Cons ?input (&/$Cons ?else ?matches)) ?special-args) + ($proc ["lux" "syntax char case!"] (&/$Item ?input (&/$Item ?else ?matches)) ?special-args) (or (contains-self-reference? ?input) (contains-self-reference? ?else) (&/fold stepwise-test false ?matches)) @@ -1064,33 +1064,33 @@ (|case branches ;; The pattern for a let-expression is a single branch, ;; tying the value to a register. - (&/$Cons [(&a-case/$StoreTestAC _register) _body] (&/$Nil)) + (&/$Item [(&a-case/$StoreTestAC _register) _body] (&/$End)) (&/T [meta ($let (pass-0 top-level-func? value) _register (pass-0 top-level-func? _body))]) - (&/$Cons [(&a-case/$BitTestAC true) _then] - (&/$Cons [(&a-case/$BitTestAC false) _else] - (&/$Nil))) + (&/$Item [(&a-case/$BitTestAC true) _then] + (&/$Item [(&a-case/$BitTestAC false) _else] + (&/$End))) (&/T [meta ($if (pass-0 top-level-func? value) (pass-0 top-level-func? _then) (pass-0 top-level-func? _else))]) - (&/$Cons [(&a-case/$BitTestAC true) _then] - (&/$Cons [(&a-case/$NoTestAC false) _else] - (&/$Nil))) + (&/$Item [(&a-case/$BitTestAC true) _then] + (&/$Item [(&a-case/$NoTestAC false) _else] + (&/$End))) (&/T [meta ($if (pass-0 top-level-func? value) (pass-0 top-level-func? _then) (pass-0 top-level-func? _else))]) - (&/$Cons [(&a-case/$BitTestAC false) _else] - (&/$Cons [(&a-case/$BitTestAC true) _then] - (&/$Nil))) + (&/$Item [(&a-case/$BitTestAC false) _else] + (&/$Item [(&a-case/$BitTestAC true) _then] + (&/$End))) (&/T [meta ($if (pass-0 top-level-func? value) (pass-0 top-level-func? _then) (pass-0 top-level-func? _else))]) - (&/$Cons [(&a-case/$BitTestAC false) _else] - (&/$Cons [(&a-case/$NoTestAC) _then] - (&/$Nil))) + (&/$Item [(&a-case/$BitTestAC false) _else] + (&/$Item [(&a-case/$NoTestAC) _then] + (&/$End))) (&/T [meta ($if (pass-0 top-level-func? value) (pass-0 top-level-func? _then) (pass-0 top-level-func? _else))]) ;; The pattern for a record-get is a single branch, with a ;; tuple pattern and a body corresponding to a ;; local-variable extracted from the tuple. - (&/$Cons [(&a-case/$TupleTestAC _sub-tests) [_ (&a/$var (&/$Local _member-idx))]] (&/$Nil)) + (&/$Item [(&a-case/$TupleTestAC _sub-tests) [_ (&a/$var (&/$Local _member-idx))]] (&/$End)) (|let [_path (record-read-path _sub-tests _member-idx)] (if (&/|empty? _path) ;; If the path is empty, that means it was a diff --git a/lux-bootstrapper/src/lux/parser.clj b/lux-bootstrapper/src/lux/parser.clj index dd33129b8..5d409400e 100644 --- a/lux-bootstrapper/src/lux/parser.clj +++ b/lux-bootstrapper/src/lux/parser.clj @@ -16,11 +16,11 @@ (if (or (.contains error base-uneven-record-error) (not (.contains error "[Parser Error]"))) (&/$Left error) - (&/$Right (&/T [state &/$Nil]))) + (&/$Right (&/T [state &/$End]))) (&/$Right state* head) ((|do [tail (repeat% action)] - (return (&/$Cons head tail))) + (return (&/$Item head tail))) state*)))) (do-template [<name> <close-tag> <description> <tag>] @@ -29,7 +29,7 @@ token &lexer/lex] (|case token [meta (<close-tag> _)] - (return (<tag> (&/fold &/|++ &/$Nil elems))) + (return (<tag> (&/fold &/|++ &/$End elems))) _ (&/fail-with-loc (str "[Parser Error] Unbalanced " <description> ".")) @@ -42,7 +42,7 @@ (defn ^:private parse-record [parse] (|do [elems* (repeat% parse) token &lexer/lex - :let [elems (&/fold &/|++ &/$Nil elems*)]] + :let [elems (&/fold &/|++ &/$End elems*)]] (|case token [meta (&lexer/$Close_Brace _)] (|do [_ (&/assert! (even? (&/|length elems)) @@ -59,10 +59,10 @@ :let [[meta token*] token]] (|case token* (&lexer/$White_Space _) - (return &/$Nil) + (return &/$End) (&lexer/$Comment _) - (return &/$Nil) + (return &/$End) (&lexer/$Bit ?value) (return (&/|list (&/T [meta (&/$Bit (.equals ^String ?value "#1"))]))) diff --git a/lux-bootstrapper/src/lux/reader.clj b/lux-bootstrapper/src/lux/reader.clj index 14914cc2e..63d4db9fb 100644 --- a/lux-bootstrapper/src/lux/reader.clj +++ b/lux-bootstrapper/src/lux/reader.clj @@ -14,10 +14,10 @@ (defn- with-line [body] (fn [state] (|case (&/get$ &/$source state) - (&/$Nil) + (&/$End) ((&/fail-with-loc "[Reader Error] EOF") state) - (&/$Cons [[file-name line-num column-num] line] + (&/$Item [[file-name line-num column-num] line] more) (|case (body file-name line-num column-num line) ($No msg) @@ -28,7 +28,7 @@ output) ($Yes output line*) - (return* (&/set$ &/$source (&/$Cons line* more) state) + (return* (&/set$ &/$source (&/$Item line* more) state) output)) ))) @@ -84,10 +84,10 @@ (loop [prefix "" reader* reader] (|case reader* - (&/$Nil) + (&/$End) (&/$Left "[Reader Error] EOF") - (&/$Cons [[file-name line-num column-num] ^String line] + (&/$Item [[file-name line-num column-num] ^String line] reader**) (if-let [^String match (re-find! regex column-num line)] (let [match-length (.length match) @@ -97,7 +97,7 @@ (str prefix match))] (if (= column-num* (.length line)) (recur prefix* reader**) - (&/$Right (&/T [(&/$Cons (&/T [(&/T [file-name line-num column-num*]) line]) + (&/$Right (&/T [(&/$Item (&/T [(&/T [file-name line-num column-num*]) line]) reader**) (&/T [(&/T [file-name line-num column-num]) prefix*])])))) (&/$Left (str "[Reader Error] Pattern failed: " regex)))))))) @@ -138,8 +138,8 @@ line])) lines (range (count lines)))] - (reduce (fn [tail head] (&/$Cons head tail)) - &/$Nil + (reduce (fn [tail head] (&/$Item head tail)) + &/$End (reverse indexed-lines)))) (defn with-source [name content body] diff --git a/lux-bootstrapper/src/lux/type.clj b/lux-bootstrapper/src/lux/type.clj index 267b6d67b..6472a341d 100644 --- a/lux-bootstrapper/src/lux/type.clj +++ b/lux-bootstrapper/src/lux/type.clj @@ -12,10 +12,10 @@ ;; [Utils] (defn |list? [xs] (|case xs - (&/$Nil) + (&/$End) true - (&/$Cons x xs*) + (&/$Item x xs*) (|list? xs*) _ @@ -23,21 +23,21 @@ (def max-stack-size 256) -(def empty-env &/$Nil) +(def empty-env &/$End) (def I64 (&/$Named (&/T [&/prelude "I64"]) (&/$UnivQ empty-env (&/$Primitive "#I64" (&/|list (&/$Parameter 1)))))) -(def Nat* (&/$Primitive &&host/nat-data-tag &/$Nil)) -(def Rev* (&/$Primitive &&host/rev-data-tag &/$Nil)) -(def Int* (&/$Primitive &&host/int-data-tag &/$Nil)) +(def Nat* (&/$Primitive &&host/nat-data-tag &/$End)) +(def Rev* (&/$Primitive &&host/rev-data-tag &/$End)) +(def Int* (&/$Primitive &&host/int-data-tag &/$End)) -(def Bit (&/$Named (&/T [&/prelude "Bit"]) (&/$Primitive "#Bit" &/$Nil))) +(def Bit (&/$Named (&/T [&/prelude "Bit"]) (&/$Primitive "#Bit" &/$End))) (def Nat (&/$Named (&/T [&/prelude "Nat"]) (&/$Apply Nat* I64))) (def Rev (&/$Named (&/T [&/prelude "Rev"]) (&/$Apply Rev* I64))) (def Int (&/$Named (&/T [&/prelude "Int"]) (&/$Apply Int* I64))) -(def Frac (&/$Named (&/T [&/prelude "Frac"]) (&/$Primitive "#Frac" &/$Nil))) -(def Text (&/$Named (&/T [&/prelude "Text"]) (&/$Primitive "#Text" &/$Nil))) +(def Frac (&/$Named (&/T [&/prelude "Frac"]) (&/$Primitive "#Frac" &/$End))) +(def Text (&/$Named (&/T [&/prelude "Text"]) (&/$Primitive "#Text" &/$End))) (def Ident (&/$Named (&/T [&/prelude "Ident"]) (&/$Product Text Text))) (defn Array [elemT] @@ -64,9 +64,9 @@ (&/$Named (&/T [&/prelude "List"]) (&/$UnivQ empty-env (&/$Sum - ;; lux;Nil + ;; lux;End Any - ;; lux;Cons + ;; lux;Item (&/$Product (&/$Parameter 1) (&/$Apply (&/$Parameter 1) (&/$Parameter 0))))))) @@ -172,7 +172,7 @@ (def Macro (&/$Named (&/T [&/prelude "Macro"]) - (&/$Primitive "#Macro" &/$Nil))) + (&/$Primitive "#Macro" &/$End))) (defn bound? [id] (fn [state] @@ -357,21 +357,21 @@ (|case type (&/$Function ?in ?out) (|let [[??out ?args] (unravel-fun ?out)] - (&/T [??out (&/$Cons ?in ?args)])) + (&/T [??out (&/$Item ?in ?args)])) _ - (&/T [type &/$Nil]))) + (&/T [type &/$End]))) (defn ^:private unravel-app ([fun-type tail] (|case fun-type (&/$Apply ?arg ?func) - (unravel-app ?func (&/$Cons ?arg tail)) + (unravel-app ?func (&/$Item ?arg tail)) _ (&/T [fun-type tail]))) ([fun-type] - (unravel-app fun-type &/$Nil))) + (unravel-app fun-type &/$End))) (do-template [<tag> <flatten> <at> <desc>] (do (defn <flatten> @@ -379,7 +379,7 @@ [type] (|case type (<tag> left right) - (&/$Cons left (<flatten> right)) + (&/$Item left (<flatten> right)) _ (&/|list type))) @@ -411,10 +411,10 @@ "(-> (List Type) Type)" [types] (|case (&/|reverse types) - (&/$Cons last prevs) + (&/$Item last prevs) (&/fold (fn [right left] (<ctor> left right)) last prevs) - (&/$Nil) + (&/$End) <unit>)) Variant$ &/$Sum Nothing @@ -425,7 +425,7 @@ (|case type (&/$Primitive name params) (|case params - (&/$Nil) + (&/$End) (str "(primitive " (pr-str name) ")") _ @@ -521,10 +521,10 @@ (defn ^:private fp-get [k fixpoints] (|let [[e a] k] (|case fixpoints - (&/$Nil) + (&/$End) &/$None - (&/$Cons [[e* a*] v*] fixpoints*) + (&/$Item [[e* a*] v*] fixpoints*) (if (and (type= e e*) (type= a a*)) (&/$Some v*) @@ -532,7 +532,7 @@ ))) (defn ^:private fp-put [k v fixpoints] - (&/$Cons (&/T [k v]) fixpoints)) + (&/$Item (&/T [k v]) fixpoints)) (defn show-type+ [type] (|case type @@ -573,7 +573,7 @@ (&/$UnivQ ?local-env ?local-def) (|case ?local-env - (&/$Nil) + (&/$End) (&/$UnivQ env ?local-def) _ @@ -581,7 +581,7 @@ (&/$ExQ ?local-env ?local-def) (|case ?local-env - (&/$Nil) + (&/$End) (&/$ExQ env ?local-def) _ @@ -606,14 +606,14 @@ (|case type-fn (&/$UnivQ local-env local-def) (return (beta-reduce (->> local-env - (&/$Cons param) - (&/$Cons type-fn)) + (&/$Item param) + (&/$Item type-fn)) local-def)) (&/$ExQ local-env local-def) (return (beta-reduce (->> local-env - (&/$Cons param) - (&/$Cons type-fn)) + (&/$Item param) + (&/$Item type-fn)) local-def)) (&/$Apply A F) @@ -635,7 +635,7 @@ (&/fail-with-loc (str "[Type System] Not a type function:\n" (show-type type-fn) "\n" "for arg: " (show-type param))))) -(def ^:private init-fixpoints &/$Nil) +(def ^:private init-fixpoints &/$End) (defn ^:private check* [fixpoints invariant?? expected actual] (if (clojure.lang.Util/identical expected actual) @@ -710,7 +710,7 @@ (&/$Left _) (|case F2 - (&/$UnivQ (&/$Cons _) _) + (&/$UnivQ (&/$Item _) _) ((|do [actual* (apply-type F2 A2)] (check* fixpoints invariant?? expected actual*)) state) @@ -910,7 +910,7 @@ (if (>= size-types size-members) (&/T [size-members (&/|++ (&/|take (dec size-members) ?member-types) (&/|list (|case (->> ?member-types (&/|drop (dec size-members)) (&/|reverse)) - (&/$Cons last prevs) + (&/$Item last prevs) (&/fold (fn [right left] (&/$Product left right)) last prevs))))]) (&/T [size-types ?member-types]) @@ -919,13 +919,13 @@ (do-template [<name> <zero> <plus>] (defn <name> [types] (|case (&/|reverse types) - (&/$Nil) + (&/$End) <zero> - (&/$Cons type (&/$Nil)) + (&/$Item type (&/$End)) type - (&/$Cons last prevs) + (&/$Item last prevs) (&/fold (fn [r l] (<plus> l r)) last prevs))) fold-prod Any &/$Product diff --git a/lux-bootstrapper/src/lux/type/host.clj b/lux-bootstrapper/src/lux/type/host.clj index dbf780a84..692062f50 100644 --- a/lux-bootstrapper/src/lux/type/host.clj +++ b/lux-bootstrapper/src/lux/type/host.clj @@ -86,17 +86,17 @@ stack (&/|list)] (if-let [super-interface (some valid-sub? (.getInterfaces sub-class))] (if (= super-class super-interface) - (&/$Cons super-interface stack) - (recur super-interface (&/$Cons super-interface stack))) + (&/$Item super-interface stack) + (recur super-interface (&/$Item super-interface stack))) (if-let [super* (.getSuperclass sub-class)] - (recur super* (&/$Cons super* stack)) + (recur super* (&/$Item super* stack)) stack))) (loop [sub-class sub-class stack (&/|list)] (let [super* (.getSuperclass sub-class)] (if (= super* super-class) - (&/$Cons super* stack) - (recur super* (&/$Cons super* stack)))))))) + (&/$Item super* stack) + (recur super* (&/$Item super* stack)))))))) (defn ^:private trace-lineage "(-> Class Class (List Class))" @@ -105,7 +105,7 @@ (&/|list) (&/|reverse (trace-lineage* super-class sub-class)))) -(let [matcher (fn [m ^TypeVariable jt lt] (&/$Cons (&/T [(.getName jt) lt]) m))] +(let [matcher (fn [m ^TypeVariable jt lt] (&/$Item (&/T [(.getName jt) lt]) m))] (defn ^:private match-params [sub-type-params params] (assert (and (= (&/|length sub-type-params) (&/|length params)) (&/|every? (partial instance? TypeVariable) sub-type-params))) @@ -137,7 +137,7 @@ Any (reduce (fn [inner _] (&/$Primitive array-data-tag (&/|list inner))) (&/$Primitive base (try (-> (Class/forName base) .getTypeParameters - seq count (repeat (&/$Primitive "java.lang.Object" &/$Nil)) + seq count (repeat (&/$Primitive "java.lang.Object" &/$End)) &/->list) (catch Exception e (&/|list)))) @@ -183,7 +183,7 @@ (if (type= Any class-type) "V" (|case class-type - (&/$Primitive "#Array" (&/$Cons (&/$Primitive class-name _) (&/$Nil))) + (&/$Primitive "#Array" (&/$Item (&/$Primitive class-name _) (&/$End))) (str "[" (&host-generics/->type-signature class-name)) (&/$Primitive class-name _) @@ -357,7 +357,7 @@ "(-> GenericType GenericClass)" [gtype] (cond (instance? Class gtype) - (&/$GenericClass (.getName ^Class gtype) &/$Nil) + (&/$GenericClass (.getName ^Class gtype) &/$End) (instance? GenericArrayType gtype) (&/$GenericArray (gtype->gclass (.getGenericComponentType ^GenericArrayType gtype))) @@ -385,7 +385,7 @@ "(-> GenericClass Text)" [gclass] (|case gclass - (&/$GenericClass gclass-name (&/$Nil)) + (&/$GenericClass gclass-name (&/$End)) (case gclass-name "void" "V" "boolean" "Z" diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux index deef09f36..242d0553e 100644 --- a/lux-jvm/source/program.lux +++ b/lux-jvm/source/program.lux @@ -208,7 +208,7 @@ (write! "java.lang.Object" 2 $state)))))))) (def: (phase_wrapper archive) - (-> Archive (generation.Operation _.Anchor _.Inst _.Definition platform.Phase_Wrapper)) + (-> Archive (generation.Operation _.Anchor _.Inst _.Definition phase.Wrapper)) (do phase.monad [instanceG (function.function' (#.Some [0 (.nat -1)]) expression.translate archive [(list) 4 ..how_to_wrap_a_phase]) phase_wrapper (generation.evaluate! [0 (.nat -2)] instanceG)] @@ -244,7 +244,7 @@ #platform.write product.right}]))) (def: (extender phase_wrapper) - (-> platform.Phase_Wrapper Extender) + (-> phase.Wrapper Extender) ... TODO: Stop relying on coercions ASAP. (<| (:as Extender) (function (@self handler)) diff --git a/stdlib/source/documentation/lux.lux b/stdlib/source/documentation/lux.lux index 1f30de85c..987d9cce5 100644 --- a/stdlib/source/documentation/lux.lux +++ b/stdlib/source/documentation/lux.lux @@ -10,7 +10,27 @@ ["." /]] ["." / #_ ["#." abstract] - ["#." control]]) + ["#." control] + ["#." data] + ... ["#." debug] + ... ["#." documentation] + ... ["#." locale] + ... ["#." macro + ... ["#/." code]] + ... ["#." math] + ... ["#." meta] + ... ["#." program] + ... ["#." target] + ... ["#." test] + ... ["#." time] + ... ... ["#." tool] ... TODO: Update & expand tests for this + ... ["#." type] + ... ["#." world] + ... ["#." ffi] + ... ["#." extension] + ... ["#." target #_ + ... <target>] + ]) (documentation: /.:of "Generates the type corresponding to a given expression." @@ -28,7 +48,8 @@ "" [..:of] [/abstract.documentation - /control.documentation])) + /control.documentation + /data.documentation])) (program: inputs (io.io (debug.log! ($.documentation ..documentation)))) diff --git a/stdlib/source/documentation/lux/abstract/monad.lux b/stdlib/source/documentation/lux/abstract/monad.lux index 2d55ff0c5..07318bce9 100644 --- a/stdlib/source/documentation/lux/abstract/monad.lux +++ b/stdlib/source/documentation/lux/abstract/monad.lux @@ -25,9 +25,9 @@ "Apply a function with monadic effects to a monadic value and yield a new monadic value." [(then monad function)]) -(documentation: /.seq +(documentation: /.all "Run all the monadic values in the list and produce a list of the base values." - [(seq monad)]) + [(all monad)]) (documentation: /.map "Apply a monadic function to all values in a list." @@ -48,7 +48,7 @@ [..Monad ..do ..then - ..seq + ..all ..map ..only ..fold] diff --git a/stdlib/source/documentation/lux/control/concurrency/frp.lux b/stdlib/source/documentation/lux/control/concurrency/frp.lux index 2500b119d..728e93be5 100644 --- a/stdlib/source/documentation/lux/control/concurrency/frp.lux +++ b/stdlib/source/documentation/lux/control/concurrency/frp.lux @@ -32,9 +32,9 @@ "A one-element channel containing the output from an async." [(of_async async)]) -(documentation: /.fold +(documentation: /.aggregate "Asynchronous fold over channels." - [(fold f init channel)]) + [(aggregate f init channel)]) (documentation: /.sequential "Transforms the given list into a channel with the same elements." @@ -50,7 +50,7 @@ ..Subscriber ..only ..of_async - ..fold + ..aggregate ..sequential ($.default /.channel_is_already_closed) ($.default /.functor) diff --git a/stdlib/source/documentation/lux/control/function.lux b/stdlib/source/documentation/lux/control/function.lux index 88556dda7..62f7b7374 100644 --- a/stdlib/source/documentation/lux/control/function.lux +++ b/stdlib/source/documentation/lux/control/function.lux @@ -36,9 +36,9 @@ [(= ((flipped f) "foo" "bar") (f "bar" "foo"))]) -(documentation: /.apply +(documentation: /.on "Simple 1-argument function application." - [(apply input function)]) + [(on input function)]) (.def: .public documentation (.List $.Module) @@ -48,7 +48,7 @@ ..composite ..constant ..flipped - ..apply + ..on ($.default /.monoid)] [/contract.documentation /memo.documentation diff --git a/stdlib/source/documentation/lux/control/parser.lux b/stdlib/source/documentation/lux/control/parser.lux index 081c5a792..7c6691d60 100644 --- a/stdlib/source/documentation/lux/control/parser.lux +++ b/stdlib/source/documentation/lux/control/parser.lux @@ -15,13 +15,12 @@ ["#." cli] ["#." code] ["#." environment] - ... ["#." json] - ... ["#." synthesis] - ... ["#." text] - ... ["#." tree] - ... ["#." type] - ... ["#." xml] - ]) + ["#." json] + ["#." synthesis] + ["#." text] + ["#." tree] + ["#." type] + ["#." xml]]) (documentation: /.Parser "A generic parser.") @@ -171,10 +170,9 @@ /cli.documentation /code.documentation /environment.documentation - ... /json.documentation - ... /synthesis.documentation - ... /text.documentation - ... /tree.documentation - ... /type.documentation - ... /xml.documentation - ])) + /json.documentation + /synthesis.documentation + /text.documentation + /tree.documentation + /type.documentation + /xml.documentation])) diff --git a/stdlib/source/documentation/lux/control/parser/json.lux b/stdlib/source/documentation/lux/control/parser/json.lux new file mode 100644 index 000000000..8dfa6a8d3 --- /dev/null +++ b/stdlib/source/documentation/lux/control/parser/json.lux @@ -0,0 +1,94 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [data + [text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Parser + "A JSON parser.") + +(documentation: /.result + (format "Executes the parser against a JSON object." + \n "Verifies that all of the JSON was consumed by the parser.") + [(result parser json)]) + +(documentation: /.any + "Just returns the JSON input without applying any logic.") + +(template [<name>] + [(`` (documentation: <name> + (format "Reads a JSON value as " (~~ (template.text [<name>])) ".")))] + + [/.null] + [/.boolean] + [/.number] + [/.string] + ) + +(template [<test> <check> <read>] + [(`` (documentation: <test> + (format "Asks whether a JSON value is a " (~~ (template.text [<read>])) ".") + [(<test> test)])) + (`` (documentation: <check> + (format "Ensures a JSON value is a " (~~ (template.text [<read>])) ".") + [(<check> test)]))] + + [/.boolean? /.boolean! ..boolean] + [/.number? /.number! ..number] + [/.string? /.string! ..string] + ) + +(documentation: /.nullable + "Enhances parser by adding NULL-handling." + [(nullable parser)]) + +(documentation: /.array + "Parses the contents of a JSON array." + [(array parser)]) + +(documentation: /.object + (format "Parses the contents of a JSON object." + \n "Use this with the 'field' combinator.") + [(object parser)]) + +(documentation: /.field + (format "Parses a field inside a JSON object." + \n "Use this inside the 'object' combinator.") + [(field field_name parser)]) + +(documentation: /.dictionary + "Parses a dictionary-like JSON object.") + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Parser + ..result + ..any + + ..null + ..boolean + ..number + ..string + + ..boolean? ..boolean! + ..number? ..number! + ..string? ..string! + + ..nullable + ..array + ..object + ..field + ..dictionary + ($.default /.unconsumed_input) + ($.default /.empty_input) + ($.default /.unexpected_value) + ($.default /.value_mismatch)] + [])) diff --git a/stdlib/source/documentation/lux/control/parser/synthesis.lux b/stdlib/source/documentation/lux/control/parser/synthesis.lux new file mode 100644 index 000000000..82b3224ea --- /dev/null +++ b/stdlib/source/documentation/lux/control/parser/synthesis.lux @@ -0,0 +1,84 @@ +(.module: + [library + [lux (#- i64 local function loop) + ["$" documentation (#+ documentation:)] + [data + [text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Parser + "A parser for the Lux compiler's synthesis nodes using during optimization.") + +(documentation: /.result + (format "Executes the parser against the inputs." + \n "Ensures all inputs are consumed by the parser.") + [(result parser input)]) + +(documentation: /.any + "Yields a synthesis node without subjecting it to any analysis.") + +(documentation: /.end! + "Ensures there are no more inputs.") + +(documentation: /.end? + "Checks whether there are no more inputs.") + +(template [<query> <assertion>] + [(`` (documentation: <query> + (format "Queries for a " (~~ (template.text [<query>])) " synthesis node."))) + (`` (documentation: <assertion> + (format "Checks for a specific " (~~ (template.text [<query>])) " synthesis node.") + [(<assertion> expected)]))] + + [/.bit /.bit!] + [/.i64 /.i64!] + [/.f64 /.f64!] + [/.text /.text!] + [/.local /.local!] + [/.foreign /.foreign!] + [/.constant /.constant!] + ) + +(documentation: /.tuple + "Parses the contents of a tuple." + [(tuple parser)]) + +(documentation: /.function + "Parses the body of a function with the 'expected' arity." + [(function expected parser)]) + +(documentation: /.loop + "Parses the initial values and the body of a loop." + [(loop init_parsers iteration_parser)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Parser + ..result + ..any + ..end! + ..end? + + ..bit ..bit! + ..i64 ..i64! + ..f64 ..f64! + ..text ..text! + ..local ..local! + ..foreign ..foreign! + ..constant ..constant! + + ..tuple + ..function + ..loop + ($.default /.cannot_parse) + ($.default /.unconsumed_input) + ($.default /.expected_empty_input) + ($.default /.wrong_arity) + ($.default /.empty_input)] + [])) diff --git a/stdlib/source/documentation/lux/control/parser/text.lux b/stdlib/source/documentation/lux/control/parser/text.lux new file mode 100644 index 000000000..52c1c6b07 --- /dev/null +++ b/stdlib/source/documentation/lux/control/parser/text.lux @@ -0,0 +1,221 @@ +(.module: + [library + [lux (#- and not local) + ["$" documentation (#+ documentation:)] + [data + [text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Offset + "An offset into a block of text.") + +(documentation: /.Parser + "A parser for text.") + +(documentation: /.Slice + "A slice of a block of text.") + +(documentation: /.result + (format "Executes a parser against a block of text." + \n "Verifies that the entire input has been processed.") + [(result parser input)]) + +(documentation: /.offset + "Yields the current offset into the input.") + +(documentation: /.any + "Yields the next character without applying any logic.") + +(documentation: /.any! + "Yields the next character (as a slice) without applying any logic.") + +(template [<name> <caveat>] + [(`` (documentation: <name> + (format "Produce a character" (~~ (template.text [<caveat>])) " if the parser fails.") + [(<name> parser)]))] + + [/.not ""] + [/.not! " (as a slice)"] + ) + +(documentation: /.this + "Checks that a specific text shows up in the input." + [(this reference)]) + +(documentation: /.end! + "Ensure the parser's input is empty.") + +(documentation: /.next + "Yields the next character (without consuming it from the input).") + +(documentation: /.remaining + "Get all of the remaining input (without consuming it).") + +(documentation: /.range + "Only yields characters within a range." + [(range bottom top)]) + +(template [<name> <desc>] + [(documentation: <name> + (format "Only yields " <desc> " characters."))] + + [/.upper "uppercase"] + [/.lower "lowercase"] + [/.decimal "decimal"] + [/.octal "octal"] + ) + +(documentation: /.alpha + "Yields alphabetic characters.") + +(documentation: /.alpha_num + "Yields alphanumeric characters.") + +(documentation: /.hexadecimal + "Yields hexadecimal digits.") + +(template [<name> <description_modifier>] + [(documentation: <name> + (format "Yields characters that are" <description_modifier> " part of a piece of text.") + [(<name> options)])] + + [/.one_of ""] + [/.none_of " not"] + ) + +(template [<name> <description_modifier>] + [(documentation: <name> + (format "Yields characters (as a slice) that are" <description_modifier> " part of a piece of text.") + [(<name> options)])] + + [/.one_of! ""] + [/.none_of! " not"] + ) + +(documentation: /.satisfies + "Yields characters that satisfy a predicate." + [(satisfies parser)]) + +(documentation: /.space + "Yields white-space.") + +(documentation: /.and + "Yields the outputs of both parsers composed together." + [(and left right)]) + +(documentation: /.and! + "Yields the outputs of both parsers composed together (as a slice)." + [(and! left right)]) + +(template [<text> <slice>] + [(`` (documentation: <text> + (format "Yields " (~~ (template.text [<name>])) " characters as a single continuous text.") + [(<text> parser)])) + (`` (documentation: <slice> + (format "Yields " (~~ (template.text [<name>])) " characters as a single continuous text (as a slice).") + [(<slice> parser)]))] + + [/.some /.some!] + [/.many /.many!] + ) + +(template [<text> <slice> <doc_modifier>] + [(`` (documentation: <text> + (format "Yields " <doc_modifier> " N characters.") + [(<text> amount parser)])) + (`` (documentation: <slice> + (format "Yields " <doc_modifier> " N characters (as a slice).") + [(<slice> amount parser)]))] + + [/.exactly /.exactly! "exactly"] + [/.at_most /.at_most! "at most"] + [/.at_least /.at_least! "at least"] + ) + +(documentation: /.between + "" + [(between minimum additional parser)]) + +(documentation: /.between! + "" + [(between! minimum additional parser)]) + +(documentation: /.enclosed + "" + [(enclosed [start end] parser)]) + +(documentation: /.local + "Applies a parser against the given input." + [(local local_input parser)]) + +(documentation: /.slice + "Converts a slice to a block of text." + [(slice parser)]) + +(documentation: /.then + "Embeds a text parser into an arbitrary parser that yields text." + [(then structured text)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Offset + ..Parser + ..Slice + ..result + ..offset + + ..any ..any! + ..not ..not! + + ..this + ..end! + ..next + ..remaining + ..range + + ..upper + ..lower + ..decimal + ..octal + + ..alpha + ..alpha_num + ..hexadecimal + + ..one_of ..one_of! + ..none_of ..none_of! + + ..satisfies + ..space + ..and ..and! + + ..some ..some! + ..many ..many! + + + ..exactly ..exactly! + ..at_most ..at_most! + ..at_least ..at_least! + + ..between + ..between! + ..enclosed + ..local + ..slice + ..then + + ($.default /.unconsumed_input) + ($.default /.expected_to_fail) + ($.default /.cannot_parse) + ($.default /.cannot_slice) + ($.default /.cannot_match) + ($.default /.character_should_be) + ($.default /.character_should_not_be) + ($.default /.character_does_not_satisfy_predicate)] + [])) diff --git a/stdlib/source/documentation/lux/control/parser/tree.lux b/stdlib/source/documentation/lux/control/parser/tree.lux new file mode 100644 index 000000000..3c5cf1bf7 --- /dev/null +++ b/stdlib/source/documentation/lux/control/parser/tree.lux @@ -0,0 +1,72 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [data + [text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Parser + "A parser of arbitrary trees.") + +(documentation: /.result' + "Applies the parser against a tree zipper." + [(result' parser zipper)]) + +(documentation: /.result + "Applies the parser against a tree." + [(result parser tree)]) + +(documentation: /.value + "Yields the value inside the current tree node.") + +(template [<name> <doc>] + [(documentation: <name> + <doc>)] + + [/.down "Move down."] + [/.up "Move up."] + + [/.right "Move to the right."] + [/.rightmost "Move to the rightmost node."] + + [/.left "Move to the left."] + [/.leftmost "Move to the leftmost node."] + + [/.next "Move to the next node."] + [/.end "Move to the last node."] + + [/.previous "Move to the previous node."] + [/.start "Move to the root node."] + ) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Parser + ..result' + ..result + ..value + + ..down + ..up + + ..right + ..rightmost + + ..left + ..leftmost + + ..next + ..end + + ..previous + ..start + + ($.default /.cannot_move_further)] + [])) diff --git a/stdlib/source/documentation/lux/control/parser/type.lux b/stdlib/source/documentation/lux/control/parser/type.lux new file mode 100644 index 000000000..0d1785b06 --- /dev/null +++ b/stdlib/source/documentation/lux/control/parser/type.lux @@ -0,0 +1,142 @@ +(.module: + [library + [lux (#- local function) + ["$" documentation (#+ documentation:)] + [data + [text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Env + "An environment for type parsing.") + +(documentation: /.Parser + "A parser of Lux types.") + +(documentation: /.fresh + "An empty parsing environment.") + +(documentation: /.result + (format "Applies a parser against a type." + \n "Verifies that the parser fully consumes the type's information.") + [(result poly type)]) + +(documentation: /.env + "Yields the current parsing environment.") + +(documentation: /.next + "Inspect a type in the input stream without consuming it.") + +(documentation: /.any + "Yields a type, without examination.") + +(documentation: /.local + "Apply a parser to the given inputs." + [(local types poly)]) + +(documentation: /.with_extension + "" + [(with_extension type poly)]) + +(template [<name>] + [(`` (documentation: <name> + (format "Parses the contents of a " (~~ (template.text [<name>])) " type.") + [(<name> poly)]))] + + [/.variant] + [/.tuple] + ) + +(documentation: /.polymorphic + "" + [(polymorphic poly)]) + +(documentation: /.function + "Parses a function's inputs and output." + [(function in_poly out_poly)]) + +(documentation: /.applied + "Parses a type application." + [(applied poly)]) + +(template [<name> <doc>] + [(documentation: <name> + <doc> + [(<name> expected)])] + + [/.exactly "Parses a type exactly."] + [/.sub "Parses a sub type."] + [/.super "Parses a super type."] + ) + +(documentation: /.adjusted_idx + "" + [(adjusted_idx env idx)]) + +(documentation: /.parameter! + "" + [(parameter! id)]) + +(documentation: /.existential + "Yields an existential type.") + +(documentation: /.named + "Yields a named type.") + +(documentation: /.recursive + "" + [(recursive poly)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + (format "Parsing of Lux types." + \n "Used mostly for polytypic programming.") + [..Env + ..Parser + ..fresh + ..result + ..env + ..next + ..any + ..local + ..with_extension + + ..variant + ..tuple + + ..polymorphic + ..function + ..applied + + ..exactly + ..sub + ..super + + ..adjusted_idx + ..parameter! + ..existential + ..named + ..recursive + + ($.default /.not_existential) + ($.default /.not_recursive) + ($.default /.not_named) + ($.default /.not_parameter) + ($.default /.unknown_parameter) + ($.default /.not_function) + ($.default /.not_application) + ($.default /.not_polymorphic) + ($.default /.not_variant) + ($.default /.not_tuple) + ($.default /.types_do_not_match) + ($.default /.wrong_parameter) + ($.default /.empty_input) + ($.default /.unconsumed_input) + ($.default /.parameter) + ($.default /.recursive_self) + ($.default /.recursive_call)] + [])) diff --git a/stdlib/source/documentation/lux/control/parser/xml.lux b/stdlib/source/documentation/lux/control/parser/xml.lux new file mode 100644 index 000000000..71390acdb --- /dev/null +++ b/stdlib/source/documentation/lux/control/parser/xml.lux @@ -0,0 +1,60 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [data + [text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Parser + "A parser of XML-encoded data.") + +(documentation: /.result + (format "Applies a parser against a stream of XML documents." + \n "Verifies that all of the inputs are consumed by the parser.") + [(result parser documents)]) + +(documentation: /.text + "Yields text from a text node.") + +(documentation: /.tag + "Yields the tag from the next node.") + +(documentation: /.attribute + "Yields the value of an attribute in the current node." + [(attribute name)]) + +(documentation: /.node + "Parses the contents of the next node if the tag matches." + [(node expected parser)]) + +(documentation: /.any + "Yields the next node.") + +(documentation: /.somewhere + "Applies the parser somewhere among the remaining inputs; instead of demanding that the parser succeeds against the immediate inputs." + [(somewhere parser)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Parser + ..result + ..text + ..tag + ..attribute + ..node + ..any + ..somewhere + ($.default /.empty_input) + ($.default /.unexpected_input) + ($.default /.wrong_tag) + ($.default /.unknown_attribute) + ($.default /.unconsumed_inputs) + ($.default /.nowhere)] + [])) diff --git a/stdlib/source/documentation/lux/data.lux b/stdlib/source/documentation/lux/data.lux new file mode 100644 index 000000000..0939016a1 --- /dev/null +++ b/stdlib/source/documentation/lux/data.lux @@ -0,0 +1,40 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [data + [text (#+ \n) + ["%" format (#+ format)]] + [collection + ["." list]]]]] + ["." / #_ + ["#." binary] + ["#." bit] + ["#." collection] + ["#." color] + ... ["#." identity] + ... ["#." name] + ... ["#." product] + ... ["#." sum] + ... ["#." text] + ... ["#." format #_ + ... ["#/." binary] + ... ["#/." json] + ... ["#/." tar] + ... ["#/." xml]] + ]) + +(.def: .public documentation + (.List $.Module) + (list.together + (list /binary.documentation + /bit.documentation + /collection.documentation + /color.documentation + ... /identity.documentation + ... /name.documentation + ... /product.documentation + ... /sum.documentation + ... /text.documentation + ... /format.documentation + ))) diff --git a/stdlib/source/documentation/lux/data/binary.lux b/stdlib/source/documentation/lux/data/binary.lux new file mode 100644 index 000000000..c740e6660 --- /dev/null +++ b/stdlib/source/documentation/lux/data/binary.lux @@ -0,0 +1,91 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [data + [text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Binary + "A binary BLOB of data.") + +(documentation: /.empty + "A fresh/empty binary BLOB of the specified size." + [(empty size)]) + +(documentation: /.aggregate + "" + [(aggregate f init binary)]) + +(documentation: /.read/8! + "Read 1 byte (8 bits) at the given index." + [(read/8! index binary)]) + +(documentation: /.read/16! + "Read 2 bytes (16 bits) at the given index." + [(read/16! index binary)]) + +(documentation: /.read/32! + "Read 4 bytes (32 bits) at the given index." + [(read/32! index binary)]) + +(documentation: /.read/64! + "Read 8 bytes (64 bits) at the given index." + [(read/64! index binary)]) + +(documentation: /.write/8! + "Write 1 byte (8 bits) at the given index." + [(write/8! index value binary)]) + +(documentation: /.write/16! + "Write 2 bytes (16 bits) at the given index." + [(write/16! index value binary)]) + +(documentation: /.write/32! + "Write 4 bytes (32 bits) at the given index." + [(write/32! index value binary)]) + +(documentation: /.write/64! + "Write 8 bytes (64 bits) at the given index." + [(write/64! index value binary)]) + +(documentation: /.copy + "Mutates the target binary BLOB by copying bytes from the source BLOB to it." + [(copy bytes source_offset source target_offset target)]) + +(documentation: /.slice + "Yields a subset of the binary BLOB, so long as the specified range is valid." + [(slice offset length binary)]) + +(documentation: /.after + "Yields a binary BLOB with at most the specified number of bytes removed." + [(after bytes binary)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Binary + ..empty + ..aggregate + ..read/8! + ..read/16! + ..read/32! + ..read/64! + ..write/8! + ..write/16! + ..write/32! + ..write/64! + ..copy + ..slice + ..after + ($.default /.index_out_of_bounds) + ($.default /.slice_out_of_bounds) + ($.default /.size) + ($.default /.equivalence) + ($.default /.monoid)] + [])) diff --git a/stdlib/source/documentation/lux/data/bit.lux b/stdlib/source/documentation/lux/data/bit.lux new file mode 100644 index 000000000..e1379b85c --- /dev/null +++ b/stdlib/source/documentation/lux/data/bit.lux @@ -0,0 +1,31 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [data + [text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.complement + (format "Generates the complement of a predicate." + \n "That is a predicate that returns the oposite of the original predicate.")) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..complement + ($.default /.no) + ($.default /.yes) + ($.default /.off) + ($.default /.on) + ($.default /.equivalence) + ($.default /.hash) + ($.default /.disjunction) + ($.default /.conjunction) + ($.default /.codec)] + [])) diff --git a/stdlib/source/documentation/lux/data/collection.lux b/stdlib/source/documentation/lux/data/collection.lux new file mode 100644 index 000000000..e96f59465 --- /dev/null +++ b/stdlib/source/documentation/lux/data/collection.lux @@ -0,0 +1,40 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [data + [text (#+ \n) + ["%" format (#+ format)]] + [collection + ["." list]]]]] + ["." / #_ + ["#." array] + ["#." bits] + ["#." dictionary] + ["#." list] + ["#." queue] + ["#." row] + ["#." sequence] + ... ["#." stack] + ... ["#." set + ... ["#/." multi] + ... ["#/." ordered]] + ... ["#." tree + ... ["#/." finger] + ... ["#/." zipper]] + ]) + +(.def: .public documentation + (.List $.Module) + (list.together + (list /array.documentation + /bits.documentation + /dictionary.documentation + /list.documentation + /queue.documentation + /row.documentation + /sequence.documentation + ... /stack.documentation + ... /set.documentation + ... /tree.documentation + ))) diff --git a/stdlib/source/documentation/lux/data/collection/array.lux b/stdlib/source/documentation/lux/data/collection/array.lux new file mode 100644 index 000000000..3bf22b587 --- /dev/null +++ b/stdlib/source/documentation/lux/data/collection/array.lux @@ -0,0 +1,124 @@ +(.module: + [library + [lux (#- example list) + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Array + "Mutable arrays.") + +(documentation: /.empty + "An empty array of the specified size." + [(empty size)]) + +(documentation: /.size + "" + [(size array)]) + +(documentation: /.read! + "" + [(read! index array)]) + +(documentation: /.write! + "Mutate the array by writing a value to the specified index." + [(write! index value array)]) + +(documentation: /.delete! + "Mutate the array by deleting the value at the specified index." + [(delete! index array)]) + +(documentation: /.contains? + "" + [(contains? index array)]) + +(documentation: /.update! + "Mutate the array by updating the value at the specified index." + [(update! index transform array)]) + +(documentation: /.upsert! + (format "Mutate the array by updating the value at the specified index." + \n "If there is no value, update and write the default value given.") + [(upsert! index default transform array)]) + +(documentation: /.copy! + "Writes the contents of one array into the other." + [(copy! length src_start src_array dest_start dest_array)]) + +(documentation: /.occupancy + "Finds out how many cells in an array are occupied." + [(occupancy array)]) + +(documentation: /.vacancy + "Finds out how many cells in an array are vacant." + [(vacancy array)]) + +(documentation: /.filter! + "Delete every item of the array that fails to satisfy the predicate." + [(filter! p xs)]) + +(documentation: /.example + "Yields the first item in the array that satisfies the predicate." + [(example p xs)]) + +(documentation: /.example+ + "Just like 'example', but with access to the index of each value." + [(example+ p xs)]) + +(documentation: /.clone + "Yields a shallow clone of the array." + [(clone xs)]) + +(documentation: /.of_list + "" + [(of_list xs)]) + +(documentation: /.list + "Yields a list with every non-empty item in the array." + [(list array)]) + +(documentation: /.list' + "Like 'list', but uses the 'default' value when encountering an empty cell in the array." + [(list' default array)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Array + ..empty + ..size + ..read! + ..write! + ..delete! + ..contains? + ..update! + ..upsert! + ..copy! + ..occupancy + ..vacancy + ..filter! + ..example + ..example+ + ..clone + ..of_list + ..list + ..list' + ($.default /.type_name) + ($.default /.equivalence) + ($.default /.monoid) + ($.default /.functor) + ($.default /.fold) + ($.default /.every?) + ($.default /.any?)] + [])) diff --git a/stdlib/source/documentation/lux/data/collection/bits.lux b/stdlib/source/documentation/lux/data/collection/bits.lux new file mode 100644 index 000000000..f5fe95dc3 --- /dev/null +++ b/stdlib/source/documentation/lux/data/collection/bits.lux @@ -0,0 +1,86 @@ +(.module: + [library + [lux (#- or and not) + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Bits + "A bit-map.") + +(documentation: /.size + "Measures the size of a bit-map by counting all the 1s in the bit-map." + [(size bits)]) + +(documentation: /.capacity + "" + [(capacity bits)]) + +(documentation: /.bit + "" + [(bit index bits)]) + +(template [<name>] + [(documentation: <name> + "" + [(<name> index input)])] + + [/.one] + [/.zero] + [/.flipped] + ) + +(documentation: /.intersects? + "" + [(intersects? reference sample)]) + +(documentation: /.not + "" + [(not input)]) + +(template [<name>] + [(documentation: <name> + "" + [(<name> param subject)])] + + [/.and] + [/.or] + [/.xor] + ) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Bits + ..size + ..capacity + ..bit + + ..one + ..zero + ..flipped + + ..intersects? + ..not + + ..and + ..or + ..xor + + ($.default /.Chunk) + ($.default /.chunk_size) + ($.default /.empty) + ($.default /.empty?) + ($.default /.equivalence)] + [])) diff --git a/stdlib/source/documentation/lux/data/collection/dictionary.lux b/stdlib/source/documentation/lux/data/collection/dictionary.lux new file mode 100644 index 000000000..95d2f998a --- /dev/null +++ b/stdlib/source/documentation/lux/data/collection/dictionary.lux @@ -0,0 +1,107 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." template]]]] + [\\library + ["." /]] + ["." / #_ + ["#." ordered] + ["#." plist]]) + +(documentation: /.Dictionary + "A dictionary implemented as a Hash-Array Mapped Trie (HAMT).") + +(documentation: /.empty + "An empty dictionary." + [(empty key_hash)]) + +(documentation: /.has + "" + [(has key val dict)]) + +(documentation: /.lacks + "" + [(lacks key dict)]) + +(documentation: /.value + "" + [(value key dict)]) + +(documentation: /.key? + "" + [(key? dict key)]) + +(documentation: /.has' + "Only puts the KV-pair if the key is not already present." + [(has' key val dict)]) + +(documentation: /.revised + "Transforms the value located at key (if available), using the given function." + [(revised key f dict)]) + +(documentation: /.revised' + (format "Updates the value at the key; if it exists." + \n "Otherwise, puts a value by applying the function to a default.") + [(revised' key default f dict)]) + +(documentation: /.of_list + "" + [(of_list key_hash kvs)]) + +(documentation: /.merged + (format "Merges 2 dictionaries." + \n "If any collisions with keys occur, the values of dict2 will overwrite those of dict1.") + [(merged dict2 dict1)]) + +(documentation: /.merged_with + (format "Merges 2 dictionaries." + \n "If any collisions with keys occur, a new value will be computed by applying 'f' to the values of dict2 and dict1.") + [(merged_with f dict2 dict1)]) + +(documentation: /.re_bound + "If there is a value under 'from_key', remove 'from_key' and store the value under 'to_key'." + [(re_bound from_key to_key dict)]) + +(documentation: /.sub + "A sub-dictionary, with only the specified keys." + [(sub keys dict)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Dictionary + ..empty + ..has + ..lacks + ..value + ..key? + ..has' + ..revised + ..revised' + ..of_list + ..merged + ..merged_with + ..re_bound + ..sub + ($.default /.key_hash) + ($.default /.key_already_exists) + ($.default /.size) + ($.default /.empty?) + ($.default /.entries) + ($.default /.keys) + ($.default /.values) + ($.default /.equivalence) + ($.default /.functor)] + [/ordered.documentation + /plist.documentation])) diff --git a/stdlib/source/documentation/lux/data/collection/dictionary/ordered.lux b/stdlib/source/documentation/lux/data/collection/dictionary/ordered.lux new file mode 100644 index 000000000..adbb1303f --- /dev/null +++ b/stdlib/source/documentation/lux/data/collection/dictionary/ordered.lux @@ -0,0 +1,84 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Dictionary + "A dictionary data-structure with ordered entries.") + +(documentation: /.empty + "An empty dictionary, employing the given order." + [(empty order)]) + +(documentation: /.value + "" + [(value key dict)]) + +(documentation: /.key? + "" + [(key? dict key)]) + +(template [<name>] + [(`` (documentation: <name> + (format "Yields value under the " (~~ (template.text [<name>])) "imum key.") + [(<name> dict)]))] + + [/.min] + [/.max] + ) + +(documentation: /.size + "" + [(size dict)]) + +(documentation: /.has + "" + [(has key value dict)]) + +(documentation: /.lacks + "" + [(lacks key dict)]) + +(documentation: /.revised + "" + [(revised key transform dict)]) + +(documentation: /.of_list + "" + [(of_list order list)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Dictionary + ..empty + ..value + ..key? + + ..min + ..max + + ..size + ..has + ..lacks + ..revised + ..of_list + ($.default /.empty?) + ($.default /.entries) + ($.default /.keys) + ($.default /.values) + ($.default /.equivalence)] + [])) diff --git a/stdlib/source/documentation/lux/data/collection/dictionary/plist.lux b/stdlib/source/documentation/lux/data/collection/dictionary/plist.lux new file mode 100644 index 000000000..2450cc9eb --- /dev/null +++ b/stdlib/source/documentation/lux/data/collection/dictionary/plist.lux @@ -0,0 +1,58 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.PList + (format "A property list." + \n "It's a simple dictionary-like structure with Text keys.")) + +(documentation: /.value + "" + [(value key properties)]) + +(documentation: /.contains? + "" + [(contains? key properties)]) + +(documentation: /.has + "" + [(has key val properties)]) + +(documentation: /.revised + "" + [(revised key f properties)]) + +(documentation: /.lacks + "" + [(lacks key properties)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..PList + ..value + ..contains? + ..has + ..revised + ..lacks + ($.default /.empty) + ($.default /.size) + ($.default /.empty?) + ($.default /.keys) + ($.default /.values) + ($.default /.equivalence)] + [])) diff --git a/stdlib/source/documentation/lux/data/collection/list.lux b/stdlib/source/documentation/lux/data/collection/list.lux new file mode 100644 index 000000000..1050ab7ce --- /dev/null +++ b/stdlib/source/documentation/lux/data/collection/list.lux @@ -0,0 +1,239 @@ +(.module: + [library + [lux (#- example) + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.aggregates + "" + [(aggregates f init inputs)]) + +(documentation: /.reversed + "" + [(reversed xs)]) + +(documentation: /.only + "A list with only values that satisfy the predicate." + [(only keep? xs)]) + +(documentation: /.partition + "Divide the list into all elements that satisfy a predicate, and all elements that do not." + [(partition satisfies? list)]) + +(documentation: /.pairs + (format "Cut the list into pairs of 2." + \n "Caveat emptor: If the list has an un-even number of elements, the last one will be skipped.") + [(pairs xs)]) + +(template [<name>] + [(documentation: <name> + "" + [(<name> n xs)])] + + [/.first] + [/.after] + ) + +(template [<name>] + [(documentation: <name> + "" + [(<name> predicate xs)])] + + [/.while] + [/.until] + ) + +(documentation: /.split_at + "" + [(split_at n xs)]) + +(documentation: /.split_when + "Segment the list by using a predicate to tell when to cut." + [(split_when predicate xs)]) + +(documentation: /.sub + "Segment the list into sub-lists of (at most) the given size." + [(sub size list)]) + +(documentation: /.repeated + "A list of the value x, repeated n times." + [(repeated n x)]) + +(documentation: /.iterations + "Generates a list element by element until the function returns #.None." + [(iterations f x)]) + +(documentation: /.one + "" + [(one check xs)]) + +(documentation: /.all + "" + [(all check xs)]) + +(documentation: /.example + "Yields the first value in the list that satisfies the predicate." + [(example predicate xs)]) + +(documentation: /.interposed + "Puts a value between every two elements in the list." + [(interposed sep xs)]) + +(documentation: /.size + "" + [(size list)]) + +(template [<name>] + [(documentation: <name> + "" + [(<name> predicate items)])] + + [/.every?] + [/.any?] + ) + +(documentation: /.item + "Fetches the element at the specified index." + [(item i xs)]) + +(documentation: /.sorted + "A list ordered by a comparison function." + [(sorted < xs)]) + +(documentation: /.empty? + "" + [(empty? xs)]) + +(documentation: /.member? + "" + [(member? eq xs x)]) + +(template [<name> <doc>] + [(documentation: <name> + <doc> + [(<name> xs)])] + + [/.head "Yields the first element of a list."] + [/.tail "For a list of size N, yields the N-1 elements after the first one."] + ) + +(documentation: /.indices + "Produces all the valid indices for a given size." + [(indices size)]) + +(documentation: /.zipped + "Create list zippers with the specified number of input lists." + [(def: zipped/2 (zipped 2)) + (def: zipped/3 (zipped 3)) + (zipped/3 xs ys zs) + ((zipped 3) xs ys zs)]) + +(documentation: /.zipped_with + "Create list zippers with the specified number of input lists." + [(def: zipped_with/2 (zipped_with 2)) + (def: zipped_with/3 (zipped_with 3)) + (zipped_with/2 + xs ys) + ((zipped_with 2) + xs ys)]) + +(documentation: /.last + "" + [(last xs)]) + +(documentation: /.inits + (format "For a list of size N, yields the first N-1 elements." + \n "Will yield a #.None for empty lists.") + [(inits xs)]) + +(documentation: /.together + "The sequential combination of all the lists.") + +(documentation: /.with + "Enhances a monad with List functionality." + [(with monad)]) + +(documentation: /.lifted + "Wraps a monadic value with List machinery." + [(lifted monad)]) + +(documentation: /.enumeration + "Pairs every element in the list with its index, starting at 0." + [(enumeration xs)]) + +(documentation: /.when + "Can be used as a guard in (co)monadic be/do expressions." + [(do monad + [value (do_something 1 2 3) + /.when (passes_test? value)] + (do_something_else 4 5 6))]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..aggregates + ..reversed + ..only + ..partition + ..pairs + + ..first + ..after + + ..while + ..until + + ..split_at + ..split_when + ..sub + ..repeated + ..iterations + ..one + ..all + ..example + ..interposed + ..size + + ..every? + ..any? + + ..item + ..sorted + ..empty? + ..member? + + ..head + ..tail + + ..indices + ..zipped + ..zipped_with + ..last + ..inits + ..together + ..with + ..lifted + ..enumeration + ..when + ($.default /.fold) + ($.default /.equivalence) + ($.default /.hash) + ($.default /.monoid) + ($.default /.functor) + ($.default /.apply) + ($.default /.monad) + ($.default /.zipped/2) + ($.default /.zipped/3) + ($.default /.zipped_with/2) + ($.default /.zipped_with/3)] + [])) diff --git a/stdlib/source/documentation/lux/data/collection/queue.lux b/stdlib/source/documentation/lux/data/collection/queue.lux new file mode 100644 index 000000000..5b866fe90 --- /dev/null +++ b/stdlib/source/documentation/lux/data/collection/queue.lux @@ -0,0 +1,62 @@ +(.module: + [library + [lux (#- list) + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." template]]]] + [\\library + ["." /]] + ["." / #_ + ["#." priority]]) + +(documentation: /.Queue + "A first-in, first-out sequential data-structure.") + +(documentation: /.of_list + "" + [(of_list entries)]) + +(documentation: /.list + "" + [(list queue)]) + +(documentation: /.front + "Yields the first value in the queue, if any.") + +(documentation: /.member? + "" + [(member? equivalence queue member)]) + +(documentation: /.next + "" + [(next queue)]) + +(documentation: /.end + "" + [(end val queue)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Queue + ..of_list + ..list + ..front + ..member? + ..next + ..end + ($.default /.empty) + ($.default /.size) + ($.default /.empty?) + ($.default /.equivalence) + ($.default /.functor)] + [/priority.documentation])) diff --git a/stdlib/source/documentation/lux/data/collection/queue/priority.lux b/stdlib/source/documentation/lux/data/collection/queue/priority.lux new file mode 100644 index 000000000..e62869ecd --- /dev/null +++ b/stdlib/source/documentation/lux/data/collection/queue/priority.lux @@ -0,0 +1,41 @@ +(.module: + [library + [lux (#- list) + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.member? + "" + [(member? equivalence queue member)]) + +(documentation: /.end + "" + [(end priority value queue)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..member? + ..end + ($.default /.Priority) + ($.default /.max) + ($.default /.min) + ($.default /.Queue) + ($.default /.empty) + ($.default /.front) + ($.default /.size) + ($.default /.next) + ($.default /.empty?)] + [])) diff --git a/stdlib/source/documentation/lux/data/collection/row.lux b/stdlib/source/documentation/lux/data/collection/row.lux new file mode 100644 index 000000000..e72e8974e --- /dev/null +++ b/stdlib/source/documentation/lux/data/collection/row.lux @@ -0,0 +1,86 @@ +(.module: + [library + [lux (#- list) + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Row + "A sequential data-structure with fast random access.") + +(documentation: /.suffix + "" + [(suffix val row)]) + +(documentation: /.within_bounds? + "Determines whether the index is within the bounds of the row." + [(within_bounds? row idx)]) + +(documentation: /.item + "" + [(item idx row)]) + +(documentation: /.has + "" + [(has idx val row)]) + +(documentation: /.revised + "" + [(revised idx f row)]) + +(documentation: /.prefix + "" + [(prefix row)]) + +(documentation: /.list + "" + [(list row)]) + +(documentation: /.member? + "" + [(member? equivalence row val)]) + +(documentation: /.row + "Row literals." + [(: (Row Nat) + (row 12 34 56 78 90))]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Row + ..suffix + ..within_bounds? + ..item + ..has + ..revised + ..prefix + ..list + ..member? + ..row + ($.default /.empty) + ($.default /.size) + ($.default /.index_out_of_bounds) + ($.default /.of_list) + ($.default /.empty?) + ($.default /.equivalence) + ($.default /.fold) + ($.default /.monoid) + ($.default /.functor) + ($.default /.apply) + ($.default /.monad) + ($.default /.reversed) + ($.default /.every?) + ($.default /.any?)] + [])) diff --git a/stdlib/source/documentation/lux/data/collection/sequence.lux b/stdlib/source/documentation/lux/data/collection/sequence.lux new file mode 100644 index 000000000..64e976155 --- /dev/null +++ b/stdlib/source/documentation/lux/data/collection/sequence.lux @@ -0,0 +1,98 @@ +(.module: + [library + [lux (#- list) + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Sequence + "An infinite sequence of values.") + +(documentation: /.iterations + "A stateful way of infinitely calculating the values of a sequence." + [(iterations step init)]) + +(documentation: /.repeated + "Repeat a value forever." + [(repeated x)]) + +(documentation: /.cycle + (format "Go over the elements of a list forever." + \n "The list should not be empty.") + [(cycle [start next])]) + +(documentation: /.item + "" + [(item idx sequence)]) + +(template [<taker> <dropper>] + [(documentation: <taker> + "" + [(<taker> pred xs)]) + (documentation: <dropper> + "" + [(<dropper> pred xs)])] + + [/.while /.until] + [/.first /.after] + ) + +(template [<splitter>] + [(documentation: <splitter> + "" + [(<splitter> pred xs)])] + + [/.split_when] + [/.split_at] + ) + +(documentation: /.only + "A new sequence only with items that satisfy the predicate." + [(only predicate sequence)]) + +(documentation: /.partition + (format "Split a sequence in two based on a predicate." + \n "The left side contains all entries for which the predicate is #1." + \n "The right side contains all entries for which the predicate is #0.") + [(partition left? xs)]) + +(documentation: /.^sequence& + (format "Allows destructuring of sequences in pattern-matching expressions." + \n "Caveat emptor: Only use it for destructuring, and not for testing values within the sequences.") + [(let [(^sequence& x y z _tail) (some_sequence_func +1 +2 +3)] + (func x y z))]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Sequence + ..iterations + ..repeated + ..cycle + ..item + + ..while ..until + ..first ..after + + ..split_when + ..split_at + + ..only + ..partition + ..^sequence& + ($.default /.head) + ($.default /.tail) + ($.default /.functor) + ($.default /.comonad)] + [])) diff --git a/stdlib/source/documentation/lux/data/color.lux b/stdlib/source/documentation/lux/data/color.lux new file mode 100644 index 000000000..96a44b6ed --- /dev/null +++ b/stdlib/source/documentation/lux/data/color.lux @@ -0,0 +1,126 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." template]]]] + [\\library + ["." /]] + ["." / #_ + ["#." named]]) + +(documentation: /.RGB + "Red-Green-Blue color format.") + +(documentation: /.HSL + "Hue-Saturation-Lightness color format.") + +(documentation: /.CMYK + "Cyan-Magenta-Yellow-Key color format.") + +(documentation: /.HSB + "Hue-Saturation-Brightness color format.") + +(documentation: /.Color + "A color value, independent of color format.") + +(documentation: /.complement + "The opposite color." + [(complement color)]) + +(documentation: /.interpolated + "" + [(interpolated ratio end start)]) + +(template [<name>] + [(documentation: <name> + "" + [(<name> ratio color)])] + + [/.darker] + [/.brighter] + [/.saturated] + [/.un_saturated] + ) + +(syntax: (palette_documentation [[_ name] <code>.identifier]) + (in (list (code.text (format "A " (text.replaced "_" "-" name) " palette."))))) + +(documentation: /.analogous + (palette_documentation /.analogous) + [(analogous spread variations color)]) + +(documentation: /.monochromatic + (palette_documentation /.monochromatic) + [(monochromatic spread variations color)]) + +(documentation: /.Alpha + "The degree of transparency of a pigment.") + +(documentation: /.transparent + "The maximum degree of transparency.") + +(documentation: /.translucent + "The average degree of transparency.") + +(documentation: /.opaque + "The minimum degree of transparency.") + +(documentation: /.Pigment + "A color with some degree of transparency.") + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..RGB + ..HSL + ..CMYK + ..HSB + ..Color + ..complement + ..interpolated + + ..darker + ..brighter + ..saturated + ..un_saturated + + ..analogous + ..monochromatic + ..Alpha + ..transparent + ..translucent + ..opaque + ..Pigment + ($.default /.of_rgb) + ($.default /.rgb) + ($.default /.equivalence) + ($.default /.hash) + ($.default /.black) + ($.default /.white) + ($.default /.addition) + ($.default /.subtraction) + ($.default /.hsl) + ($.default /.of_hsl) + ($.default /.hsb) + ($.default /.of_hsb) + ($.default /.cmyk) + ($.default /.of_cmyk) + ($.default /.gray_scale) + ($.default /.triad) + ($.default /.clash) + ($.default /.split_complement) + ($.default /.square) + ($.default /.tetradic) + ($.default /.Spread) + ($.default /.Palette)] + [/named.documentation])) diff --git a/stdlib/source/documentation/lux/data/color/named.lux b/stdlib/source/documentation/lux/data/color/named.lux new file mode 100644 index 000000000..6f9a080eb --- /dev/null +++ b/stdlib/source/documentation/lux/data/color/named.lux @@ -0,0 +1,319 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." template]] + [math + [number + ["." nat ("#\." hex)]]]]] + [\\library + ["." / + ["/#" //]]]) + +(template [<name>] + [(documentation: <name> + (let [[red green blue] (//.rgb <name>) + [_ name] (name_of <name>)] + (format "R:" (nat\encode red) + " G:" (nat\encode green) + " B:" (nat\encode blue) + " | " (text.replaced "_" " " name))))] + + [/.alice_blue] + [/.antique_white] + [/.aqua] + [/.aquamarine] + [/.azure] + [/.beige] + [/.bisque] + [/.black] + [/.blanched_almond] + [/.blue] + [/.blue_violet] + [/.brown] + [/.burly_wood] + [/.cadet_blue] + [/.chartreuse] + [/.chocolate] + [/.coral] + [/.cornflower_blue] + [/.cornsilk] + [/.crimson] + [/.cyan] + [/.dark_blue] + [/.dark_cyan] + [/.dark_goldenrod] + [/.dark_gray] + [/.dark_green] + [/.dark_khaki] + [/.dark_magenta] + [/.dark_olive_green] + [/.dark_orange] + [/.dark_orchid] + [/.dark_red] + [/.dark_salmon] + [/.dark_sea_green] + [/.dark_slate_blue] + [/.dark_slate_gray] + [/.dark_turquoise] + [/.dark_violet] + [/.deep_pink] + [/.deep_sky_blue] + [/.dim_gray] + [/.dodger_blue] + [/.fire_brick] + [/.floral_white] + [/.forest_green] + [/.fuchsia] + [/.gainsboro] + [/.ghost_white] + [/.gold] + [/.goldenrod] + [/.gray] + [/.green] + [/.green_yellow] + [/.honey_dew] + [/.hot_pink] + [/.indian_red] + [/.indigo] + [/.ivory] + [/.khaki] + [/.lavender] + [/.lavender_blush] + [/.lawn_green] + [/.lemon_chiffon] + [/.light_blue] + [/.light_coral] + [/.light_cyan] + [/.light_goldenrod_yellow] + [/.light_gray] + [/.light_green] + [/.light_pink] + [/.light_salmon] + [/.light_sea_green] + [/.light_sky_blue] + [/.light_slate_gray] + [/.light_steel_blue] + [/.light_yellow] + [/.lime] + [/.lime_green] + [/.linen] + [/.magenta] + [/.maroon] + [/.medium_aquamarine] + [/.medium_blue] + [/.medium_orchid] + [/.medium_purple] + [/.medium_sea_green] + [/.medium_slate_blue] + [/.medium_spring_green] + [/.medium_turquoise] + [/.medium_violet_red] + [/.midnight_blue] + [/.mint_cream] + [/.misty_rose] + [/.moccasin] + [/.navajo_white] + [/.navy] + [/.old_lace] + [/.olive] + [/.olive_drab] + [/.orange] + [/.orange_red] + [/.orchid] + [/.pale_goldenrod] + [/.pale_green] + [/.pale_turquoise] + [/.pale_violet_red] + [/.papaya_whip] + [/.peach_puff] + [/.peru] + [/.pink] + [/.plum] + [/.powder_blue] + [/.purple] + [/.rebecca_purple] + [/.red] + [/.rosy_brown] + [/.royal_blue] + [/.saddle_brown] + [/.salmon] + [/.sandy_brown] + [/.sea_green] + [/.sea_shell] + [/.sienna] + [/.silver] + [/.sky_blue] + [/.slate_blue] + [/.slate_gray] + [/.snow] + [/.spring_green] + [/.steel_blue] + [/.tan] + [/.teal] + [/.thistle] + [/.tomato] + [/.turquoise] + [/.violet] + [/.wheat] + [/.white] + [/.white_smoke] + [/.yellow] + [/.yellow_green] + ) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..alice_blue + ..antique_white + ..aqua + ..aquamarine + ..azure + ..beige + ..bisque + ..black + ..blanched_almond + ..blue + ..blue_violet + ..brown + ..burly_wood + ..cadet_blue + ..chartreuse + ..chocolate + ..coral + ..cornflower_blue + ..cornsilk + ..crimson + ..cyan + ..dark_blue + ..dark_cyan + ..dark_goldenrod + ..dark_gray + ..dark_green + ..dark_khaki + ..dark_magenta + ..dark_olive_green + ..dark_orange + ..dark_orchid + ..dark_red + ..dark_salmon + ..dark_sea_green + ..dark_slate_blue + ..dark_slate_gray + ..dark_turquoise + ..dark_violet + ..deep_pink + ..deep_sky_blue + ..dim_gray + ..dodger_blue + ..fire_brick + ..floral_white + ..forest_green + ..fuchsia + ..gainsboro + ..ghost_white + ..gold + ..goldenrod + ..gray + ..green + ..green_yellow + ..honey_dew + ..hot_pink + ..indian_red + ..indigo + ..ivory + ..khaki + ..lavender + ..lavender_blush + ..lawn_green + ..lemon_chiffon + ..light_blue + ..light_coral + ..light_cyan + ..light_goldenrod_yellow + ..light_gray + ..light_green + ..light_pink + ..light_salmon + ..light_sea_green + ..light_sky_blue + ..light_slate_gray + ..light_steel_blue + ..light_yellow + ..lime + ..lime_green + ..linen + ..magenta + ..maroon + ..medium_aquamarine + ..medium_blue + ..medium_orchid + ..medium_purple + ..medium_sea_green + ..medium_slate_blue + ..medium_spring_green + ..medium_turquoise + ..medium_violet_red + ..midnight_blue + ..mint_cream + ..misty_rose + ..moccasin + ..navajo_white + ..navy + ..old_lace + ..olive + ..olive_drab + ..orange + ..orange_red + ..orchid + ..pale_goldenrod + ..pale_green + ..pale_turquoise + ..pale_violet_red + ..papaya_whip + ..peach_puff + ..peru + ..pink + ..plum + ..powder_blue + ..purple + ..rebecca_purple + ..red + ..rosy_brown + ..royal_blue + ..saddle_brown + ..salmon + ..sandy_brown + ..sea_green + ..sea_shell + ..sienna + ..silver + ..sky_blue + ..slate_blue + ..slate_gray + ..snow + ..spring_green + ..steel_blue + ..tan + ..teal + ..thistle + ..tomato + ..turquoise + ..violet + ..wheat + ..white + ..white_smoke + ..yellow + ..yellow_green] + [])) diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 6554978c9..6c1335fe9 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -691,33 +691,55 @@ ... #seed Nat ... #scope_type_vars (List Nat) ... #extensions Any +... #eval (-> Type Code (-> Lux (Either Text [Lux Any]))) ... #host Any}) ("lux def type tagged" Lux (#Named ["library/lux" "Lux"] - (#Product ... "lux.info" - Info - (#Product ... "lux.source" - Source - (#Product ... "lux.location" - Location - (#Product ... "lux.current_module" - (#Apply Text Maybe) - (#Product ... "lux.modules" - (#Apply (#Product Text Module) List) - (#Product ... "lux.scopes" - (#Apply Scope List) - (#Product ... "lux.type_context" - Type_Context - (#Product ... "lux.expected" - (#Apply Type Maybe) - (#Product ... "lux.seed" - Nat - (#Product ... scope_type_vars - (#Apply Nat List) - (#Product ... extensions - Any - ... "lux.host" - Any)))))))))))) + ({Lux + (#Apply Nothing + (#UnivQ #End + (#Product + ... info + Info + (#Product + ... source + Source + (#Product + ... location + Location + (#Product + ... current_module + (#Apply Text Maybe) + (#Product + ... modules + (#Apply (#Product Text Module) List) + (#Product + ... scopes + (#Apply Scope List) + (#Product + ... type_context + Type_Context + (#Product + ... expected + (#Apply Type Maybe) + (#Product + ... seed + Nat + (#Product + ... scope_type_vars + (#Apply Nat List) + (#Product + ... extensions + Any + (#Product + ... eval + (#Function Type + (#Function Code + (#Function Lux + (#Sum Text (#Product Lux Any))))) + ... host + Any))))))))))))))} + (#Apply (#Parameter 1) (#Parameter 0)))) (record$ (#Item [(tag$ ["library/lux" "doc"]) (text$ ("lux text concat" ("lux text concat" "Represents the state of the Lux compiler during a run." __paragraph) @@ -725,7 +747,7 @@ ("lux text concat" "It is provided to macros during their invocation, so they can access compiler data." __paragraph) "Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")))] #End)) - ["info" "source" "location" "current_module" "modules" "scopes" "type_context" "expected" "seed" "scope_type_vars" "extensions" "host"] + ["info" "source" "location" "current_module" "modules" "scopes" "type_context" "expected" "seed" "scope_type_vars" "extensions" "eval" "host"] #1) ... (type: .public (Meta a) @@ -1223,7 +1245,7 @@ (failure "Wrong syntax for Ex")} tokens))) -(def:'' .private (list\reverse list) +(def:'' .private (list\reversed list) #End (All [a] (#Function ($' List a) ($' List a))) (list\fold ("lux type check" (All [a] (#Function a (#Function ($' List a) ($' List a)))) @@ -1248,7 +1270,7 @@ _ (failure "Wrong syntax for ->")} - (list\reverse tokens))) + (list\reversed tokens))) (macro:' .public (list xs) (#Item [(tag$ ["library/lux" "doc"]) @@ -1261,7 +1283,7 @@ (#Item (tuple$ (#Item [head (#Item [tail #End])])) #End)))) (tag$ ["library/lux" "End"]) - (list\reverse xs)) + (list\reversed xs)) #End))) (macro:' .public (list& xs) @@ -1281,7 +1303,7 @@ _ (failure "Wrong syntax for list&")} - (list\reverse xs))) + (list\reversed xs))) (macro:' .public (Variant tokens) (#Item [(tag$ ["library/lux" "doc"]) @@ -1300,7 +1322,7 @@ (in_meta (list (list\fold (function'' [left right] (form$ (list (tag$ ["library/lux" "Sum"]) left right))) last prevs)))} - (list\reverse tokens))) + (list\reversed tokens))) (macro:' .public (Tuple tokens) (#Item [(tag$ ["library/lux" "doc"]) @@ -1319,7 +1341,7 @@ (in_meta (list (list\fold (function'' [left right] (form$ (list (tag$ ["library/lux" "Product"]) left right))) last prevs)))} - (list\reverse tokens))) + (list\reversed tokens))) (macro:' .private (function' tokens) (let'' [name tokens'] ({(#Item [[_ (#Identifier ["" name])] tokens']) @@ -1340,7 +1362,7 @@ arg)) body'))) body - (list\reverse targs))))))} + (list\reversed targs))))))} args) _ @@ -1412,7 +1434,7 @@ (form$ (list (record$ (list [label body])) value))} binding))) body - (list\reverse (pairs bindings))))) + (list\reversed (pairs bindings))))) _ (failure "Wrong syntax for let'")} @@ -1512,7 +1534,7 @@ _ (failure "Wrong syntax for $_")} - (list\reverse tokens')) + (list\reversed tokens')) _ (failure "Wrong syntax for $_")} @@ -1588,7 +1610,7 @@ value))} var)))) body - (list\reverse (pairs bindings)))] + (list\reversed (pairs bindings)))] (in_meta (list (form$ (list (record$ (list [(record$ (list [(tag$ ["library/lux" "in"]) g!in] [(tag$ ["library/lux" "bind"]) g!bind])) body'])) monad))))) @@ -1690,7 +1712,7 @@ {#info info #source source #current_module _ #modules modules #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars} state] + #scope_type_vars scope_type_vars #eval _eval} state] ({(#Some {#module_hash _ #module_aliases _ #definitions definitions #imports _ #tags tags #types types #module_annotations _ #module_state _}) ({(#Some constant) ({(#Left real_name) @@ -1749,7 +1771,7 @@ leftI)) lastO inits))} - (list\reverse elems)) + (list\reversed elems)) #0 (do meta_monad [=elems (monad\map meta_monad untemplated elems)] @@ -1874,7 +1896,7 @@ ({{#info info #source source #current_module current_module #modules modules #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars} + #scope_type_vars scope_type_vars #eval _eval} ({(#Some module_name) (#Right [state module_name]) @@ -1979,7 +2001,7 @@ _ (failure "Wrong syntax for <|")} - (list\reverse tokens))) + (list\reversed tokens))) (def:''' .private (function\composite f g) (list [(tag$ ["library/lux" "doc"]) @@ -2101,7 +2123,7 @@ #End (All [a] (-> ($' List ($' List a)) ($' List a))) - (list\fold list\compose #End (list\reverse xs))) + (list\fold list\compose #End (list\reversed xs))) (macro:' .public (template tokens) (list [(tag$ ["library/lux" "doc"]) @@ -2298,7 +2320,7 @@ #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars} + #scope_type_vars scope_type_vars #eval _eval} (#Right state (macro' modules current_module module name))} state))))) @@ -2563,12 +2585,12 @@ #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars} + #scope_type_vars scope_type_vars #eval _eval} (#Right {#info info #source source #current_module _ #modules modules #scopes scopes #type_context types #host host #seed ("lux i64 +" 1 seed) #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars} + #scope_type_vars scope_type_vars #eval _eval} (local_identifier$ ($_ text\compose "__gensym__" prefix (nat\encode seed))))} state)) @@ -2607,7 +2629,7 @@ _ (failure "Wrong syntax for exec")} - (list\reverse tokens))) + (list\reversed tokens))) (macro:' .private (def:' tokens) (let' [parts (: (Maybe [Code Code (List Code) (Maybe Code) Code]) @@ -2687,14 +2709,14 @@ ($_ text\compose "(" (|> xs (list\map code\encode) (list\interposed " ") - list\reverse + list\reversed (list\fold text\compose "")) ")") [_ (#Tuple xs)] ($_ text\compose "[" (|> xs (list\map code\encode) (list\interposed " ") - list\reverse + list\reversed (list\fold text\compose "")) "]") [_ (#Record kvs)] @@ -2702,7 +2724,7 @@ (list\map (function' [kv] ({[k v] ($_ text\compose (code\encode k) " " (code\encode v))} kv))) (list\interposed " ") - list\reverse + list\reversed (list\fold text\compose "")) "}")} code)) @@ -2735,7 +2757,7 @@ (failure ($_ text\compose "'lux.case' expects an even number of tokens: " (|> branches (list\map code\encode) (list\interposed " ") - list\reverse + list\reversed (list\fold text\compose ""))))} branches)) @@ -2832,7 +2854,7 @@ (case tokens (^ (list [_ (#Tuple bindings)] body)) (if (multiple? 2 (list\size bindings)) - (|> bindings pairs list\reverse + (|> bindings pairs list\reversed (list\fold (: (-> [Code Code] Code Code) (function' [lr body'] (let' [[l r] lr] @@ -2874,7 +2896,7 @@ (` ([(~ g!name) (~ g!blank)] (.case (~ g!blank) (~ arg) (~ body'))))))))] (in_meta (list (nest (..local_identifier$ g!name) head - (list\fold (nest g!blank) body (list\reverse tail)))))) + (list\fold (nest g!blank) body (list\reversed tail)))))) #None (failure "Wrong syntax for function"))) @@ -3261,7 +3283,7 @@ (template [<name> <form> <message> <documentation>] [(macro: .public (<name> tokens) {#.doc <documentation>} - (case (list\reverse tokens) + (case (list\reversed tokens) (^ (list& last init)) (in_meta (list (list\fold (: (-> Code Code Code) (function (_ pre post) (` <form>))) @@ -3458,7 +3480,7 @@ (let [{#info info #source source #current_module _ #modules modules #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars} state] + #scope_type_vars scope_type_vars #eval _eval} state] (case (plist\value name modules) (#Some module) (#Right state module) @@ -3515,7 +3537,7 @@ (let [{#info info #source source #current_module _ #modules modules #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars} state] + #scope_type_vars scope_type_vars #eval _eval} state] (case expected (#Some type) (#Right state type) @@ -4032,9 +4054,9 @@ jumps ("lux i64 -" 1 relatives)] (if (n/< (list\size parts) jumps) (let [prefix (|> parts - list\reverse + list\reversed (list\after jumps) - list\reverse + list\reversed (text\interposed ..module_separator)) clean ("lux text clip" relatives (|> module "lux text size" ("lux i64 -" relatives)) module) output (case ("lux text size" clean) @@ -4128,7 +4150,7 @@ {#info info #source source #current_module current_module #modules modules #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars} + #scope_type_vars scope_type_vars #eval _eval} [current_module modules])] (case (plist\value module modules) (#Some =module) @@ -4196,7 +4218,7 @@ {#info info #source source #current_module _ #modules modules #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars} + #scope_type_vars scope_type_vars #eval _eval} (list\one (: (-> Scope (Maybe Type)) (function (_ env) (case env @@ -4219,7 +4241,7 @@ {#info info #source source #current_module _ #modules modules #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars} state] + #scope_type_vars scope_type_vars #eval _eval} state] (case (plist\value v_module modules) #None #None @@ -4243,7 +4265,7 @@ {#info info #source source #current_module _ #modules modules #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars} state] + #scope_type_vars scope_type_vars #eval _eval} state] (case (plist\value v_module modules) #None (#Left (text\compose "Unknown definition: " (name\encode name))) @@ -4301,7 +4323,7 @@ (let [{#info _ #source _ #current_module _ #modules _ #scopes _ #type_context type_context #host _ #seed _ #expected _ #location _ #extensions extensions - #scope_type_vars _} compiler + #scope_type_vars _ #eval _eval} compiler {#ex_counter _ #var_counter _ #var_bindings var_bindings} type_context] (case (type_variable type_id var_bindings) #None @@ -4337,16 +4359,16 @@ name _ - ($_ text\compose "(" name " " (|> params (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) ")")) + ($_ text\compose "(" name " " (|> params (list\map type\encode) (list\interposed " ") list\reversed (list\fold text\compose "")) ")")) (#Sum _) - ($_ text\compose "(Or " (|> (flat_variant type) (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) ")") + ($_ text\compose "(Or " (|> (flat_variant type) (list\map type\encode) (list\interposed " ") list\reversed (list\fold text\compose "")) ")") (#Product _) - ($_ text\compose "[" (|> (flat_tuple type) (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) "]") + ($_ text\compose "[" (|> (flat_tuple type) (list\map type\encode) (list\interposed " ") list\reversed (list\fold text\compose "")) "]") (#Function _) - ($_ text\compose "(-> " (|> (flat_lambda type) (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) ")") + ($_ text\compose "(-> " (|> (flat_lambda type) (list\map type\encode) (list\interposed " ") list\reversed (list\fold text\compose "")) ")") (#Parameter id) (nat\encode id) @@ -4367,7 +4389,7 @@ (let [[func args] (flat_application type)] ($_ text\compose "(" (type\encode func) " " - (|> args (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) + (|> args (list\map type\encode) (list\interposed " ") list\reversed (list\fold text\compose "")) ")")) (#Named name _) @@ -4435,7 +4457,7 @@ " ''???'')"))} (if ("lux i64 =" 0 (n/% 2 (list\size tokens))) (failure "cond requires an uneven number of arguments.") - (case (list\reverse tokens) + (case (list\reversed tokens) (^ (list& else branches')) (in_meta (list (list\fold (: (-> [Code Code] Code Code) (function (_ branch else) @@ -4834,14 +4856,14 @@ (function (_ [s b] v) (` (..with@ (~ s) (~ v) (~ b))))) value - (list\reverse pairs)) + (list\reversed pairs)) [_ accesses'] (list\fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) (function (_ [new_slot new_binding] [old_record accesses']) [(` (value@ (~ new_slot) (~ new_binding))) (#Item (list new_binding old_record) accesses')])) [record (: (List (List Code)) #End)] pairs) - accesses (list\joined (list\reverse accesses'))]] + accesses (list\joined (list\reversed accesses'))]] (in (list (` (let [(~+ accesses)] (~ update_expr))))))) @@ -5525,7 +5547,7 @@ (list) (list g!_ (` #.None)))))))) (` (#.Some (~ body))) - (: (List [Code Code]) (list\reverse levels)))] + (: (List [Code Code]) (list\reversed levels)))] (list init_pattern inner_pattern_body))) (macro: .public (^multi tokens) @@ -5608,7 +5630,7 @@ {#info info #source source #current_module _ #modules modules #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars} + #scope_type_vars scope_type_vars #eval _eval} (#Right [state scope_type_vars]))) (macro: .public (:parameter tokens) @@ -5625,7 +5647,7 @@ (^ (list [_ (#Nat idx)])) (do meta_monad [stvs ..scope_type_vars] - (case (..item idx (list\reverse stvs)) + (case (..item idx (list\reversed stvs)) (#Some var_id) (in (list (` (#Ex (~ (nat$ var_id)))))) @@ -5999,11 +6021,11 @@ [(def: (<name> g!meta untemplated_pattern elems) (-> Code (-> Code (Meta Code)) (-> (List Code) (Meta Code))) - (case (list\reverse elems) + (case (list\reversed elems) (#Item [_ (#Form (#Item [[_ (#Identifier ["" "~+"])] (#Item [spliced #End])]))] inits) (do meta_monad - [=inits (monad\map meta_monad untemplated_pattern (list\reverse inits))] + [=inits (monad\map meta_monad untemplated_pattern (list\reversed inits))] (in (` [(~ g!meta) (<tag> (~ (untemplated_list& spliced =inits)))]))) _ diff --git a/stdlib/source/library/lux/control/parser/json.lux b/stdlib/source/library/lux/control/parser/json.lux index 65569ff9e..cc954fc1b 100644 --- a/stdlib/source/library/lux/control/parser/json.lux +++ b/stdlib/source/library/lux/control/parser/json.lux @@ -23,7 +23,6 @@ ["." // ("#\." functor)]) (type: .public (Parser a) - {#.doc "A JSON parser."} (//.Parser (List JSON) a)) (exception: .public (unconsumed_input {input (List JSON)}) @@ -33,8 +32,6 @@ (exception: .public empty_input) (def: .public (result parser json) - {#.doc (example "Executes the parser against a JSON object." - "Verifies that all of the JSON was consumed by the parser.")} (All [a] (-> (Parser a) JSON (Try a))) (case (//.result parser (list json)) (#try.Success [remainder output]) @@ -49,7 +46,6 @@ (#try.Failure error))) (def: .public any - {#.doc "Just returns the JSON input without applying any logic."} (Parser JSON) (<| (function (_ inputs)) (case inputs @@ -63,9 +59,8 @@ (exception.report ["Value" (/.format value)])) -(template [<name> <type> <tag> <desc>] +(template [<name> <type> <tag>] [(def: .public <name> - {#.doc (code.text ($_ text\compose "Reads a JSON value as " <desc> "."))} (Parser <type>) (do //.monad [head ..any] @@ -76,10 +71,10 @@ _ (//.failure (exception.error ..unexpected_value [head])))))] - [null /.Null #/.Null "null"] - [boolean /.Boolean #/.Boolean "boolean"] - [number /.Number #/.Number "number"] - [string /.String #/.String "string"] + [null /.Null #/.Null] + [boolean /.Boolean #/.Boolean] + [number /.Number #/.Number] + [string /.String #/.String] ) (exception: .public [a] (value_mismatch {reference JSON} {sample JSON}) @@ -120,13 +115,11 @@ ) (def: .public (nullable parser) - {#.doc (example "Enhances parser by adding NULL-handling.")} (All [a] (-> (Parser a) (Parser (Maybe a)))) (//.or ..null parser)) (def: .public (array parser) - {#.doc "Parses the contents of a JSON array."} (All [a] (-> (Parser a) (Parser a))) (do //.monad [head ..any] @@ -148,8 +141,6 @@ (//.failure (exception.error ..unexpected_value [head]))))) (def: .public (object parser) - {#.doc (example "Parses the contents of a JSON object." - "Use this with the 'field' combinator.")} (All [a] (-> (Parser a) (Parser a))) (do //.monad [head ..any] @@ -176,8 +167,6 @@ (//.failure (exception.error ..unexpected_value [head]))))) (def: .public (field field_name parser) - {#.doc (example "Parses a field inside a JSON object." - "Use this inside the 'object' combinator.")} (All [a] (-> Text (Parser a) (Parser a))) (function (recur inputs) (case inputs @@ -204,7 +193,6 @@ (exception.except ..unconsumed_input inputs)))) (def: .public dictionary - {#.doc "Parses a dictionary-like JSON object."} (All [a] (-> (Parser a) (Parser (Dictionary Text a)))) (|>> (//.and ..string) //.some diff --git a/stdlib/source/library/lux/control/parser/synthesis.lux b/stdlib/source/library/lux/control/parser/synthesis.lux index dadf00655..b336a0d58 100644 --- a/stdlib/source/library/lux/control/parser/synthesis.lux +++ b/stdlib/source/library/lux/control/parser/synthesis.lux @@ -49,12 +49,9 @@ (exception: .public empty_input) (type: .public Parser - {#.doc (example "A parser for the Lux compiler's synthesis nodes using during optimization.")} (//.Parser (List Synthesis))) (def: .public (result parser input) - {#.doc (example "Executes the parser against the inputs." - "Ensures all inputs are consumed by the parser.")} (All [a] (-> (Parser a) (List Synthesis) (Try a))) (case (parser input) (#try.Failure error) @@ -67,7 +64,6 @@ (exception.except ..unconsumed_input unconsumed))) (def: .public any - {#.doc (example "Yields a synthesis node without subjecting it to any analysis.")} (Parser Synthesis) (.function (_ input) (case input @@ -78,7 +74,6 @@ (#try.Success [tail head])))) (def: .public end! - {#.doc "Ensures there are no more inputs."} (Parser Any) (.function (_ tokens) (case tokens @@ -86,7 +81,6 @@ _ (exception.except ..expected_empty_input [tokens])))) (def: .public end? - {#.doc "Checks whether there are no more inputs."} (Parser Bit) (.function (_ tokens) (#try.Success [tokens (case tokens @@ -128,7 +122,6 @@ ) (def: .public (tuple parser) - {#.doc (example "Parses the contents of a tuple.")} (All [a] (-> (Parser a) (Parser a))) (.function (_ input) (case input @@ -141,7 +134,6 @@ (exception.except ..cannot_parse input)))) (def: .public (function expected parser) - {#.doc (example "Parses the body of a function with the 'expected' arity.")} (All [a] (-> Arity (Parser a) (Parser [(Environment Synthesis) a]))) (.function (_ input) (case input @@ -156,7 +148,6 @@ (exception.except ..cannot_parse input)))) (def: .public (loop init_parsers iteration_parser) - {#.doc (example "Parses the initial values and the body of a loop.")} (All [a b] (-> (Parser a) (Parser b) (Parser [Register a b]))) (.function (_ input) (case input diff --git a/stdlib/source/library/lux/control/parser/text.lux b/stdlib/source/library/lux/control/parser/text.lux index 46ed6e987..b95df4bfd 100644 --- a/stdlib/source/library/lux/control/parser/text.lux +++ b/stdlib/source/library/lux/control/parser/text.lux @@ -21,7 +21,6 @@ ["." //]) (type: .public Offset - {#.doc (example "An offset into a block of text.")} Nat) (def: start_offset @@ -29,11 +28,9 @@ 0) (type: .public Parser - {#.doc (example "A parser for text.")} (//.Parser [Offset Text])) (type: .public Slice - {#.doc (example "A slice of a block of text.")} {#basis Offset #distance Offset}) @@ -56,8 +53,6 @@ (exception: .public cannot_slice) (def: .public (result parser input) - {#.doc (example "Executes a parser against a block of text." - "Verifies that the entire input has been processed.")} (All [a] (-> (Parser a) Text (Try a))) (case (parser [start_offset input]) (#try.Failure msg) @@ -69,7 +64,6 @@ (exception.except ..unconsumed_input [end_offset input])))) (def: .public offset - {#.doc (example "Yields the current offset into the input.")} (Parser Offset) (function (_ (^@ input [offset tape])) (#try.Success [input offset]))) @@ -87,7 +81,6 @@ slices)))) (def: .public any - {#.doc "Yields the next character without applying any logic."} (Parser Text) (function (_ [offset tape]) (case (/.char offset tape) @@ -98,7 +91,6 @@ (exception.except ..cannot_parse [])))) (def: .public any! - {#.doc "Yields the next character (as a slice) without applying any logic."} (Parser Slice) (function (_ [offset tape]) (case (/.char offset tape) @@ -110,9 +102,8 @@ _ (exception.except ..cannot_slice [])))) -(template [<name> <type> <any> <caveat>] +(template [<name> <type> <any>] [(`` (def: .public (<name> parser) - {#.doc (example (~~ (template.text ["Produce a character" <caveat> " if the parser fails."])))} (All [a] (-> (Parser a) (Parser <type>))) (function (_ input) (case (parser input) @@ -122,8 +113,8 @@ _ (exception.except ..expected_to_fail input)))))] - [not Text ..any ""] - [not! Slice ..any! " (as a slice)"] + [not Text ..any] + [not! Slice ..any!] ) (exception: .public (cannot_match {reference Text}) @@ -131,7 +122,6 @@ ["Reference" (/.format reference)])) (def: .public (this reference) - {#.doc (example "Checks that a specific text shows up in the input.")} (-> Text (Parser Any)) (function (_ [offset tape]) (case (/.index_of' offset reference tape) @@ -145,7 +135,6 @@ (exception.except ..cannot_match [reference])))) (def: .public end! - {#.doc "Ensure the parser's input is empty."} (Parser Any) (function (_ (^@ input [offset tape])) (if (n.= offset (/.size tape)) @@ -153,7 +142,6 @@ (exception.except ..unconsumed_input input)))) (def: .public next - {#.doc "Yields the next character (without consuming it from the input)."} (Parser Text) (function (_ (^@ input [offset tape])) (case (/.char offset tape) @@ -164,13 +152,11 @@ (exception.except ..cannot_parse [])))) (def: .public remaining - {#.doc "Get all of the remaining input (without consuming it)."} (Parser Text) (function (_ (^@ input [offset tape])) (#try.Success [input (remaining' offset tape)]))) (def: .public (range bottom top) - {#.doc "Only yields characters within a range."} (-> Nat Nat (Parser Text)) (do //.monad [char any @@ -182,7 +168,6 @@ (template [<name> <bottom> <top> <desc>] [(def: .public <name> - {#.doc (code.text ($_ /\compose "Only yields " <desc> " characters."))} (Parser Text) (..range (char <bottom>) (char <top>)))] @@ -193,17 +178,14 @@ ) (def: .public alpha - {#.doc "Yields alphabetic characters."} (Parser Text) (//.either lower upper)) (def: .public alpha_num - {#.doc "Yields alphanumeric characters."} (Parser Text) (//.either alpha decimal)) (def: .public hexadecimal - {#.doc "Yields hexadecimal digits."} (Parser Text) ($_ //.either decimal @@ -265,7 +247,6 @@ ["Character" (/.format (/.of_char character))])) (def: .public (satisfies parser) - {#.doc "Yields characters that satisfy a predicate."} (-> (-> Char Bit) (Parser Text)) (function (_ [offset tape]) (case (/.char offset tape) @@ -278,12 +259,10 @@ (exception.except ..cannot_parse [])))) (def: .public space - {#.doc "Yields white-space."} (Parser Text) (..satisfies /.space?)) (def: .public (and left right) - {#.doc (example "Yields the outputs of both parsers composed together.")} (-> (Parser Text) (Parser Text) (Parser Text)) (do //.monad [=left left @@ -291,7 +270,6 @@ (in ($_ /\compose =left =right)))) (def: .public (and! left right) - {#.doc (example "Yields the outputs of both parsers composed together (as a slice).")} (-> (Parser Slice) (Parser Slice) (Parser Slice)) (do //.monad [[left::basis left::distance] left @@ -300,7 +278,6 @@ (template [<name> <base> <doc_modifier>] [(def: .public (<name> parser) - {#.doc (code.text ($_ /\compose "Yields " <doc_modifier> " characters as a single continuous text (as a slice)."))} (-> (Parser Text) (Parser Text)) (|> parser <base> (\ //.monad map /.together)))] @@ -310,7 +287,6 @@ (template [<name> <base> <doc_modifier>] [(def: .public (<name> parser) - {#.doc (code.text ($_ /\compose "Yields " <doc_modifier> " characters as a single continuous text (as a slice)."))} (-> (Parser Slice) (Parser Slice)) (with_slices (<base> parser)))] @@ -320,7 +296,6 @@ (template [<name> <base> <doc_modifier>] [(def: .public (<name> amount parser) - {#.doc (code.text ($_ /\compose "Yields " <doc_modifier> " N characters (as a slice)."))} (-> Nat (Parser Text) (Parser Text)) (|> parser (<base> amount) @@ -333,7 +308,6 @@ (template [<name> <base> <doc_modifier>] [(def: .public (<name> amount parser) - {#.doc (code.text ($_ /\compose "Yields " <doc_modifier> " N characters (as a slice)."))} (-> Nat (Parser Slice) (Parser Slice)) (with_slices (<base> amount parser)))] @@ -361,7 +335,6 @@ (//.after (this start)))) (def: .public (local local_input parser) - {#.doc "Applies a parser against the given input."} (All [a] (-> Text (Parser a) (Parser a))) (function (_ real_input) (case (..result parser local_input) @@ -372,7 +345,6 @@ (#try.Success [real_input value])))) (def: .public (slice parser) - {#.doc (example "Converts a slice to a block of text.")} (-> (Parser Slice) (Parser Text)) (do //.monad [[basis distance] parser] @@ -385,7 +357,6 @@ (exception.except ..cannot_slice []))))) (def: .public (then structured text) - {#.doc (example "Embeds a text parser into an arbitrary parser that yields text.")} (All [s a] (-> (Parser a) (//.Parser s Text) diff --git a/stdlib/source/library/lux/control/parser/tree.lux b/stdlib/source/library/lux/control/parser/tree.lux index cba23cf82..1f7a54a1a 100644 --- a/stdlib/source/library/lux/control/parser/tree.lux +++ b/stdlib/source/library/lux/control/parser/tree.lux @@ -13,23 +13,19 @@ ["." //]) (type: .public (Parser t a) - {#.doc (example "A parser of arbitrary trees.")} (//.Parser (Zipper t) a)) (def: .public (result' parser zipper) - {#.doc (example "Applies the parser against a tree zipper.")} (All [t a] (-> (Parser t a) (Zipper t) (Try a))) (do try.monad [[zipper output] (//.result parser zipper)] (in output))) (def: .public (result parser tree) - {#.doc (example "Applies the parser against a tree.")} (All [t a] (-> (Parser t a) (Tree t) (Try a))) (result' parser (zipper.zipper tree))) (def: .public value - {#.doc (example "Yields the value inside the current tree node.")} (All [t] (Parser t t)) (function (_ zipper) (#try.Success [zipper (zipper.value zipper)]))) diff --git a/stdlib/source/library/lux/control/parser/type.lux b/stdlib/source/library/lux/control/parser/type.lux index e6ea2b3dd..029d130fd 100644 --- a/stdlib/source/library/lux/control/parser/type.lux +++ b/stdlib/source/library/lux/control/parser/type.lux @@ -1,6 +1,4 @@ (.module: - {#.doc (.example "Parsing of Lux types." - "Used mostly for polytypic programming.")} [library [lux (#- function local) [abstract @@ -61,15 +59,12 @@ (text.interposed ""))])) (type: .public Env - {#.doc (example "An environment for type parsing.")} (Dictionary Nat [Type Code])) (type: .public (Parser a) - {#.doc (example "A parser of Lux types.")} (//.Parser [Env (List Type)] a)) (def: .public fresh - {#.doc (example "An empty parsing environment.")} Env (dictionary.empty n.hash)) @@ -88,13 +83,10 @@ (exception.except ..unconsumed_input remaining)))) (def: .public (result poly type) - {#.doc (example "Applies a parser against a type." - "Verifies that the parser fully consumes the type's information.")} (All [a] (-> (Parser a) Type (Try a))) (result' ..fresh poly (list type))) (def: .public env - {#.doc (example "Yields the current parsing environment.")} (Parser Env) (.function (_ [env inputs]) (#try.Success [[env inputs] env]))) @@ -110,7 +102,6 @@ (#try.Success [[env remaining] output])))) (def: .public next - {#.doc (example "Inspect a type in the input stream without consuming it.")} (Parser Type) (.function (_ [env inputs]) (case inputs @@ -121,7 +112,6 @@ (#try.Success [[env inputs] headT])))) (def: .public any - {#.doc (example "Yields a type, without examination.")} (Parser Type) (.function (_ [env inputs]) (case inputs @@ -132,7 +122,6 @@ (#try.Success [[env tail] headT])))) (def: .public (local types poly) - {#.doc (example "Apply a parser to the given inputs.")} (All [a] (-> (List Type) (Parser a) (Parser a))) (.function (_ [env pass_through]) (case (result' env poly types) @@ -222,7 +211,6 @@ (in [funcL all_varsL output]))))) (def: .public (function in_poly out_poly) - {#.doc (example "Parses a function's inputs and output.")} (All [i o] (-> (Parser i) (Parser o) (Parser [i o]))) (do //.monad [headT any @@ -233,7 +221,6 @@ (//.failure (exception.error ..not_function headT))))) (def: .public (applied poly) - {#.doc (example "Parses a type application.")} (All [a] (-> (Parser a) (Parser a))) (do //.monad [headT any @@ -242,9 +229,8 @@ (//.failure (exception.error ..not_application headT)) (..local (#.Item funcT paramsT) poly)))) -(template [<name> <test> <doc>] +(template [<name> <test>] [(def: .public (<name> expected) - {#.doc (example <doc>)} (-> Type (Parser Any)) (do //.monad [actual any] @@ -252,12 +238,9 @@ (in []) (//.failure (exception.error ..types_do_not_match [expected actual])))))] - [exactly type\= - "Parses a type exactly."] - [sub check.subsumes? - "Parses a sub type."] - [super (function.flipped check.subsumes?) - "Parses a super type."] + [exactly type\=] + [sub check.subsumes?] + [super (function.flipped check.subsumes?)] ) (def: .public (adjusted_idx env idx) @@ -299,7 +282,6 @@ (//.failure (exception.error ..not_parameter headT))))) (def: .public existential - {#.doc (example "Yields an existential type.")} (Parser Nat) (do //.monad [headT any] @@ -311,7 +293,6 @@ (//.failure (exception.error ..not_existential headT))))) (def: .public named - {#.doc (example "Yields a named type.")} (Parser [Name Type]) (do //.monad [inputT any] diff --git a/stdlib/source/library/lux/control/parser/xml.lux b/stdlib/source/library/lux/control/parser/xml.lux index 5785ecba8..2b0332544 100644 --- a/stdlib/source/library/lux/control/parser/xml.lux +++ b/stdlib/source/library/lux/control/parser/xml.lux @@ -18,7 +18,6 @@ ["." //]) (type: .public (Parser a) - {#.doc (example "A parser of XML-encoded data.")} (//.Parser [Attrs (List XML)] a)) (exception: .public empty_input) @@ -50,13 +49,10 @@ (#try.Failure error))) (def: .public (result parser documents) - {#.doc (example "Applies a parser against a stream of XML documents." - "Verifies that all of the inputs are consumed by the parser.")} (All [a] (-> (Parser a) (List XML) (Try a))) (..result' parser /.attributes documents)) (def: .public text - {#.doc (example "Yields text from a text node.")} (Parser Text) (function (_ [attrs documents]) (case documents @@ -72,7 +68,6 @@ (exception.except ..unexpected_input []))))) (def: .public tag - {#.doc (example "Yields the tag from the next node.")} (Parser Tag) (function (_ [attrs documents]) (case documents @@ -88,7 +83,6 @@ (#try.Success [[attrs documents] tag]))))) (def: .public (attribute name) - {#.doc (example "Yields the value of an attribute in the current node.")} (-> Attribute (Parser Text)) (function (_ [attrs documents]) (case (dictionary.value name attrs) @@ -99,7 +93,6 @@ (#try.Success [[attrs documents] value])))) (def: .public (node expected parser) - {#.doc (example "Parses the contents of the next node if the tag matches.")} (All [a] (-> Tag (Parser a) (Parser a))) (function (_ [attrs documents]) (case documents @@ -119,7 +112,6 @@ (exception.except ..wrong_tag [expected actual])))))) (def: .public any - {#.doc (example "Yields the next node.")} (Parser XML) (function (_ [attrs documents]) (case documents @@ -132,7 +124,6 @@ (exception: .public nowhere) (def: .public (somewhere parser) - {#.doc (example "Applies the parser somewhere among the remaining inputs; instead of demanding that the parser succeeds against the immediate inputs.")} (All [a] (-> (Parser a) (Parser a))) (function (recur [attrs input]) (case (//.result parser [attrs input]) diff --git a/stdlib/source/library/lux/data/binary.lux b/stdlib/source/library/lux/data/binary.lux index 13b9b5a9d..6028c1a68 100644 --- a/stdlib/source/library/lux/data/binary.lux +++ b/stdlib/source/library/lux/data/binary.lux @@ -33,9 +33,7 @@ ["Offset" (%.nat offset)] ["Length" (%.nat length)])) -(with_expansions [<documentation> (as_is {#.doc (example "A binary BLOB of data.")}) - <jvm> (as_is (type: .public Binary - <documentation> +(with_expansions [<jvm> (as_is (type: .public Binary (ffi.type [byte])) (ffi.import: java/lang/Object) @@ -78,17 +76,14 @@ (length ffi.Number)]) (type: .public Binary - <documentation> Uint8Array)) @.python (type: .public Binary - <documentation> (primitive "bytearray")) @.scheme (as_is (type: .public Binary - <documentation> (primitive "bytevector")) (ffi.import: (make-bytevector [Nat] Binary)) @@ -98,7 +93,6 @@ ... Default (type: .public Binary - <documentation> (array.Array (I64 Any))))) (template: (!size binary) @@ -171,7 +165,6 @@ (|>> !size)) (def: .public (empty size) - {#.doc (example "A fresh/empty binary BLOB of the specified size.")} (-> Nat Binary) (for {@.old (ffi.array byte size) @.jvm (ffi.array byte size) @@ -200,14 +193,12 @@ output)))) (def: .public (read/8! index binary) - {#.doc (example "Read 1 byte (8 bits) at the given index.")} (-> Nat Binary (Try I64)) (if (n.< (..!size binary) index) (#try.Success (!read index binary)) (exception.except ..index_out_of_bounds [(..!size binary) index]))) (def: .public (read/16! index binary) - {#.doc (example "Read 2 bytes (16 bits) at the given index.")} (-> Nat Binary (Try I64)) (if (n.< (..!size binary) (n.+ 1 index)) (#try.Success ($_ i64.or @@ -216,7 +207,6 @@ (exception.except ..index_out_of_bounds [(..!size binary) index]))) (def: .public (read/32! index binary) - {#.doc (example "Read 4 bytes (32 bits) at the given index.")} (-> Nat Binary (Try I64)) (if (n.< (..!size binary) (n.+ 3 index)) (#try.Success ($_ i64.or @@ -227,7 +217,6 @@ (exception.except ..index_out_of_bounds [(..!size binary) index]))) (def: .public (read/64! index binary) - {#.doc (example "Read 8 bytes (64 bits) at the given index.")} (-> Nat Binary (Try I64)) (if (n.< (..!size binary) (n.+ 7 index)) (#try.Success ($_ i64.or @@ -242,7 +231,6 @@ (exception.except ..index_out_of_bounds [(..!size binary) index]))) (def: .public (write/8! index value binary) - {#.doc (example "Write 1 byte (8 bits) at the given index.")} (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) index) (#try.Success (|> binary @@ -250,7 +238,6 @@ (exception.except ..index_out_of_bounds [(..!size binary) index]))) (def: .public (write/16! index value binary) - {#.doc (example "Write 2 bytes (16 bits) at the given index.")} (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) (n.+ 1 index)) (#try.Success (|> binary @@ -259,7 +246,6 @@ (exception.except ..index_out_of_bounds [(..!size binary) index]))) (def: .public (write/32! index value binary) - {#.doc (example "Write 4 bytes (32 bits) at the given index.")} (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) (n.+ 3 index)) (#try.Success (|> binary @@ -270,7 +256,6 @@ (exception.except ..index_out_of_bounds [(..!size binary) index]))) (def: .public (write/64! index value binary) - {#.doc (example "Write 8 bytes (64 bits) at the given index.")} (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) (n.+ 7 index)) (for {@.scheme (let [write_high (|>> (!write index (i64.right_shifted 56 value)) @@ -323,7 +308,6 @@ ["Target output space" (%.nat target_output)]))) (def: .public (copy bytes source_offset source target_offset target) - {#.doc (example "Mutates the target binary BLOB by copying bytes from the source BLOB to it.")} (-> Nat Nat Binary Nat Binary (Try Binary)) (with_expansions [<jvm> (as_is (do try.monad [_ (java/lang/System::arraycopy source (.int source_offset) target (.int target_offset) (.int bytes))] @@ -345,7 +329,6 @@ (#try.Success target)))))))) (def: .public (slice offset length binary) - {#.doc (example "Yields a subset of the binary BLOB, so long as the specified range is valid.")} (-> Nat Nat Binary (Try Binary)) (let [size (..!size binary) limit (n.+ length offset)] @@ -359,7 +342,6 @@ (..copy length offset binary 0 (..empty length))))))) (def: .public (after bytes binary) - {#.doc (example "Yields a binary BLOB with at most the specified number of bytes removed.")} (-> Nat Binary Binary) (case bytes 0 binary diff --git a/stdlib/source/library/lux/data/bit.lux b/stdlib/source/library/lux/data/bit.lux index efdca1f5b..6d7b7c9c3 100644 --- a/stdlib/source/library/lux/data/bit.lux +++ b/stdlib/source/library/lux/data/bit.lux @@ -61,7 +61,5 @@ _ (#.Left "Wrong syntax for Bit.")))) (def: .public complement - {#.doc (example "Generates the complement of a predicate." - "That is a predicate that returns the oposite of the original predicate.")} (All [a] (-> (-> a Bit) (-> a Bit))) (function.composite not)) diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux index ae6aa7b96..c7fe53e3f 100644 --- a/stdlib/source/library/lux/data/collection/array.lux +++ b/stdlib/source/library/lux/data/collection/array.lux @@ -22,7 +22,6 @@ "#Array") (type: .public (Array a) - {#.doc "Mutable arrays."} (#.Primitive ..type_name (#.Item a #.End))) (with_expansions [<index_type> (primitive "java.lang.Long") @@ -37,7 +36,6 @@ (as_is)) (def: .public (empty size) - {#.doc (.example "An empty array of the specified size.")} (All [a] (-> Nat (Array a))) (for {@.old (:expected ("jvm anewarray" "(java.lang.Object )" size)) @@ -110,7 +108,6 @@ #.None)) (def: .public (write! index value array) - {#.doc (.example "Mutate the array by writing a value to the specified index.")} (All [a] (-> Nat a (Array a) (Array a))) (for {@.old @@ -130,7 +127,6 @@ @.scheme ("scheme array write" index value array)})) (def: .public (delete! index array) - {#.doc (.example "Mutate the array by deleting the value at the specified index.")} (All [a] (-> Nat (Array a) (Array a))) (if (n.< (size array) index) @@ -160,7 +156,6 @@ false)) (def: .public (update! index transform array) - {#.doc (.example "Mutate the array by updating the value at the specified index.")} (All [a] (-> Nat (-> a a) (Array a) (Array a))) (case (read! index array) @@ -171,8 +166,6 @@ (write! index (transform value) array))) (def: .public (upsert! index default transform array) - {#.doc (.example "Mutate the array by updating the value at the specified index." - "If there is no value, update and write the default value given.")} (All [a] (-> Nat a (-> a a) (Array a) (Array a))) (write! index @@ -180,7 +173,6 @@ array)) (def: .public (copy! length src_start src_array dest_start dest_array) - {#.doc (.example "Writes the contents of one array into the other.")} (All [a] (-> Nat Nat (Array a) Nat (Array a) (Array a))) @@ -197,7 +189,6 @@ (list.indices length)))) (def: .public (occupancy array) - {#.doc "Finds out how many cells in an array are occupied."} (All [a] (-> (Array a) Nat)) (list\fold (function (_ idx count) (case (read! idx array) @@ -210,12 +201,10 @@ (list.indices (size array)))) (def: .public (vacancy array) - {#.doc "Finds out how many cells in an array are vacant."} (All [a] (-> (Array a) Nat)) (n.- (..occupancy array) (..size array))) (def: .public (filter! p xs) - {#.doc (.example "Delete every item of the array that fails to satisfy the predicate.")} (All [a] (-> (Predicate a) (Array a) (Array a))) (list\fold (function (_ idx xs') @@ -231,7 +220,6 @@ (list.indices (size xs)))) (def: .public (example p xs) - {#.doc (.example "Yields the first item in the array that satisfies the predicate.")} (All [a] (-> (Predicate a) (Array a) (Maybe a))) (let [arr_size (size xs)] @@ -248,7 +236,6 @@ #.None)))) (def: .public (example+ p xs) - {#.doc "Just like 'example', but with access to the index of each value."} (All [a] (-> (-> Nat a Bit) (Array a) (Maybe [Nat a]))) (let [arr_size (size xs)] @@ -265,7 +252,6 @@ #.None)))) (def: .public (clone xs) - {#.doc (.example "Yields a shallow clone of the array.")} (All [a] (-> (Array a) (Array a))) (let [arr_size (size xs)] (list\fold (function (_ idx ys) @@ -290,7 +276,6 @@ (-- 0)) (def: .public (list array) - {#.doc (.example "Yields a list with every non-empty item in the array.")} (All [a] (-> (Array a) (List a))) (loop [idx (-- (size array)) output #.End] @@ -308,7 +293,6 @@ output))))) (def: .public (list' default array) - {#.doc (.example "Like 'list', but uses the 'default' value when encountering an empty cell in the array.")} (All [a] (-> a (Array a) (List a))) (loop [idx (-- (size array)) output #.End] diff --git a/stdlib/source/library/lux/data/collection/bits.lux b/stdlib/source/library/lux/data/collection/bits.lux index b5059ea8a..6c375247c 100644 --- a/stdlib/source/library/lux/data/collection/bits.lux +++ b/stdlib/source/library/lux/data/collection/bits.lux @@ -21,7 +21,6 @@ i64.width) (type: .public Bits - {#.doc (example "A bit-map.")} (Array Chunk)) (def: empty_chunk @@ -33,7 +32,6 @@ (array.empty 0)) (def: .public (size bits) - {#.doc (example "Measures the size of a bit-map by counting all the 1s in the bit-map.")} (-> Bits Nat) (array\fold (function (_ chunk total) (|> chunk i64.ones (n.+ total))) diff --git a/stdlib/source/library/lux/data/collection/dictionary.lux b/stdlib/source/library/lux/data/collection/dictionary.lux index 6773a3b95..faab0f7b2 100644 --- a/stdlib/source/library/lux/data/collection/dictionary.lux +++ b/stdlib/source/library/lux/data/collection/dictionary.lux @@ -556,7 +556,6 @@ colls))) (type: .public (Dictionary k v) - {#.doc "A dictionary implemented as a Hash-Array Mapped Trie (HAMT)."} {#hash (Hash k) #root (Node k v)}) @@ -565,7 +564,6 @@ (value@ #..hash)) (def: .public (empty key_hash) - {#.doc (example "An empty dictionary.")} (All [k v] (-> (Hash k) (Dictionary k v))) {#hash key_hash #root empty_node}) @@ -594,14 +592,12 @@ (exception: .public key_already_exists) (def: .public (has' key val dict) - {#.doc "Only puts the KV-pair if the key is not already present."} (All [k v] (-> k v (Dictionary k v) (Try (Dictionary k v)))) (case (value key dict) #.None (#try.Success (has key val dict)) (#.Some _) (exception.except ..key_already_exists []))) (def: .public (revised key f dict) - {#.doc "Transforms the value located at key (if available), using the given function."} (All [k v] (-> k (-> v v) (Dictionary k v) (Dictionary k v))) (case (value key dict) #.None @@ -611,8 +607,6 @@ (has key (f val) dict))) (def: .public (revised' key default f dict) - {#.doc (example "Updates the value at the key; if it exists." - "Otherwise, puts a value by applying the function to a default.")} (All [k v] (-> k v (-> v v) (Dictionary k v) (Dictionary k v))) (..has key (f (maybe.else default @@ -651,16 +645,12 @@ ) (def: .public (merged dict2 dict1) - {#.doc (example "Merges 2 dictionaries." - "If any collisions with keys occur, the values of dict2 will overwrite those of dict1.")} (All [k v] (-> (Dictionary k v) (Dictionary k v) (Dictionary k v))) (list\fold (function (_ [key val] dict) (has key val dict)) dict1 (entries dict2))) (def: .public (merged_with f dict2 dict1) - {#.doc (example "Merges 2 dictionaries." - "If any collisions with keys occur, a new value will be computed by applying 'f' to the values of dict2 and dict1.")} (All [k v] (-> (-> v v v) (Dictionary k v) (Dictionary k v) (Dictionary k v))) (list\fold (function (_ [key val2] dict) (case (value key dict) @@ -673,7 +663,6 @@ (entries dict2))) (def: .public (re_bound from_key to_key dict) - {#.doc (example "If there is a value under 'from_key', remove 'from_key' and store the value under 'to_key'.")} (All [k v] (-> k k (Dictionary k v) (Dictionary k v))) (case (value from_key dict) #.None @@ -685,7 +674,6 @@ (has to_key val)))) (def: .public (sub keys dict) - {#.doc "A sub-dictionary, with only the specified keys."} (All [k v] (-> (List k) (Dictionary k v) (Dictionary k v))) (let [[key_hash _] dict] (list\fold (function (_ key new_dict) diff --git a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux index 567c1f457..f19843db9 100644 --- a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux @@ -46,12 +46,10 @@ ) (type: .public (Dictionary k v) - {#.doc (example "A dictionary data-structure with ordered entries.")} {#&order (Order k) #root (Maybe (Node k v))}) (def: .public (empty order) - {#.doc (example "An empty dictionary, employing the given order.")} (All [k v] (-> (Order k) (Dictionary k v))) {#&order order #root #.None}) diff --git a/stdlib/source/library/lux/data/collection/dictionary/plist.lux b/stdlib/source/library/lux/data/collection/dictionary/plist.lux index c56994d6c..e98a2c51b 100644 --- a/stdlib/source/library/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/library/lux/data/collection/dictionary/plist.lux @@ -14,8 +14,6 @@ ... https://en.wikipedia.org/wiki/Property_list (type: .public (PList a) - {#.doc (example "A property list." - "It's a simple dictionary-like structure with Text keys.")} (List [Text a])) (def: .public empty diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index cb52d478d..a4bb340e7 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -51,7 +51,6 @@ xs)) (def: .public (only keep? xs) - {#.doc (.example "A list with only values that satisfy the predicate.")} (All [a] (-> (Predicate a) (List a) (List a))) (case xs @@ -64,7 +63,6 @@ (only keep? xs')))) (def: .public (partition satisfies? list) - {#.doc "Divide the list into all elements that satisfy a predicate, and all elements that do not."} (All [a] (-> (Predicate a) (List a) [(List a) (List a)])) (case list #.End @@ -77,8 +75,6 @@ [in (#.Item head out)])))) (def: .public (pairs xs) - {#.doc (.example "Cut the list into pairs of 2." - "Caveat emptor: If the list has an un-even number of elements, the last one will be skipped.")} (All [a] (-> (List a) (List [a a]))) (case xs (^ (list& x1 x2 xs')) @@ -147,14 +143,12 @@ (split_when' predicate (#.Item x ys) xs')))) (def: .public (split_when predicate xs) - {#.doc "Segment the list by using a predicate to tell when to cut."} (All [a] (-> (Predicate a) (List a) [(List a) (List a)])) (let [[ys' xs'] (split_when' predicate #.End xs)] [(reversed ys') xs'])) (def: .public (sub size list) - {#.doc "Segment the list into sub-lists of (at most) the given size."} (All [a] (-> Nat (List a) (List (List a)))) (case list #.End @@ -165,7 +159,6 @@ (#.Item pre (sub size post))))) (def: .public (repeated n x) - {#.doc "A list of the value x, repeated n times."} (All [a] (-> Nat a (List a))) (case n @@ -183,7 +176,6 @@ (list))) (def: .public (iterations f x) - {#.doc "Generates a list element by element until the function returns #.None."} (All [a] (-> (-> a (Maybe a)) a (List a))) (case (f x) @@ -235,7 +227,6 @@ (all check xs'))))) (def: .public (example predicate xs) - {#.doc "Yields the first value in the list that satisfies the predicate."} (All [a] (-> (Predicate a) (List a) (Maybe a))) (..one (function (_ value) @@ -245,7 +236,6 @@ xs)) (def: .public (interposed sep xs) - {#.doc "Puts a value between every two elements in the list."} (All [a] (-> a (List a) (List a))) (case xs @@ -279,7 +269,6 @@ ) (def: .public (item i xs) - {#.doc "Fetches the element at the specified index."} (All [a] (-> Nat (List a) (Maybe a))) (case xs @@ -371,7 +360,6 @@ (|>> reversed (fold compose identity)))) (def: .public (sorted < xs) - {#.doc (.example "A list ordered by a comparison function.")} (All [a] (-> (-> a a Bit) (List a) (List a))) (case xs #.End @@ -421,7 +409,6 @@ ) (def: .public (indices size) - {#.doc "Produces all the valid indices for a given size."} (All [a] (-> Nat (List Nat))) (case size 0 (list) @@ -454,11 +441,6 @@ _ (recur input' output'))))) (macro: .public (zipped tokens state) - {#.doc (.example "Create list zippers with the specified number of input lists." - (def: .public zipped/2 (zipped 2)) - (def: .public zipped/3 (zipped 3)) - (zipped/3 xs ys zs) - ((zipped 3) xs ys zs))} (case tokens (^ (list [_ (#.Nat num_lists)])) (if (n.> 0 num_lists) @@ -499,11 +481,6 @@ (def: .public zipped/3 (zipped 3)) (macro: .public (zipped_with tokens state) - {#.doc (.example "Create list zippers with the specified number of input lists." - (def: .public zipped_with/2 (zipped_with 2)) - (def: .public zipped_with/3 (zipped_with 3)) - (zipped_with/2 + xs ys) - ((zipped_with 2) + xs ys))} (case tokens (^ (list [_ (#.Nat num_lists)])) (if (n.> 0 num_lists) @@ -559,8 +536,6 @@ (last xs'))) (def: .public (inits xs) - {#.doc (.example "For a list of size N, yields the first N-1 elements." - "Will yield a #.None for empty lists.")} (All [a] (-> (List a) (Maybe (List a)))) (case xs #.End @@ -579,12 +554,10 @@ )) (def: .public together - {#.doc (.example "The sequential combination of all the lists.")} (All [a] (-> (List (List a)) (List a))) (\ ..monad join)) (implementation: .public (with monad) - {#.doc (.example "Enhances a monad with List functionality.")} (All [M] (-> (Monad M) (Monad (All [a] (M (List a)))))) (def: &functor @@ -605,12 +578,10 @@ (in (..together lla))))) (def: .public (lifted monad) - {#.doc (.example "Wraps a monadic value with List machinery.")} (All [M a] (-> (Monad M) (-> (M a) (M (List a))))) (\ monad map (\ ..monad in))) (def: .public (enumeration xs) - {#.doc "Pairs every element in the list with its index, starting at 0."} (All [a] (-> (List a) (List [Nat a]))) (loop [idx 0 xs xs] @@ -622,11 +593,6 @@ (#.Item [idx x] (recur (++ idx) xs'))))) (macro: .public (when tokens state) - {#.doc (.example "Can be used as a guard in (co)monadic be/do expressions." - (do monad - [value (do_something 1 2 3) - ..when (passes_test? value)] - (do_something_else 4 5 6)))} (case tokens (^ (.list test then)) (#.Right [state (.list (` (.if (~ test) diff --git a/stdlib/source/library/lux/data/collection/queue.lux b/stdlib/source/library/lux/data/collection/queue.lux index a54543eae..e8caf83f7 100644 --- a/stdlib/source/library/lux/data/collection/queue.lux +++ b/stdlib/source/library/lux/data/collection/queue.lux @@ -12,7 +12,6 @@ ["n" nat]]]]]) (type: .public (Queue a) - {#.doc (example "A first-in, first-out sequential data-structure.")} {#front (List a) #rear (List a)}) @@ -32,7 +31,6 @@ (list\compose front (list.reversed rear)))) (def: .public front - {#.doc (example "Yields the first value in the queue, if any.")} (All [a] (-> (Queue a) (Maybe a))) (|>> (value@ #front) list.head)) diff --git a/stdlib/source/library/lux/data/collection/row.lux b/stdlib/source/library/lux/data/collection/row.lux index e77ef1bdf..16929459e 100644 --- a/stdlib/source/library/lux/data/collection/row.lux +++ b/stdlib/source/library/lux/data/collection/row.lux @@ -183,7 +183,6 @@ #.End)))) (type: .public (Row a) - {#.doc (example "A sequential data-structure with fast random access.")} {#level Level #size Nat #root (Hierarchy a) @@ -242,7 +241,6 @@ (exception: base_was_not_found) (def: .public (within_bounds? row idx) - {#.doc (example "Determines whether the index is within the bounds of the row.")} (All [a] (-> (Row a) Nat Bit)) (n.< (value@ #size row) idx)) @@ -350,17 +348,15 @@ (All [a] (-> (List a) (Row a))) (list\fold ..suffix ..empty)) -(def: .public (member? a/Equivalence row val) +(def: .public (member? equivalence row val) (All [a] (-> (Equivalence a) (Row a) a Bit)) - (list.member? a/Equivalence (list row) val)) + (list.member? equivalence (list row) val)) (def: .public empty? (All [a] (-> (Row a) Bit)) (|>> (value@ #size) (n.= 0))) (syntax: .public (row [elems (<>.some <code>.any)]) - {#.doc (example "Row literals." - (row 12 34 56 78 90))} (in (.list (` (..of_list (.list (~+ elems))))))) (implementation: (node_equivalence Equivalence<a>) diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index 42cd682df..2bed3b721 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -20,25 +20,20 @@ ["n" nat]]]]]) (type: .public (Sequence a) - {#.doc "An infinite sequence of values."} (Cont [a (Sequence a)])) (def: .public (iterations step init) - {#.doc "A stateful way of infinitely calculating the values of a sequence."} (All [a b] (-> (-> a [a b]) a (Sequence b))) (let [[next x] (step init)] (//.pending [x (iterations step next)]))) (def: .public (repeated x) - {#.doc "Repeat a value forever."} (All [a] (-> a (Sequence a))) (//.pending [x (repeated x)])) (def: .public (cycle [start next]) - {#.doc (example "Go over the elements of a list forever." - "The list should not be empty.")} (All [a] (-> [a (List a)] (Sequence a))) (loop [head start @@ -103,7 +98,6 @@ ) (def: .public (only predicate sequence) - {#.doc (example "A new sequence only with items that satisfy the predicate.")} (All [a] (-> (-> a Bit) (Sequence a) (Sequence a))) (let [[head tail] (//.result sequence)] (if (predicate head) @@ -111,9 +105,6 @@ (only predicate tail)))) (def: .public (partition left? xs) - {#.doc (example "Split a sequence in two based on a predicate." - "The left side contains all entries for which the predicate is #1." - "The right side contains all entries for which the predicate is #0.")} (All [a] (-> (-> a Bit) (Sequence a) [(Sequence a) (Sequence a)])) [(..only left? xs) (..only (bit.complement left?) xs)]) @@ -139,10 +130,6 @@ (syntax: .public (^sequence& [patterns (<code>.form (<>.many <code>.any)) body <code>.any branches (<>.some <code>.any)]) - {#.doc (example "Allows destructuring of sequences in pattern-matching expressions." - "Caveat emptor: Only use it for destructuring, and not for testing values within the sequences." - (let [(^sequence& x y z _tail) (some_sequence_func +1 +2 +3)] - (func x y z)))} (with_identifiers [g!sequence] (let [body+ (` (let [(~+ (list\join (list\map (function (_ pattern) (list (` [(~ pattern) (~ g!sequence)]) diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux index 1cebc0408..d34918cf2 100644 --- a/stdlib/source/library/lux/data/color.lux +++ b/stdlib/source/library/lux/data/color.lux @@ -42,29 +42,25 @@ (|>> (f.* rgb_factor) f.int .nat)) (type: .public RGB - {#.doc (example "Red-Green-Blue color format.")} {#red Nat #green Nat #blue Nat}) (type: .public HSL - {#.doc (example "Hue-Saturation-Lightness color format.")} [Frac Frac Frac]) (type: .public CMYK - {#.doc (example "Cyan-Magenta-Yellow-Key color format.")} {#cyan Frac #magenta Frac #yellow Frac #key Frac}) (type: .public HSB - {#.doc (example "Hue-Saturation-Brightness color format.")} [Frac Frac Frac]) (abstract: .public Color - {#.doc (example "A color value, independent of color format.")} - + {} + RGB (def: .public (of_rgb [red green blue]) @@ -128,7 +124,6 @@ (|> ..top (n.- value))) (def: .public (complement color) - {#.doc (example "The opposite color.")} (-> Color Color) (let [[red green blue] (:representation color)] (:abstraction {#red (complement' red) @@ -409,13 +404,7 @@ (type: .public Palette (-> Spread Nat Color (List Color))) -(syntax: (palette_documentation [name <code>.local_identifier]) - (let [name (text.replaced "_" "-" name) - g!documentation (code.text (format "A " name " palette."))] - (in (list (` {#.doc (.example (~ g!documentation))}))))) - (`` (def: .public (analogous spread variations color) - (~~ (..palette_documentation analogous)) Palette (let [[hue saturation brightness] (hsb color) spread (..normal spread)] @@ -426,7 +415,6 @@ (list.indices variations))))) (`` (def: .public (monochromatic spread variations color) - (~~ (..palette_documentation monochromatic)) Palette (let [[hue saturation brightness] (hsb color) spread (..normal spread)] @@ -439,25 +427,20 @@ of_hsb)))))) (type: .public Alpha - {#.doc (example "The degree of transparency of a pigment.")} Rev) (def: .public transparent - {#.doc (example "The maximum degree of transparency.")} Alpha rev\bottom) (def: .public translucent - {#.doc (example "The average degree of transparency.")} Alpha .5) (def: .public opaque - {#.doc (example "The minimum degree of transparency.")} Alpha rev\top) (type: .public Pigment - {#.doc (example "A color with some degree of transparency.")} {#color Color #alpha Alpha}) diff --git a/stdlib/source/library/lux/data/color/named.lux b/stdlib/source/library/lux/data/color/named.lux index f94dacd1a..5e5e5bc65 100644 --- a/stdlib/source/library/lux/data/color/named.lux +++ b/stdlib/source/library/lux/data/color/named.lux @@ -1,30 +1,10 @@ (.module: [library [lux #* - [control - ["<>" parser - ["<.>" code]]] - [data - ["." text - ["%" format (#+ format)]]] - [macro - ["." syntax (#+ syntax:)] - ["." code]] [math [number (#+ hex)]]]] ["." // (#+ Color)]) -(syntax: (documentation [<red> <code>.text - <green> <code>.text - <blue> <code>.text - <name> <code>.local_identifier]) - (|> <name> - (text.replaced "_" " ") - (format <red> <green> <blue> " | ") - code.text - list - in)) - (template [<red> <green> <blue> <name>] [(`` (def: .public <name> {#.doc (example (~~ (..documentation <red> <green> <blue> <name>)))} diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index d7f3c9544..bc91e8880 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -392,21 +392,21 @@ (-> (Type Declaration) Code) (|>> ..signature code.text)) -(def: (make_get_const_parser class_name field_name) +(def: (get_const_parser class_name field_name) (-> Text Text (Parser Code)) (do <>.monad [.let [dotted_name (format "::" field_name)] _ (<code>.this! (code.identifier ["" dotted_name]))] (in (get_static_field class_name field_name)))) -(def: (make_get_var_parser class_name field_name self_name) +(def: (get_var_parser class_name field_name self_name) (-> Text Text Text (Parser Code)) (do <>.monad [.let [dotted_name (format "::" field_name)] _ (<code>.this! (code.identifier ["" dotted_name]))] (in (get_virtual_field class_name field_name (code.local_identifier self_name))))) -(def: (make_put_var_parser class_name field_name self_name) +(def: (put_var_parser class_name field_name self_name) (-> Text Text Text (Parser Code)) (do <>.monad [.let [dotted_name (format "::" field_name)] @@ -450,17 +450,17 @@ (-> Text Text [Member_Declaration FieldDecl] (Parser Code)) (case field (#ConstantField _) - (make_get_const_parser class_name field_name) + (get_const_parser class_name field_name) (#VariableField _) - (<>.either (make_get_var_parser class_name field_name self_name) - (make_put_var_parser class_name field_name self_name)))) + (<>.either (get_var_parser class_name field_name self_name) + (put_var_parser class_name field_name self_name)))) (def: (decorate_input [class value]) (-> [(Type Value) Code] Code) (` [(~ (code.text (..signature class))) (~ value)])) -(def: (make_constructor_parser class_name arguments) +(def: (constructor_parser class_name arguments) (-> Text (List Argument) (Parser Code)) (do <>.monad [args (: (Parser (List Code)) @@ -471,7 +471,7 @@ (list.zipped/2 (list\map product.right arguments)) (list\map ..decorate_input)))))))) -(def: (make_static_method_parser class_name method_name arguments) +(def: (static_method_parser class_name method_name arguments) (-> Text Text (List Argument) (Parser Code)) (do <>.monad [.let [dotted_name (format "::" method_name "!")] @@ -497,30 +497,30 @@ (list.zipped/2 (list\map product.right arguments)) (list\map ..decorate_input))))))))] - [make_special_method_parser "jvm member invoke special"] - [make_virtual_method_parser "jvm member invoke virtual"] + [special_method_parser "jvm member invoke special"] + [virtual_method_parser "jvm member invoke virtual"] ) (def: (method->parser class_name [[method_name _ _] meth_def]) (-> Text [Member_Declaration Method_Definition] (Parser Code)) (case meth_def (#ConstructorMethod strict? type_vars self_name args constructor_args return_expr exs) - (make_constructor_parser class_name args) + (constructor_parser class_name args) (#StaticMethod strict? type_vars args return_type return_expr exs) - (make_static_method_parser class_name method_name args) + (static_method_parser class_name method_name args) (#VirtualMethod final? strict? type_vars self_name args return_type return_expr exs) - (make_virtual_method_parser class_name method_name args self_name) + (virtual_method_parser class_name method_name args self_name) (#OverridenMethod strict? owner_class type_vars self_name args return_type return_expr exs) - (make_special_method_parser class_name method_name args self_name) + (special_method_parser class_name method_name args self_name) (#AbstractMethod type_vars args return_type exs) - (make_virtual_method_parser class_name method_name args "") + (virtual_method_parser class_name method_name args "") (#NativeMethod type_vars args return_type exs) - (make_virtual_method_parser class_name method_name args ""))) + (virtual_method_parser class_name method_name args ""))) (def: privacy_modifier^ (Parser Privacy) diff --git a/stdlib/source/library/lux/macro/syntax/definition.lux b/stdlib/source/library/lux/macro/syntax/definition.lux index 14e907870..79fde60e7 100644 --- a/stdlib/source/library/lux/macro/syntax/definition.lux +++ b/stdlib/source/library/lux/macro/syntax/definition.lux @@ -124,7 +124,7 @@ <code>.bit )))) -(exception: .public (lacks_type! {definition Definition}) +(exception: .public (lacks_type {definition Definition}) (exception.report ["Definition" (%.code (..format definition))])) @@ -138,5 +138,5 @@ (in []) (#.Right _) - (<>.lifted (exception.except ..lacks_type! [definition])))] + (<>.lifted (exception.except ..lacks_type [definition])))] (in definition))) diff --git a/stdlib/source/library/lux/math/number/rev.lux b/stdlib/source/library/lux/math/number/rev.lux index 3fc60202c..c7d5641ce 100644 --- a/stdlib/source/library/lux/math/number/rev.lux +++ b/stdlib/source/library/lux/math/number/rev.lux @@ -25,6 +25,7 @@ Rev (.rev (//i64.left_shifted (//nat.- <power> //i64.width) 1)))] + [00 /1] [01 /2] [02 /4] [03 /8] diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 7b6e893d3..0b4b809fc 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -599,3 +599,10 @@ (#try.Failure error) (..failure error))) + +(def: .public (eval type code) + (-> Type Code (Meta Any)) + (do {! ..monad} + [eval (\ ! map (value@ #.eval) + ..compiler_state)] + (eval type code))) diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux index 29af87345..e92cd49e4 100644 --- a/stdlib/source/library/lux/test.lux +++ b/stdlib/source/library/lux/test.lux @@ -310,7 +310,7 @@ Text (text.of_char 31)) -(def: encode_coverage +(def: encoded_coverage (-> (List Text) Text) (list\fold (function (_ short aggregate) (case aggregate @@ -318,7 +318,7 @@ _ (format aggregate ..coverage_separator short))) "")) -(def: (decode_coverage module encoding) +(def: (coverage module encoding) (-> Text Text (Set Name)) (loop [remaining encoding output (set.of_list name.hash (list))] @@ -366,7 +366,7 @@ (def: (covering' module coverage test) (-> Text Text Test Test) - (let [coverage (..decode_coverage module coverage)] + (let [coverage (..coverage module coverage)] (|> (..context module test) (random\map (async\map (function (_ [tally documentation]) [(revised@ #expected_coverage (set.union coverage) tally) @@ -388,7 +388,7 @@ (#.Item short aggregate) aggregate)) #.End) - ..encode_coverage)]] + ..encoded_coverage)]] (in (list (` ((~! ..covering') (~ (code.text module)) (~ (code.text coverage)) diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux index 04971dadd..c01a1f6c1 100644 --- a/stdlib/source/library/lux/tool/compiler/default/init.lux +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -169,9 +169,9 @@ (in [buffer registry]))) ... TODO: Inline ASAP -(def: (process_directive archive expander pre_payoad code) +(def: (process_directive wrapper archive expander pre_payoad code) (All [directive] - (-> Archive Expander (Payload directive) Code + (-> ///phase.Wrapper Archive Expander (Payload directive) Code (All [anchor expression] (///directive.Operation anchor expression directive [Requirements (Payload directive)])))) @@ -181,26 +181,26 @@ (///generation.set_buffer pre_buffer)) _ (///directive.lifted_generation (///generation.set_registry pre_registry)) - requirements (let [execute! (directiveP.phase expander)] + requirements (let [execute! (directiveP.phase wrapper expander)] (execute! archive code)) post_payload (..get_current_payload pre_payoad)] (in [requirements post_payload]))) -(def: (iteration' archive expander reader source pre_payload) +(def: (iteration' wrapper archive expander reader source pre_payload) (All [directive] - (-> Archive Expander Reader Source (Payload directive) + (-> ///phase.Wrapper Archive Expander Reader Source (Payload directive) (All [anchor expression] (///directive.Operation anchor expression directive [Source Requirements (Payload directive)])))) (do ///phase.monad [[source code] (///directive.lifted_analysis (..read source reader)) - [requirements post_payload] (process_directive archive expander pre_payload code)] + [requirements post_payload] (process_directive wrapper archive expander pre_payload code)] (in [source requirements post_payload]))) -(def: (iteration archive expander module source pre_payload aliases) +(def: (iteration wrapper archive expander module source pre_payload aliases) (All [directive] - (-> Archive Expander Module Source (Payload directive) Aliases + (-> ///phase.Wrapper Archive Expander Module Source (Payload directive) Aliases (All [anchor expression] (///directive.Operation anchor expression directive (Maybe [Source Requirements (Payload directive)]))))) @@ -208,7 +208,7 @@ [reader (///directive.lifted_analysis (..reader module aliases source))] (function (_ state) - (case (///phase.result' state (..iteration' archive expander reader source pre_payload)) + (case (///phase.result' state (..iteration' wrapper archive expander reader source pre_payload)) (#try.Success [state source&requirements&buffer]) (#try.Success [state (#.Some source&requirements&buffer)]) @@ -228,11 +228,11 @@ (-> .Module Aliases) (|>> (value@ #.module_aliases) (dictionary.of_list text.hash))) -(def: .public (compiler expander prelude write_directive) +(def: .public (compiler wrapper expander prelude write_directive) (All [anchor expression directive] - (-> Expander Module (-> directive Binary) + (-> ///phase.Wrapper Expander Module (-> directive Binary) (Instancer (///directive.State+ anchor expression directive) .Module))) - (let [execute! (directiveP.phase expander)] + (let [execute! (directiveP.phase wrapper expander)] (function (_ key parameters input) (let [dependencies (default_dependencies prelude input)] {#///.dependencies dependencies @@ -243,7 +243,7 @@ (..begin dependencies hash input)) .let [module (value@ #///.module input)]] (loop [iteration (<| (///phase.result' state) - (..iteration archive expander module source buffer ///syntax.no_aliases))] + (..iteration wrapper archive expander module source buffer ///syntax.no_aliases))] (do ! [[state ?source&requirements&temporary_payload] iteration] (case ?source&requirements&temporary_payload @@ -284,5 +284,5 @@ (value@ #///directive.referrals) (monad.map ! (execute! archive))) temporary_payload (..get_current_payload temporary_payload)] - (..iteration archive expander module source temporary_payload (..module_aliases analysis_module))))))})])) + (..iteration wrapper archive expander module source temporary_payload (..module_aliases analysis_module))))))})])) )))))})))) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index 1ac28821f..b5eed68f8 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -64,15 +64,12 @@ (with_expansions [<type_vars> (as_is anchor expression directive) <Operation> (as_is ///generation.Operation <type_vars>)] - (type: .public Phase_Wrapper - (All [s i o] (-> (Phase s i o) Any))) - (type: .public (Platform <type_vars>) {#&file_system (file.System Async) #host (///generation.Host expression directive) #phase (///generation.Phase <type_vars>) #runtime (<Operation> [Registry Output]) - #phase_wrapper (-> Archive (<Operation> Phase_Wrapper)) + #phase_wrapper (-> Archive (<Operation> ///phase.Wrapper)) #write (-> directive Binary)}) ... TODO: Get rid of this @@ -197,7 +194,7 @@ (def: (phase_wrapper archive platform state) (All [<type_vars>] - (-> Archive <Platform> <State+> (Try [<State+> Phase_Wrapper]))) + (-> Archive <Platform> <State+> (Try [<State+> ///phase.Wrapper]))) (let [phase_wrapper (value@ #phase_wrapper platform)] (|> archive phase_wrapper @@ -206,8 +203,8 @@ (def: (complete_extensions host_directive_bundle phase_wrapper [analysers synthesizers generators directives]) (All [<type_vars>] - (-> (-> Phase_Wrapper (///directive.Bundle <type_vars>)) - Phase_Wrapper + (-> (-> ///phase.Wrapper (///directive.Bundle <type_vars>)) + ///phase.Wrapper [(Dictionary Text ///analysis.Handler) (Dictionary Text ///synthesis.Handler) (Dictionary Text (///generation.Handler <type_vars>)) @@ -230,11 +227,11 @@ ///analysis.Bundle <Platform> <Bundle> - (-> Phase_Wrapper (///directive.Bundle <type_vars>)) + (-> ///phase.Wrapper (///directive.Bundle <type_vars>)) (Program expression directive) - [Type Type Type] (-> Phase_Wrapper Extender) + [Type Type Type] (-> ///phase.Wrapper Extender) Import (List Context) - (Async (Try [<State+> Archive])))) + (Async (Try [<State+> Archive ///phase.Wrapper])))) (do {! (try.with async.monad)} [.let [state (//init.state (value@ #static.host static) module @@ -247,7 +244,8 @@ [archive analysis_state bundles] (ioW.thaw (value@ #host platform) (value@ #&file_system platform) static import compilation_sources) .let [with_missing_extensions (: (All [<type_vars>] - (-> <Platform> (Program expression directive) <State+> (Async (Try <State+>)))) + (-> <Platform> (Program expression directive) <State+> + (Async (Try [///phase.Wrapper <State+>])))) (function (_ platform program state) (async\in (do try.monad @@ -256,19 +254,20 @@ (initialize_state (extender phase_wrapper) (:expected (..complete_extensions host_directive_bundle phase_wrapper (:expected bundles))) analysis_state) - (try\map (//init.with_default_directives expander host_analysis program anchorT,expressionT,directiveT (extender phase_wrapper))))))))]] + (try\map (|>> (//init.with_default_directives expander host_analysis program anchorT,expressionT,directiveT (extender phase_wrapper)) + [phase_wrapper])))))))]] (if (archive.archived? archive archive.runtime_module) (do ! - [state (with_missing_extensions platform program state)] - (in [state archive])) + [[phase_wrapper state] (with_missing_extensions platform program state)] + (in [state archive phase_wrapper])) (do ! [[state [archive payload]] (|> (..process_runtime archive platform) (///phase.result' state) async\in) _ (..cache_module static platform 0 payload) - state (with_missing_extensions platform program state)] - (in [state archive]))))) + [phase_wrapper state] (with_missing_extensions platform program state)] + (in [state archive phase_wrapper]))))) (def: compilation_log_separator (format text.new_line text.tab)) @@ -523,9 +522,9 @@ try.trusted product.left)) - (def: .public (compile import static expander platform compilation context) + (def: .public (compile phase_wrapper import static expander platform compilation context) (All [<type_vars>] - (-> Import Static Expander <Platform> Compilation <Context> <Return>)) + (-> ///phase.Wrapper Import Static Expander <Platform> Compilation <Context> <Return>)) (let [[compilation_sources compilation_host_dependencies compilation_libraries compilation_target compilation_module] compilation base_compiler (:sharing [<type_vars>] <Context> @@ -533,7 +532,7 @@ (///.Compiler <State+> .Module Any) (:expected - ((//init.compiler expander syntax.prelude (value@ #write platform)) $.key (list)))) + ((//init.compiler phase_wrapper expander syntax.prelude (value@ #write platform)) $.key (list)))) compiler (..parallel context (function (_ importer import! module_id [archive state] module) 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 aefd908c4..45216a70f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux @@ -553,4 +553,5 @@ #.seed 0 #.scope_type_vars (list) #.extensions [] + #.eval (:as (-> Type Code (Meta Any)) []) #.host []}) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux index 1859802d6..8bba841e2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux @@ -27,7 +27,7 @@ [descriptor (#+ Module)]]]]]]]]) (type: .public Eval - (-> Archive Nat Type Code (Operation Any))) + (-> Archive Type Code (Operation Any))) (def: (context [module_id artifact_id]) (-> Context Context) @@ -42,12 +42,14 @@ (generation.Phase anchor expression artifact) Eval)) (let [analyze (analysisP.phase expander)] - (function (eval archive count type exprC) + (function (eval archive type exprC) (do phase.monad [exprA (type.with_type type (analyze archive exprC)) module (extensionP.lifted - meta.current_module_name)] + meta.current_module_name) + count (extensionP.lifted + meta.seed)] (phase.lifted (do try.monad [exprS (|> exprA (synthesisP.phase archive) (phase.result synthesis_state))] (phase.result generation_state diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux index ee12a8bf0..c8cfe9c0e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux @@ -124,10 +124,10 @@ (compile archive expansion)) _ - (/function.on compile argsC+ functionT functionA archive functionC))) + (/function.apply compile argsC+ functionT functionA archive functionC))) _ - (/function.on compile argsC+ functionT functionA archive functionC))) + (/function.apply compile argsC+ functionT functionA archive functionC))) _ (//.except ..unrecognized_syntax [location.dummy code']))) 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 b3642f5f3..fc7575260 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 @@ -84,7 +84,7 @@ (#.Var id) (do ///.monad [?caseT' (//type.with_env - (check.read id))] + (check.read' id))] (.case ?caseT' (#.Some caseT') (recur envs caseT') @@ -110,7 +110,7 @@ (do ///.monad [funcT' (//type.with_env (do check.monad - [?funct' (check.read funcT_id)] + [?funct' (check.read' funcT_id)] (.case ?funct' (#.Some funct') (in funct') diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux index 69e75f374..8aa2f284f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -71,7 +71,7 @@ (#.Var id) (do ! [?expectedT' (//type.with_env - (check.read id))] + (check.read' id))] (case ?expectedT' (#.Some expectedT') (recur expectedT') @@ -85,8 +85,7 @@ functionA (recur functionT) _ (//type.with_env (check.check expectedT functionT))] - (in functionA)) - )) + (in functionA)))) (#.Function inputT outputT) (<| (\ ! map (.function (_ [scope bodyA]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux index 0420b7811..452bf6bc1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -166,7 +166,8 @@ (#.Var infer_id) (do ///.monad - [?inferT' (//type.with_env (check.read infer_id))] + [?inferT' (//type.with_env + (check.read' infer_id))] (case ?inferT' (#.Some inferT') (general archive analyse inferT' args) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux index fe296c83e..886ffe065 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -119,7 +119,7 @@ (#.Var id) (do ! [?expectedT' (//type.with_env - (check.read id))] + (check.read' id))] (case ?expectedT' (#.Some expectedT') (//type.with_type expectedT' @@ -144,7 +144,8 @@ (case funT (#.Var funT_id) (do ! - [?funT' (//type.with_env (check.read funT_id))] + [?funT' (//type.with_env + (check.read' funT_id))] (case ?funT' (#.Some funT') (//type.with_type (#.Apply inputT funT') @@ -208,7 +209,7 @@ (#.Var id) (do ! [?expectedT' (//type.with_env - (check.read id))] + (check.read' id))] (case ?expectedT' (#.Some expectedT') (//type.with_type expectedT' @@ -237,7 +238,8 @@ (case funT (#.Var funT_id) (do ! - [?funT' (//type.with_env (check.read funT_id))] + [?funT' (//type.with_env + (check.read' funT_id))] (case ?funT' (#.Some funT') (//type.with_type (#.Apply inputT funT') diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux index cc34e04cf..3c6425da3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux @@ -1,16 +1,17 @@ (.module: [library [lux #* + ["." meta] [abstract ["." monad (#+ do)]] [control + ["." try] ["." exception (#+ exception:)]] [data [text ["%" format (#+ format)]] [collection - ["." list ("#\." fold monoid)]]] - ["." meta]]] + ["." list ("#\." fold monoid)]]]]] ["." // #_ ["#." extension] ["#." analysis @@ -18,11 +19,14 @@ ["/#" // #_ ["/" directive (#+ Phase)] ["#." analysis + ["." evaluation] ["#/." macro (#+ Expander)]] [/// ["//" phase] [reference (#+) - [variable (#+)]]]]]) + [variable (#+)]] + [meta + [archive (#+ Archive)]]]]]) (exception: .public (not_a_directive {code Code}) (exception.report @@ -36,44 +40,68 @@ (exception.report ["Name" (%.name name)])) +(type: Eval + (-> Type Code (Meta Any))) + +(def: (meta_eval archive bundle compiler_eval) + (-> Archive ///analysis.Bundle evaluation.Eval + Eval) + (function (_ type code lux) + (case (compiler_eval archive type code [bundle lux]) + (#try.Success [[_bundle lux'] value]) + (#try.Success [lux' value]) + + (#try.Failure error) + (#try.Failure error)))) + (with_expansions [<lux_def_module> (as_is [|form_location| (#.Form (list& [|text_location| (#.Text "lux def module")] annotations))])] - (def: .public (phase expander) - (-> Expander Phase) - (let [analyze (//analysis.phase expander)] + (def: .public (phase wrapper expander) + (-> //.Wrapper Expander Phase) + (let [analysis (//analysis.phase expander)] (function (recur archive code) - (case code - (^ [_ (#.Form (list& [_ (#.Text name)] inputs))]) - (//extension.apply archive recur [name inputs]) + (do {! //.monad} + [state //.get_state + .let [compiler_eval (meta_eval archive + (value@ [#//extension.state #/.analysis #/.state #//extension.bundle] state) + (evaluation.evaluator expander + (value@ [#//extension.state #/.synthesis #/.state] state) + (value@ [#//extension.state #/.generation #/.state] state) + (value@ [#//extension.state #/.generation #/.phase] state))) + extension_eval (:as Eval (wrapper (:expected compiler_eval)))] + _ (//.set_state (with@ [#//extension.state #/.analysis #/.state #//extension.state #.eval] extension_eval state))] + (case code + (^ [_ (#.Form (list& [_ (#.Text name)] inputs))]) + (//extension.apply archive recur [name inputs]) - (^ [_ (#.Form (list& macro inputs))]) - (do {! //.monad} - [expansion (/.lifted_analysis - (do ! - [macroA (//analysis/type.with_type Macro - (analyze archive macro))] - (case macroA - (^ (///analysis.constant macro_name)) - (do ! - [?macro (//extension.lifted (meta.macro macro_name)) - macro (case ?macro - (#.Some macro) - (in macro) - - #.None - (//.except ..macro_was_not_found macro_name))] - (//extension.lifted (///analysis/macro.expand expander macro_name macro inputs))) - - _ - (//.except ..invalid_macro_call code))))] - (case expansion - (^ (list& <lux_def_module> referrals)) - (|> (recur archive <lux_def_module>) - (\ ! map (revised@ #/.referrals (list\compose referrals)))) + (^ [_ (#.Form (list& macro inputs))]) + (do ! + [expansion (/.lifted_analysis + (do ! + [macroA (//analysis/type.with_type Macro + (analysis archive macro))] + (case macroA + (^ (///analysis.constant macro_name)) + (do ! + [?macro (//extension.lifted (meta.macro macro_name)) + macro (case ?macro + (#.Some macro) + (in macro) + + #.None + (//.except ..macro_was_not_found macro_name))] + (//extension.lifted (///analysis/macro.expand expander macro_name macro inputs))) + + _ + (//.except ..invalid_macro_call code))))] + (case expansion + (^ (list& <lux_def_module> referrals)) + (|> (recur archive <lux_def_module>) + (\ ! map (revised@ #/.referrals (list\compose referrals)))) - _ - (|> expansion - (monad.map ! (recur archive)) - (\ ! map (list\fold /.merge_requirements /.no_requirements))))) + _ + (|> expansion + (monad.map ! (recur archive)) + (\ ! map (list\fold /.merge_requirements /.no_requirements))))) - _ - (//.except ..not_a_directive code)))))) + _ + (//.except ..not_a_directive code))))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index d26820e9a..e56a48572 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -164,9 +164,8 @@ (case args (^ (list typeC valueC)) (do {! ////.monad} - [seed (///.lifted meta.seed) - actualT (\ ! map (|>> (:as Type)) - (eval archive seed Type typeC)) + [actualT (\ ! map (|>> (:as Type)) + (eval archive Type typeC)) _ (typeA.infer actualT)] (typeA.with_type actualT (analyse archive valueC))) @@ -180,9 +179,8 @@ (case args (^ (list typeC valueC)) (do {! ////.monad} - [seed (///.lifted meta.seed) - actualT (\ ! map (|>> (:as Type)) - (eval archive seed Type typeC)) + [actualT (\ ! map (|>> (:as Type)) + (eval archive Type typeC)) _ (typeA.infer actualT) [valueT valueA] (typeA.with_inference (analyse archive valueC))] @@ -240,7 +238,8 @@ (///bundle.install "error" (unary Text Nothing)) (///bundle.install "exit" (unary Int Nothing))))) -(def: I64* (type (I64 Any))) +(def: I64* + (type (I64 Any))) (def: bundle::i64 Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux index 1e7ca8cc3..f26b13ade 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -34,7 +34,7 @@ (def: arity_arguments (-> Arity (List Synthesis)) - (|>> dec + (|>> -- (enum.range n.enum 1) (list\map (|>> /.variable/local)))) diff --git a/stdlib/source/library/lux/tool/compiler/phase.lux b/stdlib/source/library/lux/tool/compiler/phase.lux index 92680654d..7e137387e 100644 --- a/stdlib/source/library/lux/tool/compiler/phase.lux +++ b/stdlib/source/library/lux/tool/compiler/phase.lux @@ -34,6 +34,9 @@ (type: .public (Phase s i o) (-> Archive i (Operation s o))) +(type: .public Wrapper + (All [s i o] (-> (Phase s i o) Any))) + (def: .public (result' state operation) (All [s o] (-> s (Operation s o) (Try [s o]))) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 7f0e29903..184914216 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -121,10 +121,10 @@ analysis.Bundle (IO (Platform <parameters>)) (generation.Bundle <parameters>) - (-> platform.Phase_Wrapper (directive.Bundle <parameters>)) + (-> phase.Wrapper (directive.Bundle <parameters>)) (Program expression artifact) [Type Type Type] - (-> platform.Phase_Wrapper Extender) + (-> phase.Wrapper Extender) Service [Packager file.Path] (Async Any))) @@ -137,20 +137,21 @@ (do (try.with async.monad) [.let [[compilation_sources compilation_host_dependencies compilation_libraries compilation_target compilation_module] compilation] import (/import.import (value@ #platform.&file_system platform) compilation_libraries) - [state archive] (:sharing [<parameters>] - (Platform <parameters>) - platform - - (Async (Try [(directive.State+ <parameters>) - Archive])) - (:expected (platform.initialize static compilation_module expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender - import compilation_sources))) + [state archive phase_wrapper] (:sharing [<parameters>] + (Platform <parameters>) + platform + + (Async (Try [(directive.State+ <parameters>) + Archive + phase.Wrapper])) + (:expected (platform.initialize static compilation_module expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender + import compilation_sources))) [archive state] (:sharing [<parameters>] (Platform <parameters>) platform (Async (Try [Archive (directive.State+ <parameters>)])) - (:expected (platform.compile import static expander platform compilation [archive state]))) + (:expected (platform.compile phase_wrapper import static expander platform compilation [archive state]))) _ (ioW.freeze (value@ #platform.&file_system platform) static archive) program_context (async\in ($/program.context archive)) host_dependencies (..load_host_dependencies (value@ #platform.&file_system platform) compilation_host_dependencies) diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index 93f2f8530..a335aa996 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -103,6 +103,7 @@ #.seed seed #.scope_type_vars (list) #.extensions [] + #.eval (:as (-> Type Code (Meta Any)) []) #.host []}]))) (def: expander diff --git a/stdlib/source/test/lux/macro/syntax/definition.lux b/stdlib/source/test/lux/macro/syntax/definition.lux index 11074fbc7..e76d65a7b 100644 --- a/stdlib/source/test/lux/macro/syntax/definition.lux +++ b/stdlib/source/test/lux/macro/syntax/definition.lux @@ -51,6 +51,7 @@ #.seed 0 #.scope_type_vars (list) #.extensions [] + #.eval (:as (-> Type Code (Meta Any)) []) #.host []}) (def: .public test @@ -84,12 +85,12 @@ (#try.Success actual) (\ /.equivalence = expected actual)))) - (_.cover [/.lacks_type!] + (_.cover [/.lacks_type] (let [expected (with@ #/.value (#.Right untyped_value) expected)] (case (<code>.result (/.typed compiler) (list (/.format expected))) (#try.Failure error) - (exception.match? /.lacks_type! error) + (exception.match? /.lacks_type error) (#try.Success actual) false))) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index a56457c9c..742523a67 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -65,6 +65,7 @@ #.seed expected_seed #.scope_type_vars (list) #.extensions [] + #.eval (:as (-> Type Code (Meta Any)) []) #.host []}]] ($_ _.and (_.cover [/.result] @@ -112,6 +113,7 @@ #.seed expected_seed #.scope_type_vars (list) #.extensions [] + #.eval (:as (-> Type Code (Meta Any)) []) #.host []}]] ($_ _.and (_.cover [/.failure] @@ -212,6 +214,7 @@ #.seed expected_seed #.scope_type_vars (list) #.extensions [] + #.eval (:as (-> Type Code (Meta Any)) []) #.host []}]] (<| (_.for [.Module]) ($_ _.and @@ -310,6 +313,7 @@ #.seed expected_seed #.scope_type_vars (list) #.extensions [] + #.eval (:as (-> Type Code (Meta Any)) []) #.host []}]] ($_ _.and (_.cover [/.seed] @@ -401,6 +405,7 @@ #.seed 0 #.scope_type_vars (list) #.extensions [] + #.eval (:as (-> Type Code (Meta Any)) []) #.host []}])))]] ($_ _.and (_.cover [.Global .Alias /.globals] @@ -522,6 +527,7 @@ #.seed 0 #.scope_type_vars (list) #.extensions [] + #.eval (:as (-> Type Code (Meta Any)) []) #.host []}])))]] ($_ _.and (_.cover [/.export] @@ -703,6 +709,7 @@ #.seed 0 #.scope_type_vars (list) #.extensions [] + #.eval (:as (-> Type Code (Meta Any)) []) #.host []})]] ($_ _.and (_.cover [/.tag_lists] @@ -812,6 +819,7 @@ #.seed 0 #.scope_type_vars (list) #.extensions [] + #.eval (:as (-> Type Code (Meta Any)) []) #.host []})]] ($_ _.and (_.cover [.Scope /.locals] @@ -918,6 +926,7 @@ #.seed expected_seed #.scope_type_vars (list) #.extensions [] + #.eval (:as (-> Type Code (Meta Any)) []) #.host []}]] ($_ _.and (_.for [/.functor] |