Bug fixes.

7 files changed, 145 insertions, 166 deletions

diff --git a/stdlib/source/lux/abstract/interval.lux b/stdlib/source/lux/abstract/interval.lux
index f5c3ce656..17e749804 100644
--- a/stdlib/source/lux/abstract/interval.lux
+++ b/stdlib/source/lux/abstract/interval.lux
@@ -1,3 +1,4 @@
+## https://en.wikipedia.org/wiki/Interval_(mathematics)
 (.module:
   [lux #*]
   [//
diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux
index a31b90195..bba140a7a 100644
--- a/stdlib/source/lux/target/jvm/bytecode.lux
+++ b/stdlib/source/lux/target/jvm/bytecode.lux
@@ -9,8 +9,7 @@
     ["." state (#+ State')]
     ["." function]
     ["." try (#+ Try)]
-    ["." exception (#+ exception:)]
-    ["." pipe (#+ when>)]]
+    ["." exception (#+ exception:)]]
    [data
     ["." product]
     ["." maybe]
@@ -124,13 +123,13 @@
    ["Expected" (/stack.format expected)]
    ["Actual" (/stack.format actual)]))
 
-(with-expansions [<success> (as-is (#try.Success [[pool
-                                                   environment
-                                                   (update@ #known
-                                                            (dictionary.put label [actual (#.Some @here)])
-                                                            tracker)]
-                                                  [..relative-identity
-                                                   []]]))]
+(with-expansions [<success> (as-is (wrap [[pool
+                                           environment
+                                           (update@ #known
+                                                    (dictionary.put label [actual (#.Some @here)])
+                                                    tracker)]
+                                          [..relative-identity
+                                           []]]))]
   (def: #export (set-label label)
     (-> Label (Bytecode Any))
     (function (_ [pool environment tracker])
@@ -193,7 +192,7 @@
       (wrap [[pool
               environment'
               (set@ #program-counter program-counter' tracker)]
-             [(function.constant (#try.Success [..no-exceptions (bytecode input)]))
+             [(function.constant (wrap [..no-exceptions (bytecode input)]))
               []]]))))
 
 (template [<name> <frames>]
@@ -408,11 +407,11 @@
   (function (_ [pool environment tracker])
     (do try.monad
       [_ (/environment.stack environment)]
-      (#try.Success [[pool
-                      (/environment.discontinue environment)
-                      tracker]
-                     [..relative-identity
-                      []]]))))
+      (wrap [[pool
+              (/environment.discontinue environment)
+              tracker]
+             [..relative-identity
+              []]]))))
 
 (template [<name> <consumption> <instruction>]
   [(def: #export <name>
@@ -660,6 +659,15 @@
     #.None
     (exception.throw ..unknown-label [label])))
 
+(def: (acknowledge-label stack label tracker)
+  (-> Stack Label Tracker Tracker)
+  (case (dictionary.get label (get@ #known tracker))
+    (#.Some _)
+    tracker
+
+    #.None
+    (update@ #known (dictionary.put label [stack #.None]) tracker)))
+
 (template [<consumption> <name> <instruction>]
   [(def: #export (<name> label)
      (-> Label (Bytecode Any))
@@ -675,8 +683,7 @@
                      [[pool
                        environment'
                        (|> tracker
-                           (when> [(get@ #known) (dictionary.contains? label) not]
-                                  [(update@ #known (dictionary.put label [actual #.None]))])
+                           (..acknowledge-label actual label)
                            (set@ #program-counter program-counter'))]
                       [(function (_ resolver)
                          (do try.monad
@@ -689,7 +696,7 @@
                              (exception.throw ..cannot-do-a-big-jump [label @from jump])
 
                              (#.Right jump)
-                             (#try.Success [..no-exceptions (bytecode jump)]))))
+                             (wrap [..no-exceptions (bytecode jump)]))))
                        []]])))))))]
 
   [$1 ifeq _.ifeq]
@@ -713,71 +720,49 @@
   [$2 if-acmpne _.if-acmpne]
   )
 
-(def: #export (goto label)
-  (-> Label (Bytecode Any))
-  (let [[estimator bytecode] _.goto]
-    (function (_ [pool environment tracker])
-      (do try.monad
-        [#let [@here (get@ #program-counter tracker)]
-         program-counter' (step estimator @here)]
-        (wrap (let [@from @here]
-                [[pool
-                  (/environment.discontinue environment)
-                  (set@ #program-counter program-counter' tracker)]
-                 [(function (_ resolver)
-                    (case (dictionary.get label resolver)
-                      (#.Some [expected (#.Some @to)])
-                      (do try.monad
-                        [actual (/environment.stack environment)
-                         _ (exception.assert ..mismatched-environments [(name-of _.goto) label @here expected actual]
-                                             (:: /stack.equivalence = expected actual))
-                         jump (..jump @from @to)]
-                        (case jump
-                          (#.Left jump)
-                          (exception.throw ..cannot-do-a-big-jump [label @from jump])
-
-                          (#.Right jump)
-                          (#try.Success [..no-exceptions (bytecode jump)])))
-
-                      (#.Some [expected #.None])
-                      (exception.throw ..unset-label [label])
-
-                      #.None
-                      (exception.throw ..unknown-label [label])))
-                  []]]))))))
+(template [<name> <instruction> <on-long-jump> <on-short-jump>]
+  [(def: #export (<name> label)
+     (-> Label (Bytecode Any))
+     (let [[estimator bytecode] <instruction>]
+       (function (_ [pool environment tracker])
+         (do try.monad
+           [actual (/environment.stack environment)
+            #let [@here (get@ #program-counter tracker)]
+            program-counter' (step estimator @here)]
+           (wrap (let [@from @here]
+                   [[pool
+                     (/environment.discontinue environment)
+                     (|> tracker
+                         (..acknowledge-label actual label)
+                         (set@ #program-counter program-counter'))]
+                    [(function (_ resolver)
+                       (case (dictionary.get label resolver)
+                         (#.Some [expected (#.Some @to)])
+                         (do try.monad
+                           [_ (exception.assert ..mismatched-environments [(name-of <instruction>) label @here expected actual]
+                                                (:: /stack.equivalence = expected actual))
+                            jump (..jump @from @to)]
+                           (case jump
+                             (#.Left jump)
+                             <on-long-jump>
 
-(def: #export (goto-w label)
-  (-> Label (Bytecode Any))
-  (let [[estimator bytecode] _.goto-w]
-    (function (_ [pool environment tracker])
-      (do try.monad
-        [#let [@here (get@ #program-counter tracker)]
-         program-counter' (step estimator @here)]
-        (wrap (let [@from @here]
-                [[pool
-                  (/environment.discontinue environment)
-                  (set@ #program-counter program-counter' tracker)]
-                 [(function (_ resolver)
-                    (case (dictionary.get label resolver)
-                      (#.Some [expected (#.Some @to)])
-                      (do try.monad
-                        [actual (/environment.stack environment)
-                         _ (exception.assert ..mismatched-environments [(name-of _.goto-w) label @here expected actual]
-                                             (:: /stack.equivalence = expected actual))
-                         jump (..jump @from @to)]
-                        (case jump
-                          (#.Left jump)
-                          (#try.Success [..no-exceptions (bytecode jump)])
-
-                          (#.Right jump)
-                          (#try.Success [..no-exceptions (bytecode (/jump.lift jump))])))
-
-                      (#.Some [expected #.None])
-                      (exception.throw ..unset-label [label])
-                      
-                      #.None
-                      (exception.throw ..unknown-label [label])))
-                  []]]))))))
+                             (#.Right jump)
+                             <on-short-jump>))
+
+                         (#.Some [expected #.None])
+                         (exception.throw ..unset-label [label])
+
+                         #.None
+                         (exception.throw ..unknown-label [label])))
+                     []]]))))))]
+
+  [goto _.goto
+   (exception.throw ..cannot-do-a-big-jump [label @from jump])
+   (wrap [..no-exceptions (bytecode jump)])]
+  [goto-w _.goto-w
+   (wrap [..no-exceptions (bytecode jump)])
+   (wrap [..no-exceptions (bytecode (/jump.lift jump))])]
+  )
 
 (def: (big-jump jump)
   (-> Any-Jump Big-Jump)
@@ -797,18 +782,20 @@
       (do try.monad
         [environment' (|> environment
                           (/environment.consumes $1))
+         actual (/environment.stack environment')
          program-counter' (step (estimator (list.size afterwards)) (get@ #program-counter tracker))]
         (wrap (let [@from (get@ #program-counter tracker)]
-                [[pool environment' (set@ #program-counter program-counter' tracker)]
+                [[pool
+                  environment'
+                  (|> (list@fold (..acknowledge-label actual) tracker (list& default at-minimum afterwards))
+                      (set@ #program-counter program-counter'))]
                  [(function (_ resolver)
                     (let [get (: (-> Label (Maybe [Stack (Maybe Address)]))
                                  (function (_ label)
                                    (dictionary.get label resolver)))]
                       (case (do maybe.monad
-                              [[_ @default] (get default)
-                               @default @default
-                               [_ @at-minimum] (get at-minimum)
-                               @at-minimum @at-minimum
+                              [@default (|> default get (monad.bind @ product.right))
+                               @at-minimum (|> at-minimum get (monad.bind @ product.right))
                                @afterwards (|> afterwards
                                                (monad.map @ get)
                                                (monad.bind @ (monad.map @ product.right)))]
@@ -819,7 +806,7 @@
                            >at-minimum (:: @ map ..big-jump (..jump @from @at-minimum))
                            >afterwards (monad.map @ (|>> (..jump @from) (:: @ map ..big-jump))
                                                   @afterwards)]
-                          (#try.Success [..no-exceptions (bytecode minimum >default [>at-minimum >afterwards])]))
+                          (wrap [..no-exceptions (bytecode minimum >default [>at-minimum >afterwards])]))
 
                         #.None
                         (exception.throw ..invalid-tableswitch []))))
@@ -838,16 +825,19 @@
       (do try.monad
         [environment' (|> environment
                           (/environment.consumes $1))
+         actual (/environment.stack environment')
          program-counter' (step (estimator (list.size cases)) (get@ #program-counter tracker))]
         (wrap (let [@from (get@ #program-counter tracker)]
-                [[pool environment' (set@ #program-counter program-counter' tracker)]
+                [[pool
+                  environment'
+                  (|> (list@fold (..acknowledge-label actual) tracker (list& default (list@map product.right cases)))
+                      (set@ #program-counter program-counter'))]
                  [(function (_ resolver)
                     (let [get (: (-> Label (Maybe [Stack (Maybe Address)]))
                                  (function (_ label)
                                    (dictionary.get label resolver)))]
                       (case (do maybe.monad
-                              [[_ @default] (get default)
-                               @default @default
+                              [@default (|> default get (monad.bind @ product.right))
                                @cases (|> cases
                                           (monad.map @ (|>> product.right get))
                                           (monad.bind @ (monad.map @ product.right)))]
@@ -858,7 +848,7 @@
                            >cases (|> @cases
                                       (monad.map @ (|>> (..jump @from) (:: @ map ..big-jump)))
                                       (:: @ map (|>> (list.zip2 (list@map product.left cases)))))]
-                          (#try.Success [..no-exceptions (bytecode >default >cases)]))
+                          (wrap [..no-exceptions (bytecode >default >cases)]))
 
                         #.None
                         (exception.throw ..invalid-lookupswitch []))))
@@ -972,9 +962,7 @@
       (#try.Success
        [[pool
          environment
-         (|> tracker
-             (when> [(get@ #known) (dictionary.contains? @handler) not]
-                    [(update@ #known (dictionary.put @handler [/stack.catch #.None]))]))]
+         (..acknowledge-label /stack.catch @handler tracker)]
         [(function (_ resolver)
            (do try.monad
              [[_ @start] (..resolve-label @start resolver)
diff --git a/stdlib/source/lux/target/jvm/encoding/unsigned.lux b/stdlib/source/lux/target/jvm/encoding/unsigned.lux
index 4286976dc..65e3632f7 100644
--- a/stdlib/source/lux/target/jvm/encoding/unsigned.lux
+++ b/stdlib/source/lux/target/jvm/encoding/unsigned.lux
@@ -41,16 +41,20 @@
       (n.< (:representation reference)
            (:representation sample))))
 
-  (exception: #export (value-exceeds-the-maximum {value Nat}
+  (exception: #export (value-exceeds-the-maximum {type Name}
+                                                 {value Nat}
                                                  {maximum (Unsigned Any)})
     (exception.report
+     ["Type" (%.name type)]
      ["Value" (%.nat value)]
      ["Maximum" (%.nat (:representation maximum))]))
 
   (exception: #export [brand] (subtraction-cannot-yield-negative-value
+                               {type Name}
                                {parameter (Unsigned brand)}
                                {subject (Unsigned brand)})
     (exception.report
+     ["Type" (%.name type)]
      ["Parameter" (%.nat (:representation parameter))]
      ["Subject" (%.nat (:representation subject))]))
 
@@ -69,7 +73,7 @@
        (-> Nat (Try <name>))
        (if (n.<= (:representation <maximum>) value)
          (#try.Success (:abstraction value))
-         (exception.throw ..value-exceeds-the-maximum [value <maximum>])))
+         (exception.throw ..value-exceeds-the-maximum [(name-of <name>) value <maximum>])))
 
      (def: #export (<+> parameter subject)
        (-> <name> <name> (Try <name>))
@@ -83,7 +87,7 @@
              subject' (:representation subject)]
          (if (n.<= subject' parameter')
            (#try.Success (:abstraction (n.- parameter' subject')))
-           (exception.throw ..subtraction-cannot-yield-negative-value [parameter subject]))))
+           (exception.throw ..subtraction-cannot-yield-negative-value [(name-of <name>) parameter subject]))))
 
      (def: #export (<max> left right)
        (-> <name> <name> <name>)
diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux
index e5c7304ee..1dd5af027 100644
--- a/stdlib/source/lux/target/jvm/type.lux
+++ b/stdlib/source/lux/target/jvm/type.lux
@@ -5,7 +5,8 @@
     [hash (#+ Hash)]]
    [data
     ["." maybe]
-    ["." text]
+    ["." text
+     ["%" format (#+ Format)]]
     [number
      ["n" nat]]
     [collection
@@ -195,3 +196,7 @@
                           (text.size repr)))
           (:: maybe.monad map (|>> //name.internal //name.external)))
       #.None)))
+
+(def: #export format
+  (All [a] (Format (Type a)))
+  (|>> ..signature /signature.signature))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux
index 68e81845b..ba9b80add 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux
@@ -89,16 +89,12 @@
                                    _.areturn)
                              _ (do _.monad
                                  [@default _.new-label
-                                  #let [failure ($_ _.compose
-                                                    (_.set-label @default)
-                                                    ////runtime.apply-failure
-                                                    _.aconst-null
-                                                    _.areturn)]
                                   @labelsH _.new-label
                                   @labelsT (|> _.new-label
                                                (list.repeat (dec num-partials))
                                                (monad.seq _.monad))
-                                  #let [cases (|> (#.Cons [@labelsH @labelsT])
+                                  #let [cases (|> (list@compose (#.Cons [@labelsH @labelsT])
+                                                                (list @default))
                                                   list.enumerate
                                                   (list@map (function (_ [stage @case])
                                                               (let [current-partials (|> (list.indices stage)
@@ -107,53 +103,51 @@
                                                                     already-partial? (n.> 0 stage)
                                                                     exact-match? (i.= over-extent (.int stage))
                                                                     has-more-than-necessary? (i.> over-extent (.int stage))]
-                                                                (cond exact-match?
-                                                                      ($_ _.compose
-                                                                          (_.set-label @case)
-                                                                          ////reference.this
-                                                                          (if already-partial?
-                                                                            (_.invokevirtual class //reset.name (//reset.type class))
-                                                                            (_@wrap []))
-                                                                          current-partials
-                                                                          (..inputs ..this-offset apply-arity)
-                                                                          (_.invokevirtual class //implementation.name (//implementation.type function-arity))
-                                                                          _.areturn)
-                                                                      
-                                                                      has-more-than-necessary?
-                                                                      (let [inputs-to-completion (|> function-arity (n.- stage))
-                                                                            inputs-left (|> apply-arity (n.- inputs-to-completion))]
-                                                                        ($_ _.compose
-                                                                            (_.set-label @case)
-                                                                            ////reference.this
-                                                                            (_.invokevirtual class //reset.name (//reset.type class))
-                                                                            current-partials
-                                                                            (..inputs ..this-offset inputs-to-completion)
-                                                                            (_.invokevirtual class //implementation.name (//implementation.type function-arity))
-                                                                            (apply (n.+ ..this-offset inputs-to-completion) inputs-left)
-                                                                            _.areturn))
+                                                                ($_ _.compose
+                                                                    (_.set-label @case)
+                                                                    (cond exact-match?
+                                                                          ($_ _.compose
+                                                                              ////reference.this
+                                                                              (if already-partial?
+                                                                                (_.invokevirtual class //reset.name (//reset.type class))
+                                                                                (_@wrap []))
+                                                                              current-partials
+                                                                              (..inputs ..this-offset apply-arity)
+                                                                              (_.invokevirtual class //implementation.name (//implementation.type function-arity))
+                                                                              _.areturn)
+                                                                          
+                                                                          has-more-than-necessary?
+                                                                          (let [inputs-to-completion (|> function-arity (n.- stage))
+                                                                                inputs-left (|> apply-arity (n.- inputs-to-completion))]
+                                                                            ($_ _.compose
+                                                                                ////reference.this
+                                                                                (_.invokevirtual class //reset.name (//reset.type class))
+                                                                                current-partials
+                                                                                (..inputs ..this-offset inputs-to-completion)
+                                                                                (_.invokevirtual class //implementation.name (//implementation.type function-arity))
+                                                                                (apply (n.+ ..this-offset inputs-to-completion) inputs-left)
+                                                                                _.areturn))
 
-                                                                      ## (i.< over-extent (.int stage))
-                                                                      (let [current-environment (|> (list.indices (list.size environment))
-                                                                                                    (list@map (///foreign.get class))
-                                                                                                    (monad.seq _.monad))
-                                                                            missing-partials (|> _.aconst-null
-                                                                                                 (list.repeat (|> num-partials (n.- apply-arity) (n.- stage)))
-                                                                                                 (monad.seq _.monad))]
-                                                                        ($_ _.compose
-                                                                            (_.set-label @case)
-                                                                            (_.new class)
-                                                                            _.dup
-                                                                            current-environment
-                                                                            ///partial/count.value
-                                                                            (..increment apply-arity)
-                                                                            current-partials
-                                                                            (..inputs ..this-offset apply-arity)
-                                                                            missing-partials
-                                                                            (_.invokevirtual class //init.name (//init.type environment function-arity))
-                                                                            _.areturn))))))
+                                                                          ## (i.< over-extent (.int stage))
+                                                                          (let [current-environment (|> (list.indices (list.size environment))
+                                                                                                        (list@map (///foreign.get class))
+                                                                                                        (monad.seq _.monad))
+                                                                                missing-partials (|> _.aconst-null
+                                                                                                     (list.repeat (|> num-partials (n.- apply-arity) (n.- stage)))
+                                                                                                     (monad.seq _.monad))]
+                                                                            ($_ _.compose
+                                                                                (_.new class)
+                                                                                _.dup
+                                                                                current-environment
+                                                                                ///partial/count.value
+                                                                                (..increment apply-arity)
+                                                                                current-partials
+                                                                                (..inputs ..this-offset apply-arity)
+                                                                                missing-partials
+                                                                                (_.invokevirtual class //init.name (//init.type environment function-arity))
+                                                                                _.areturn)))))))
                                                   (monad.seq _.monad))]]
                                  ($_ _.compose
                                      ///partial/count.value
                                      (_.tableswitch (try.assume (signed.s4 +0)) @default [@labelsH @labelsT])
-                                     ## cases
-                                     failure)))))))
+                                     cases)))))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux
index 0a51d555d..7308c0734 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux
@@ -41,7 +41,7 @@
 
 (def: (partials arity)
   (-> Arity (List (Type Value)))
-  (list.repeat arity ////type.value))
+  (list.repeat (dec arity) ////type.value))
 
 (def: #export (type environment arity)
   (-> Environment Arity (Type category.Method))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
index 89a1b94c1..99a8ed79a 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
@@ -230,12 +230,6 @@
                       (..illegal-state-exception message)
                       _.athrow))))
 
-(def: apply-failure::name "apply_failure")
-(def: #export apply-failure (..procedure ..apply-failure::name ..failure::type))
-
-(def: apply-failure::method
-  (..failure ..apply-failure::name "Error while applying function."))
-
 (def: pm-failure::name "pm_failure")
 (def: #export pm-failure (..procedure ..pm-failure::name ..failure::type))
 
@@ -515,7 +509,6 @@
                                     (list ..decode-frac::method
                                           ..variant::method
 
-                                          ..apply-failure::method
                                           ..pm-failure::method
 
                                           ..push::method
@@ -547,16 +540,10 @@
                                                              (_.aload arity)
                                                              (_.invokevirtual //function.class ..apply::name (..apply::type //function/arity.minimum))
                                                              _.areturn))))))
-                           (list& (method.method method.public
+                           (list& (method.method (modifier@compose method.public method.abstract)
                                                  ..apply::name (..apply::type //function/arity.minimum)
                                                  (list)
-                                                 ## TODO: It shouldn't be necessary to set the code for this method, since it's abstract.
-                                                 ## Setting this might be a bug. Verify & fix ASAP.
-                                                 (#.Some
-                                                  ($_ _.compose
-                                                      ..apply-failure
-                                                      ..this
-                                                      _.areturn)))))
+                                                 #.None)))
         <init>::method (method.method method.public "<init>" //function.init
                                       (list)
                                       (#.Some