diff options
Diffstat (limited to 'stdlib/source/library/lux/macro/pattern.lux')
-rw-r--r-- | stdlib/source/library/lux/macro/pattern.lux | 235 |
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 ..`)))))) |