From cc928a8675cb35dabd4a4957ab6612b70f015d58 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 29 Aug 2015 18:12:27 -0400
Subject: - Removed the (unnecessary) lux/data/cont module. - Removed the
 (unnecessary) lux/data/error module and moved it's structures to
 lux/data/either. - Implemented the \slots destructurer for records. -
 Implemented quicksort for lists as the "sort" function in lux/data/list. -
 Added tags for the Cursor type.

---
 source/lux.lux | 45 +++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 41 insertions(+), 4 deletions(-)

(limited to 'source/lux.lux')

diff --git a/source/lux.lux b/source/lux.lux
index d96b18fcb..cf56f326a 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -160,6 +160,7 @@
   (#NamedT ["lux" "Cursor"]
            (#TupleT (#Cons Text (#Cons Int (#Cons Int #Nil))))))
 (_lux_export Cursor)
+(_lux_declare-tags [#module #line #column] Cursor)
 
 ## (deftype (Meta m v)
 ##   (| (#Meta m v)))
@@ -785,8 +786,8 @@
     (#Meta _ (#RecordS pairs))
     (record$ (map (_lux_: (->' (#TupleT (#Cons AST (#Cons AST #Nil))) (#TupleT (#Cons AST (#Cons AST #Nil))))
                           (lambda'' [pair]
-                               (let'' [name val] pair
-                                      [name (update-bounds val)])))
+                                    (let'' [name val] pair
+                                           [name (update-bounds val)])))
                   pairs))
 
     (#Meta _ (#FormS (#Cons (#Meta _ (#TagS "lux" "BoundT")) (#Cons (#Meta _ (#IntS idx)) #Nil))))
@@ -931,8 +932,8 @@
 (def''' (as-pairs xs)
   (All' [a] (->' ($' List a) ($' List (#TupleT (list a a)))))
   (_lux_case xs
-    (#Cons [x (#Cons [y xs'])])
-    (#Cons [[x y] (as-pairs xs')])
+    (#Cons x (#Cons y xs'))
+    (#Cons [x y] (as-pairs xs'))
 
     _
     #Nil))
@@ -3224,3 +3225,39 @@
 
 (defmacro #export (export tokens)
   (return (map (lambda [token] (` (_lux_export (~ token)))) tokens)))
+
+(defmacro #export (\slots tokens)
+  (case tokens
+    (\ (list body (#Meta _ (#TupleS (list& hslot' tslots')))))
+    (do Lux/Monad
+      [slots (: (Lux (, Ident (List Ident)))
+                (case (: (Maybe (, Ident (List Ident)))
+                         (do Maybe/Monad
+                           [hslot (get-ident hslot')
+                            tslots (map% Maybe/Monad get-ident tslots')]
+                           (wrap [hslot tslots])))
+                  (#Some slots)
+                  (return slots)
+                  
+                  #None
+                  (fail "Wrong syntax for \\slots")))
+       #let [[hslot tslots] slots]
+       hslot (normalize hslot)
+       tslots (map% Lux/Monad normalize tslots)
+       output (resolve-tag hslot)
+       g!_ (gensym "_")
+       #let [[idx tags type] output
+             slot-pairings (map (: (-> Ident (, Text AST))
+                                   (lambda [[module name]] [name (symbol$ ["" name])]))
+                                (list& hslot tslots))
+             pattern (record$ (map (: (-> Ident (, AST AST))
+                                      (lambda [[module name]]
+                                        (let [tag (tag$ [module name])]
+                                          (case (get name slot-pairings)
+                                            (#Some binding) [tag binding]
+                                            #None           [tag g!_]))))
+                                   tags))]]
+      (return (list pattern body)))
+    
+    _
+    (fail "Wrong syntax for \\slots")))
-- 
cgit v1.2.3