Ported JVM common extension generation to the new JVM bytecode machinery.

8 files changed, 549 insertions, 25 deletions

diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux
index c3b806dd7..b2f24de63 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux
@@ -5,8 +5,7 @@
    [control
     ["." try]
     ["<>" parser
-     ["<s>" synthesis (#+ Parser)]]
-    ["ex" exception (#+ exception:)]]
+     ["<s>" synthesis (#+ Parser)]]]
    [data
     ["." product]
     [number
@@ -16,8 +15,7 @@
      ["." dictionary]]]
    [target
     [jvm
-     ["." type
-      ["." signature]]]]
+     ["." type]]]
    [tool
     [compiler
      ["." synthesis (#+ Synthesis %synthesis)]
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux
index 858a46c44..c5c4d15ff 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux
@@ -34,7 +34,7 @@
          (-> Text Phase s (Operation Expression))]
         Handler))
   (function (_ extension-name phase input)
-    (case (<s>.run input parser)
+    (case (<s>.run parser input)
       (#try.Success input')
       (handler extension-name phase input')
 
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux
index 959cc6375..eed30cf71 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux
@@ -11,7 +11,7 @@
    ["#." case]
    ["#." loop]
    ["//#" ///
-    ## ["." extension]
+    ["#." extension]
     [//
      [analysis (#+)]
      ["." synthesis]
@@ -63,9 +63,6 @@
     (^ (synthesis.function/apply application))
     (/function.apply generate application)
 
-    ## (#synthesis.Extension extension)
-    ## (/extension.apply generate extension)
-
-    _
-    (undefined)
+    (#synthesis.Extension extension)
+    (///extension.apply generate extension)
     ))
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 b0f03106c..3240288f7 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux
@@ -70,9 +70,6 @@
       _.aaload
       (_.checkcast //runtime.$Stack)))
 
-(def: left-flag _.aconst-null)
-(def: right-flag (_.ldc/string ""))
-
 (def: (path' phase stack-depth @else @end path)
   (-> Phase Nat Label Label Path (Operation (Instruction Any)))
   (.case path
@@ -142,8 +139,8 @@
              (_.goto @else)
              (_.set-label @success)
              //runtime.push))))
-    ([synthesis.side/left  ..left-flag function.identity]
-     [synthesis.side/right ..right-flag .inc])
+    ([synthesis.side/left  //runtime.left-flag function.identity]
+     [synthesis.side/right //runtime.right-flag .inc])
 
     (^ (synthesis.member/left lefts))
     (operation@wrap (.let [optimized-projection (.case lefts
@@ -151,7 +148,7 @@
                                                   _.aaload
                                                   
                                                   lefts
-                                                  //runtime.left)]
+                                                  //runtime.left-projection)]
                       ($_ _.compose
                           ..peek
                           (_.checkcast //runtime.$Tuple)
@@ -164,7 +161,7 @@
                         ..peek
                         (_.checkcast //runtime.$Tuple)
                         (..ldc/integer lefts)
-                        //runtime.right
+                        //runtime.right-projection
                         //runtime.push))
     
     ## Extra optimization
@@ -195,8 +192,8 @@
                   <projection>
                   (_.astore (unsigned.u1 register))
                   then!))))
-    ([synthesis.member/left  //runtime.left]
-     [synthesis.member/right //runtime.right])
+    ([synthesis.member/left //runtime.left-projection]
+     [synthesis.member/right //runtime.right-projection])
 
     (#synthesis.Alt leftP rightP)
     (do phase.monad
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension.lux
new file mode 100644
index 000000000..b7cc9c9fe
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension.lux
@@ -0,0 +1,17 @@
+(.module:
+  [lux #*
+   [data
+    [collection
+     ["." dictionary]]]]
+  ["." / #_
+   ["#." common]
+   ## ["#." host]
+   [//
+    [runtime (#+ Bundle)]]])
+
+(def: #export bundle
+  Bundle
+  ($_ dictionary.merge
+      /common.bundle
+      ## /host.bundle
+      ))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux
new file mode 100644
index 000000000..8759bf2e8
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux
@@ -0,0 +1,459 @@
+(.module:
+  [lux (#- Type)
+   [host (#+ import:)]
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["." try]
+    ["<>" parser
+     ["<s>" synthesis (#+ Parser)]]
+    ["." exception (#+ exception:)]]
+   [data
+    ["." product]
+    [number
+     ["." i32]
+     ["f" frac]]
+    [collection
+     ["." list ("#@." monad)]
+     ["." dictionary]]]
+   [target
+    [jvm
+     ["_" instruction (#+ Label Instruction) ("#@." monad)]
+     ["." constant]
+     [encoding
+      ["." signed (#+ S4)]]
+     ["." type (#+ Type)
+      [category (#+ Primitive Class)]]]]]
+  ["." ///
+   ["#." value]
+   ["#." runtime (#+ Operation Phase Bundle Handler)]
+   ["#." function #_
+    ["#" abstract]]
+   ["//#" ///
+    [generation
+     [extension (#+ Nullary Unary Binary Trinary Variadic
+                    nullary unary binary trinary variadic)]]
+    [extension
+     ["#extension" /]
+     ["#." bundle]]
+    ["/#" //
+     ["#." synthesis (#+ Synthesis %synthesis)]]]])
+
+(def: #export (custom [parser handler])
+  (All [s]
+    (-> [(Parser s)
+         (-> Text Phase s (Operation (Instruction Any)))]
+        Handler))
+  (function (_ extension-name phase input)
+    (case (<s>.run parser input)
+      (#try.Success input')
+      (handler extension-name phase input')
+
+      (#try.Failure error)
+      (/////.throw /////extension.invalid-syntax [extension-name //////synthesis.%synthesis input]))))
+
+(def: $Boolean (type.class "java.lang.Boolean" (list)))
+(def: $Double (type.class "java.lang.Double" (list)))
+(def: $Character (type.class "java.lang.Character" (list)))
+(def: $String (type.class "java.lang.String" (list)))
+(def: $CharSequence (type.class "java.lang.CharSequence" (list)))
+(def: $Object (type.class "java.lang.Object" (list)))
+(def: $PrintStream (type.class "java.io.PrintStream" (list)))
+(def: $System (type.class "java.lang.System" (list)))
+(def: $Error (type.class "java.lang.Error" (list)))
+
+(def: lux-int
+  (Instruction Any)
+  ($_ _.compose
+      _.i2l
+      (///value.wrap type.long)))
+
+(def: jvm-int
+  (Instruction Any)
+  ($_ _.compose
+      (///value.unwrap type.long)
+      _.l2i))
+
+(def: ensure-string
+  (Instruction Any)
+  (_.checkcast $String))
+
+(def: (predicate instruction)
+  (-> (-> Label (Instruction Any))
+      (Instruction Any))
+  (do _.monad
+    [@then _.new-label
+     @end _.new-label]
+    ($_ _.compose
+        (instruction @then)
+        (_.getstatic $Boolean "FALSE" $Boolean)
+        (_.goto @end)
+        (_.set-label @then)
+        (_.getstatic $Boolean "TRUE" $Boolean)
+        (_.set-label @end)
+        )))
+
+(def: unit (_.ldc/string //////synthesis.unit))
+
+## TODO: Get rid of this ASAP
+(def: lux::syntax-char-case!
+  (..custom [($_ <>.and
+                 <s>.any
+                 <s>.any
+                 (<>.some (<s>.tuple ($_ <>.and
+                                         (<s>.tuple (<>.many <s>.i64))
+                                         <s>.any))))
+             (function (_ extension-name phase [inputS elseS conditionalsS])
+               (do /////.monad
+                 [@end ///runtime.forge-label
+                  inputG (phase inputS)
+                  elseG (phase elseS)
+                  conditionalsG+ (: (Operation (List [(List [S4 Label])
+                                                      (Instruction Any)]))
+                                    (monad.map @ (function (_ [chars branch])
+                                                   (do @
+                                                     [branchG (phase branch)
+                                                      @branch ///runtime.forge-label]
+                                                     (wrap [(list@map (function (_ char)
+                                                                        [(signed.s4 (.int char)) @branch])
+                                                                      chars)
+                                                            ($_ _.compose
+                                                                (_.set-label @branch)
+                                                                branchG
+                                                                (_.goto @end))])))
+                                               conditionalsS))
+                  #let [table (|> conditionalsG+
+                                  (list@map product.left)
+                                  list@join)
+                        conditionalsG (|> conditionalsG+
+                                          (list@map product.right)
+                                          (monad.seq _.monad))]]
+                 (wrap (do _.monad
+                         [@else _.new-label]
+                         ($_ _.compose
+                             inputG (///value.unwrap type.long) _.l2i
+                             (_.lookupswitch @else table)
+                             conditionalsG
+                             (_.set-label @else)
+                             elseG
+                             (_.set-label @end)
+                             )))))]))
+
+(def: (lux::is [referenceG sampleG])
+  (Binary (Instruction Any))
+  ($_ _.compose
+      referenceG
+      sampleG
+      (..predicate _.if-acmpeq)))
+
+(def: (lux::try riskyG)
+  (Unary (Instruction Any))
+  ($_ _.compose
+      riskyG
+      (_.checkcast ///function.class)
+      ///runtime.try))
+
+(def: bundle::lux
+  Bundle
+  (|> (: Bundle /////bundle.empty)
+      (/////bundle.install "syntax char case!" ..lux::syntax-char-case!)
+      (/////bundle.install "is" (binary ..lux::is))
+      (/////bundle.install "try" (unary ..lux::try))))
+
+(template [<name> <op>]
+  [(def: (<name> [maskG inputG])
+     (Binary (Instruction Any))
+     ($_ _.compose
+         inputG (///value.unwrap type.long)
+         maskG (///value.unwrap type.long)
+         <op> (///value.wrap type.long)))]
+
+  [i64::and _.land]
+  [i64::or  _.lor]
+  [i64::xor _.lxor]
+  )
+
+(template [<name> <op>]
+  [(def: (<name> [shiftG inputG])
+     (Binary (Instruction Any))
+     ($_ _.compose
+         inputG (///value.unwrap type.long)
+         shiftG ..jvm-int
+         <op> (///value.wrap type.long)))]
+
+  [i64::left-shift             _.lshl]
+  [i64::arithmetic-right-shift _.lshr]
+  [i64::logical-right-shift    _.lushr]
+  )
+
+(import: #long java/lang/Double
+  (#static MIN_VALUE java/lang/Double)
+  (#static MAX_VALUE java/lang/Double))
+
+(def: ldc/double
+  (-> Frac (Instruction Any))
+  (|>> constant.double _.ldc/double))
+
+(template [<name> <const>]
+  [(def: (<name> _)
+     (Nullary (Instruction Any))
+     ($_ _.compose
+         (..ldc/double <const>)
+         (///value.wrap type.double)))]
+
+  [f64::smallest (java/lang/Double::MIN_VALUE)]
+  [f64::min      (f.* -1.0 (java/lang/Double::MAX_VALUE))]
+  [f64::max      (java/lang/Double::MAX_VALUE)]
+  )
+
+(template [<name> <type> <op>]
+  [(def: (<name> [paramG subjectG])
+     (Binary (Instruction Any))
+     ($_ _.compose
+         subjectG (///value.unwrap <type>)
+         paramG (///value.unwrap <type>)
+         <op> (///value.wrap <type>)))]
+
+  [i64::+ type.long   _.ladd]
+  [i64::- type.long   _.lsub]
+  [i64::* type.long   _.lmul]
+  [i64::/ type.long   _.ldiv]
+  [i64::% type.long   _.lrem]
+  
+  [f64::+ type.double _.dadd]
+  [f64::- type.double _.dsub]
+  [f64::* type.double _.dmul]
+  [f64::/ type.double _.ddiv]
+  [f64::% type.double _.drem]
+  )
+
+(def: ldc/integer
+  (-> (I64 Any) (Instruction Any))
+  (|>> .i64 i32.i32 constant.integer _.ldc/integer))
+
+(template [<eq> <lt> <type> <cmp>]
+  [(template [<name> <reference>]
+     [(def: (<name> [paramG subjectG])
+        (Binary (Instruction Any))
+        ($_ _.compose
+            subjectG (///value.unwrap <type>)
+            paramG (///value.unwrap <type>)
+            <cmp>
+            (..ldc/integer <reference>)
+            (..predicate _.if-icmpeq)))]
+     
+     [<eq> +0]
+     [<lt> -1])]
+
+  [i64::= i64::< type.long   _.lcmp]
+  [f64::= f64::< type.double _.dcmpg]
+  )
+
+(def: (to-string class from)
+  (-> (Type Class) (Type Primitive) (Instruction Any))
+  (_.invokestatic class "toString" (type.method [(list from) ..$String (list)])))
+
+(template [<name> <prepare> <transform>]
+  [(def: (<name> inputG)
+     (Unary (Instruction Any))
+     ($_ _.compose
+         inputG
+         <prepare>
+         <transform>))]
+
+  [i64::f64
+   (///value.unwrap type.long)
+   ($_ _.compose
+       _.l2d
+       (///value.wrap type.double))]
+
+  [i64::char
+   (///value.unwrap type.long)
+   ($_ _.compose
+       _.l2i
+       _.i2c
+       (..to-string ..$Character type.char))]
+
+  [f64::i64
+   (///value.unwrap type.double)
+   ($_ _.compose
+       _.d2l
+       (///value.wrap type.long))]
+  
+  [f64::encode
+   (///value.unwrap type.double)
+   (..to-string ..$Double type.double)]
+  
+  [f64::decode
+   ..ensure-string
+   ///runtime.decode-frac]
+  )
+
+(def: bundle::i64
+  Bundle
+  (<| (/////bundle.prefix "i64")
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "and" (binary ..i64::and))
+          (/////bundle.install "or" (binary ..i64::or))
+          (/////bundle.install "xor" (binary ..i64::xor))
+          (/////bundle.install "left-shift" (binary ..i64::left-shift))
+          (/////bundle.install "logical-right-shift" (binary ..i64::logical-right-shift))
+          (/////bundle.install "arithmetic-right-shift" (binary ..i64::arithmetic-right-shift))
+          (/////bundle.install "=" (binary ..i64::=))
+          (/////bundle.install "<" (binary ..i64::<))
+          (/////bundle.install "+" (binary ..i64::+))
+          (/////bundle.install "-" (binary ..i64::-))
+          (/////bundle.install "*" (binary ..i64::*))
+          (/////bundle.install "/" (binary ..i64::/))
+          (/////bundle.install "%" (binary ..i64::%))
+          (/////bundle.install "f64" (unary ..i64::f64))
+          (/////bundle.install "char" (unary ..i64::char)))))
+
+(def: bundle::f64
+  Bundle
+  (<| (/////bundle.prefix "f64")
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "+" (binary ..f64::+))
+          (/////bundle.install "-" (binary ..f64::-))
+          (/////bundle.install "*" (binary ..f64::*))
+          (/////bundle.install "/" (binary ..f64::/))
+          (/////bundle.install "%" (binary ..f64::%))
+          (/////bundle.install "=" (binary ..f64::=))
+          (/////bundle.install "<" (binary ..f64::<))
+          (/////bundle.install "smallest" (nullary ..f64::smallest))
+          (/////bundle.install "min" (nullary ..f64::min))
+          (/////bundle.install "max" (nullary ..f64::max))
+          (/////bundle.install "i64" (unary ..f64::i64))
+          (/////bundle.install "encode" (unary ..f64::encode))
+          (/////bundle.install "decode" (unary ..f64::decode)))))
+
+(def: (text::size inputG)
+  (Unary (Instruction Any))
+  ($_ _.compose
+      inputG
+      ..ensure-string
+      (_.invokevirtual ..$String "length" (type.method [(list) type.int (list)]))
+      ..lux-int))
+
+(def: no-op (Instruction Any) (_@wrap []))
+
+(template [<name> <pre-subject> <pre-param> <op> <post>]
+  [(def: (<name> [paramG subjectG])
+     (Binary (Instruction Any))
+     ($_ _.compose
+         subjectG <pre-subject>
+         paramG <pre-param>
+         <op> <post>))]
+
+  [text::= ..no-op ..no-op
+   (_.invokevirtual ..$Object "equals" (type.method [(list ..$Object) type.boolean (list)]))
+   (///value.wrap type.boolean)]
+  [text::< ..ensure-string ..ensure-string
+   (_.invokevirtual ..$String "compareTo" (type.method [(list ..$String) type.int (list)]))
+   (..predicate _.iflt)]
+  [text::char ..ensure-string ..jvm-int
+   (_.invokevirtual ..$String "charAt" (type.method [(list type.int) type.char (list)]))
+   ..lux-int]
+  )
+
+(def: (text::concat [leftG rightG])
+  (Binary (Instruction Any))
+  ($_ _.compose
+      leftG ..ensure-string
+      rightG ..ensure-string
+      (_.invokevirtual ..$String "concat" (type.method [(list ..$String) ..$String (list)]))))
+
+(def: (text::clip [startG endG subjectG])
+  (Trinary (Instruction Any))
+  ($_ _.compose
+      subjectG ..ensure-string
+      startG ..jvm-int
+      endG ..jvm-int
+      (_.invokevirtual ..$String "substring" (type.method [(list type.int type.int) ..$String (list)]))))
+
+(def: index-method (type.method [(list ..$String type.int) type.int (list)]))
+(def: (text::index [startG partG textG])
+  (Trinary (Instruction Any))
+  (do _.monad
+    [@not-found _.new-label
+     @end _.new-label]
+    ($_ _.compose
+        textG ..ensure-string
+        partG ..ensure-string
+        startG ..jvm-int
+        (_.invokevirtual ..$String "indexOf" index-method)
+        _.dup
+        (ldc/integer -1)
+        (_.if-icmpeq @not-found)
+        ..lux-int
+        ///runtime.some-injection
+        (_.goto @end)
+        (_.set-label @not-found)
+        _.pop
+        ///runtime.none-injection
+        (_.set-label @end))))
+
+(def: bundle::text
+  Bundle
+  (<| (/////bundle.prefix "text")
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "=" (binary ..text::=))
+          (/////bundle.install "<" (binary ..text::<))
+          (/////bundle.install "concat" (binary ..text::concat))
+          (/////bundle.install "index" (trinary ..text::index))
+          (/////bundle.install "size" (unary ..text::size))
+          (/////bundle.install "char" (binary ..text::char))
+          (/////bundle.install "clip" (trinary ..text::clip)))))
+
+(def: string-method (type.method [(list ..$String) type.void (list)]))
+(def: (io::log messageG)
+  (Unary (Instruction Any))
+  ($_ _.compose
+      (_.getstatic ..$System "out" ..$PrintStream)
+      messageG
+      ..ensure-string
+      (_.invokevirtual ..$PrintStream "println" ..string-method)
+      ..unit))
+
+(def: (io::error messageG)
+  (Unary (Instruction Any))
+  ($_ _.compose
+      (_.new ..$Error)
+      _.dup
+      messageG
+      ..ensure-string
+      (_.invokespecial ..$Error "<init>" ..string-method)
+      _.athrow))
+
+(def: exit-method (type.method [(list type.int) type.void (list)]))
+(def: (io::exit codeG)
+  (Unary (Instruction Any))
+  ($_ _.compose
+      codeG ..jvm-int
+      (_.invokestatic ..$System "exit" ..exit-method)
+      _.aconst-null))
+
+(def: time-method (type.method [(list) type.long (list)]))
+(def: (io::current-time _)
+  (Nullary (Instruction Any))
+  ($_ _.compose
+      (_.invokestatic ..$System "currentTimeMillis" ..time-method)
+      (///value.wrap type.long)))
+
+(def: bundle::io
+  Bundle
+  (<| (/////bundle.prefix "io")
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "log" (unary ..io::log))
+          (/////bundle.install "error" (unary ..io::error))
+          (/////bundle.install "exit" (unary ..io::exit))
+          (/////bundle.install "current-time" (nullary ..io::current-time)))))
+
+(def: #export bundle
+  Bundle
+  (<| (/////bundle.prefix "lux")
+      (|> bundle::lux
+          (dictionary.merge ..bundle::i64)
+          (dictionary.merge ..bundle::f64)
+          (dictionary.merge ..bundle::text)
+          (dictionary.merge ..bundle::io))))
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 87a43fb02..3868b747f 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
@@ -3,19 +3,24 @@
    [data
     [binary (#+ Binary)]
     [number
+     ["." i32]
      ["." i64]
      ["n" nat]]]
    [target
     [jvm
      ["_" instruction (#+ Label Instruction)]
+     ["." constant]
      ["." type (#+ Type)
       ["." category (#+ Method)]]]]]
   ["." // #_
    ["#." value]
+   ["#." function #_
+    ["#" abstract]]
    ["/#" //
     ["/#" //
      [//
-      [reference (#+ Register)]]]]]
+      [reference (#+ Register)]
+      ["." synthesis]]]]]
   )
 
 (type: #export Byte-Code Binary)
@@ -39,6 +44,8 @@
 
 (def: #export class (type.class "LuxRuntime" (list)))
 
+(def: $Text (type.class "java.lang.String" (list)))
+
 (def: #export $Tag type.int)
 (def: #export $Flag //value.type)
 (def: #export $Variant (type.array //value.type))
@@ -82,12 +89,62 @@
 (def: projection-type
   (type.method [(list ..$Tuple $Offset) //value.type (list)]))
 
-(def: #export left
+(def: #export left-projection
   (..procedure "left" ..projection-type))
 
-(def: #export right
+(def: #export right-projection
   (..procedure "right" ..projection-type))
 
+(def: try-name
+  "try")
+
+(def: try-type
+  (type.method [(list //function.class) ..$Variant (list)]))
+
+(def: #export try
+  (_.invokestatic ..class ..try-name ..try-type))
+
+(def: #export decode-frac
+  (..procedure "decode_frac" (type.method [(list ..$Text) ..$Variant (list)])))
+
+(def: #export variant
+  (..procedure "variant" (type.method [(list ..$Tag ..$Flag //value.type) ..$Variant (list)])))
+
+(def: ldc/integer
+  (-> (I64 Any) (Instruction Any))
+  (|>> .i64 i32.i32 constant.integer _.ldc/integer))
+
+(def: #export left-flag _.aconst-null)
+(def: #export right-flag (_.ldc/string ""))
+
+(def: #export left-injection
+  (Instruction Any)
+  ($_ _.compose
+      (..ldc/integer +0)
+      ..left-flag
+      _.dup2-x1
+      _.pop2
+      ..variant))
+
+(def: #export right-injection
+  (Instruction Any)
+  ($_ _.compose
+      (..ldc/integer +1)
+      ..right-flag
+      _.dup2-x1
+      _.pop2
+      ..variant))
+
+(def: #export some-injection right-injection)
+
+(def: #export none-injection
+  (Instruction Any)
+  ($_ _.compose
+      (..ldc/integer +0)
+      _.aconst-null
+      (_.ldc/string synthesis.unit)
+      ..variant))
+
 (def: #export forge-label
   (Operation Label)
   (let [shift (n./ 2 i64.width)]
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 0efa89571..c03076d26 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -5,8 +5,7 @@
                                           [case (#+)]
                                           [loop (#+)]
                                           [function (#+)]
-                                          ## [extension (#+)]
-                                          )]
+                                          [extension (#+)])]
   (.module:
     ["/" lux #*
      [abstract