diff options
Diffstat (limited to 'stdlib/source/library/lux/meta/macro.lux')
| -rw-r--r-- | stdlib/source/library/lux/meta/macro.lux | 213 |
1 files changed, 213 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/meta/macro.lux b/stdlib/source/library/lux/meta/macro.lux new file mode 100644 index 000000000..86e9fe57d --- /dev/null +++ b/stdlib/source/library/lux/meta/macro.lux @@ -0,0 +1,213 @@ +(.require + [library + [lux (.except local symbol function macro) + [abstract + ["[0]" monad (.only do)]] + [data + ["[0]" text (.use "[1]#[0]" monoid)] + [collection + ["[0]" list (.use "[1]#[0]" monoid monad)]]] + [math + [number + ["[0]" nat] + ["[0]" int]]]]] + ["[0]" // (.only) + ["[0]" code] + ["[0]" location] + ["[0]" symbol (.use "[1]#[0]" codec)]]) + +(def .public (single_expansion syntax) + (-> Code (Meta (List Code))) + (case syntax + [_ {.#Form {.#Item [[_ {.#Symbol name}] args]}}] + (do //.monad + [?macro (//.macro name)] + (case ?macro + {.#Some macro} + ((as Macro' macro) args) + + {.#None} + (at //.monad in (list syntax)))) + + _ + (at //.monad in (list syntax)))) + +(def .public (expansion syntax) + (-> Code (Meta (List Code))) + (case syntax + [_ {.#Form {.#Item [[_ {.#Symbol name}] args]}}] + (do //.monad + [?macro (//.macro name)] + (case ?macro + {.#Some macro} + (do [! //.monad] + [top_level_expansion ((as Macro' macro) args)] + (|> top_level_expansion + (monad.each //.monad expansion) + (at ! each list#conjoint))) + + {.#None} + (at //.monad in (list syntax)))) + + _ + (at //.monad in (list syntax)))) + +(def .public (full_expansion syntax) + (-> Code (Meta (List Code))) + (case syntax + [_ {.#Form {.#Item [[_ {.#Symbol name}] args]}}] + (do //.monad + [?macro (//.macro name)] + (case ?macro + {.#Some macro} + (do //.monad + [expansion ((as Macro' macro) args) + expansion' (monad.each //.monad full_expansion expansion)] + (in (list#conjoint expansion'))) + + {.#None} + (do //.monad + [parts' (monad.each //.monad full_expansion (list.partial (code.symbol name) args))] + (in (list (code.form (list#conjoint parts'))))))) + + [_ {.#Form {.#Item [harg targs]}}] + (do //.monad + [harg+ (full_expansion harg) + targs+ (monad.each //.monad full_expansion targs)] + (in (list (code.form (list#composite harg+ (list#conjoint (is (List (List Code)) targs+))))))) + + [_ {.#Variant members}] + (do //.monad + [members' (monad.each //.monad full_expansion members)] + (in (list (code.variant (list#conjoint members'))))) + + [_ {.#Tuple members}] + (do //.monad + [members' (monad.each //.monad full_expansion members)] + (in (list (code.tuple (list#conjoint members'))))) + + _ + (at //.monad in (list syntax)))) + +(def .public (symbol prefix) + (-> Text (Meta Code)) + (do //.monad + [id //.seed] + (in (|> id + (at nat.decimal encoded) + (all text#composite "__gensym__" prefix) + [""] code.symbol)))) + +(def (local ast) + (-> Code (Meta Text)) + (case ast + [_ {.#Symbol [_ name]}] + (at //.monad in name) + + _ + (//.failure (text#composite "Code is not a local symbol: " (code.format ast))))) + +(def .public wrong_syntax_error + (-> Symbol Text) + (|>> symbol#encoded + (text.prefix (text#composite "Wrong syntax for " text.\'')) + (text.suffix (text#composite text.\'' ".")))) + +(def .public with_symbols + (.macro (_ tokens) + (case tokens + (pattern (list [_ {.#Tuple symbols}] body)) + (do [! //.monad] + [symbol_names (monad.each ! ..local symbols) + .let [symbol_defs (list#conjoint (list#each (is (-> Text (List Code)) + (.function (_ name) (list (code.symbol ["" name]) (` (..symbol (, (code.text name))))))) + symbol_names))]] + (in (list (` ((,! do) (,! //.monad) + [(,* symbol_defs)] + (, body)))))) + + _ + (//.failure (..wrong_syntax_error (.symbol ..with_symbols)))))) + +(def .public (one_expansion token) + (-> Code (Meta Code)) + (do //.monad + [token+ (..expansion token)] + (case token+ + (pattern (list token')) + (in token') + + _ + (//.failure "Macro expanded to more than 1 element.")))) + +(with_template [<macro> <func>] + [(def .public <macro> + (.macro (_ tokens) + (let [[module _] (.symbol .._) + [_ short] (.symbol <macro>) + macro_name [module short]] + (case (is (Maybe [Bit Code]) + (case tokens + (pattern (list [_ {.#Text "omit"}] + token)) + {.#Some [#1 token]} + + (pattern (list token)) + {.#Some [#0 token]} + + _ + {.#None})) + {.#Some [omit? token]} + (do //.monad + [location //.location + output (<func> token) + .let [_ ("lux io log" (all text#composite (symbol#encoded macro_name) " " (location.format location))) + _ (list#each (|>> code.format "lux io log") + output) + _ ("lux io log" "")]] + (in (if omit? + (list) + output))) + + {.#None} + (//.failure (..wrong_syntax_error macro_name))))))] + + [log_single_expansion! ..single_expansion] + [log_expansion! ..expansion] + [log_full_expansion! ..full_expansion] + ) + +(def .public times + (.macro (_ tokens) + (case tokens + (pattern (list.partial [_ {.#Nat times}] terms)) + (loop (again [times times + before terms]) + (case times + 0 + (at //.monad in before) + + _ + (do [! //.monad] + [after (|> before + (monad.each ! ..single_expansion) + (at ! each list#conjoint))] + (again (-- times) after)))) + + _ + (//.failure (..wrong_syntax_error (.symbol ..times)))))) + +(def .public final + (.macro (_ it) + (let [! //.monad] + (|> it + (monad.each ! ..expansion) + (at ! each list#conjoint))))) + +(def .public function + (-> Macro Macro') + (|>> (as Macro'))) + +(def .public macro + (-> Macro' Macro) + (|>> (as Macro))) |