diff options
author | Eduardo Julian | 2017-01-04 23:06:04 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-01-04 23:06:04 -0400 |
commit | 069f66e0746488c9d2e3c26f14a09b5d416e456f (patch) | |
tree | 56a3c5efefeff0b12edf27880741b60f9e89de0c /stdlib/source/lux.lux | |
parent | 8343ca14bdc6ec29070021cb6d8ef05e0a234fb6 (diff) |
- Moved the template: macro to the lux module.
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux.lux | 114 |
1 files changed, 114 insertions, 0 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)))) + ))))) + )) |