diff options
author | Eduardo Julian | 2017-10-19 13:40:34 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-10-19 13:40:34 -0400 |
commit | eb770f4473a904285ea559279331a93cdb5b7ded (patch) | |
tree | ee727995b9215edec8c73a7dbe1516a2c5662b8e /stdlib/source/lux.lux | |
parent | 6c24a9830cfbf32fbbb6fbfd6f2b7354cb994605 (diff) |
- Implemented an more comfortable alternative to "with-expansions".
Diffstat (limited to 'stdlib/source/lux.lux')
-rw-r--r-- | stdlib/source/lux.lux | 65 |
1 files changed, 61 insertions, 4 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 205f1a543..fd8948164 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -4556,8 +4556,8 @@ ## => (function [<arg>] (fold text/compose \"\" - (interpose \" \" - (map int/encode <arg>))))"} + (interpose \" \" + (map int/encode <arg>))))"} (do Monad<Meta> [g!arg (gensym "arg")] (return (list (` (function [(~ g!arg)] (|> (~ g!arg) (~@ tokens)))))))) @@ -4568,8 +4568,8 @@ ## => (function [<arg>] (fold text/compose \"\" - (interpose \" \" - (map int/encode <arg>))))"} + (interpose \" \" + (map int/encode <arg>))))"} (do Monad<Meta> [g!arg (gensym "arg")] (return (list (` (function [(~ g!arg)] (<| (~@ tokens) (~ g!arg)))))))) @@ -5906,3 +5906,60 @@ _ (fail "Wrong syntax for 'for'")))) + +(do-template [<name> <type> <output>] + [(def: (<name> xy) + (All [a b] (-> [a b] <type>)) + (let [[x y] xy] + <output>))] + + [left a x] + [right b y]) + +(def: (label-code code) + (-> Code (Meta [(List [Code Code]) Code])) + (case code + (^ [ann (#Form (list [_ (#Symbol ["" "~~"])] expansion))]) + (do Monad<Meta> + [g!expansion (gensym "g!expansion")] + (wrap [(list [g!expansion expansion]) g!expansion])) + + (^template [<tag>] + [ann (<tag> parts)] + (do Monad<Meta> + [=parts (mapM Monad<Meta> label-code parts)] + (wrap [(fold list/compose (list) (map left =parts)) + [ann (<tag> (map right =parts))]]))) + ([#Form] [#Tuple]) + + [ann (#Record kvs)] + (do Monad<Meta> + [=kvs (mapM Monad<Meta> + (function [[key val]] + (do Monad<Meta> + [=key (label-code key) + =val (label-code val) + #let [[key-labels key-labelled] =key + [val-labels val-labelled] =val]] + (wrap [(list/compose key-labels val-labels) [key-labelled val-labelled]]))) + kvs)] + (wrap [(fold list/compose (list) (map left =kvs)) + [ann (#Record (map right =kvs))]])) + + _ + (:: Monad<Meta> wrap [(list) code]))) + +(macro: #export (`` tokens) + (case tokens + (^ (list raw)) + (do Monad<Meta> + [=raw (label-code raw) + #let [[labels labelled] =raw]] + (wrap (list (` (with-expansions [(~@ (|> labels + (map (function [[label expansion]] (list label expansion))) + list/join))] + (~ labelled)))))) + + _ + (fail "Wrong syntax for ``") + )) |