aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/macro/pattern.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/library/lux/macro/pattern.lux235
1 files changed, 121 insertions, 114 deletions
diff --git a/stdlib/source/library/lux/macro/pattern.lux b/stdlib/source/library/lux/macro/pattern.lux
index 708d81a18..4e6811c93 100644
--- a/stdlib/source/library/lux/macro/pattern.lux
+++ b/stdlib/source/library/lux/macro/pattern.lux
@@ -2,15 +2,16 @@
[library
[lux (.except or template let |> `)]])
-(macro: (locally tokens lux)
- (.let [[prelude _] (symbol ._)]
- (case tokens
- (pattern (list [@ {.#Symbol ["" name]}]))
- {.#Right [lux (list (.` ("lux in-module" (~ [@ {.#Text prelude}])
- (~ [@ {.#Symbol [prelude name]}]))))]}
+(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 ""})))
+ _
+ {.#Left ""}))))
(.template [<name>]
[(def: <name> (..locally <name>))]
@@ -68,103 +69,108 @@
[frac$]
)
-(macro: .public (or tokens)
- (case tokens
- (pattern (partial_list [_ {.#Form patterns}] body branches))
- (case patterns
- {.#End}
- (failure (..wrong_syntax_error (symbol ..or)))
+(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 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 ..template))))
+
_
- (.let [pairs (.|> patterns
- (list#each (function (_ pattern) (list pattern body)))
- list#conjoint)]
- (meta#in (list#composite pairs branches))))
- _
- (failure (..wrong_syntax_error (symbol ..or)))))
-
-(macro: .public (template 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))
+ (failure (..wrong_syntax_error (symbol ..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})))))))))))
- {.#None}
- (failure (..wrong_syntax_error (symbol ..template))))
-
- _
- (failure (..wrong_syntax_error (symbol ..template)))))
-
-(macro: .public (multi 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)))))
-
-(macro: .public (let 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)))))
-
-(macro: .public (|> 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 ..|>)))))
+ _
+ (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)
@@ -230,17 +236,18 @@
[.#Tuple ..untemplated_tuple])
)))
-(macro: .public (` 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)))
+(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)))
+ (pattern (list template))
+ (do meta_monad
+ [pattern (untemplated_pattern template)]
+ (in (list pattern)))
- _
- (failure (..wrong_syntax_error (symbol ..`)))))
+ _
+ (failure (..wrong_syntax_error (symbol ..`))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 18:14:09 +0000