From eb770f4473a904285ea559279331a93cdb5b7ded Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 19 Oct 2017 13:40:34 -0400
Subject: - Implemented an more comfortable alternative to "with-expansions".

---
 stdlib/source/lux.lux | 65 +++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 61 insertions(+), 4 deletions(-)

(limited to 'stdlib/source/lux.lux')

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 ``")
+    ))
-- 
cgit v1.2.3