aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--documentation/bookmark/architecture.md1
-rw-r--r--documentation/bookmark/assurance.md5
-rw-r--r--documentation/bookmark/business/management.md2
-rw-r--r--documentation/bookmark/concurrency/asynchronous.md5
-rw-r--r--documentation/bookmark/concurrency/lock.md5
-rw-r--r--documentation/bookmark/database/distributed.md5
-rw-r--r--documentation/bookmark/design.md5
-rw-r--r--documentation/bookmark/documentation.md1
-rw-r--r--documentation/bookmark/food.md2
-rw-r--r--documentation/bookmark/math/arithmetic.md7
-rw-r--r--documentation/bookmark/math/philosophy.md5
-rw-r--r--documentation/bookmark/media/content.md5
-rw-r--r--documentation/bookmark/open_source/funding.md2
-rw-r--r--documentation/bookmark/paradigm/logic_programming.md10
-rw-r--r--documentation/bookmark/programming_language/design.md5
-rw-r--r--documentation/bookmark/software/design.md5
-rw-r--r--documentation/bookmark/software/engineering/negative.md (renamed from documentation/bookmark/software_engineering/negative.md)0
-rw-r--r--documentation/bookmark/software/engineering/practice.md (renamed from documentation/bookmark/software_engineering/practice.md)0
-rw-r--r--documentation/bookmark/tool/text_editor/emacs.md5
-rw-r--r--documentation/bookmark/user_interface/animation.md2
-rw-r--r--documentation/bookmark/water.md5
-rw-r--r--documentation/bookmark/web_framework.md16
-rw-r--r--stdlib/source/library/lux/control/parser.lux5
-rw-r--r--stdlib/source/library/lux/data/text.lux12
-rw-r--r--stdlib/source/library/lux/math/number/frac.lux52
-rw-r--r--stdlib/source/library/lux/math/number/int.lux25
-rw-r--r--stdlib/source/library/lux/math/number/nat.lux61
-rw-r--r--stdlib/source/library/lux/meta.lux106
-rw-r--r--stdlib/source/library/lux/meta/code.lux155
-rw-r--r--stdlib/source/library/lux/meta/macro/context.lux3
-rw-r--r--stdlib/source/library/lux/meta/macro/custom.lux53
-rw-r--r--stdlib/source/library/lux/meta/macro/syntax/export.lux39
-rw-r--r--stdlib/source/library/lux/meta/type.lux519
-rw-r--r--stdlib/source/library/lux/meta/type/primitive.lux1
34 files changed, 664 insertions, 465 deletions
diff --git a/documentation/bookmark/architecture.md b/documentation/bookmark/architecture.md
index 13cee1b37..9ae72001f 100644
--- a/documentation/bookmark/architecture.md
+++ b/documentation/bookmark/architecture.md
@@ -1,6 +1,7 @@
# Reference
0. []()
+0. [How to plan the architectural attributes?](https://kalali.blog/2022/06/software-architecture-attributes-how-to-decide/)
0. [Architectural Decision Records](https://adr.github.io/)
0. [Why You Should Care about Software Architecture](https://www.infoq.com/articles/care-about-architecture/)
0. [Software Architecture: It Might Not Be What You Think It Is](https://www.infoq.com/articles/what-software-architecture/)
diff --git a/documentation/bookmark/assurance.md b/documentation/bookmark/assurance.md
new file mode 100644
index 000000000..841b072b6
--- /dev/null
+++ b/documentation/bookmark/assurance.md
@@ -0,0 +1,5 @@
+# Reference
+
+0. []()
+0. [High Assurance Rust: Developing Secure and Robust Software](https://highassurance.rs/landing.html)
+
diff --git a/documentation/bookmark/business/management.md b/documentation/bookmark/business/management.md
index 0e5dd29eb..f6ce4e385 100644
--- a/documentation/bookmark/business/management.md
+++ b/documentation/bookmark/business/management.md
@@ -1,6 +1,8 @@
# Reference
0. []()
+0. [Monitoring Employees Makes Them More Likely to Break Rules](https://hbr.org/2022/06/monitoring-employees-makes-them-more-likely-to-break-rules)
+0. [Why criticism lasts longer than praise](https://www.bbc.com/future/article/20220624-why-criticism-lasts-longer-than-praise)
0. [What Engineering Managers Should Do (and Why We Don’t) • Lena Reinhard • GOTO 2019](https://www.youtube.com/watch?v=Q_bJVokYLRI)
0. [Effective project management in 10 simple steps](https://www.cenizal.com/ten-rules-of-project-management/)
0. [When Everything is Important But Nothing is Getting Done](https://sharedphysics.com/everything-is-important/)
diff --git a/documentation/bookmark/concurrency/asynchronous.md b/documentation/bookmark/concurrency/asynchronous.md
new file mode 100644
index 000000000..7a42a589f
--- /dev/null
+++ b/documentation/bookmark/concurrency/asynchronous.md
@@ -0,0 +1,5 @@
+# Reference
+
+0. []()
+0. [The Internals of Asynchronous Programming](https://betterprogramming.pub/asynchronous-programming-8aaae83cd9f3)
+
diff --git a/documentation/bookmark/concurrency/lock.md b/documentation/bookmark/concurrency/lock.md
new file mode 100644
index 000000000..61bf88f16
--- /dev/null
+++ b/documentation/bookmark/concurrency/lock.md
@@ -0,0 +1,5 @@
+# Reference
+
+0. []()
+0. [Deadlock-free Mutexes and Directed Acyclic Graphs](https://bertptrs.nl/2022/06/23/deadlock-free-mutexes-and-directed-acyclic-graphs.html)
+
diff --git a/documentation/bookmark/database/distributed.md b/documentation/bookmark/database/distributed.md
new file mode 100644
index 000000000..32746c2dd
--- /dev/null
+++ b/documentation/bookmark/database/distributed.md
@@ -0,0 +1,5 @@
+# Reference
+
+0. []()
+0. [Let's Remix Distributed Database Design!](https://www.youtube.com/watch?v=rNmZZLant9o)
+
diff --git a/documentation/bookmark/design.md b/documentation/bookmark/design.md
new file mode 100644
index 000000000..2d52d7454
--- /dev/null
+++ b/documentation/bookmark/design.md
@@ -0,0 +1,5 @@
+# Reference
+
+0. []()
+0. [Banner blindness](https://en.wikipedia.org/wiki/Banner_blindness)
+
diff --git a/documentation/bookmark/documentation.md b/documentation/bookmark/documentation.md
index ab65452ba..414242336 100644
--- a/documentation/bookmark/documentation.md
+++ b/documentation/bookmark/documentation.md
@@ -53,6 +53,7 @@
# README
0. []()
+0. [writing one sentence per line](https://sive.rs/1s)
0. https://github.com/LappleApple/feedmereadmes
# Doclet
diff --git a/documentation/bookmark/food.md b/documentation/bookmark/food.md
index d23173ebc..353474be8 100644
--- a/documentation/bookmark/food.md
+++ b/documentation/bookmark/food.md
@@ -1,4 +1,6 @@
# Reference
+0. []()
+0. [Remilk](https://www.remilk.com/)
0. [Squareat](https://squareat.com/)
diff --git a/documentation/bookmark/math/arithmetic.md b/documentation/bookmark/math/arithmetic.md
index 93e4a97ee..8959f3a51 100644
--- a/documentation/bookmark/math/arithmetic.md
+++ b/documentation/bookmark/math/arithmetic.md
@@ -1,12 +1,19 @@
# Saturation
+0. []()
0. [Saturation arithmetic](https://en.wikipedia.org/wiki/Saturation_arithmetic)
# Interval
+0. []()
0. [Interval Arithmetic: Not All Intervals are Created Equal](https://samlikes.pizza/pluto_interval_blog.jl.html)
0. [Growing a Language, by Guy Steele](https://www.youtube.com/watch?v=_ahvzDzKdB0&t=2214s)
0. [Yet another alternative to floating-point numbers](https://wordsandbuttons.online/yet_another_alternative_to_floating_point_numbers.html)
0. [Interval arithmetic](https://en.wikipedia.org/wiki/Interval_arithmetic)
0. [How do you compute the midpoint of an interval?](https://hal.archives-ouvertes.fr/file/index/docid/576641/filename/computing-midpoint.pdf)
+# Reference
+
+0. []()
+0. [Wheel theory](https://en.wikipedia.org/wiki/Wheel_theory)
+
diff --git a/documentation/bookmark/math/philosophy.md b/documentation/bookmark/math/philosophy.md
new file mode 100644
index 000000000..e3be3ac0c
--- /dev/null
+++ b/documentation/bookmark/math/philosophy.md
@@ -0,0 +1,5 @@
+# Reference
+
+0. []()
+0. [What is the point of formalising mathematics?](https://lawrencecpaulson.github.io/2022/06/22/Why-formalise.html)
+
diff --git a/documentation/bookmark/media/content.md b/documentation/bookmark/media/content.md
new file mode 100644
index 000000000..70a3f635a
--- /dev/null
+++ b/documentation/bookmark/media/content.md
@@ -0,0 +1,5 @@
+# Reference
+
+0. []()
+0. [Content](https://mitpress.mit.edu/books/content)
+
diff --git a/documentation/bookmark/open_source/funding.md b/documentation/bookmark/open_source/funding.md
index 877dbd6aa..fdb2802e7 100644
--- a/documentation/bookmark/open_source/funding.md
+++ b/documentation/bookmark/open_source/funding.md
@@ -1,5 +1,7 @@
# Reference
0. []()
+0. [Comradery](https://comradery.co/)
+ 0. [Comradery is developing a cooperative way to get paid online: A more democratic take on the Patreon model](https://www.theverge.com/23060001/comradery-coop-crowdfunding-patreon)
0. [Fund OSS through package managers](https://dusted.codes/fund-oss-through-package-managers)
diff --git a/documentation/bookmark/paradigm/logic_programming.md b/documentation/bookmark/paradigm/logic_programming.md
index 9cb7df2e6..64629d311 100644
--- a/documentation/bookmark/paradigm/logic_programming.md
+++ b/documentation/bookmark/paradigm/logic_programming.md
@@ -1,17 +1,22 @@
# Concurrent Logic Programming
+0. []()
0. [The Joy of Concurrent Logic Programming](http://www.call-with-current-continuation.org/articles/the-joy-of-concurrent-logic-programming.txt)
# Unification
+0. []()
0. [Functors of the World, Unite!](https://www.youtube.com/watch?v=8k7YH9st_8U)
# Inspiration
+0. []()
0. [Next-Paradigm Programming Languages: What Will They Look Like and What Changes Will They Bring?](https://arxiv.org/abs/1905.00402)
# Reference
+0. []()
+0. [Symbolic artificial intelligence at Pipedrive](https://medium.com/pipedrive-engineering/symbolic-artificial-intelligence-at-pipedrive-a9bd36d06b9e)
0. [PrologHub](https://prologhub.com/)
0. https://book.simply-logical.space/
0. [Higher-Order Logic Programming](https://www.lix.polytechnique.fr/~dale/papers/Handbook_Logic_AI_LP.pdf)
@@ -42,6 +47,7 @@
# Language
+0. []()
0. [A Gentle Introduction to MicroKanren](https://erik-j.de/microkanren/)
0. [Curry: A Truly Integrated Functional Logic Language](https://www-ps.informatik.uni-kiel.de/currywiki/)
0. https://flix.github.io/
@@ -54,18 +60,22 @@
# Beyond logic programming
+0. []()
0. https://github.com/Web-Prolog/swi-web-prolog
# Constraint Logic Programming
+0. []()
0. http://www.pathwayslms.com/swipltuts/clpfd/clpfd.html
0. https://stackabuse.com/constraint-programming-with-python-constraint/
# Constraint Handling Rules
+0. []()
0. http://chrjs.net/
# Answer Set Programming
+0. []()
0. [What Is Answer Set Programming?](https://www.cs.utexas.edu/users/vl/papers/wiasp.pdf)
diff --git a/documentation/bookmark/programming_language/design.md b/documentation/bookmark/programming_language/design.md
new file mode 100644
index 000000000..3957c22ac
--- /dev/null
+++ b/documentation/bookmark/programming_language/design.md
@@ -0,0 +1,5 @@
+# Reference
+
+0. []()
+0. [Computer Science - Brian Kernighan on successful language design](https://www.youtube.com/watch?v=Sg4U4r_AgJU)
+
diff --git a/documentation/bookmark/software/design.md b/documentation/bookmark/software/design.md
new file mode 100644
index 000000000..6e16e07bd
--- /dev/null
+++ b/documentation/bookmark/software/design.md
@@ -0,0 +1,5 @@
+# Reference
+
+0. []()
+0. [A Compendium of Software Design](https://software-design.matteoditucci.com/)
+
diff --git a/documentation/bookmark/software_engineering/negative.md b/documentation/bookmark/software/engineering/negative.md
index fa6581c9b..fa6581c9b 100644
--- a/documentation/bookmark/software_engineering/negative.md
+++ b/documentation/bookmark/software/engineering/negative.md
diff --git a/documentation/bookmark/software_engineering/practice.md b/documentation/bookmark/software/engineering/practice.md
index bedcd49f3..bedcd49f3 100644
--- a/documentation/bookmark/software_engineering/practice.md
+++ b/documentation/bookmark/software/engineering/practice.md
diff --git a/documentation/bookmark/tool/text_editor/emacs.md b/documentation/bookmark/tool/text_editor/emacs.md
new file mode 100644
index 000000000..7d25adea7
--- /dev/null
+++ b/documentation/bookmark/tool/text_editor/emacs.md
@@ -0,0 +1,5 @@
+# Reference
+
+0. []()
+0. [straight.el: next-generation, purely functional package manager for the Emacs hacker.](https://github.com/radian-software/straight.el)
+
diff --git a/documentation/bookmark/user_interface/animation.md b/documentation/bookmark/user_interface/animation.md
index b0f47f6b9..7bbdca51c 100644
--- a/documentation/bookmark/user_interface/animation.md
+++ b/documentation/bookmark/user_interface/animation.md
@@ -1,5 +1,7 @@
# Reference
+0. []()
+0. [How to animate multiplayer cursors](https://liveblocks.io/blog/how-to-animate-multiplayer-cursors)
0. [Lottie](https://lottiefiles.com/what-is-lottie)
0. https://easings.net/
diff --git a/documentation/bookmark/water.md b/documentation/bookmark/water.md
new file mode 100644
index 000000000..5882e0530
--- /dev/null
+++ b/documentation/bookmark/water.md
@@ -0,0 +1,5 @@
+# Reference
+
+0. []()
+0. [Air well (condenser)](https://en.wikipedia.org/wiki/Air_well_(condenser))
+
diff --git a/documentation/bookmark/web_framework.md b/documentation/bookmark/web_framework.md
index 87623c576..08b1aacd0 100644
--- a/documentation/bookmark/web_framework.md
+++ b/documentation/bookmark/web_framework.md
@@ -1,19 +1,27 @@
# State
+0. []()
0. [Jotai: Primitive and flexible state management for React](https://jotai.org/)
# Virtual DOM
+0. []()
0. [Virtual DOM is pure overhead](https://svelte.dev/blog/virtual-dom-is-pure-overhead)
0. [million: <1kb virtual DOM - it's fast!](https://million.js.org/)
0. [Optimal Virtual DOM](https://blog.kabir.sh/posts/optimal-virtual-dom.html)
# Input
+0. []()
0. [High-performance input handling on the web](https://nolanlawson.com/2019/08/11/high-performance-input-handling-on-the-web/)
# Reference
+0. []()
+0. [UIs Are Not Pure Functions of the Model - React.js and Cocoa Side by Side](https://blog.metaobject.com/2018/12/uis-are-not-pure-functions-of-model.html)
+0. [UIs are streaming DAGs](https://hyperfiddle.notion.site/UIs-are-streaming-DAGs-e181461681a8452bb9c7a9f10f507991)
+0. [You Might Not Need an Effect](https://beta-reactjs-org-git-you-might-not-fbopensource.vercel.app/learn/you-might-not-need-an-effect)
+0. [Concepts of React Rendering](https://blog.boringdev.io/concepts-of-react-rendering)
0. [You can't capture the nuance of my form fields](https://drewdevault.com/2021/06/27/You-cant-capture-the-nuance.html)
0. [Line-tracking using plain CSS](https://bubblin.io/blog/line-tracking)
0. [Redux is half of a pattern (1/2)](https://dev.to/davidkpiano/redux-is-half-of-a-pattern-1-2-1hd7)
@@ -32,6 +40,7 @@
# Exemplar
+0. []()
0. [Voby](https://github.com/vobyjs/voby)
0. ["Janus: Easy Complex UI with Declarative FRP" by Issa Tseng](https://www.youtube.com/watch?v=7S57O3VwIyQ)
0. https://github.com/alpinejs/alpine
@@ -110,21 +119,25 @@
# Architecture
+0. []()
0. https://jew.ski/raj/
0. https://github.com/redux-saga/redux-saga
# Platforms
+0. []()
0. https://www.producthunt.com/posts/mason
# State-management
+0. []()
0. [Some re-frame patterns for composability](https://vvvvalvalval.github.io/posts/some-re-frame-patterns-for-composability.html)
0. https://github.com/keajs/kea
0. https://github.com/isocroft/Radixx
# Styling
+0. []()
0. [CSS Protips](https://github.com/AllThingsSmitty/css-protips)
0. [Layout-isolated components](https://visly.app/blog/layout-isolated-components)
0. [Centering in CSS: A Complete Guide](https://css-tricks.com/centering-css-complete-guide/)
@@ -155,10 +168,12 @@
# Design system
+0. []()
0. https://ant.design/
# Rendering
+0. []()
0. [The Virtual DOM is slow. Meet the Memoized DOM](https://www.freecodecamp.org/news/the-virtual-dom-is-slow-meet-the-memoized-dom-bb19f546cc52/)
0. [Incrementally Improving The DOM](https://blog.functorial.com/posts/2018-04-08-Incrementally-Improving-The-DOM.html)
0. https://medium.com/@ryansolid/the-fastest-way-to-render-the-dom-e3b226b15ca3
@@ -168,6 +183,7 @@
# Database query
+0. []()
0. http://slick.lightbend.com/docs/
0. https://books.underscore.io/essential-slick/essential-slick-3.html
diff --git a/stdlib/source/library/lux/control/parser.lux b/stdlib/source/library/lux/control/parser.lux
index 6b57ce695..d7cf37138 100644
--- a/stdlib/source/library/lux/control/parser.lux
+++ b/stdlib/source/library/lux/control/parser.lux
@@ -11,10 +11,7 @@
[data
["[0]" product]
[collection
- ["[0]" list (.use "[1]#[0]" functor monoid)]]]
- [math
- [number
- ["n" nat]]]]])
+ ["[0]" list (.use "[1]#[0]" functor monoid)]]]]])
(type .public (Parser s a)
(-> s (Try [s a])))
diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux
index 8b0547523..e9fa52957 100644
--- a/stdlib/source/library/lux/data/text.lux
+++ b/stdlib/source/library/lux/data/text.lux
@@ -18,9 +18,7 @@
["n" nat]
["[0]" i64]]]
[meta
- ["@" target]
- [macro
- ["^" pattern]]]]])
+ ["@" target]]]])
(type .public Char
Nat)
@@ -316,7 +314,7 @@
(def .public together
(-> (List Text) Text)
- (let [(^.open "[0]") ..monoid]
+ (with ..monoid
(|>> list.reversed
(list#mix composite identity))))
@@ -339,7 +337,8 @@
(def .public (space? char)
(-> Char Bit)
(with_expansions [<options> (with_template [<char>]
- [(.char (,, (static <char>)))]
+ [(.char (,, (static <char>)))
+ true]
[..tab]
[..vertical_tab]
@@ -349,8 +348,7 @@
[..form_feed]
)]
(`` (case char
- (^.or <options>)
- true
+ <options>
_
false))))
diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux
index fb2f1b85f..a11b95741 100644
--- a/stdlib/source/library/lux/math/number/frac.lux
+++ b/stdlib/source/library/lux/math/number/frac.lux
@@ -16,9 +16,7 @@
[data
["[0]" text]]
[meta
- ["@" target]
- [macro
- ["^" pattern]]]]]
+ ["@" target]]]]
["[0]" //
["[1][0]" i64]
["[1][0]" nat]
@@ -754,29 +752,31 @@
(..* exponent)
(..* sign)))))
-(def (representation_exponent codec representation)
- (-> (Codec Text Nat) Text (Try [Text Int]))
- (case [("lux text index" 0 "e+" representation)
- ("lux text index" 0 "E+" representation)
- ("lux text index" 0 "e-" representation)
- ("lux text index" 0 "E-" representation)]
- (^.with_template [<factor> <patterns>]
- [<patterns>
- (do try.monad
- [.let [after_offset (//nat.+ 2 split_index)
- after_length (//nat.- after_offset ("lux text size" representation))]
- exponent (|> representation
- ("lux text clip" after_offset after_length)
- (at codec decoded))]
- (in [("lux text clip" 0 split_index representation)
- (//int.* <factor> (.int exponent))]))])
- ([+1 (^.or [{.#Some split_index} {.#None} {.#None} {.#None}]
- [{.#None} {.#Some split_index} {.#None} {.#None}])]
- [-1 (^.or [{.#None} {.#None} {.#Some split_index} {.#None}]
- [{.#None} {.#None} {.#None} {.#Some split_index}])])
-
- _
- {try.#Success [representation +0]}))
+(`` (def (representation_exponent codec representation)
+ (-> (Codec Text Nat) Text (Try [Text Int]))
+ (case [("lux text index" 0 "e+" representation)
+ ("lux text index" 0 "E+" representation)
+ ("lux text index" 0 "e-" representation)
+ ("lux text index" 0 "E-" representation)]
+ (,, (with_template [<factor> <pattern>]
+ [<pattern>
+ (do try.monad
+ [.let [after_offset (//nat.+ 2 split_index)
+ after_length (//nat.- after_offset ("lux text size" representation))]
+ exponent (|> representation
+ ("lux text clip" after_offset after_length)
+ (at codec decoded))]
+ (in [("lux text clip" 0 split_index representation)
+ (//int.* <factor> (.int exponent))]))]
+
+ [+1 [{.#Some split_index} {.#None} {.#None} {.#None}]]
+ [+1 [{.#None} {.#Some split_index} {.#None} {.#None}]]
+
+ [-1 [{.#None} {.#None} {.#Some split_index} {.#None}]]
+ [-1 [{.#None} {.#None} {.#None} {.#Some split_index}]]))
+
+ _
+ {try.#Success [representation +0]})))
(with_template [<struct> <nat> <int> <error>]
[(def .public <struct>
diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux
index 3eb21d465..d5a563dd5 100644
--- a/stdlib/source/library/lux/math/number/int.lux
+++ b/stdlib/source/library/lux/math/number/int.lux
@@ -15,10 +15,7 @@
[function
[predicate (.only Predicate)]]]
[data
- [text (.only Char)]]
- [meta
- [macro
- ["^" pattern]]]]]
+ [text (.only Char)]]]]
["[0]" //
["[1][0]" nat]
["[1][0]" i64]])
@@ -147,14 +144,18 @@
b1 (- (* q b1) a1))))))
... https://en.wikipedia.org/wiki/Least_common_multiple
-(def .public (lcm a b)
- (-> Int Int Int)
- (case [a b]
- (^.or [_ +0] [+0 _])
- +0
-
- _
- (|> a (/ (gcd a b)) (* b))))
+(`` (def .public (lcm a b)
+ (-> Int Int Int)
+ (case [a b]
+ (,, (with_template [<pattern>]
+ [<pattern>
+ +0]
+
+ [[_ +0]]
+ [[+0 _]]))
+
+ _
+ (|> a (/ (gcd a b)) (* b)))))
(def .public frac
(-> Int Frac)
diff --git a/stdlib/source/library/lux/math/number/nat.lux b/stdlib/source/library/lux/math/number/nat.lux
index 75bf0fe2b..c502f4d96 100644
--- a/stdlib/source/library/lux/math/number/nat.lux
+++ b/stdlib/source/library/lux/math/number/nat.lux
@@ -12,10 +12,7 @@
[control
["[0]" function]
["[0]" maybe]
- ["[0]" try (.only Try)]]
- [meta
- [macro
- ["^" pattern]]]]])
+ ["[0]" try (.only Try)]]]])
(with_template [<extension> <output> <name>]
[(def .public (<name> parameter subject)
@@ -122,14 +119,18 @@
(-> Nat Nat Bit)
(..= 1 (..gcd a b)))
-(def .public (lcm a b)
- (-> Nat Nat Nat)
- (case [a b]
- (^.or [_ 0] [0 _])
- 0
+(`` (def .public (lcm a b)
+ (-> Nat Nat Nat)
+ (case [a b]
+ (,, (with_template [<pattern>]
+ [<pattern>
+ 0]
+
+ [[_ 0]]
+ [[0 _]]))
- _
- (|> a (../ (..gcd a b)) (..* b))))
+ _
+ (|> a (../ (..gcd a b)) (..* b)))))
(def .public even?
(-> Nat Bit)
@@ -272,22 +273,28 @@
15 "F"
_ (undefined)))
-(def (hexadecimal_value digit)
- (-> Nat (Maybe Nat))
- (case digit
- (^.with_template [<character> <number>]
- [(char <character>)
- {.#Some <number>}])
- (["0" 0] ["1" 1] ["2" 2] ["3" 3] ["4" 4]
- ["5" 5] ["6" 6] ["7" 7] ["8" 8] ["9" 9])
-
- (^.with_template [<lower> <upper> <number>]
- [(^.or (char <lower>)
- (char <upper>))
- {.#Some <number>}])
- (["a" "A" 10] ["b" "B" 11] ["c" "C" 12]
- ["d" "D" 13] ["e" "E" 14] ["f" "F" 15])
- _ {.#None}))
+(`` (def (hexadecimal_value digit)
+ (-> Nat (Maybe Nat))
+ (case digit
+ (,, (with_template [<character> <number>]
+ [(char <character>)
+ {.#Some <number>}]
+
+ ["0" 0] ["1" 1] ["2" 2] ["3" 3] ["4" 4]
+ ["5" 5] ["6" 6] ["7" 7] ["8" 8] ["9" 9]))
+
+ (,, (with_template [<lower> <upper> <number>]
+ [(char <lower>)
+ {.#Some <number>}
+
+ (char <upper>)
+ {.#Some <number>}]
+
+ ["a" "A" 10] ["b" "B" 11] ["c" "C" 12]
+ ["d" "D" 13] ["e" "E" 14] ["f" "F" 15]))
+
+ _
+ {.#None})))
(with_template [<shift> <struct> <to_character> <to_value> <error>]
[(def .public <struct>
diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux
index a1bb5d944..54f31901a 100644
--- a/stdlib/source/library/lux/meta.lux
+++ b/stdlib/source/library/lux/meta.lux
@@ -21,9 +21,7 @@
[/
["[0]" location]
["[0]" symbol (.use "[1]#[0]" codec equivalence)]
- ["[0]" code]
- [macro
- ["^" pattern]]])
+ ["[0]" code]])
... (.type (Meta a)
... (-> Lux (Try [Lux a])))
@@ -234,23 +232,27 @@
bound
(type_variable idx bindings'))))
-(def (clean_type type)
- (-> Type (Meta Type))
- (case type
- {.#Var var}
- (function (_ lux)
- (case (|> lux
- (the [.#type_context .#var_bindings])
- (type_variable var))
- (^.or {.#None}
- {.#Some {.#Var _}})
- {try.#Success [lux type]}
+(`` (def (clean_type type)
+ (-> Type (Meta Type))
+ (case type
+ {.#Var var}
+ (function (_ lux)
+ (case (|> lux
+ (the [.#type_context .#var_bindings])
+ (type_variable var))
+ (,, (with_template [<pattern>]
+ [<pattern>
+ {try.#Success [lux type]}]
- {.#Some type'}
- {try.#Success [lux type']}))
+ [{.#None}]
+ [{.#Some {.#Var _}}]))
+
- _
- (at ..monad in type)))
+ {.#Some type'}
+ {try.#Success [lux type']}))
+
+ _
+ (at ..monad in type))))
(def .public (var_type name)
(-> Text (Meta Type))
@@ -324,22 +326,25 @@
(|> module
(the .#definitions)
(list.all (function (_ [def_name global])
- (case global
- (^.or {.#Definition [exported? _]}
- {.#Type [exported? _]})
- (if (and exported?
- (text#= normal_short def_name))
- {.#Some (symbol#encoded [module_name def_name])}
- {.#None})
-
- {.#Alias _}
- {.#None}
-
- {.#Tag _}
- {.#None}
-
- {.#Slot _}
- {.#None}))))))
+ (`` (case global
+ (,, (with_template [<pattern>]
+ [<pattern>
+ (if (and exported?
+ (text#= normal_short def_name))
+ {.#Some (symbol#encoded [module_name def_name])}
+ {.#None})]
+
+ [{.#Definition [exported? _]}]
+ [{.#Type [exported? _]}]))
+
+ {.#Alias _}
+ {.#None}
+
+ {.#Tag _}
+ {.#None}
+
+ {.#Slot _}
+ {.#None})))))))
list.together
(list.sorted text#<)
(text.interposed ..listing_separator))
@@ -500,21 +505,24 @@
[lux]
{try.#Success})))
-(def .public (tags_of type_name)
- (-> Symbol (Meta (Maybe (List Symbol))))
- (do ..monad
- [.let [[module_name name] type_name]
- module (..module module_name)]
- (case (property.value name (the .#definitions module))
- {.#Some {.#Type [exported? type labels]}}
- (case labels
- (^.or {.#Left labels}
- {.#Right labels})
- (in {.#Some (list#each (|>> [module_name])
- {.#Item labels})}))
-
- _
- (in {.#None}))))
+(`` (def .public (tags_of type_name)
+ (-> Symbol (Meta (Maybe (List Symbol))))
+ (do ..monad
+ [.let [[module_name name] type_name]
+ module (..module module_name)]
+ (case (property.value name (the .#definitions module))
+ {.#Some {.#Type [exported? type labels]}}
+ (case labels
+ (,, (with_template [<pattern>]
+ [<pattern>
+ (in {.#Some (list#each (|>> [module_name])
+ {.#Item labels})})]
+
+ [{.#Left labels}]
+ [{.#Right labels}])))
+
+ _
+ (in {.#None})))))
(def .public location
(Meta Location)
diff --git a/stdlib/source/library/lux/meta/code.lux b/stdlib/source/library/lux/meta/code.lux
index c65f613c5..68d5327b1 100644
--- a/stdlib/source/library/lux/meta/code.lux
+++ b/stdlib/source/library/lux/meta/code.lux
@@ -17,9 +17,7 @@
["[0]" frac]]]
[meta
["[0]" location]
- ["[0]" symbol]
- [macro
- ["^" pattern]]]]])
+ ["[0]" symbol]]]])
... (type (Code' w)
... {.#Bit Bit}
@@ -60,76 +58,81 @@
[local .#Symbol])
-(def .public equivalence
- (Equivalence Code)
- (implementation
- (def (= x y)
- (case [x y]
- (^.with_template [<tag> <eq>]
- [[[_ {<tag> x'}] [_ {<tag> y'}]]
- (at <eq> = x' y')])
- ([.#Bit bit.equivalence]
- [.#Nat nat.equivalence]
- [.#Int int.equivalence]
- [.#Rev rev.equivalence]
- [.#Frac frac.equivalence]
- [.#Text text.equivalence]
- [.#Symbol symbol.equivalence])
-
- (^.with_template [<tag>]
- [[[_ {<tag> xs'}] [_ {<tag> ys'}]]
- (at (list.equivalence =) = xs' ys')])
- ([.#Form]
- [.#Variant]
- [.#Tuple])
-
- _
- false))))
-
-(def .public (format ast)
- (-> Code Text)
- (case ast
- (^.with_template [<tag> <struct>]
- [[_ {<tag> value}]
- (at <struct> encoded value)])
- ([.#Bit bit.codec]
- [.#Nat nat.decimal]
- [.#Int int.decimal]
- [.#Rev rev.decimal]
- [.#Frac frac.decimal]
- [.#Symbol symbol.codec])
-
- [_ {.#Text value}]
- (text.format value)
-
- (^.with_template [<tag> <open> <close>]
- [[_ {<tag> members}]
- (all text#composite
- <open>
- (list#mix (function (_ next prev)
- (let [next (format next)]
- (if (text#= "" prev)
- next
- (all text#composite prev " " next))))
- ""
- members)
- <close>)])
- ([.#Form "(" ")"]
- [.#Variant "{" "}"]
- [.#Tuple "[" "]"])
- ))
-
-(def .public (replaced original substitute ast)
- (-> Code Code Code Code)
- (if (at ..equivalence = original ast)
- substitute
- (case ast
- (^.with_template [<tag>]
- [[location {<tag> parts}]
- [location {<tag> (list#each (replaced original substitute) parts)}]])
- ([.#Form]
- [.#Variant]
- [.#Tuple])
-
- _
- ast)))
+(`` (def .public equivalence
+ (Equivalence Code)
+ (implementation
+ (def (= x y)
+ (case [x y]
+ (,, (with_template [<tag> <eq>]
+ [[[_ {<tag> x'}] [_ {<tag> y'}]]
+ (at <eq> = x' y')]
+
+ [.#Bit bit.equivalence]
+ [.#Nat nat.equivalence]
+ [.#Int int.equivalence]
+ [.#Rev rev.equivalence]
+ [.#Frac frac.equivalence]
+ [.#Text text.equivalence]
+ [.#Symbol symbol.equivalence]))
+
+ (,, (with_template [<tag>]
+ [[[_ {<tag> xs'}] [_ {<tag> ys'}]]
+ (at (list.equivalence =) = xs' ys')]
+
+ [.#Form]
+ [.#Variant]
+ [.#Tuple]))
+
+ _
+ false)))))
+
+(`` (def .public (format ast)
+ (-> Code Text)
+ (case ast
+ (,, (with_template [<tag> <struct>]
+ [[_ {<tag> value}]
+ (at <struct> encoded value)]
+
+ [.#Bit bit.codec]
+ [.#Nat nat.decimal]
+ [.#Int int.decimal]
+ [.#Rev rev.decimal]
+ [.#Frac frac.decimal]
+ [.#Symbol symbol.codec]))
+
+ [_ {.#Text value}]
+ (text.format value)
+
+ (,, (with_template [<tag> <open> <close>]
+ [[_ {<tag> members}]
+ (all text#composite
+ <open>
+ (list#mix (function (_ next prev)
+ (let [next (format next)]
+ (if (text#= "" prev)
+ next
+ (all text#composite prev " " next))))
+ ""
+ members)
+ <close>)]
+
+ [.#Form "(" ")"]
+ [.#Variant "{" "}"]
+ [.#Tuple "[" "]"]))
+ )))
+
+(`` (def .public (replaced original substitute ast)
+ (-> Code Code Code Code)
+ (if (at ..equivalence = original ast)
+ substitute
+ (case ast
+ (,, (with_template [<tag>]
+ [[location {<tag> parts}]
+ [location {<tag> (list#each (replaced original substitute) parts)}]]
+
+ [.#Form]
+ [.#Variant]
+ [.#Tuple]))
+
+ _
+ ast))))
diff --git a/stdlib/source/library/lux/meta/macro/context.lux b/stdlib/source/library/lux/meta/macro/context.lux
index 0cf61b454..99b62e8ab 100644
--- a/stdlib/source/library/lux/meta/macro/context.lux
+++ b/stdlib/source/library/lux/meta/macro/context.lux
@@ -19,8 +19,7 @@
["[0]" code (.only)
["?[1]" \\parser]]]]]
["[0]" // (.only)
- [syntax (.only syntax)]
- ["^" pattern]])
+ [syntax (.only syntax)]])
(type .public Stack
List)
diff --git a/stdlib/source/library/lux/meta/macro/custom.lux b/stdlib/source/library/lux/meta/macro/custom.lux
new file mode 100644
index 000000000..632219851
--- /dev/null
+++ b/stdlib/source/library/lux/meta/macro/custom.lux
@@ -0,0 +1,53 @@
+(.require
+ [library
+ [lux (.except local)
+ [abstract
+ [monad (.only do)]]
+ [control
+ ["?" parser (.use "[1]#[0]" functor)]
+ ["[0]" exception (.only exception)]]]]
+ ["[0]" // (.only)
+ [syntax (.only syntax)
+ ["[0]" export]]
+ ["/[1]" // (.only)
+ ["[0]" code (.only)
+ ["?[1]" \\parser (.only Parser)]]
+ ["[0]" type (.only)
+ [primitive (.except)]]]])
+
+(exception .public (invalid_type [expected Type
+ actual Type])
+ (exception.report
+ (list ["Expected" (type.format expected)]
+ ["Actual" (type.format actual)])))
+
+(def local
+ (Parser Code)
+ (?#each code.local ?code.local))
+
+(def .public custom
+ (syntax (_ [[public|private <type> <in> <out> <by_name>]
+ (export.parser (all ?.and
+ ..local
+ ..local
+ ..local
+ ..local))])
+ (//.with_symbols [g!_ g!type g!value]
+ (in (list (` (primitive (, public|private) (, <type>)
+ Macro))
+
+ (` (def (, public|private) (, <in>)
+ (-> Macro (, <type>))
+ (|>> abstraction)))
+
+ (` (def (, public|private) (, <out>)
+ (-> (, <type>) Macro)
+ (|>> representation)))
+
+ (` (def (, public|private) ((, <by_name>) (, g!_))
+ (-> Symbol (Meta (, <type>)))
+ ((,! do) (,! ///.monad)
+ [[(, g!_) (, g!type) (, g!value)] ((,! ///.export) (, g!_))]
+ (if (at (,! type.equivalence) (,' =) (, <type>) (, g!type))
+ ((,' in) (as (, <type>) (, g!value)))
+ ((,! ///.failure) ((,! exception.except) ..invalid_type [(, <type>) (, g!type)])))))))))))
diff --git a/stdlib/source/library/lux/meta/macro/syntax/export.lux b/stdlib/source/library/lux/meta/macro/syntax/export.lux
index d68b4a678..1bc78cb9f 100644
--- a/stdlib/source/library/lux/meta/macro/syntax/export.lux
+++ b/stdlib/source/library/lux/meta/macro/syntax/export.lux
@@ -7,30 +7,31 @@
["<>" parser]]
[meta
["[0]" code
- ["<[1]>" \\parser (.only Parser)]]
- [macro
- ["^" pattern]]]]])
+ ["<[1]>" \\parser (.only Parser)]]]]])
(def .public default_policy
Code
(` .private))
-(def policy
- (Parser Code)
- (do [! <>.monad]
- [candidate <code>.next]
- (case candidate
- [_ {.#Symbol ["" _]}]
- (in default_policy)
-
- (^.or [_ {.#Bit _}]
- [_ {.#Symbol _}])
- (do !
- [_ <code>.any]
- (in candidate))
-
- _
- (in default_policy))))
+(`` (def policy
+ (Parser Code)
+ (do [! <>.monad]
+ [candidate <code>.next]
+ (case candidate
+ [_ {.#Symbol ["" _]}]
+ (in default_policy)
+
+ (,, (with_template [<pattern>]
+ [<pattern>
+ (do !
+ [_ <code>.any]
+ (in candidate))]
+
+ [[_ {.#Bit _}]]
+ [[_ {.#Symbol _}]]))
+
+ _
+ (in default_policy)))))
(def .public parser
(All (_ a) (-> (Parser a) (Parser [Code a])))
diff --git a/stdlib/source/library/lux/meta/type.lux b/stdlib/source/library/lux/meta/type.lux
index 4d4293e6d..9af406098 100644
--- a/stdlib/source/library/lux/meta/type.lux
+++ b/stdlib/source/library/lux/meta/type.lux
@@ -24,8 +24,7 @@
["[0]" code (.only)
["<[1]>" \\parser (.only Parser)]]
["[0]" macro (.only)
- [syntax (.only syntax)]
- ["^" pattern]]]]])
+ [syntax (.only syntax)]]]]])
(with_template [<name> <tag>]
[(def .public (<name> type)
@@ -77,202 +76,226 @@
[flat_tuple .#Product]
)
-(def .public (format type)
- (-> Type Text)
- (case type
- {.#Primitive name params}
- (all text#composite
- "(Primitive "
- (text.enclosed' text.double_quote name)
- (|> params
- (list#each (|>> format (text#composite " ")))
- (list#mix (function.flipped text#composite) ""))
- ")")
-
- (^.with_template [<tag> <open> <close> <flat>]
- [{<tag> _}
- (all text#composite <open>
- (|> (<flat> type)
- (list#each format)
- list.reversed
- (list.interposed " ")
- (list#mix text#composite ""))
- <close>)])
- ([.#Sum "(Or " ")" flat_variant]
- [.#Product "[" "]" flat_tuple])
-
- {.#Function input output}
- (.let [[ins out] (flat_function type)]
- (all text#composite "(-> "
- (|> ins
- (list#each format)
- list.reversed
- (list.interposed " ")
- (list#mix text#composite ""))
- " " (format out) ")"))
-
- {.#Parameter idx}
- (n#encoded idx)
-
- {.#Var id}
- (all text#composite "-" (n#encoded id))
-
- {.#Ex id}
- (all text#composite "+" (n#encoded id))
-
- {.#Apply param fun}
- (.let [[type_func type_args] (flat_application type)]
- (all text#composite "(" (format type_func) " " (|> type_args (list#each format) list.reversed (list.interposed " ") (list#mix text#composite "")) ")"))
-
- (^.with_template [<tag> <desc>]
- [{<tag> env body}
- (all text#composite "(" <desc> " {" (|> env (list#each format) (text.interposed " ")) "} " (format body) ")")])
- ([.#UnivQ "All"]
- [.#ExQ "Ex"])
-
- {.#Named [module name] type}
- (all text#composite module "." name)
- ))
+(`` (def .public (format type)
+ (-> Type Text)
+ (case type
+ {.#Primitive name params}
+ (all text#composite
+ "(Primitive "
+ (text.enclosed' text.double_quote name)
+ (|> params
+ (list#each (|>> format (text#composite " ")))
+ (list#mix (function.flipped text#composite) ""))
+ ")")
+
+ (,, (with_template [<tag> <open> <close> <flat>]
+ [{<tag> _}
+ (all text#composite <open>
+ (|> (<flat> type)
+ (list#each format)
+ list.reversed
+ (list.interposed " ")
+ (list#mix text#composite ""))
+ <close>)]
+
+ [.#Sum "(Or " ")" flat_variant]
+ [.#Product "[" "]" flat_tuple]))
+
+ {.#Function input output}
+ (.let [[ins out] (flat_function type)]
+ (all text#composite "(-> "
+ (|> ins
+ (list#each format)
+ list.reversed
+ (list.interposed " ")
+ (list#mix text#composite ""))
+ " " (format out) ")"))
+
+ {.#Parameter idx}
+ (n#encoded idx)
+
+ {.#Var id}
+ (all text#composite "-" (n#encoded id))
+
+ {.#Ex id}
+ (all text#composite "+" (n#encoded id))
+
+ {.#Apply param fun}
+ (.let [[type_func type_args] (flat_application type)]
+ (all text#composite "(" (format type_func) " " (|> type_args (list#each format) list.reversed (list.interposed " ") (list#mix text#composite "")) ")"))
+
+ (,, (with_template [<tag> <desc>]
+ [{<tag> env body}
+ (all text#composite "(" <desc> " {" (|> env (list#each format) (text.interposed " ")) "} " (format body) ")")]
+
+ [.#UnivQ "All"]
+ [.#ExQ "Ex"]))
+
+ {.#Named [module name] type}
+ (all text#composite module "." name)
+ )))
... https://en.wikipedia.org/wiki/Lambda_calculus#%CE%B2-reduction
-(def (reduced env type)
- (-> (List Type) Type Type)
- (case type
- {.#Primitive name params}
- {.#Primitive name (list#each (reduced env) params)}
-
- (^.with_template [<tag>]
- [{<tag> left right}
- {<tag> (reduced env left) (reduced env right)}])
- ([.#Sum] [.#Product]
- [.#Function] [.#Apply])
-
- (^.with_template [<tag>]
- [{<tag> old_env def}
- (case old_env
- {.#End}
- {<tag> env def}
+(`` (def (reduced env type)
+ (-> (List Type) Type Type)
+ (case type
+ {.#Primitive name params}
+ {.#Primitive name (list#each (reduced env) params)}
+
+ (,, (with_template [<tag>]
+ [{<tag> left right}
+ {<tag> (reduced env left) (reduced env right)}]
- _
- {<tag> (list#each (reduced env) old_env) def})])
- ([.#UnivQ]
- [.#ExQ])
-
- {.#Parameter idx}
- (maybe.else (panic! (all text#composite
- "Unknown type parameter" text.new_line
- " Index: " (n#encoded idx) text.new_line
- "Environment: " (|> env
- list.enumeration
- (list#each (.function (_ [index type])
- (all text#composite
- (n#encoded index)
- " " (..format type))))
- (text.interposed (text#composite text.new_line " ")))))
- (list.item idx env))
-
- _
- type
- ))
-
-(def .public equivalence
- (Equivalence Type)
- (implementation
- (def (= x y)
- (or (for @.php
- ... TODO: Remove this once JPHP is gone.
- false
- (same? x y))
- (case [x y]
- [{.#Primitive xname xparams} {.#Primitive yname yparams}]
- (and (text#= xname yname)
- (n.= (list.size yparams) (list.size xparams))
- (list#mix (.function (_ [x y] prev) (and prev (= x y)))
- #1
- (list.zipped_2 xparams yparams)))
-
- (^.with_template [<tag>]
- [[{<tag> xid} {<tag> yid}]
- (n.= yid xid)])
- ([.#Var] [.#Ex] [.#Parameter])
-
- (^.or [{.#Function xleft xright} {.#Function yleft yright}]
- [{.#Apply xleft xright} {.#Apply yleft yright}])
- (and (= xleft yleft)
- (= xright yright))
-
- [{.#Named xname xtype} {.#Named yname ytype}]
- (and (symbol#= xname yname)
- (= xtype ytype))
-
- (^.with_template [<tag>]
- [[{<tag> xL xR} {<tag> yL yR}]
- (and (= xL yL) (= xR yR))])
- ([.#Sum] [.#Product])
-
- (^.or [{.#UnivQ xenv xbody} {.#UnivQ yenv ybody}]
- [{.#ExQ xenv xbody} {.#ExQ yenv ybody}])
- (and (n.= (list.size yenv) (list.size xenv))
- (= xbody ybody)
- (list#mix (.function (_ [x y] prev) (and prev (= x y)))
- #1
- (list.zipped_2 xenv yenv)))
-
- _
- #0
- )))))
-
-(def .public (applied params func)
- (-> (List Type) Type (Maybe Type))
- (case params
- {.#End}
- {.#Some func}
+ [.#Sum] [.#Product]
+ [.#Function] [.#Apply]))
+
+ (,, (with_template [<tag>]
+ [{<tag> old_env def}
+ (case old_env
+ {.#End}
+ {<tag> env def}
- {.#Item param params'}
- (case func
- (^.with_template [<tag>]
- [{<tag> env body}
- (|> body
- (reduced (list.partial func param env))
- (applied params'))])
- ([.#UnivQ] [.#ExQ])
-
- {.#Apply A F}
- (applied (list.partial A params) F)
-
- {.#Named name unnamed}
- (applied params unnamed)
-
- _
- {.#None})))
+ _
+ {<tag> (list#each (reduced env) old_env) def})]
-(def .public (code type)
- (-> Type Code)
- (case type
- {.#Primitive name params}
- (` {.#Primitive (, (code.text name))
- (.list (,* (list#each code params)))})
-
- (^.with_template [<tag>]
- [{<tag> idx}
- (` {<tag> (, (code.nat idx))})])
- ([.#Var] [.#Ex] [.#Parameter])
-
- (^.with_template [<tag>]
- [{<tag> left right}
- (` {<tag> (, (code left))
- (, (code right))})])
- ([.#Sum] [.#Product] [.#Function] [.#Apply])
-
- {.#Named name sub_type}
- (code.symbol name)
-
- (^.with_template [<tag>]
- [{<tag> env body}
- (` {<tag> (.list (,* (list#each code env)))
- (, (code body))})])
- ([.#UnivQ] [.#ExQ])
- ))
+ [.#UnivQ]
+ [.#ExQ]))
+
+ {.#Parameter idx}
+ (maybe.else (panic! (all text#composite
+ "Unknown type parameter" text.new_line
+ " Index: " (n#encoded idx) text.new_line
+ "Environment: " (|> env
+ list.enumeration
+ (list#each (.function (_ [index type])
+ (all text#composite
+ (n#encoded index)
+ " " (..format type))))
+ (text.interposed (text#composite text.new_line " ")))))
+ (list.item idx env))
+
+ _
+ type
+ )))
+
+(`` (def .public equivalence
+ (Equivalence Type)
+ (implementation
+ (def (= x y)
+ (or (for @.php
+ ... TODO: Remove this once JPHP is gone.
+ false
+ (same? x y))
+ (case [x y]
+ [{.#Primitive xname xparams} {.#Primitive yname yparams}]
+ (and (text#= xname yname)
+ (n.= (list.size yparams) (list.size xparams))
+ (list#mix (.function (_ [x y] prev) (and prev (= x y)))
+ #1
+ (list.zipped_2 xparams yparams)))
+
+ (,, (with_template [<tag>]
+ [[{<tag> xid} {<tag> yid}]
+ (n.= yid xid)]
+
+ [.#Var]
+ [.#Ex]
+ [.#Parameter]
+ ))
+
+ (,, (with_template [<tag>]
+ [[{<tag> ll lr} {<tag> rl rr}]
+ (and (= ll rl)
+ (= lr rr))]
+
+ [.#Function]
+ [.#Apply]
+ [.#Sum]
+ [.#Product]
+ ))
+
+ [{.#Named xname xtype} {.#Named yname ytype}]
+ (and (symbol#= xname yname)
+ (= xtype ytype))
+
+ (,, (with_template [<tag>]
+ [[{<tag> xenv xbody} {<tag> yenv ybody}]
+ (and (n.= (list.size yenv) (list.size xenv))
+ (= xbody ybody)
+ (list#mix (.function (_ [x y] prev) (and prev (= x y)))
+ #1
+ (list.zipped_2 xenv yenv)))]
+
+ [.#UnivQ]
+ [.#ExQ]
+ ))
+
+ _
+ #0
+ ))))))
+
+(`` (def .public (applied params func)
+ (-> (List Type) Type (Maybe Type))
+ (case params
+ {.#End}
+ {.#Some func}
+
+ {.#Item param params'}
+ (case func
+ (,, (with_template [<tag>]
+ [{<tag> env body}
+ (|> body
+ (reduced (list.partial func param env))
+ (applied params'))]
+
+ [.#UnivQ]
+ [.#ExQ]))
+
+ {.#Apply A F}
+ (applied (list.partial A params) F)
+
+ {.#Named name unnamed}
+ (applied params unnamed)
+
+ _
+ {.#None}))))
+
+(`` (def .public (code type)
+ (-> Type Code)
+ (case type
+ {.#Primitive name params}
+ (` {.#Primitive (, (code.text name))
+ (.list (,* (list#each code params)))})
+
+ (,, (with_template [<tag>]
+ [{<tag> idx}
+ (` {<tag> (, (code.nat idx))})]
+
+ [.#Var]
+ [.#Ex]
+ [.#Parameter]))
+
+ (,, (with_template [<tag>]
+ [{<tag> left right}
+ (` {<tag> (, (code left))
+ (, (code right))})]
+
+ [.#Sum]
+ [.#Product]
+ [.#Function]
+ [.#Apply]))
+
+ {.#Named name sub_type}
+ (code.symbol name)
+
+ (,, (with_template [<tag>]
+ [{<tag> env body}
+ (` {<tag> (.list (,* (list#each code env)))
+ (, (code body))})]
+
+ [.#UnivQ]
+ [.#ExQ]))
+ )))
(def .public (de_aliased type)
(-> Type Type)
@@ -338,22 +361,26 @@
[ex_q .#ExQ]
)
-(def .public (quantified? type)
- (-> Type Bit)
- (case type
- {.#Named [module name] _type}
- (quantified? _type)
+(`` (def .public (quantified? type)
+ (-> Type Bit)
+ (case type
+ {.#Named [module name] _type}
+ (quantified? _type)
- {.#Apply A F}
- (|> (..applied (list A) F)
- (at maybe.monad each quantified?)
- (maybe.else #0))
-
- (^.or {.#UnivQ _} {.#ExQ _})
- #1
+ {.#Apply A F}
+ (|> (..applied (list A) F)
+ (at maybe.monad each quantified?)
+ (maybe.else #0))
- _
- #0))
+ (,, (with_template [<pattern>]
+ [<pattern>
+ #1]
+
+ [{.#UnivQ _}]
+ [{.#ExQ _}]))
+
+ _
+ #0)))
(def .public (array depth element_type)
(-> Nat Type Type)
@@ -366,14 +393,16 @@
(def .public (flat_array type)
(-> Type [Nat Type])
- (case type
- (^.multi {.#Primitive name (list element_type)}
- (text#= array.type_name name))
- (.let [[depth element_type] (flat_array element_type)]
- [(++ depth) element_type])
+ (with_expansions [<default> [0 type]]
+ (case type
+ {.#Primitive name (list element_type)}
+ (if (text#= array.type_name name)
+ (.let [[depth element_type] (flat_array element_type)]
+ [(++ depth) element_type])
+ <default>)
- _
- [0 type]))
+ _
+ <default>)))
(def .public array?
(-> Type Bit)
@@ -476,34 +505,40 @@
... The value of this expression will never be relevant, so it doesn't matter what it is.
(.as .Nothing [])))))))))
-(def .public (replaced before after)
- (-> Type Type Type Type)
- (.function (again it)
- (if (at ..equivalence = before it)
- after
- (case it
- {.#Primitive name co_variant}
- {.#Primitive name (list#each again co_variant)}
-
- (^.with_template [<tag>]
- [{<tag> left right}
- {<tag> (again left) (again right)}])
- ([.#Sum]
- [.#Product]
- [.#Function]
- [.#Apply])
-
- (^.with_template [<tag>]
- [{<tag> env body}
- {<tag> (list#each again env) (again body)}])
- ([.#UnivQ]
- [.#ExQ])
-
- (^.or {.#Parameter _}
- {.#Var _}
- {.#Ex _}
- {.#Named _})
- it))))
+(`` (def .public (replaced before after)
+ (-> Type Type Type Type)
+ (.function (again it)
+ (if (at ..equivalence = before it)
+ after
+ (case it
+ {.#Primitive name co_variant}
+ {.#Primitive name (list#each again co_variant)}
+
+ (,, (with_template [<tag>]
+ [{<tag> left right}
+ {<tag> (again left) (again right)}]
+
+ [.#Sum]
+ [.#Product]
+ [.#Function]
+ [.#Apply]))
+
+ (,, (with_template [<tag>]
+ [{<tag> env body}
+ {<tag> (list#each again env) (again body)}]
+
+ [.#UnivQ]
+ [.#ExQ]))
+
+ (,, (with_template [<pattern>]
+ [<pattern>
+ it]
+
+ [{.#Parameter _}]
+ [{.#Var _}]
+ [{.#Ex _}]
+ [{.#Named _}]))
+ )))))
(def .public let
(syntax (_ [bindings (<code>.tuple (<>.some (<>.and <code>.any <code>.any)))
diff --git a/stdlib/source/library/lux/meta/type/primitive.lux b/stdlib/source/library/lux/meta/type/primitive.lux
index c1ead54eb..40bcdba68 100644
--- a/stdlib/source/library/lux/meta/type/primitive.lux
+++ b/stdlib/source/library/lux/meta/type/primitive.lux
@@ -15,7 +15,6 @@
["[0]" code (.only)
["<[1]>" \\parser (.only Parser)]]
["[0]" macro (.only)
- ["^" pattern]
["[0]" context]
[syntax (.only syntax)
["|[0]|" export]]]]]]