- Some refactoring.

- Small additions/features.

5 files changed, 167 insertions, 130 deletions

diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index a906c97aa..ca6ab6540 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -4,7 +4,7 @@
     [monad (#+ do)]
     ["p" parser]]
    [data
-    ["/" error (#+ Error)]
+    ["//" error (#+ Error)]
     ["." maybe]
     ["." product]
     ["." text ("text/." Monoid<Text>)]
@@ -37,33 +37,33 @@
     (-> (Exception e) (-> Text a) (Error a)
         (Error a)))
   (case try
-    (#/.Success output)
-    (#/.Success output)
+    (#//.Success output)
+    (#//.Success output)
 
-    (#/.Error error)
+    (#//.Error error)
     (let [reference (get@ #label exception)]
       (if (text.starts-with? reference error)
-        (#/.Success (|> error
-                        (text.clip (text.size reference) (text.size error))
-                        maybe.assume
-                        then))
-        (#/.Error error)))))
+        (#//.Success (|> error
+                         (text.clip (text.size reference) (text.size error))
+                         maybe.assume
+                         then))
+        (#//.Error error)))))
 
 (def: #export (otherwise to-do try)
   {#.doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."}
   (All [a]
     (-> (-> Text a) (Error a) a))
   (case try
-    (#/.Success output)
+    (#//.Success output)
     output
 
-    (#/.Error error)
+    (#//.Error error)
     (to-do error)))
 
 (def: #export (return value)
   {#.doc "A way to lift normal values into the error-handling context."}
   (All [a] (-> a (Error a)))
-  (#/.Success value))
+  (#//.Success value))
 
 (def: #export (construct exception message)
   {#.doc "Constructs an exception."}
@@ -73,12 +73,12 @@
 (def: #export (throw exception message)
   {#.doc "Decorate an error message with an Exception and lift it into the error-handling context."}
   (All [e] (-> (Exception e) e Error))
-  (#/.Error (construct exception message)))
+  (#//.Error (construct exception message)))
 
 (def: #export (assert exception message test)
   (All [e] (-> (Exception e) e Bit (Error Any)))
   (if test
-    (#/.Success [])
+    (#//.Success [])
     (..throw exception message)))
 
 (syntax: #export (exception: {export csr.export}
@@ -139,16 +139,16 @@
 (def: #export (with-stack exception message computation)
   (All [e a] (-> (Exception e) e (Error a) (Error a)))
   (case computation
-    (#/.Error error)
-    (#/.Error (case error
-                ""
-                (..construct exception message)
-
-                _
-                ($_ "lux text concat"
-                    (..construct exception message)
-                    ..separator
-                    error)))
+    (#//.Error error)
+    (#//.Error (case error
+                 ""
+                 (..construct exception message)
+
+                 _
+                 ($_ "lux text concat"
+                     (..construct exception message)
+                     ..separator
+                     error)))
 
     success
     success))
diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux
index 36b2354fc..6f07ceb0a 100644
--- a/stdlib/source/lux/control/monad.lux
+++ b/stdlib/source/lux/control/monad.lux
@@ -93,38 +93,42 @@
     (#.Left "Wrong syntax for 'do'")))
 
 ## [Functions]
-(def: #export (seq monad xs)
+(def: #export (seq monad)
   {#.doc "Run all the monadic values in the list and produce a list of the base values."}
   (All [M a]
-    (-> (Monad M) (List (M a)) (M (List a))))
-  (case xs
-    #.Nil
-    (:: monad wrap #.Nil)
-    
-    (#.Cons x xs')
-    (do monad
-      [_x x
-       _xs (seq monad xs')]
-      (wrap (#.Cons _x _xs)))
-    ))
-
-(def: #export (map monad f xs)
-  {#.doc "Apply a monad-producing function to all values in a list."}
+    (-> (Monad M) (List (M a))
+        (M (List a))))
+  (let [(^open "!/.") monad]
+    (function (recur xs)
+      (case xs
+        #.Nil
+        (!/wrap #.Nil)
+        
+        (#.Cons x xs')
+        (|> x
+            (!/map (function (_ _x)
+                     (!/map (|>> (#.Cons _x)) (recur xs'))))
+            !/join)))))
+
+(def: #export (map monad f)
+  {#.doc "Apply a monadic function to all values in a list."}
   (All [M a b]
-    (-> (Monad M) (-> a (M b)) (List a) (M (List b))))
-  (case xs
-    #.Nil
-    (:: monad wrap #.Nil)
-    
-    (#.Cons x xs')
-    (do monad
-      [_x (f x)
-       _xs (map monad f xs')]
-      (wrap (#.Cons _x _xs)))
-    ))
+    (-> (Monad M) (-> a (M b)) (List a)
+        (M (List b))))
+  (let [(^open "!/.") monad]
+    (function (recur xs)
+      (case xs
+        #.Nil
+        (!/wrap #.Nil)
+        
+        (#.Cons x xs')
+        (|> (f x)
+            (!/map (function (_ _x)
+                     (!/map (|>> (#.Cons _x)) (recur xs'))))
+            !/join)))))
 
 (def: #export (fold monad f init xs)
-  {#.doc "Fold a list with a monad-producing function."}
+  {#.doc "Fold a list with a monadic function."}
   (All [M a b]
     (-> (Monad M) (-> b a (M a)) a (List b)
         (M a)))
diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux
index 2e92ec64b..339e4e7ca 100644
--- a/stdlib/source/lux/data/collection/array.lux
+++ b/stdlib/source/lux/data/collection/array.lux
@@ -8,6 +8,7 @@
     [predicate (#+ Predicate)]]
    [data
     ["." product]
+    ["." maybe]
     [collection
      ["." list ("list/." Fold<List>)]]]
    [compiler
@@ -56,6 +57,23 @@
   (`` (for {(~~ (static host.jvm))
             ("jvm aastore" xs i x)})))
 
+(def: #export (update index transform array)
+  (All [a]
+    (-> Nat (-> a a) (Array a) (Array a)))
+  (case (read index array)
+    #.None
+    array
+
+    (#.Some value)
+    (write index (transform value) array)))
+
+(def: #export (upsert index default transform array)
+  (All [a]
+    (-> Nat a (-> a a) (Array a) (Array a)))
+  (write index
+         (|> array (read index) (maybe.default default) transform)
+         array))
+
 (def: #export (delete i xs)
   (All [a]
     (-> Nat (Array a) (Array a)))
@@ -182,6 +200,16 @@
                #.None
                output)))))
 
+(def: #export (to-list' default array)
+  (All [a] (-> a (Array a) (List a)))
+  (loop [idx (dec (size array))
+         output #.Nil]
+    (if (n/= underflow idx)
+      output
+      (recur (dec idx)
+             (#.Cons (maybe.default default (read idx array))
+                     output)))))
+
 (structure: #export (Equivalence<Array> Equivalence<a>)
   (All [a] (-> (Equivalence a) (Equivalence (Array a))))
   (def: (= xs ys)
diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
index 3a2b96635..7d2e55982 100644
--- a/stdlib/source/lux/type/check.lux
+++ b/stdlib/source/lux/type/check.lux
@@ -55,12 +55,11 @@
   (def: (map f fa)
     (function (_ context)
       (case (fa context)
-        (#error.Error error)
-        (#error.Error error)
-
         (#error.Success [context' output])
         (#error.Success [context' (f output)])
-        ))))
+
+        (#error.Error error)
+        (#error.Error error)))))
 
 (structure: #export _ (Apply Check)
   (def: functor Functor<Check>)
@@ -109,15 +108,14 @@
 (def: (var::get id plist)
   (-> Var Type-Vars (Maybe (Maybe Type)))
   (case plist
-    #.Nil
-    #.None
-
     (#.Cons [var-id var-type]
             plist')
     (if (!n/= id var-id)
       (#.Some var-type)
       (var::get id plist'))
-    ))
+
+    #.Nil
+    #.None))
 
 (def: (var::new id plist)
   (-> Var Type-Vars Type-Vars)
@@ -135,32 +133,30 @@
       (#.Cons [var-id value]
               plist')
       (#.Cons [var-id var-type]
-              (var::put id value plist')))
-    ))
+              (var::put id value plist')))))
 
 (def: (var::remove id plist)
   (-> Var Type-Vars Type-Vars)
   (case plist
-    #.Nil
-    #.Nil
-
     (#.Cons [var-id var-type]
             plist')
     (if (!n/= id var-id)
       plist'
       (#.Cons [var-id var-type]
               (var::remove id plist')))
-    ))
+
+    #.Nil
+    #.Nil))
 
 ## [[Logic]]
 (def: #export (run context proc)
   (All [a] (-> Type-Context (Check a) (Error a)))
   (case (proc context)
-    (#error.Error error)
-    (#error.Error error)
-
     (#error.Success [context' output])
-    (#error.Success output)))
+    (#error.Success output)
+
+    (#error.Error error)
+    (#error.Error error)))
 
 (def: #export (throw exception message)
   (All [e a] (-> (ex.Exception e) e (Check a)))
@@ -190,8 +186,8 @@
          #.None
          (ex.throw unknown-type-var id))))]
 
-  [bound? Bit #0 #1]
-  [read (Maybe Type) #.None (#.Some bound)]
+  [bound? Bit          #0     #1]
+  [read   (Maybe Type) #.None (#.Some bound)]
   )
 
 (def: (peek id)
@@ -201,24 +197,24 @@
       (#.Some (#.Some bound))
       (#error.Success [context bound])
 
-      (#.Some #.None)
+      (#.Some _)
       (ex.throw unbound-type-var id)
 
-      #.None
+      _
       (ex.throw unknown-type-var id))))
 
 (def: #export (bind type id)
   (-> Type Var (Check Any))
   (function (_ context)
     (case (|> context (get@ #.var-bindings) (var::get id))
-      (#.Some (#.Some bound))
-      (ex.throw cannot-rebind-var [id type bound])
-      
       (#.Some #.None)
       (#error.Success [(update@ #.var-bindings (var::put id (#.Some type)) context)
                        []])
 
-      #.None
+      (#.Some (#.Some bound))
+      (ex.throw cannot-rebind-var [id type bound])
+      
+      _
       (ex.throw unknown-type-var id))))
 
 (def: (update type id)
@@ -229,7 +225,7 @@
       (#error.Success [(update@ #.var-bindings (var::put id (#.Some type)) context)
                        []])
       
-      #.None
+      _
       (ex.throw unknown-type-var id))))
 
 (def: #export var
@@ -241,18 +237,6 @@
                            (update@ #.var-bindings (var::new id)))
                        [id (#.Var id)]]))))
 
-(def: get-bindings
-  (Check (List [Var (Maybe Type)]))
-  (function (_ context)
-    (#error.Success [context
-                     (get@ #.var-bindings context)])))
-
-(def: (set-bindings value)
-  (-> (List [Var (Maybe Type)]) (Check Any))
-  (function (_ context)
-    (#error.Success [(set@ #.var-bindings value context)
-                     []])))
-
 (def: (apply-type! funcT argT)
   (-> Type Type (Check Type))
   (case funcT
@@ -260,35 +244,35 @@
     (do Monad<Check>
       [?funcT' (read func-id)]
       (case ?funcT'
-        #.None
-        (throw invalid-type-application [funcT argT])
-
         (#.Some funcT')
-        (apply-type! funcT' argT)))
+        (apply-type! funcT' argT)
+
+        _
+        (throw invalid-type-application [funcT argT])))
 
     _
-    (function (_ context)
-      (case (//.apply (list argT) funcT)
-        #.None
-        (ex.throw invalid-type-application [funcT argT])
+    (case (//.apply (list argT) funcT)
+      (#.Some output)
+      (check/wrap output)
 
-        (#.Some output)
-        (#error.Success [context output])))))
+      _
+      (throw invalid-type-application [funcT argT]))))
 
 (type: #export Ring (Set Var))
 
 (def: empty-ring Ring (set.new number.Hash<Nat>))
 
-(def: #export (ring id)
+## TODO: Optimize this by not using sets anymore.
+(def: #export (ring start)
   (-> Var (Check Ring))
   (function (_ context)
-    (loop [current id
-           output (set.add id empty-ring)]
+    (loop [current start
+           output (set.add start empty-ring)]
       (case (|> context (get@ #.var-bindings) (var::get current))
         (#.Some (#.Some type))
         (case type
           (#.Var post)
-          (if (!n/= id post)
+          (if (!n/= start post)
             (#error.Success [context output])
             (recur post (set.add post output)))
           
@@ -351,6 +335,7 @@
   (-> Assumption (List Assumption) (List Assumption))
   (#.Cons assumption assumptions))
 
+## TODO: "if-bind" can be optimized...
 (def: (if-bind id type then else)
   (All [a]
     (-> Var Type (Check a) (-> Type (Check a))
@@ -360,7 +345,7 @@
         [_ (..bind type id)]
         then)
       (do Monad<Check>
-        [ring (ring id)
+        [ring (..ring id)
          _ (assert "" (n/> 1 (set.size ring)))
          _ (monad.map @ (update type) (set.to-list ring))]
         then)
@@ -368,18 +353,21 @@
         [?bound (read id)]
         (else (maybe.default (#.Var id) ?bound)))))
 
+## TODO: "link-2" can be optimized...
 (def: (link-2 left right)
   (-> Var Var (Check Any))
   (do Monad<Check>
     [_ (..bind (#.Var right) left)]
     (..bind (#.Var left) right)))
 
+## TODO: "link-3" can be optimized...
 (def: (link-3 interpose to from)
   (-> Var Var Var (Check Any))
   (do Monad<Check>
     [_ (update (#.Var interpose) from)]
     (update (#.Var to) interpose)))
 
+## TODO: "check-vars" can be optimized...
 (def: (check-vars check' assumptions idE idA)
   (-> (-> (List Assumption) Type Type (Check (List Assumption)))
       (List Assumption)
@@ -391,7 +379,7 @@
       [ebound (attempt (peek idE))
        abound (attempt (peek idA))]
       (case [ebound abound]
-        ## Link the 2 variables circularily
+        ## Link the 2 variables circularly
         [#.None #.None]
         (do @
           [_ (link-2 idE idA)]
@@ -423,8 +411,8 @@
         (case [etype atype]
           [(#.Var targetE) (#.Var targetA)]
           (do @
-            [ringE (ring idE)
-             ringA (ring idA)]
+            [ringE (..ring idE)
+             ringA (..ring idA)]
             (if (:: set.Equivalence<Set> = ringE ringA)
               (wrap assumptions)
               ## Fuse 2 rings
@@ -436,18 +424,15 @@
                                targetE
                                (set.to-list ringA))]
                 (wrap assumptions))))
-          
-          [(#.Var targetE) _]
-          (do @
-            [ring (ring idE)
-             _ (monad.map @ (update atype) (set.to-list ring))]
-            (wrap assumptions))
-          
-          [_ (#.Var targetA)]
-          (do @
-            [ring (ring idA)
-             _ (monad.map @ (update etype) (set.to-list ring))]
-            (wrap assumptions))
+
+          (^template [<pattern> <id> <type>]
+            <pattern>
+            (do @
+              [ring (..ring <id>)
+               _ (monad.map @ (update <type>) (set.to-list ring))]
+              (wrap assumptions)))
+          ([[(#.Var _) _] idE atype]
+           [[_ (#.Var _)] idA etype])
           
           _
           (check' assumptions etype atype))))))
@@ -472,6 +457,7 @@
       output
       output)))
 
+## TODO: "check-apply" can be optimized...
 (def: (check-apply check' assumptions [eAT eFT] [aAT aFT])
   (-> (-> (List Assumption) Type Type (Check (List Assumption))) (List Assumption)
       [Type Type] [Type Type]
@@ -523,6 +509,7 @@
     _
     (fail "")))
 
+## TODO: "check'" can be optimized...
 (def: #export (check' assumptions expected actual)
   {#.doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."}
   (-> (List Assumption) Type Type (Check (List Assumption)))
@@ -555,18 +542,19 @@
          [(#.Var id) F2])
         
         [(#.Apply A F) _]
-        (let [fx-pair [expected actual]]
-          (if (assumed? fx-pair assumptions)
+        (let [new-assumption [expected actual]]
+          (if (assumed? new-assumption assumptions)
             (check/wrap assumptions)
             (do Monad<Check>
               [expected' (apply-type! F A)]
-              (check' (assume! fx-pair assumptions) expected' actual))))
+              (check' (assume! new-assumption assumptions) expected' actual))))
 
         [_ (#.Apply A F)]
         (do Monad<Check>
           [actual' (apply-type! F A)]
           (check' assumptions expected actual'))
 
+        ## TODO: Refactor-away as cold-code
         (^template [<tag> <instancer>]
           [(<tag> _) _]
           (do Monad<Check>
@@ -576,6 +564,7 @@
         ([#.UnivQ ..existential]
          [#.ExQ ..var])
 
+        ## TODO: Refactor-away as cold-code
         (^template [<tag> <instancer>]
           [_ (<tag> _)]
           (do Monad<Check>
@@ -654,9 +643,9 @@
   (-> Type (Check Type))
   (case inputT
     (#.Primitive name paramsT+)
-    (do Monad<Check>
-      [paramsT+' (monad.map @ clean paramsT+)]
-      (wrap (#.Primitive name paramsT+')))
+    (|> paramsT+
+        (monad.map Monad<Check> clean)
+        (check/map (|>> (#.Primitive name))))
 
     (^or (#.Parameter _) (#.Ex _) (#.Named _))
     (check/wrap inputT)
@@ -664,9 +653,9 @@
     (^template [<tag>]
       (<tag> leftT rightT)
       (do Monad<Check>
-        [leftT' (clean leftT)
-         rightT' (clean rightT)]
-        (wrap (<tag> leftT' rightT'))))
+        [leftT' (clean leftT)]
+        (|> (clean rightT)
+            (check/map (|>> (<tag> leftT'))))))
     ([#.Sum] [#.Product] [#.Function] [#.Apply])
 
     (#.Var id)
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index aa8ce2116..4bc2e6632 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -4,8 +4,9 @@
     ["." monad (#+ Monad do)]
     ["ex" exception (#+ Exception exception:)]]
    [data
+    ["." maybe]
     ["." error (#+ Error)]
-    [text
+    ["." text
      format]
     [collection
      ["." array (#+ Array)]]]
@@ -83,6 +84,21 @@
      separator)
   )
 
+(def: #export (un-nest System<!> file)
+  (All [!] (-> (System !) File (Maybe [File Text])))
+  (case (text.last-index-of (:: System<!> separator) file)
+    #.None
+    #.None
+    
+    (#.Some last-separator)
+    (let [[parent temp] (maybe.assume (text.split last-separator file))
+          [_ child] (maybe.assume (text.split (text.size (:: System<!> separator)) temp))]
+      (#.Some [parent child]))))
+
+(def: #export (nest System<!> [parent child])
+  (All [!] (-> (System !) [File Text] File))
+  (format parent (:: System<!> separator) child))
+
 (do-template [<name>]
   [(exception: #export (<name> {file File})
      (ex.report ["File" file]))]