From 069f66e0746488c9d2e3c26f14a09b5d416e456f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 4 Jan 2017 23:06:04 -0400 Subject: - Moved the template: macro to the lux module. --- stdlib/source/lux.lux | 114 ++++++++++++++++++++++++++++++++ stdlib/source/lux/macro/template.lux | 32 --------- stdlib/test/test/lux.lux | 10 +++ stdlib/test/test/lux/macro/template.lux | 27 -------- stdlib/test/tests.lux | 9 ++- 5 files changed, 128 insertions(+), 64 deletions(-) delete mode 100644 stdlib/source/lux/macro/template.lux delete mode 100644 stdlib/test/test/lux/macro/template.lux (limited to 'stdlib') 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 wrap [(#;Some #Export) tokens']) + + (^ (list& [_ (#TagS ["" "hidden"])] tokens')) + (:: Monad wrap [(#;Some #Hidden) tokens']) + + _ + (:: Monad 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 + [args (mapM Monad + (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 wrap [token tokens']) + + _ + (fail "Couldn't parse anything.") + )) + +(def: (parse-end tokens) + (-> (List AST) (Lux Unit)) + (case tokens + (^ (list)) + (:: Monad 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 wrap [(record$ _anns) tokens']) + + _ + (:: Monad 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 + [?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 Fold] - [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)))))))) - )) diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index 1085a1376..5b530ba98 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -172,3 +172,13 @@ (is "lol" (default "yolo" (#;Some "lol"))))) )) + +(template: (hypotenuse x y) + (i.+ (i.* x x) (i.* y y))) + +(test: "Templates" + [x R;int + y R;int] + (assert "Template application is a stand-in for the templated code." + (i.= (i.+ (i.* x x) (i.* y y)) + (hypotenuse x y)))) diff --git a/stdlib/test/test/lux/macro/template.lux b/stdlib/test/test/lux/macro/template.lux deleted file mode 100644 index 4ff5e683f..000000000 --- a/stdlib/test/test/lux/macro/template.lux +++ /dev/null @@ -1,27 +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 (codata [io]) - (control monad) - (data text/format - [error #- fail]) - (math ["R" random]) - pipe - [compiler] - (macro ["s" syntax] - ["&" template #+ template:])) - lux/test) - -(template: (hypotenuse x y) - (i.+ (i.* x x) (i.* y y))) - -(test: "Templates" - [x R;int - y R;int] - (assert "Template application is a stand-in for the templated code." - (i.= (i.+ (i.* x x) (i.* y y)) - (hypotenuse x y)))) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 9e7c1c246..c57ca61c5 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -48,19 +48,18 @@ [set] [stack] [tree] - [vector] + ## [vector] [zipper]) - (text [format])) + (text [format]) + ) ["_;" math] (math ["_;" ratio] ["_;" complex] ## ["_;" random] - ["_;" simple] - ) + ["_;" simple]) ## ["_;" macro] (macro ["_;" ast] ["_;" syntax] - ["_;" template] (poly ["poly_;" eq] ["poly_;" text-encoder] ["poly_;" functor])) -- cgit v1.2.3