Moved "lux/macro" to "lux/meta/macro".

1 files changed, 256 insertions, 0 deletions

diff --git a/stdlib/source/library/lux/meta/macro/pattern.lux b/stdlib/source/library/lux/meta/macro/pattern.lux
new file mode 100644
index 000000000..affa8273a
--- /dev/null
+++ b/stdlib/source/library/lux/meta/macro/pattern.lux
@@ -0,0 +1,256 @@
+(.require
+ [library
+  [lux (.except or let with_template |> `)]])
+
+(def partial_list
+  (`` ("lux in-module" (,, (static .prelude)) .partial_list)))
+
+(def locally
+  (macro (_ tokens lux)
+    (.let [[prelude _] (symbol ._)]
+      (case tokens
+        (pattern (list [@ {.#Symbol ["" name]}]))
+        {.#Right [lux (list (.` ("lux in-module" (, [@ {.#Text prelude}])
+                                 (, [@ {.#Symbol [prelude name]}]))))]}
+
+        _
+        {.#Left ""}))))
+
+(.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]
+
+  [symbol_short]
+  [tuple_list]
+
+  [meta#monad]
+  [text$]
+  [generated_symbol]
+  [type_definition]
+  [record_slots]
+  [text#composite]
+  [type#encoded]
+  [module_alias]
+  [symbol$]
+  [tuple$]
+  [monad#mix]
+  [zipped_2]
+
+  [multi_level_case^]
+  [multi_level_case$]
+  [type_code]
+  [expected_type]
+
+  [wrong_syntax_error]
+  [local$]
+
+  [list#reversed]
+  [untemplated_list]
+  [bit$]
+  [nat$]
+  [int$]
+  [rev$]
+  [frac$]
+  )
+
+(def .public or
+  (macro (_ tokens)
+    (case tokens
+      (pattern (partial_list [_ {.#Form patterns}] body branches))
+      (case patterns
+        {.#End}
+        (failure (..wrong_syntax_error (symbol ..or)))
+
+        _
+        (.let [pairs (.|> patterns
+                          (list#each (function (_ pattern) (list pattern body)))
+                          list#conjoint)]
+          (meta#in (list#composite pairs branches))))
+      _
+      (failure (..wrong_syntax_error (symbol ..or))))))
+
+(def .public with_template
+  (macro (_ tokens)
+    (case tokens
+      (pattern (partial_list [_ {.#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'))
+                      (.let [apply (is (-> Replacement_Environment (List Code))
+                                       (function (_ env) (list#each (realized_template env) templates)))]
+                        (.|> data'
+                             (list#each (function#composite apply (replacement_environment bindings')))
+                             list#conjoint
+                             in))
+                      {.#None}))))
+        {.#Some output}
+        (meta#in (list#composite output branches))
+        
+        {.#None}
+        (failure (..wrong_syntax_error (symbol ..with_template))))
+      
+      _
+      (failure (..wrong_syntax_error (symbol ..with_template))))))
+
+(def .public multi
+  (macro (_ tokens)
+    (case tokens
+      (pattern (partial_list [_meta {.#Form levels}] body next_branches))
+      (do meta#monad
+        [mlc (multi_level_case^ levels)
+         .let [initial_bind? (case mlc
+                               [[_ {.#Symbol _}] _]
+                               #1
+
+                               _
+                               #0)]
+         expected ..expected_type
+         g!temp (..generated_symbol "temp")]
+        (in (list 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})))))))))))
+      
+      _
+      (failure (..wrong_syntax_error (symbol ..multi))))))
+
+(def .public let
+  (macro (_ tokens)
+    (case tokens
+      (pattern (partial_list [_meta {.#Form (list [_ {.#Symbol ["" name]}] pattern)}] body branches))
+      (.let [g!whole (local$ name)]
+        (meta#in (partial_list g!whole
+                               (.` (case (, g!whole) (, pattern) (, body)))
+                               branches)))
+      
+      _
+      (failure (..wrong_syntax_error (symbol ..let))))))
+
+(def .public |>
+  (macro (_ tokens)
+    (case tokens
+      (pattern (partial_list [_meta {.#Form (list [_ {.#Symbol ["" name]}] [_ {.#Tuple steps}])}] body branches))
+      (.let [g!name (local$ name)]
+        (meta#in (partial_list g!name
+                               (.` (.let [(, g!name) (.|> (, g!name) (,* steps))]
+                                     (, body)))
+                               branches)))
+      
+      _
+      (failure (..wrong_syntax_error (symbol ..|>))))))
+
+(def (name$ [module name])
+  (-> Symbol Code)
+  (.` [(, (text$ module)) (, (text$ name))]))
+
+(def (untemplated_partial_list last inits)
+  (-> Code (List Code) Code)
+  (case inits
+    {.#End}
+    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))}])))
+
+       _
+       (do meta#monad
+         [=elems (monad#each meta#monad untemplated_pattern elems)]
+         (in (.` [(, g!meta) {<tag> (, (untemplated_list =elems))}])))))]
+
+  [.#Form untemplated_form]
+  [.#Variant untemplated_variant]
+  [.#Tuple untemplated_tuple]
+  )
+
+(def (untemplated_pattern pattern)
+  (-> Code (Meta Code))
+  (do meta#monad
+    [g!meta (..generated_symbol "g!meta")]
+    (case pattern
+      (..with_template [<tag> <gen>]
+        [[_ {<tag> value}]
+         (in (.` [(, g!meta) {<tag> (, (<gen> value))}]))])
+      ([.#Bit    bit$]
+       [.#Nat    nat$]
+       [.#Int    int$]
+       [.#Rev    rev$]
+       [.#Frac   frac$]
+       [.#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])
+      )))
+
+(def .public `
+  (macro (_ tokens)
+    (case tokens
+      (pattern (partial_list [_meta {.#Form (list template)}] body branches))
+      (do meta#monad
+        [pattern (untemplated_pattern template)]
+        (in (partial_list pattern body branches)))
+
+      (pattern (list template))
+      (do meta#monad
+        [pattern (untemplated_pattern template)]
+        (in (list pattern)))
+
+      _
+      (failure (..wrong_syntax_error (symbol ..`))))))