aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/source/lux.lux114
-rw-r--r--stdlib/source/lux/macro/template.lux32
-rw-r--r--stdlib/test/test/lux.lux10
-rw-r--r--stdlib/test/test/lux/macro/template.lux27
-rw-r--r--stdlib/test/tests.lux9
5 files changed, 128 insertions, 64 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))))))))
- ))
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]))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 07:59:10 +0000