- :: can now be used to refer to sub-structures within a structure.

5 files changed, 57 insertions, 43 deletions

diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index bac65ef16..541b4bcdc 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -2244,11 +2244,11 @@
                   "-")]
           ((_lux_: (-> Int Text Text)
              (lambda' recur [input  output]
-                 (if (i.= 0 input)
-                   (_lux_proc ["text" "append"] [sign output])
-                   (recur (i./ 10 input)
-                          (_lux_proc ["text" "append"] [(|> input (i.% 10) (_lux_:! Nat) digit-to-text)
-                                                        output])))))
+                      (if (i.= 0 input)
+                        (_lux_proc ["text" "append"] [sign output])
+                        (recur (i./ 10 input)
+                               (_lux_proc ["text" "append"] [(|> input (i.% 10) (_lux_:! Nat) digit-to-text)
+                                                             output])))))
            (|> value (i./ 10) Int/abs)
            (|> value (i.% 10) Int/abs (_lux_:! Nat) digit-to-text)))))
 
@@ -4204,24 +4204,6 @@
     _
     (list)))
 
-(def: (use-field prefix [module name] type)
-  (-> Text Ident Type (Lux [AST AST]))
-  (do Monad<Lux>
-    [output (resolve-type-tags type)
-     pattern (: (Lux AST)
-                (case output
-                  (#Some [tags members])
-                  (do Monad<Lux>
-                    [slots (mapM Monad<Lux>
-                                 (: (-> [Ident Type] (Lux [AST AST]))
-                                    (lambda [[sname stype]] (use-field prefix sname stype)))
-                                 (zip2 tags members))]
-                    (return (record$ slots)))
-                  
-                  #None
-                  (return (symbol$ ["" (Text/append prefix name)]))))]
-    (return [(tag$ [module name]) pattern])))
-
 (def: (Type/show type)
   (-> Type Text)
   (case type
@@ -4270,23 +4252,56 @@
     ($_ Text/append prefix ";" name)
     ))
 
+(def: (foldM Monad<m> f init inputs)
+  (All [m o i]
+    (-> (Monad m) (-> i o (m o)) o (List i) (m o)))
+  (case inputs
+    #;Nil
+    (do Monad<m>
+      []
+      (wrap init))
+
+    (#;Cons input inputs')
+    (do Monad<m>
+      [output (f input init)]
+      (foldM Monad<m> f output inputs'))))
+
 (macro: #hidden (^open' tokens)
   (case tokens
     (^ (list [_ (#SymbolS name)] [_ (#TextS prefix)] body))
     (do Monad<Lux>
-      [struct-type (find-type name)
-       output (resolve-type-tags struct-type)]
-      (case output
-        (#Some [tags members])
-        (do Monad<Lux>
-          [slots (mapM Monad<Lux> (: (-> [Ident Type] (Lux [AST AST]))
-                                     (lambda [[sname stype]] (use-field prefix sname stype)))
-                       (zip2 tags members))
-           #let [pattern (record$ slots)]]
-          (return (list (` (;_lux_case (~ (symbol$ name)) (~ pattern) (~ body))))))
+      [init-type (find-type name)
+       struct-evidence (resolve-type-tags init-type)]
+      (case struct-evidence
+        #;None
+        (fail (Text/append "Can only \"open\" structs: " (Type/show init-type)))
 
-        _
-        (fail (Text/append "Can only \"open\" structs: " (Type/show struct-type)))))
+        (#;Some tags&members)
+        (do Monad<Lux>
+          [full-body ((: (-> Ident [(List Ident) (List Type)] AST (Lux AST))
+                         (lambda recur [source [tags members] target]
+                           (let [pattern (record$ (map (lambda [[t-module t-name]]
+                                                         [(tag$ [t-module t-name])
+                                                          (symbol$ ["" (Text/append prefix t-name)])])
+                                                       tags))]
+                             (do Monad<Lux>
+                               [enhanced-target (foldM Monad<Lux>
+                                                       (lambda [[[_ m-name] m-type] enhanced-target]
+                                                         (do Monad<Lux>
+                                                           [m-structure (resolve-type-tags m-type)]
+                                                           (case m-structure
+                                                             (#;Some m-tags&members)
+                                                             (recur ["" (Text/append prefix m-name)]
+                                                                    m-tags&members
+                                                                    enhanced-target)
+
+                                                             #;None
+                                                             (wrap enhanced-target))))
+                                                       target
+                                                       (zip2 tags members))]
+                               (wrap (` (;_lux_case (~ (symbol$ source)) (~ pattern) (~ enhanced-target))))))))
+                      name tags&members body)]
+          (wrap (list full-body)))))
 
     _
     (fail "Wrong syntax for ^open")))
diff --git a/stdlib/source/lux/control/interval.lux b/stdlib/source/lux/control/interval.lux
index c007477b4..673ad630f 100644
--- a/stdlib/source/lux/control/interval.lux
+++ b/stdlib/source/lux/control/interval.lux
@@ -72,14 +72,14 @@
 (def: #export (union left right)
   (All [a] (-> (Interval a) (Interval a) (Interval a)))
   (struct (def: enum (get@ #enum right))
-          (def: bottom (order;min (get@ [#enum #enum;order] right) (:: left bottom) (:: right bottom)))
-          (def: top (order;max (get@ [#enum #enum;order] right) (:: left top) (:: right top)))))
+          (def: bottom (order;min (:: right order) (:: left bottom) (:: right bottom)))
+          (def: top (order;max (:: right order) (:: left top) (:: right top)))))
 
 (def: #export (intersection left right)
   (All [a] (-> (Interval a) (Interval a) (Interval a)))
   (struct (def: enum (get@ #enum right))
-          (def: bottom (order;max (get@ [#enum #enum;order] right) (:: left bottom) (:: right bottom)))
-          (def: top (order;min (get@ [#enum #enum;order] right) (:: left top) (:: right top)))))
+          (def: bottom (order;max (:: right order) (:: left bottom) (:: right bottom)))
+          (def: top (order;min (:: right order) (:: left top) (:: right top)))))
 
 (def: #export (complement interval)
   (All [a] (-> (Interval a) (Interval a)))
diff --git a/stdlib/source/lux/data/coll/ordered.lux b/stdlib/source/lux/data/coll/ordered.lux
index 37fbb1505..568a3f1be 100644
--- a/stdlib/source/lux/data/coll/ordered.lux
+++ b/stdlib/source/lux/data/coll/ordered.lux
@@ -489,5 +489,5 @@
 
 (struct: #export Eq<Set> (All [a] (Eq (Set a)))
   (def: (= reference sample)
-    (:: (list;Eq<List> (get@ [#order #order;eq] sample))
+    (:: (list;Eq<List> (:: sample eq))
         = (to-list reference) (to-list sample))))
diff --git a/stdlib/source/lux/data/coll/queue.lux b/stdlib/source/lux/data/coll/queue.lux
index 03d40b020..520211dca 100644
--- a/stdlib/source/lux/data/coll/queue.lux
+++ b/stdlib/source/lux/data/coll/queue.lux
@@ -36,7 +36,7 @@
 
 (def: #export empty?
   (All [a] (-> (Queue a) Bool))
-  (|>. (get@ [#front]) list;empty?))
+  (|>. (get@ #front) list;empty?))
 
 (def: #export (member? Eq<a> queue member)
   (All [a] (-> (Eq a) (Queue a) a Bool))
diff --git a/stdlib/source/lux/function/state.lux b/stdlib/source/lux/function/state.lux
index 5f5b96e4b..edca1d81b 100644
--- a/stdlib/source/lux/function/state.lux
+++ b/stdlib/source/lux/function/state.lux
@@ -83,8 +83,7 @@
 
 (struct: (Applicative<StateT> Monad<M>)
   (All [M s] (-> (Monad M) (Applicative (All [a] (-> s (M [s a]))))))
-  (def: functor (Functor<StateT> (get@ [#M;applicative #A;functor]
-                                       Monad<M>)))
+  (def: functor (Functor<StateT> (:: Monad<M> functor)))
 
   (def: (wrap a)
     (lambda [state]