Extensible macro vocabulary for "lux/macro/pattern.`".

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))