aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux14
-rw-r--r--stdlib/source/library/lux/meta/macro/class.lux55
-rw-r--r--stdlib/source/library/lux/meta/macro/pattern.lux240
-rw-r--r--stdlib/source/library/lux/meta/macro/vocabulary.lux53
-rw-r--r--stdlib/source/test/lux/meta/macro.lux2
5 files changed, 200 insertions, 164 deletions
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux
index 72885ce92..e9ef84319 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux
@@ -111,25 +111,25 @@
[.#Int /simple.int]
[.#Rev /simple.rev])
- (^.` [(,* elems)])
+ (^.` [(^.,* elems)])
(/complex.record analysis archive elems)
- (^.` {(, [_ {.#Symbol tag}]) (,* values)})
+ (^.` {(^., [_ {.#Symbol tag}]) (^.,* values)})
(..variant_analysis analysis archive tag values)
- (^.` ({(,* branches)} (, input)))
+ (^.` ({(^.,* branches)} (^., input)))
(..case_analysis analysis archive input branches code)
- (^.` ([(, [_ {.#Symbol ["" function_name]}]) (, [_ {.#Symbol ["" arg_name]}])] (, body)))
+ (^.` ([(^., [_ {.#Symbol ["" function_name]}]) (^., [_ {.#Symbol ["" arg_name]}])] (^., body)))
(/function.function analysis function_name arg_name archive body)
- (^.` ((, [_ {.#Text extension_name}]) (,* extension_args)))
+ (^.` ((^., [_ {.#Text extension_name}]) (^.,* extension_args)))
(//extension.apply archive analysis [extension_name extension_args])
- (^.` ((, functionC) (,* argsC+)))
+ (^.` ((^., functionC) (^.,* argsC+)))
(..apply_analysis expander analysis archive functionC argsC+)
- (^.` {(, [_ {.#Nat lefts}]) (, [_ {.#Bit right?}]) (,* values)})
+ (^.` {(^., [_ {.#Nat lefts}]) (^., [_ {.#Bit right?}]) (^.,* values)})
(..sum_analysis analysis archive lefts right? values)
_
diff --git a/stdlib/source/library/lux/meta/macro/class.lux b/stdlib/source/library/lux/meta/macro/class.lux
deleted file mode 100644
index 1c529d7cc..000000000
--- a/stdlib/source/library/lux/meta/macro/class.lux
+++ /dev/null
@@ -1,55 +0,0 @@
-... [Not everything is an expression](https://codewords.recurse.com/issues/two/not-everything-is-an-expression)
-
-(.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/pattern.lux b/stdlib/source/library/lux/meta/macro/pattern.lux
index 7e3b30d9d..4c78c8c36 100644
--- a/stdlib/source/library/lux/meta/macro/pattern.lux
+++ b/stdlib/source/library/lux/meta/macro/pattern.lux
@@ -1,17 +1,28 @@
(.require
[library
- [lux (.except or let with_template |> `)]])
-
-(def list#partial
- (`` ("lux in-module" (,, (static .prelude)) .list#partial)))
+ [lux (.except or let with_template |>
+ ` , ,*
+ UnQuote unquote unquote_macro
+ Spliced_UnQuote spliced_unquote spliced_unquote_macro)
+ [abstract
+ ["[0]" monad (.only do)]]
+ [control
+ ["[0]" maybe]
+ ["[0]" try]]
+ [data
+ [collection
+ ["[0]" list (.use "[1]#[0]" monoid monad)]]]]]
+ ["[0]" // (.only)
+ [vocabulary (.only vocabulary)]
+ ["/[1]" // (.use "[1]#[0]" monad)]])
(def locally
(macro (_ tokens lux)
(.let [[prelude _] (symbol ._)]
(case tokens
(list [@ {.#Symbol ["" name]}])
- {.#Right [lux (list (.` ("lux in-module" (, [@ {.#Text prelude}])
- (, [@ {.#Symbol [prelude name]}]))))]}
+ {.#Right [lux (list (.` ("lux in-module" (., [@ {.#Text prelude}])
+ (., [@ {.#Symbol [prelude name]}]))))]}
_
{.#Left ""}))))
@@ -19,22 +30,8 @@
(.with_template [<name>]
[(def <name> (..locally <name>))]
- [list#size]
- [list#composite]
- [list#each]
- [list#conjoint]
- [every?]
-
- [maybe#monad]
-
[function#composite]
- [failure]
- [meta#in]
-
- [do]
- [monad#each]
-
[Replacement_Environment]
[realized_template]
[replacement_environment]
@@ -42,7 +39,6 @@
[symbol_short]
[tuple_list]
- [meta#monad]
[text$]
[generated_symbol]
[type_definition]
@@ -52,7 +48,6 @@
[module_alias]
[symbol$]
[tuple$]
- [monad#mix]
[zipped_2]
[multi_level_case^]
@@ -63,47 +58,48 @@
[wrong_syntax_error]
[local$]
- [list#reversed]
[untemplated_list]
[bit$]
[nat$]
[int$]
[rev$]
[frac$]
+
+ [one_expansion]
)
(def .public or
(pattern
(macro (_ tokens)
(case tokens
- (list#partial [_ {.#Form patterns}] body branches)
+ (list.partial [_ {.#Form patterns}] body branches)
(case patterns
{.#End}
- (failure (..wrong_syntax_error (symbol ..or)))
+ (///.failure (..wrong_syntax_error (symbol ..or)))
_
(.let [pairs (.|> patterns
(list#each (function (_ pattern) (list pattern body)))
list#conjoint)]
- (meta#in (list#composite pairs branches))))
+ (///#in (list#composite pairs branches))))
_
- (failure (..wrong_syntax_error (symbol ..or)))))))
+ (///.failure (..wrong_syntax_error (symbol ..or)))))))
(def .public with_template
(pattern
(macro (_ tokens)
(case tokens
- (list#partial [_ {.#Form (list [_ {.#Tuple bindings}]
+ (list.partial [_ {.#Form (list [_ {.#Tuple bindings}]
[_ {.#Tuple templates}])}]
[_ {.#Form data}]
branches)
(case (is (Maybe (List Code))
- (do maybe#monad
- [bindings' (monad#each maybe#monad symbol_short bindings)
- data' (monad#each maybe#monad tuple_list data)]
- (.let [num_bindings (list#size bindings')]
- (if (every? (|>> ("lux i64 =" num_bindings))
- (list#each list#size data'))
+ (do maybe.monad
+ [bindings' (monad.each maybe.monad symbol_short bindings)
+ data' (monad.each maybe.monad tuple_list data)]
+ (.let [num_bindings (list.size bindings')]
+ (if (list.every? (|>> ("lux i64 =" num_bindings))
+ (list#each list.size data'))
(.let [apply (is (-> Replacement_Environment (List Code))
(function (_ env) (list#each (realized_template env) templates)))]
(.|> data'
@@ -112,20 +108,20 @@
in))
{.#None}))))
{.#Some output}
- (meta#in (list#composite output branches))
+ (///#in (list#composite output branches))
{.#None}
- (failure (..wrong_syntax_error (symbol ..with_template))))
+ (///.failure (..wrong_syntax_error (symbol ..with_template))))
_
- (failure (..wrong_syntax_error (symbol ..with_template)))))))
+ (///.failure (..wrong_syntax_error (symbol ..with_template)))))))
(def .public multi
(pattern
(macro (_ tokens)
(case tokens
- (list#partial [_meta {.#Form levels}] body next_branches)
- (do meta#monad
+ (list.partial [_meta {.#Form levels}] body next_branches)
+ (do ///.monad
[mlc (multi_level_case^ levels)
.let [initial_bind? (case mlc
[[_ {.#Symbol _}] _]
@@ -136,53 +132,53 @@
expected ..expected_type
g!temp (..generated_symbol "temp")]
(in (list g!temp
- (.` ({{.#Some (, g!temp)}
- (, g!temp)
+ (.` ({{.#Some (., g!temp)}
+ (., g!temp)
{.#None}
- (.case (, g!temp)
- (,* next_branches))}
- ("lux type check" {.#Apply (, (type_code expected)) Maybe}
- (.case (, g!temp)
- (,* (multi_level_case$ g!temp [mlc body]))
-
- (,* (if initial_bind?
- (list)
- (list g!temp (.` {.#None})))))))))))
+ (.case (., g!temp)
+ (.,* next_branches))}
+ ("lux type check" {.#Apply (., (type_code expected)) Maybe}
+ (.case (., g!temp)
+ (.,* (multi_level_case$ g!temp [mlc body]))
+
+ (.,* (if initial_bind?
+ (list)
+ (list g!temp (.` {.#None})))))))))))
_
- (failure (..wrong_syntax_error (symbol ..multi)))))))
+ (///.failure (..wrong_syntax_error (symbol ..multi)))))))
(def .public let
(pattern
(macro (_ tokens)
(case tokens
- (list#partial [_meta {.#Form (list [_ {.#Symbol ["" name]}] pattern)}] body branches)
+ (list.partial [_meta {.#Form (list [_ {.#Symbol ["" name]}] pattern)}] body branches)
(.let [g!whole (local$ name)]
- (meta#in (list#partial g!whole
- (.` (case (, g!whole) (, pattern) (, body)))
- branches)))
+ (///#in (list.partial g!whole
+ (.` (case (., g!whole) (., pattern) (., body)))
+ branches)))
_
- (failure (..wrong_syntax_error (symbol ..let)))))))
+ (///.failure (..wrong_syntax_error (symbol ..let)))))))
(def .public |>
(pattern
(macro (_ tokens)
(case tokens
- (list#partial [_meta {.#Form (list [_ {.#Symbol ["" name]}] [_ {.#Tuple steps}])}] body branches)
+ (list.partial [_meta {.#Form (list [_ {.#Symbol ["" name]}] [_ {.#Tuple steps}])}] body branches)
(.let [g!name (local$ name)]
- (meta#in (list#partial g!name
- (.` (.let [(, g!name) (.|> (, g!name) (,* steps))]
- (, body)))
- branches)))
+ (///#in (list.partial g!name
+ (.` (.let [(., g!name) (.|> (., g!name) (.,* steps))]
+ (., body)))
+ branches)))
_
- (failure (..wrong_syntax_error (symbol ..|>)))))))
+ (///.failure (..wrong_syntax_error (symbol ..|>)))))))
(def (name$ [module name])
(-> Symbol Code)
- (.` [(, (text$ module)) (, (text$ name))]))
+ (.` [(., (text$ module)) (., (text$ name))]))
(def (untemplated_partial_list last inits)
(-> Code (List Code) Code)
@@ -191,37 +187,62 @@
last
{.#Item [init inits']}
- (.` {.#Item (, init) (, (untemplated_partial_list last inits'))})))
-
-(.with_template [<tag> <name>]
- [(def (<name> g!meta untemplated_pattern elems)
- (-> Code (-> Code (Meta Code))
- (-> (List Code) (Meta Code)))
- (case (list#reversed elems)
- {.#Item [_ {.#Form {.#Item [[_ {.#Symbol ["" ",*"]}] {.#Item [spliced {.#End}]}]}}]
- inits}
- (do meta#monad
- [=inits (monad#each meta#monad untemplated_pattern (list#reversed inits))]
- (in (.` [(, g!meta) {<tag> (, (untemplated_partial_list spliced =inits))}])))
+ (.` {.#Item (., init) (., (untemplated_partial_list last inits'))})))
+
+(vocabulary
+ [.public Spliced_UnQuote]
+ [.public spliced_unquote]
+ [.public spliced_unquote_macro]
+ [.private named_spliced_unquote])
+
+(def (untemplated_composite <tag> g!meta untemplated_pattern elems)
+ (-> Code Code (-> Code (Meta Code))
+ (-> (List Code) (Meta Code)))
+ (with_expansions [<default> (do ///.monad
+ [=elems (monad.each ///.monad untemplated_pattern elems)]
+ (in (.` [(., g!meta) {(., <tag>) (., (untemplated_list =elems))}])))]
+ (case (list.reversed elems)
+ {.#Item [_ {.#Form {.#Item [_ {.#Symbol global}] parameters}}]
+ inits}
+ (do ///.monad
+ [micro (///.try (..named_spliced_unquote global))]
+ (case micro
+ {try.#Success micro}
+ (do ///.monad
+ [output (..one_expansion ((//.function micro) parameters))
+ =inits (monad.each ///.monad untemplated_pattern (list.reversed inits))]
+ (in (.` [(., g!meta) {(., <tag>) (., (untemplated_partial_list output =inits))}])))
+
+ {try.#Failure error}
+ <default>))
+
+ _
+ <default>)))
+
+(def .public ,*
+ (..spliced_unquote
+ (macro (_ tokens)
+ ({{.#Item it {.#End}}
+ (at ///.monad in (list it))
_
- (do meta#monad
- [=elems (monad#each meta#monad untemplated_pattern elems)]
- (in (.` [(, g!meta) {<tag> (, (untemplated_list =elems))}])))))]
+ (///.failure (..wrong_syntax_error (symbol ..,*)))}
+ tokens))))
- [.#Form untemplated_form]
- [.#Variant untemplated_variant]
- [.#Tuple untemplated_tuple]
- )
+(vocabulary
+ [.public UnQuote]
+ [.public unquote]
+ [.public unquote_macro]
+ [.private named_unquote])
(def (untemplated_pattern pattern)
(-> Code (Meta Code))
- (do meta#monad
+ (do ///.monad
[g!meta (..generated_symbol "g!meta")]
(case pattern
(..with_template [<tag> <gen>]
[[_ {<tag> value}]
- (in (.` [(, g!meta) {<tag> (, (<gen> value))}]))])
+ (in (.` [(., g!meta) {<tag> (., (<gen> value))}]))])
([.#Bit bit$]
[.#Nat nat$]
[.#Int int$]
@@ -230,33 +251,50 @@
[.#Text text$]
[.#Symbol name$])
- [_ {.#Form {.#Item [[_ {.#Symbol ["" ","]}] {.#Item [unquoted {.#End}]}]}}]
- (in unquoted)
-
- [_ {.#Form {.#Item [[_ {.#Symbol ["" ",*"]}] {.#Item [spliced {.#End}]}]}}]
- (failure "Cannot use (,*) inside of `code` unless it is the last element in a form or a tuple.")
-
- (..with_template [<tag> <untemplated>]
- [[_ {<tag> elems}]
- (<untemplated> g!meta untemplated_pattern elems)])
- ([.#Form ..untemplated_form]
- [.#Variant ..untemplated_variant]
- [.#Tuple ..untemplated_tuple])
+ [@composite {.#Form {.#Item [@global {.#Symbol global}] parameters}}]
+ (do ///.monad
+ [micro (///.try (..named_unquote global))]
+ (case micro
+ {try.#Success micro}
+ (do ///.monad
+ [[_ output] (..one_expansion ((//.function micro) parameters))]
+ (in [@composite output]))
+
+ {try.#Failure error}
+ (untemplated_composite (.` .#Form) g!meta untemplated_pattern (list.partial [@global {.#Symbol global}] parameters))))
+
+ (..with_template [<tag>]
+ [[_ {<tag> it}]
+ (untemplated_composite (.` <tag>) g!meta untemplated_pattern it)])
+ ([.#Form]
+ [.#Variant]
+ [.#Tuple])
)))
(def .public `
(pattern
(macro (_ tokens)
(case tokens
- (list#partial [_meta {.#Form (list template)}] body branches)
- (do meta#monad
+ (list.partial [_meta {.#Form (list template)}] body branches)
+ (do ///.monad
[pattern (untemplated_pattern template)]
- (in (list#partial pattern body branches)))
+ (in (list.partial pattern body branches)))
(list template)
- (do meta#monad
+ (do ///.monad
[pattern (untemplated_pattern template)]
(in (list pattern)))
_
- (failure (..wrong_syntax_error (symbol ..`)))))))
+ (///.failure (..wrong_syntax_error (symbol ..`)))))))
+
+(def .public ,
+ UnQuote
+ (..unquote
+ (macro (_ tokens)
+ ({{.#Item it {.#End}}
+ (at ///.monad in (list it))
+
+ _
+ (///.failure (..wrong_syntax_error (symbol ..,)))}
+ tokens))))
diff --git a/stdlib/source/library/lux/meta/macro/vocabulary.lux b/stdlib/source/library/lux/meta/macro/vocabulary.lux
new file mode 100644
index 000000000..73b91c35a
--- /dev/null
+++ b/stdlib/source/library/lux/meta/macro/vocabulary.lux
@@ -0,0 +1,53 @@
+... [Not everything is an expression](https://codewords.recurse.com/issues/two/not-everything-is-an-expression)
+
+(.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 Code])
+ (?code.tuple (export.parser (?#each code.local ?code.local))))
+
+(def .public vocabulary
+ (syntax (_ [[public|private@type type] ..local
+ [public|private@micro micro] ..local
+ [public|private@macro macro] ..local
+ [public|private@by_name by_name] ..local])
+ (//.with_symbols [g!_ g!type g!value]
+ (in (list (` ((,! primitive) (, public|private@type) (, type)
+ Macro
+
+ (def (, public|private@micro) (, micro)
+ (-> Macro (, type))
+ (|>> ((,! abstraction))))
+
+ (def (, public|private@macro) (, macro)
+ (-> (, type) Macro)
+ (|>> ((,! representation))))))
+
+ (` (def (, public|private@by_name) ((, by_name) (, g!_))
+ (-> Symbol (Meta Macro))
+ ((,! do) (,! ///.monad)
+ [[(, g!_) (, g!type) (, g!value)] ((,! ///.export) (, g!_))]
+ (if (at (,! type.equivalence) (,' =) (, type) (, g!type))
+ ((,' in) ((, macro) (as (, type) (, g!value))))
+ ((,! ///.failure) ((,! exception.error) ..invalid_type [(, type) (, g!type)])))))))))))
diff --git a/stdlib/source/test/lux/meta/macro.lux b/stdlib/source/test/lux/meta/macro.lux
index d128a74be..e2705e961 100644
--- a/stdlib/source/test/lux/meta/macro.lux
+++ b/stdlib/source/test/lux/meta/macro.lux
@@ -178,7 +178,7 @@
<actual> (/.times <cycles> (..iterated <max> <expected>))]
(let [expected_remaining (n.- <cycles> <max>)]
(case (` <actual>)
- (^.` (..iterated (, [_ {.#Nat actual_remaining}]) (, [_ {.#Nat actual}])))
+ (^.` (..iterated (^., [_ {.#Nat actual_remaining}]) (^., [_ {.#Nat actual}])))
(and (n.= expected_remaining actual_remaining)
(n.= <expected> actual))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-22 23:47:17 +0000