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

1 files changed, 139 insertions, 101 deletions

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