Properly track how the stack changes in the presence of discontinuities.

6 files changed, 272 insertions, 128 deletions

diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux
index 34e887bc1..5ad3d2204 100644
--- a/stdlib/source/lux/target/jvm/bytecode.lux
+++ b/stdlib/source/lux/target/jvm/bytecode.lux
@@ -9,7 +9,8 @@
     ["." state (#+ State')]
     ["." function]
     ["." try (#+ Try)]
-    ["." exception (#+ exception:)]]
+    ["." exception (#+ exception:)]
+    ["." pipe (#+ when>)]]
    [data
     ["." product]
     ["." maybe]
@@ -31,7 +32,8 @@
    ["_" instruction (#+ Primitive-Array-Type Instruction Estimator) ("#@." monoid)]
    ["#." environment (#+ Environment)
     [limit
-     ["/." registry (#+ Register Registry)]]]
+     ["/." registry (#+ Register Registry)]
+     ["/." stack (#+ Stack)]]]
    ["/#" // #_
     ["#." index (#+ Index)]
     [encoding
@@ -50,7 +52,7 @@
 
 (type: #export Label Nat)
 
-(type: #export Resolver (Dictionary Label Address))
+(type: #export Resolver (Dictionary Label [Stack (Maybe Address)]))
 
 (type: #export Tracker
   {#program-counter Address
@@ -110,18 +112,45 @@
   (exception.report
    ["Label" (%.nat label)]))
 
-(def: #export (set-label label)
-  (-> Label (Bytecode Any))
-  (function (_ [pool environment tracker])
-    (if (dictionary.contains? label (get@ #known tracker))
-      (exception.throw ..label-has-already-been-set [label])
-      (#try.Success [[pool
-                      environment
-                      (update@ #known
-                               (dictionary.put label (get@ #program-counter tracker))
-                               tracker)]
-                     [..relative-identity
-                      []]]))))
+(exception: #export (mismatched-environments {instruction Name}
+                                             {label Label}
+                                             {address Address}
+                                             {expected Stack}
+                                             {actual Stack})
+  (exception.report
+   ["Instruction" (%.name instruction)]
+   ["Label" (%.nat label)]
+   ["Address" (/address.format address)]
+   ["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
+                                                   []]]))]
+  (def: #export (set-label label)
+    (-> Label (Bytecode Any))
+    (function (_ [pool environment tracker])
+      (let [@here (get@ #program-counter tracker)]
+        (case (dictionary.get label (get@ #known tracker))
+          (#.Some [expected (#.Some address)])
+          (exception.throw ..label-has-already-been-set [label])
+          
+          (#.Some [expected #.None])
+          (do try.monad
+            [[actual environment] (/environment.continue expected environment)]
+            <success>)
+
+          #.None
+          (do try.monad
+            [[actual environment] (/environment.continue (|> environment
+                                                             (get@ #/environment.stack)
+                                                             (maybe.default /stack.empty))
+                                                         environment)]
+            <success>))))))
 
 (def: #export monad
   (Monad Bytecode)
@@ -132,10 +161,9 @@
       (: (Monad Try))
       try.monad))
 
-(def: #export (fail error)
+(def: #export fail
   (-> Text Bytecode)
-  (function (_ [pool environment tracker])
-    (#try.Failure error)))
+  (|>> #try.Failure function.constant))
 
 (def: #export (throw exception value)
   (All [e] (-> (exception.Exception e) e Bytecode))
@@ -191,6 +219,17 @@
   [@4 5]
   )
 
+(def: discontinuity!
+  (Bytecode Any)
+  (function (_ [pool environment tracker])
+    (do try.monad
+      [_ (/environment.stack environment)]
+      (#try.Success [[pool
+                      (/environment.discontinue environment)
+                      tracker]
+                     [..relative-identity
+                      []]]))))
+
 (template [<name> <consumption> <production> <registry> <instruction>]
   [(def: #export <name>
      (Bytecode Any)
@@ -369,21 +408,29 @@
   [dcmpl $4 $1 @_ _.dcmpl]
   [dcmpg $4 $1 @_ _.dcmpg]
 
-  [ireturn $1 $0 @_ _.ireturn]
-  [lreturn $2 $0 @_ _.lreturn]
-  [freturn $1 $0 @_ _.freturn]
-  [dreturn $2 $0 @_ _.dreturn]
-  [areturn $1 $0 @_ _.areturn]
-  [return $0 $0 @_ _.return]
-
   [arraylength $1 $1 @_ _.arraylength]
   
-  [athrow $1 $0 @_ _.athrow]
-  
   [monitorenter $1 $0 @_ _.monitorenter]
   [monitorexit $1 $0 @_ _.monitorexit]
   )
 
+(template [<name> <consumption> <instruction>]
+  [(def: #export <name>
+     (Bytecode Any)
+     (do ..monad
+       [_ (..bytecode <consumption> $0 @_ <instruction> [])]
+       ..discontinuity!))]
+
+  [ireturn $1 _.ireturn]
+  [lreturn $2 _.lreturn]
+  [freturn $1 _.freturn]
+  [dreturn $2 _.dreturn]
+  [areturn $1 _.areturn]
+  [return $0 _.return]
+
+  [athrow $1 _.athrow]
+  )
+
 (def: #export (bipush byte)
   (-> U1 (Bytecode Any))
   (..bytecode $0 $1 @_ _.bipush [byte]))
@@ -597,12 +644,19 @@
         (:: @ map (|>> #.Left) (//signed.s4 jump))
         (:: @ map (|>> #.Right) (//signed.s2 jump))))))
 
+(exception: #export (unset-label {label Label})
+  (exception.report
+   ["Label" (%.nat label)]))
+
 (def: (resolve-label label resolver)
-  (-> Label Resolver (Try Address))
+  (-> Label Resolver (Try [Stack Address]))
   (case (dictionary.get label resolver)
-    (#.Some address)
-    (#try.Success address)
+    (#.Some [actual (#.Some address)])
+    (#try.Success [actual address])
 
+    (#.Some [actual #.None])
+    (exception.throw ..unset-label [label])
+    
     #.None
     (exception.throw ..unknown-label [label])))
 
@@ -611,23 +665,32 @@
      (-> Label (Bytecode Any))
      (let [[estimator bytecode] <instruction>]
        (function (_ [pool environment tracker])
-         (do try.monad
-           [environment' (|> environment
-                             (/environment.consumes <consumption>))
-            program-counter' (step estimator (get@ #program-counter tracker))]
-           (wrap (let [@from (get@ #program-counter tracker)]
-                   [[pool environment' (set@ #program-counter program-counter' tracker)]
-                    [(function (_ resolver)
-                       (do try.monad
-                         [@to (..resolve-label label resolver)
-                          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)]))))
-                     []]]))))))]
+         (let [@here (get@ #program-counter tracker)]
+           (do try.monad
+             [environment' (|> environment
+                               (/environment.consumes <consumption>))
+              actual (/environment.stack environment')
+              program-counter' (step estimator @here)]
+             (wrap (let [@from @here]
+                     [[pool
+                       environment'
+                       (|> tracker
+                           (when> [(get@ #known) (dictionary.contains? label) not]
+                                  [(update@ #known (dictionary.put label [actual #.None]))])
+                           (set@ #program-counter program-counter'))]
+                      [(function (_ resolver)
+                         (do try.monad
+                           [[expected @to] (..resolve-label label resolver)
+                            _ (exception.assert ..mismatched-environments [(name-of <instruction>) 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)]))))
+                       []]])))))))]
 
   [$1 ifeq _.ifeq]
   [$1 ifne _.ifne]
@@ -655,14 +718,20 @@
   (let [[estimator bytecode] _.goto]
     (function (_ [pool environment tracker])
       (do try.monad
-        [program-counter' (step estimator (get@ #program-counter tracker))]
-        (wrap (let [@from (get@ #program-counter tracker)]
-                [[pool environment (set@ #program-counter program-counter' tracker)]
+        [#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 @to)
+                      (#.Some [expected (#.Some @to)])
                       (do try.monad
-                        [jump (..jump @from @to)]
+                        [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])
@@ -670,6 +739,9 @@
                           (#.Right jump)
                           (#try.Success [..no-exceptions (bytecode jump)])))
 
+                      (#.Some [expected #.None])
+                      (exception.throw ..unset-label [label])
+
                       #.None
                       (exception.throw ..unknown-label [label])))
                   []]]))))))
@@ -679,14 +751,20 @@
   (let [[estimator bytecode] _.goto-w]
     (function (_ [pool environment tracker])
       (do try.monad
-        [program-counter' (step estimator (get@ #program-counter tracker))]
-        (wrap (let [@from (get@ #program-counter tracker)]
-                [[pool environment (set@ #program-counter program-counter' tracker)]
+        [#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 @to)
+                      (#.Some [expected (#.Some @to)])
                       (do try.monad
-                        [jump (..jump @from @to)]
+                        [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)])
@@ -694,6 +772,9 @@
                           (#.Right jump)
                           (#try.Success [..no-exceptions (bytecode (/jump.lift jump))])))
 
+                      (#.Some [expected #.None])
+                      (exception.throw ..unset-label [label])
+                      
                       #.None
                       (exception.throw ..unknown-label [label])))
                   []]]))))))
@@ -720,13 +801,17 @@
         (wrap (let [@from (get@ #program-counter tracker)]
                 [[pool environment' (set@ #program-counter program-counter' tracker)]
                  [(function (_ resolver)
-                    (let [get (: (-> Label (Maybe Address))
+                    (let [get (: (-> Label (Maybe [Stack (Maybe Address)]))
                                  (function (_ label)
                                    (dictionary.get label resolver)))]
                       (case (do maybe.monad
-                              [@default (get default)
-                               @at-minimum (get at-minimum)
-                               @afterwards (monad.map @ get afterwards)]
+                              [[_ @default] (get default)
+                               @default @default
+                               [_ @at-minimum] (get at-minimum)
+                               @at-minimum @at-minimum
+                               @afterwards (|> afterwards
+                                               (monad.map @ get)
+                                               (monad.bind @ (monad.map @ product.right)))]
                               (wrap [@default @at-minimum @afterwards]))
                         (#.Some [@default @at-minimum @afterwards])
                         (do try.monad
@@ -757,12 +842,15 @@
         (wrap (let [@from (get@ #program-counter tracker)]
                 [[pool environment' (set@ #program-counter program-counter' tracker)]
                  [(function (_ resolver)
-                    (let [get (: (-> Label (Maybe Address))
+                    (let [get (: (-> Label (Maybe [Stack (Maybe Address)]))
                                  (function (_ label)
                                    (dictionary.get label resolver)))]
                       (case (do maybe.monad
-                              [@default (get default)
-                               @cases (monad.map @ (|>> product.right get) cases)]
+                              [[_ @default] (get default)
+                               @default @default
+                               @cases (|> cases
+                                          (monad.map @ (|>> product.right get))
+                                          (monad.bind @ (monad.map @ product.right)))]
                               (wrap [@default @cases]))
                         (#.Some [@default @cases])
                         (do try.monad
@@ -785,8 +873,8 @@
   [(def: #export (<name> class)
      (-> (Type <category>) (Bytecode Any))
      (do ..monad
-       ## TODO: Make sure it's impossible to have indexes greater than U2.
-       [index (..lift (//constant/pool.class (//name.internal (..reflection class))))]
+       [## TODO: Make sure it's impossible to have indexes greater than U2.
+        index (..lift (//constant/pool.class (//name.internal (..reflection class))))]
        (..bytecode <consumption> <production> @_ <instruction> [index])))]
 
   [$0 $1 new Class _.new]
@@ -882,15 +970,19 @@
     [@catch (..lift (//constant/pool.class (//name.internal (..reflection catch))))]
     (function (_ [pool environment tracker])
       (#try.Success
-       [[pool environment tracker]
+       [[pool
+         environment
+         (|> tracker
+             (when> [(get@ #known) (dictionary.contains? @handler) not]
+                    [(update@ #known (dictionary.put @handler [/stack.catch #.None]))]))]
         [(function (_ resolver)
            (do try.monad
-             [@start (..resolve-label @start resolver)
-              @end (..resolve-label @end resolver)
+             [[_ @start] (..resolve-label @start resolver)
+              [_ @end] (..resolve-label @end resolver)
               _ (if (/address.after? @start @end)
                   (wrap [])
                   (exception.throw ..invalid-range-for-try [@start @end]))
-              @handler (..resolve-label @handler resolver)]
+              [_ @handler] (..resolve-label @handler resolver)]
              (wrap [(row.row {#//exception.start @start
                               #//exception.end @end
                               #//exception.handler @handler
diff --git a/stdlib/source/lux/target/jvm/bytecode/address.lux b/stdlib/source/lux/target/jvm/bytecode/address.lux
index 4b58b1ca1..0af06f9e9 100644
--- a/stdlib/source/lux/target/jvm/bytecode/address.lux
+++ b/stdlib/source/lux/target/jvm/bytecode/address.lux
@@ -9,7 +9,9 @@
     [format
      [binary (#+ Writer)]]
     [number
-     ["n" nat]]]
+     ["n" nat]]
+    [text
+     ["%" format (#+ Format)]]]
    [type
     abstract]]
   ["." // #_
@@ -65,4 +67,8 @@
   (def: #export writer
     (Writer Address)
     (|>> :representation ///unsigned.writer/2))
+
+  (def: #export format
+    (Format Address)
+    (|>> :representation ///unsigned.value %.nat))
   )
diff --git a/stdlib/source/lux/target/jvm/bytecode/environment.lux b/stdlib/source/lux/target/jvm/bytecode/environment.lux
index 51927b96e..7ebacf5de 100644
--- a/stdlib/source/lux/target/jvm/bytecode/environment.lux
+++ b/stdlib/source/lux/target/jvm/bytecode/environment.lux
@@ -4,7 +4,8 @@
     [monad (#+ do)]
     [monoid (#+ Monoid)]]
    [control
-    ["." try (#+ Try)]]]
+    ["." try (#+ Try)]
+    ["." exception (#+ exception:)]]]
   [/
    ["/." limit (#+ Limit)
     ["/." stack (#+ Stack)]
@@ -17,7 +18,7 @@
 
 (type: #export Environment
   {#limit Limit
-   #stack Stack})
+   #stack (Maybe Stack)})
 
 (template [<name> <limit>]
   [(def: #export (<name> type)
@@ -25,7 +26,7 @@
      (do try.monad
        [limit (<limit> type)]
        (wrap {#limit limit
-              #stack /stack.empty})))]
+              #stack (#.Some /stack.empty)})))]
 
   [static /limit.static]
   [virtual /limit.virtual]
@@ -45,25 +46,59 @@
         [environment (left environment)]
         (right environment)))))
 
+(exception: #export discontinuity)
+
+(def: #export (stack environment)
+  (-> Environment (Try Stack))
+  (case (get@ #..stack environment)
+    (#.Some stack)
+    (#try.Success stack)
+
+    #.None
+    (exception.throw ..discontinuity [])))
+
+(def: #export discontinue
+  (-> Environment Environment)
+  (set@ #..stack #.None))
+
+(exception: #export (mismatched-stacks {expected Stack}
+                                       {actual Stack})
+  (exception.report
+   ["Expected" (/stack.format expected)]
+   ["Actual" (/stack.format actual)]))
+
+(def: #export (continue expected environment)
+  (-> Stack Environment (Try [Stack Environment]))
+  (case (get@ #..stack environment)
+    (#.Some actual)
+    (if (:: /stack.equivalence = expected actual)
+      (#try.Success [actual environment])
+      (exception.throw ..mismatched-stacks [expected actual]))
+
+    #.None
+    (#try.Success [expected (set@ #..stack (#.Some expected) environment)])))
+
 (def: #export (consumes amount)
   (-> U2 Condition)
   ## TODO: Revisit this definition once lenses/optics have been implemented,
   ## since it can probably be simplified with them.
   (function (_ environment)
     (do try.monad
-      [stack' (/stack.pop amount (get@ #..stack environment))]
-      (wrap (set@ #..stack stack' environment)))))
+      [previous (..stack environment)
+       current (/stack.pop amount previous)]
+      (wrap (set@ #..stack (#.Some current) environment)))))
 
 (def: #export (produces amount)
   (-> U2 Condition)
   (function (_ environment)
     (do try.monad
-      [current (/stack.push amount (get@ #..stack environment))
+      [previous (..stack environment)
+       current (/stack.push amount previous)
        #let [limit (|> environment
                        (get@ [#..limit #/limit.stack])
                        (/stack.max current))]]
       (wrap (|> environment
-                (set@ #..stack current)
+                (set@ #..stack (#.Some current))
                 (set@ [#..limit #/limit.stack] limit))))))
 
 (def: #export (has registry)
diff --git a/stdlib/source/lux/target/jvm/bytecode/environment/limit/stack.lux b/stdlib/source/lux/target/jvm/bytecode/environment/limit/stack.lux
index 87ad6a31b..fe72f79a5 100644
--- a/stdlib/source/lux/target/jvm/bytecode/environment/limit/stack.lux
+++ b/stdlib/source/lux/target/jvm/bytecode/environment/limit/stack.lux
@@ -6,6 +6,8 @@
     ["." try (#+ Try)]]
    [data
     ["." maybe]
+    [text
+     ["%" format (#+ Format)]]
     [format
      [binary (#+ Writer)]]]
    [type
@@ -19,9 +21,14 @@
   
   U2
 
-  (def: #export empty
-    Stack
-    (|> 0 /////unsigned.u2 maybe.assume :abstraction))
+  (template [<frames> <name>]
+    [(def: #export <name>
+       Stack
+       (|> <frames> /////unsigned.u2 maybe.assume :abstraction))]
+
+    [0 empty]
+    [1 catch]
+    )
 
   (def: #export equivalence
     (Equivalence Stack)
@@ -53,6 +60,10 @@
     (:abstraction
      (/////unsigned.max/2 (:representation left)
                           (:representation right))))
+
+  (def: #export format
+    (Format Stack)
+    (|>> :representation /////unsigned.value %.nat))
   )
 
 (def: #export length
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 c8076cada..f2349ff41 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
@@ -162,19 +162,18 @@
 (def: (risky $unsafe)
   (-> (Bytecode Any) (Bytecode Any))
   (do _.monad
-    [@from _.new-label
-     @to _.new-label
+    [@try _.new-label
      @handler _.new-label]
     ($_ _.compose
-        (_.try @from @to @handler //type.error)
-        (_.set-label @from)
+        (_.try @try @handler @handler //type.error)
+        (_.set-label @try)
         $unsafe
         ..some-injection
         _.areturn
-        (_.set-label @to)
         (_.set-label @handler)
         ..none-injection
-        _.areturn)))
+        _.areturn
+        )))
 
 (def: decode-frac::name "decode_frac")
 (def: decode-frac::type (type.method [(list //type.text) //type.variant (list)]))
@@ -189,7 +188,8 @@
                    ($_ _.compose
                        ..this
                        (_.invokestatic //type.frac "parseDouble" (type.method [(list //type.text) type.double (list)]))
-                       (//value.wrap type.double))))))
+                       (//value.wrap type.double)
+                       )))))
 
 (def: #export log!
   (Bytecode Any)
@@ -450,8 +450,7 @@
                  (list)
                  (#.Some
                   (do _.monad
-                    [@from _.new-label
-                     @to _.new-label
+                    [@try _.new-label
                      @handler _.new-label
                      #let [$unsafe ..this
                            unit _.aconst-null
@@ -473,11 +472,10 @@
                                             ## WTP
                                             )]]
                     ($_ _.compose
-                        (_.try @from @to @handler //type.error)
-                        (_.set-label @from)
+                        (_.try @try @handler @handler //type.error)
+                        (_.set-label @try)
                         $unsafe unit ..apply
                         ..right-injection _.areturn
-                        (_.set-label @to)
                         (_.set-label @handler) ## T
                         string-writer          ## TW
                         _.dup-x1               ## WTW
@@ -520,8 +518,7 @@
                                           left-projection::method
                                           right-projection::method
 
-                                          ..try::method
-                                          ))
+                                          ..try::method))
                                   (row.row)))]
     (do ////.monad
       [_ (///.execute! class [class bytecode])]
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 7b2283cb8..ab6cd5867 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -1314,14 +1314,16 @@
                    (function (_ goto)
                      (<| (..bytecode (|>> (:coerce java/lang/Long) ("jvm leq" expected)))
                          (do /.monad
-                           [^value /.new-label
-                            ^end /.new-label
-                            _ (goto ^value)
+                           [@skipped /.new-label
+                            @value /.new-label
+                            @end /.new-label
+                            _ (goto @value)
+                            _ (/.set-label @skipped)
                             _ (..$Long::literal dummy)
-                            _ (goto ^end)
-                            _ (/.set-label ^value)
+                            _ (goto @end)
+                            _ (/.set-label @value)
                             _ (..$Long::literal expected)
-                            _ (/.set-label ^end)]
+                            _ (/.set-label @end)]
                            ..$Long::wrap))))]]
     ($_ _.and
         (_.lift "GOTO" (jump /.goto))
@@ -1339,17 +1341,17 @@
              afterwards (:: @ map (n.% 10) random.nat)])
           (..bytecode (|>> (:coerce java/lang/Long) ("jvm leq" expected)))
           (do /.monad
-            [^right /.new-label
-             ^wrong /.new-label
-             ^return /.new-label
+            [@right /.new-label
+             @wrong /.new-label
+             @return /.new-label
              _ (/.bipush (|> minimum /signed.value .nat /unsigned.u1 try.assume))
-             _ (/.tableswitch minimum ^wrong [^right (list.repeat afterwards ^wrong)])
-             _ (/.set-label ^wrong)
+             _ (/.tableswitch minimum @wrong [@right (list.repeat afterwards @wrong)])
+             _ (/.set-label @wrong)
              _ (..$Long::literal dummy)
-             _ (/.goto ^return)
-             _ (/.set-label ^right)
+             _ (/.goto @return)
+             _ (/.set-label @right)
              _ (..$Long::literal expected)
-             _ (/.set-label ^return)]
+             _ (/.set-label @return)]
             ..$Long::wrap))
       (<| (_.lift "LOOKUPSWITCH")
           (do random.monad
@@ -1365,20 +1367,20 @@
              dummy ..$Long::random])
           (..bytecode (|>> (:coerce java/lang/Long) ("jvm leq" expected)))
           (do /.monad
-            [^right /.new-label
-             ^wrong /.new-label
-             ^return /.new-label
+            [@right /.new-label
+             @wrong /.new-label
+             @return /.new-label
              _ (..$Integer::literal (host.long-to-int choice))
-             _ (/.lookupswitch ^wrong (list@map (function (_ option)
+             _ (/.lookupswitch @wrong (list@map (function (_ option)
                                                   [(|> option /signed.s4 try.assume)
-                                                   (if (i.= choice option) ^right ^wrong)])
+                                                   (if (i.= choice option) @right @wrong)])
                                                 options))
-             _ (/.set-label ^wrong)
+             _ (/.set-label @wrong)
              _ (..$Long::literal dummy)
-             _ (/.goto ^return)
-             _ (/.set-label ^right)
+             _ (/.goto @return)
+             _ (/.set-label @right)
              _ (..$Long::literal expected)
-             _ (/.set-label ^return)]
+             _ (/.set-label @return)]
             ..$Long::wrap))
       ))
 
@@ -1392,23 +1394,24 @@
         (..bytecode (|>> (:coerce java/lang/Long) ("jvm leq" expected)))
         (do /.monad
           [#let [$Exception (/type.class "java.lang.Exception" (list))]
-           ^start /.new-label
-           ^end /.new-label
-           ^handler /.new-label
-           ^return /.new-label
-           _ (/.try ^start ^end ^handler $Exception)
-           _ (/.set-label ^start)
+           @skipped /.new-label
+           @try /.new-label
+           @handler /.new-label
+           @return /.new-label
+           _ (/.try @try @handler @handler $Exception)
+           _ (/.set-label @try)
            _ (/.new $Exception)
            _ /.dup
            _ (..$String::literal exception)
            _ (/.invokespecial $Exception "<init>" (/type.method [(list ..$String) /type.void (list)]))
            _ /.athrow
+           _ (/.set-label @skipped)
            _ (..$Long::literal dummy)
-           _ (/.goto ^return)
-           _ (/.set-label ^end)
-           _ (/.set-label ^handler)
+           _ (/.goto @return)
+           _ (/.set-label @handler)
+           _ /.pop
            _ (..$Long::literal expected)
-           _ (/.set-label ^return)]
+           _ (/.set-label @return)]
           ..$Long::wrap))))
 
 (def: code