diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/macro/class.lux | 55 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/macro/pattern.lux | 240 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/macro/vocabulary.lux | 53 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta/macro.lux | 2 |
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)) |