diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux.lux | 114 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/template.lux | 32 |
2 files changed, 114 insertions, 32 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 4ff962e0f..13dc4072e 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -5597,3 +5597,117 @@ _ (fail "Wrong syntax for type-of"))) + +(type: #hidden Export-Level' + #Export + #Hidden) + +(def: (parse-export-level tokens) + (-> (List AST) (Lux [(Maybe Export-Level') (List AST)])) + (case tokens + (^ (list& [_ (#TagS ["" "export"])] tokens')) + (:: Monad<Lux> wrap [(#;Some #Export) tokens']) + + (^ (list& [_ (#TagS ["" "hidden"])] tokens')) + (:: Monad<Lux> wrap [(#;Some #Hidden) tokens']) + + _ + (:: Monad<Lux> wrap [#;None tokens]) + )) + +(def: (gen-export-level ?export-level) + (-> (Maybe Export-Level') (List AST)) + (case ?export-level + #;None + (list) + + (#;Some #Export) + (list (' #export)) + + (#;Some #Hidden) + (list (' #hidden)) + )) + +(def: (parse-complex-declaration tokens) + (-> (List AST) (Lux [[Text (List Text)] (List AST)])) + (case tokens + (^ (list& [_ (#FormS (list& [_ (#SymbolS ["" name])] args'))] tokens')) + (do Monad<Lux> + [args (mapM Monad<Lux> + (lambda [arg'] + (case arg' + [_ (#SymbolS ["" arg-name])] + (wrap arg-name) + + _ + (fail "Couldn't parse an argument."))) + args')] + (wrap [[name args] tokens'])) + + _ + (fail "Couldn't parse a complex declaration.") + )) + +(def: (parse-any tokens) + (-> (List AST) (Lux [AST (List AST)])) + (case tokens + (^ (list& token tokens')) + (:: Monad<Lux> wrap [token tokens']) + + _ + (fail "Couldn't parse anything.") + )) + +(def: (parse-end tokens) + (-> (List AST) (Lux Unit)) + (case tokens + (^ (list)) + (:: Monad<Lux> wrap []) + + _ + (fail "Expected input ASTs to be empty.") + )) + +(def: (parse-anns tokens) + (-> (List AST) (Lux [AST (List AST)])) + (case tokens + (^ (list& [_ (#RecordS _anns)] tokens')) + (:: Monad<Lux> wrap [(record$ _anns) tokens']) + + _ + (:: Monad<Lux> wrap [(' {}) tokens]) + )) + +(macro: #export (template: tokens) + {#;doc (doc "Define macros in the style of do-template and ^template." + "For simple macros that don't need any fancy features." + (template: (square x) + (i.* x x)))} + (do Monad<Lux> + [?export-level|tokens (parse-export-level tokens) + #let [[?export-level tokens] ?export-level|tokens] + name+args|tokens (parse-complex-declaration tokens) + #let [[[name args] tokens] name+args|tokens] + anns|tokens (parse-anns tokens) + #let [[anns tokens] anns|tokens] + input-template|tokens (parse-any tokens) + #let [[input-template tokens] input-template|tokens] + _ (parse-end tokens) + g!tokens (gensym "tokens") + g!compiler (gensym "compiler") + g!_ (gensym "_") + #let [rep-env (map (lambda [arg] + [arg (` ((~' ~) (~ (symbol$ ["" arg]))))]) + args)]] + (wrap (list (` (macro: (~@ (gen-export-level ?export-level)) + ((~ (symbol$ ["" name])) (~ g!tokens) (~ g!compiler)) + (~ anns) + (case (~ g!tokens) + (^ (list (~@ (map (|>. [""] symbol$) args)))) + (#;Right [(~ g!compiler) + (list (` (~ (replace-syntax rep-env input-template))))]) + + (~ g!_) + (#;Left (~ (text$ (Text/append "Wrong syntax for " name)))) + ))))) + )) diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux deleted file mode 100644 index 293c87509..000000000 --- a/stdlib/source/lux/macro/template.lux +++ /dev/null @@ -1,32 +0,0 @@ -## Copyright (c) Eduardo Julian. All rights reserved. -## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. -## If a copy of the MPL was not distributed with this file, -## You can obtain one at http://mozilla.org/MPL/2.0/. - -(;module: - lux - (lux (control monad) - (data (struct [list "" Monad<List> Fold<List>] - [dict #+ Dict]) - [text]) - [compiler] - (macro [ast] - ["s" syntax #+ syntax: Syntax] - (syntax [common])))) - -## [Syntax] -(syntax: #export (template: [_ex-lev common;export-level] [[name args] common;decl] input-template) - {#;doc (doc "Define macros in the style of do-template and ^template." - "For simple macros that don't need any fancy features." - (template: (square x) - (i.* x x)))} - (let [output-template (fold (lambda [arg' template'] - (ast;replace arg' - (` ((~' ~) (~ arg'))) - template')) - input-template - (map ast;local-symbol args))] - (wrap (list (` (syntax: (~@ (common;gen-export-level _ex-lev)) ((~ (ast;symbol ["" name])) - (~@ (map (|>. [""] ast;symbol) args))) - ((~' wrap) (list (` (~ output-template)))))))) - )) |