Some tweaks to how dictionaries and rows work.

13 files changed, 112 insertions, 87 deletions

diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el
index 26b31f03c..47a90d0bb 100644
--- a/lux-mode/lux-mode.el
+++ b/lux-mode/lux-mode.el
@@ -361,6 +361,9 @@ highlighted region)."
           (font-lock-syntactic-face-function
            . lux-font-lock-syntactic-face-function))))
 
+(defvar withRE (concat "with" (altRE "-" "\\'")))
+(defvar definitionRE ":\\'")
+
 (defun lux-indent-function (indent-point state)
   "When indenting a line within a function call, indent properly.
 
@@ -416,8 +419,8 @@ This function also returns nil meaning don't specify the indentation."
               ((or (eq method 'defun)
                    (and (null method)
                         (> (length function) 2)
-                        (or (string-match "with-" function)
-                            (string-match ":\\'" function))))
+						(or (string-match withRE function)
+                            (string-match definitionRE function))))
                (lisp-indent-defform state indent-point))
               ((integerp method)
                (lisp-indent-specform method state
diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index 118b9ed1a..ed200189c 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -153,7 +153,7 @@
       ..separator
       error))
 
-(def: #export (with-stack exception message computation)
+(def: #export (with exception message computation)
   (All [e a] (-> (Exception e) e (Try a) (Try a)))
   (case computation
     (#//.Failure error)
diff --git a/stdlib/source/lux/control/try.lux b/stdlib/source/lux/control/try.lux
index 3b27fd6a3..7202f5c75 100644
--- a/stdlib/source/lux/control/try.lux
+++ b/stdlib/source/lux/control/try.lux
@@ -122,6 +122,7 @@
 (macro: #export (default tokens compiler)
   {#.doc (doc "Allows you to provide a default value that will be used"
               "if a (Try x) value turns out to be #Failure."
+              "Note: the expression for the default value will not be computed if the base computation succeeds."
               (= "bar"
                  (default "foo" (#Success "bar")))
               (= "foo"
diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux
index 195640d66..c4c8efeb1 100644
--- a/stdlib/source/lux/data/collection/dictionary.lux
+++ b/stdlib/source/lux/data/collection/dictionary.lux
@@ -4,6 +4,9 @@
     [hash (#+ Hash)]
     [equivalence (#+ Equivalence)]
     [functor (#+ Functor)]]
+   [control
+    ["." try (#+ Try)]
+    ["." exception (#+ exception:)]]
    [data
     ["." maybe]
     ["." product]
@@ -569,12 +572,14 @@
     #.None     #0
     (#.Some _) #1))
 
+(exception: #export key-already-exists)
+
 (def: #export (try-put key val dict)
   {#.doc "Only puts the KV-pair if the key is not already present."}
-  (All [k v] (-> k v (Dictionary k v) (Dictionary k v)))
+  (All [k v] (-> k v (Dictionary k v) (Try (Dictionary k v))))
   (case (get key dict)
-    #.None     (put key val dict)
-    (#.Some _) dict))
+    #.None     (#try.Success (put key val dict))
+    (#.Some _) (exception.throw ..key-already-exists [])))
 
 (def: #export (update key f dict)
   {#.doc "Transforms the value located at key (if available), using the given function."}
diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux
index d73f8bbf5..2b7b555be 100644
--- a/stdlib/source/lux/data/collection/row.lux
+++ b/stdlib/source/lux/data/collection/row.lux
@@ -10,6 +10,8 @@
     [fold (#+ Fold)]
     [predicate (#+ Predicate)]]
    [control
+    ["." try (#+ Try)]
+    ["." exception (#+ exception:)]
     ["p" parser
      ["s" code (#+ Parser)]]]
    [data
@@ -225,59 +227,71 @@
           (set@ #tail (new-tail val)))
       )))
 
+(exception: incorrect-row-structure)
+
+(exception: #export [a] (index-out-of-bounds {row (Row a)} {index Nat})
+  (exception.report ["Size" (:: n.decimal encode (get@ #size row))]
+                    ["Index" (:: n.decimal encode index)]))
+
+(exception: base-was-not-found)
+
+(def: #export (within-bounds? row idx)
+  (All [a] (-> (Row a) Nat Bit))
+  (and (n.>= 0 idx)
+       (n.< (get@ #size row) idx)))
+
 (def: (base-for idx row)
-  (All [a] (-> Index (Row a) (Maybe (Base a))))
-  (let [row-size (get@ #size row)]
-    (if (and (n.>= 0 idx)
-             (n.< row-size idx))
-      (if (n.>= (tail-off row-size) idx)
-        (#.Some (get@ #tail row))
-        (loop [level (get@ #level row)
-               hierarchy (get@ #root row)]
-          (case [(n.> branching-exponent level)
-                 (array.read (branch-idx (i64.logic-right-shift level idx)) hierarchy)]
-            [#1 (#.Some (#Hierarchy sub))]
-            (recur (level-down level) sub)
-
-            [#0 (#.Some (#Base base))]
-            (#.Some base)
-
-            [_ #.None]
-            #.None
-
-            _
-            (error! "Incorrect row structure."))))
-      #.None)))
+  (All [a] (-> Index (Row a) (Try (Base a))))
+  (if (within-bounds? row idx)
+    (if (n.>= (tail-off (get@ #size row)) idx)
+      (#try.Success (get@ #tail row))
+      (loop [level (get@ #level row)
+             hierarchy (get@ #root row)]
+        (case [(n.> branching-exponent level)
+               (array.read (branch-idx (i64.logic-right-shift level idx)) hierarchy)]
+          [#1 (#.Some (#Hierarchy sub))]
+          (recur (level-down level) sub)
+
+          [#0 (#.Some (#Base base))]
+          (#try.Success base)
+
+          [_ #.None]
+          (exception.throw ..base-was-not-found [])
+
+          _
+          (exception.throw ..incorrect-row-structure []))))
+    (exception.throw ..index-out-of-bounds [row idx])))
 
 (def: #export (nth idx row)
-  (All [a] (-> Nat (Row a) (Maybe a)))
-  (do maybe.monad
+  (All [a] (-> Nat (Row a) (Try a)))
+  (do try.monad
     [base (base-for idx row)]
-    (array.read (branch-idx idx) base)))
+    (case (array.read (branch-idx idx) base)
+      (#.Some value)
+      (#try.Success value)
+      
+      #.None
+      (exception.throw ..incorrect-row-structure []))))
 
 (def: #export (put idx val row)
-  (All [a] (-> Nat a (Row a) (Row a)))
+  (All [a] (-> Nat a (Row a) (Try (Row a))))
   (let [row-size (get@ #size row)]
-    (if (and (n.>= 0 idx)
-             (n.< row-size idx))
-      (if (n.>= (tail-off row-size) idx)
-        (update@ #tail (`` (for {(~~ (static @.old))
-                                 (: (-> (Base ($ 0)) (Base ($ 0)))
-                                    (|>> array.clone (array.write (branch-idx idx) val)))}
-                                (|>> array.clone (array.write (branch-idx idx) val))))
-                 row)
-        (update@ #root (put' (get@ #level row) idx val)
-                 row))
-      row)))
+    (if (within-bounds? row idx)
+      (#try.Success (if (n.>= (tail-off row-size) idx)
+                      (update@ #tail (`` (for {(~~ (static @.old))
+                                               (: (-> (Base ($ 0)) (Base ($ 0)))
+                                                  (|>> array.clone (array.write (branch-idx idx) val)))}
+                                              (|>> array.clone (array.write (branch-idx idx) val))))
+                               row)
+                      (update@ #root (put' (get@ #level row) idx val)
+                               row)))
+      (exception.throw ..index-out-of-bounds [row idx]))))
 
 (def: #export (update idx f row)
-  (All [a] (-> Nat (-> a a) (Row a) (Row a)))
-  (case (nth idx row)
-    (#.Some val)
-    (put idx (f val) row)
-
-    #.None
-    row))
+  (All [a] (-> Nat (-> a a) (Row a) (Try (Row a))))
+  (do try.monad
+    [val (nth idx row)]
+    (put idx (f val) row)))
 
 (def: #export (pop row)
   (All [a] (-> (Row a) (Row a)))
diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux
index 3a8bc8497..6d425011c 100644
--- a/stdlib/source/lux/data/maybe.lux
+++ b/stdlib/source/lux/data/maybe.lux
@@ -89,6 +89,7 @@
 (macro: #export (default tokens state)
   {#.doc (doc "Allows you to provide a default value that will be used"
               "if a (Maybe x) value turns out to be #.None."
+              "Note: the expression for the default value will not be computed if the base computation succeeds."
               (default +20 (#.Some +10))
               "=>"
               +10
diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux
index b0d5c46fa..2e4ff9937 100644
--- a/stdlib/source/lux/target/jvm/constant/pool.lux
+++ b/stdlib/source/lux/target/jvm/constant/pool.lux
@@ -53,7 +53,7 @@
       (with-expansions [<try-again> (as-is (recur (.inc idx)))]
         (loop [idx 0]
           (case (row.nth idx pool)
-            (#.Some entry)
+            (#try.Success entry)
             (case entry
               [index (<tag> reference)]
               (if (:: <equivalence> = reference <value>')
@@ -64,7 +64,7 @@
               _
               <try-again>)
             
-            #.None
+            (#try.Failure _)
             (let [new (<tag> <value>')]
               (do try.monad
                 [@new (//unsigned.u2 (//.size new))
diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux
index dfb7baf7e..0e9aa8f79 100644
--- a/stdlib/source/lux/time/date.lux
+++ b/stdlib/source/lux/time/date.lux
@@ -94,21 +94,24 @@
       (i.- (i./ +100 year))
       (i.+ (i./ +400 year))))
 
-(def: normal-months
+(def: #export common-months
   (Row Nat)
   (row 31 28 31
        30 31 30
        31 31 30
        31 30 31))
 
-(def: leap-year-months
+(def: #export leap-year-months
   (Row Nat)
-  (row.update [1] inc normal-months))
+  (|> common-months
+      (row.update 1 inc)
+      maybe.assume))
 
 (def: (divisible? factor input)
   (-> Int Int Bit)
   (|> input (i.% factor) (i.= +0)))
 
+## https://en.wikipedia.org/wiki/Leap_year#Algorithm
 (def: (leap-year? year)
   (-> Int Bit)
   (and (divisible? +4 year)
@@ -138,7 +141,7 @@
              _ (p.fail "Invalid month."))
      #let [months (if (leap-year? utc-year)
                     leap-year-months
-                    normal-months)
+                    common-months)
            month-days (|> months
                           (row.nth (.nat (dec utc-month)))
                           maybe.assume)]
diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux
index b9d504f1a..a8d308951 100644
--- a/stdlib/source/lux/time/instant.lux
+++ b/stdlib/source/lux/time/instant.lux
@@ -107,17 +107,6 @@
           (recur (dec reference) (duration.merge year time-left)))
         ))))
 
-(def: normal-months
-  (Row Nat)
-  (row 31 28 31
-       30 31 30
-       31 31 30
-       31 30 31))
-
-(def: leap-year-months
-  (Row Nat)
-  (row.update [1] inc normal-months))
-
 (def: (find-month months time)
   (-> (Row Nat) duration.Duration [Nat duration.Duration])
   (if (order.>= duration.order duration.empty time)
@@ -254,8 +243,8 @@
 ##                  (and (i.>= +1 utc-month)
 ##                       (i.<= +12 utc-month)))
 ##      #let [months (if (leap-year? utc-year)
-##                     leap-year-months
-##                     normal-months)
+##                     date.leap-year-months
+##                     date.common-months)
 ##            month-days (|> months
 ##                           (row.nth (.nat (dec utc-month)))
 ##                           maybe.assume)]
diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
index 36254634e..b561823ee 100644
--- a/stdlib/source/lux/type/check.lux
+++ b/stdlib/source/lux/type/check.lux
@@ -531,9 +531,9 @@
       _
       (fail ""))))
 
-(def: (with-stack exception parameter check)
+(def: (with exception parameter check)
   (All [e a] (-> (Exception e) e (Check a) (Check a)))
-  (|>> check (exception.with-stack exception parameter)))
+  (|>> check (exception.with exception parameter)))
 
 ## TODO: "check'" can be optimized...
 (def: #export (check' assumptions expected actual)
@@ -541,7 +541,7 @@
   (Checker Type)
   (if (is? expected actual)
     (check@wrap assumptions)
-    (with-stack type-check-failed [expected actual]
+    (with type-check-failed [expected actual]
       (case [expected actual]
         [(#.Var idE) (#.Var idA)]
         (check-vars check' assumptions idE idA)
diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux
index 652ff6127..55583e45f 100644
--- a/stdlib/source/lux/type/implicit.lux
+++ b/stdlib/source/lux/type/implicit.lux
@@ -4,6 +4,7 @@
     ["." monad (#+ Monad do)]
     ["eq" equivalence]]
    [control
+    ["." try]
     ["p" parser
      ["s" code (#+ Parser)]]]
    [data
@@ -132,7 +133,7 @@
   (do macro.monad
     [local-batches macro.locals
      #let [total-locals (list@fold (function (_ [name type] table)
-                                     (dict.try-put name type table))
+                                     (try.default table (dict.try-put name type table)))
                                    (: (Dictionary Text Type)
                                       (dict.new text.hash))
                                    (list@join local-batches))]]
diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux
index 432909629..55b569a31 100644
--- a/stdlib/source/test/lux/data/collection/dictionary.lux
+++ b/stdlib/source/test/lux/data/collection/dictionary.lux
@@ -9,6 +9,8 @@
      [/
       ["$." equivalence]
       ["$." functor (#+ Injection)]]}]
+   [control
+    ["." try]]
    [data
     ["." maybe]
     [number
@@ -67,15 +69,20 @@
                       _          #1))
 
             (_.test "Should be able to try-put and then get a value."
-                    (case (/.get non-key (/.try-put non-key test-val dict))
-                      (#.Some v) (n.= test-val v)
-                      _          #1))
+                    (case (/.try-put non-key test-val dict)
+                      (#try.Success dict)
+                      (case (/.get non-key dict)
+                        (#.Some v) (n.= test-val v)
+                        _          true)
+
+                      (#try.Failure _)
+                      false))
             (_.test "Shouldn't be able to try-put an existing key."
                     (or (n.= 0 size)
                         (let [first-key (|> dict /.keys list.head maybe.assume)]
-                          (case (/.get first-key (/.try-put first-key test-val dict))
-                            (#.Some v) (not (n.= test-val v))
-                            _          #1))))
+                          (case (/.try-put first-key test-val dict)
+                            (#try.Success _) false
+                            (#try.Failure _) true))))
             (_.test "Removing a key should make it's value inaccessible."
                     (let [base (/.put non-key test-val dict)]
                       (and (/.contains? non-key base)
diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux
index 80917c7eb..c6f462825 100644
--- a/stdlib/source/test/lux/data/collection/row.lux
+++ b/stdlib/source/test/lux/data/collection/row.lux
@@ -12,8 +12,9 @@
       ["$." functor (#+ Injection)]
       ["$." apply]
       ["$." monad]]}]
+   [control
+    ["." try]]
    [data
-    ["." maybe]
     [number
      ["n" nat]]
     [collection
@@ -54,19 +55,19 @@
                           (and (n.= (inc size) (/.size (/.add non-member sample)))
                                (n.= (dec size) (/.size (/.pop sample)))))
                   (_.test (format (%.name (name-of /.put))
-                                  " " (%.name (name-of /.nth)))
+                                  " &&& " (%.name (name-of /.nth)))
                           (|> sample
-                              (/.put idx non-member)
-                              (/.nth idx)
-                              maybe.assume
+                              (/.put idx non-member) try.assume
+                              (/.nth idx) try.assume
                               (is? non-member)))
                   (_.test (%.name (name-of /.update))
                           (|> sample
-                              (/.put idx non-member) (/.update idx inc)
-                              (/.nth idx) maybe.assume
+                              (/.put idx non-member) try.assume
+                              (/.update idx inc) try.assume
+                              (/.nth idx) try.assume
                               (n.= (inc non-member))))
                   (_.test (format (%.name (name-of /.to-list))
-                                  " " (%.name (name-of /.from-list)))
+                                  " &&& " (%.name (name-of /.from-list)))
                           (|> sample /.to-list /.from-list (/@= sample)))
                   (_.test (%.name (name-of /.member?))
                           (and (not (/.member? n.equivalence sample non-member))