aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-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
12 files changed, 566 insertions, 465 deletions
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]]]]]]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 23:03:40 +0000