CHANGE shifting forged labels to avoid accidental collisions with legitimate labels

5 files changed, 23 insertions, 11 deletions

diff --git a/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux
index 5f62d4d50..ccf8c8d96 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux
@@ -61,8 +61,8 @@
   (/////directive.lift-generation
    (do ////.monad
      [codeT (generate codeS)
-      count ////generation.next
-      codeV (////generation.evaluate! (format "evaluate" (%.nat count)) codeT)]
+      id ////generation.next
+      codeV (////generation.evaluate! (format "evaluate" (%.nat id)) codeT)]
      (wrap [code//type codeT codeV]))))
 
 (def: (evaluate! type codeC)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux
index 1fe43b8da..b0f03106c 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux
@@ -200,7 +200,7 @@
 
     (#synthesis.Alt leftP rightP)
     (do phase.monad
-      [@alt-else generation.next
+      [@alt-else //runtime.forge-label
        left! (path' phase (inc stack-depth) @alt-else @end leftP)
        right! (path' phase stack-depth @else @end rightP)]
       (wrap ($_ _.compose
@@ -222,7 +222,7 @@
 (def: (path phase path @end)
   (-> Phase Path Label (Operation (Instruction Any)))
   (do phase.monad
-    [@else generation.next
+    [@else //runtime.forge-label
      pathG (..path' phase 1 @else @end path)]
     (wrap ($_ _.compose
               pathG
@@ -264,7 +264,7 @@
 (def: #export (case phase valueS path)
   (-> Phase Synthesis Path (Operation (Instruction Any)))
   (do phase.monad
-    [@end generation.next
+    [@end //runtime.forge-label
      valueG (phase valueS)
      pathG (..path phase path @end)]
     (wrap ($_ _.compose
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux
index a6a89993e..a0292ccc3 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux
@@ -44,7 +44,7 @@
     ["#." reset]
     ["#." apply]]
    ["/#" // #_
-    [runtime (#+ Operation Phase)]
+    ["#." runtime (#+ Operation Phase)]
     [////
      [reference (#+ Register)]
      [analysis (#+ Environment)]
@@ -93,7 +93,7 @@
 (def: #export (abstraction generate [environment arity bodyS])
   (-> Phase Abstraction (Operation (Instruction Any)))
   (do phase.monad
-    [@begin generation.next
+    [@begin //runtime.forge-label
      [function-class bodyG] (generation.with-context
                               (generation.with-anchor [@begin ..this-offset]
                                 (generate bodyS)))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux
index 5537715b0..6e7ac6f23 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux
@@ -73,7 +73,7 @@
 (def: #export (scope translate [offset initsS+ iterationS])
   (-> Phase [Nat (List Synthesis) Synthesis] (Operation (Instruction Any)))
   (do phase.monad
-    [@begin generation.next
+    [@begin //runtime.forge-label
      initsI+ (monad.map @ translate initsS+)
      iterationG (generation.with-anchor [@begin offset]
                   (translate iterationS))
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 078a136b7..87a43fb02 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
@@ -1,7 +1,10 @@
 (.module:
   [lux (#- Type Definition case)
    [data
-    [binary (#+ Binary)]]
+    [binary (#+ Binary)]
+    [number
+     ["." i64]
+     ["n" nat]]]
    [target
     [jvm
      ["_" instruction (#+ Label Instruction)]
@@ -10,8 +13,9 @@
   ["." // #_
    ["#." value]
    ["/#" //
-    [///
-     [reference (#+ Register)]]]]
+    ["/#" //
+     [//
+      [reference (#+ Register)]]]]]
   )
 
 (type: #export Byte-Code Binary)
@@ -83,3 +87,11 @@
 
 (def: #export right
   (..procedure "right" ..projection-type))
+
+(def: #export forge-label
+  (Operation Label)
+  (let [shift (n./ 2 i64.width)]
+    ## This shift is done to avoid the possibility of forged labels
+    ## to be in the range of the labels that are generated automatically
+    ## during the evaluation of Instruction expressions.
+    (:: ////.monad map (i64.left-shift shift) ///.next)))