Made sure the "phase" parameter of extensions is always usable (even across language boundaries)

3 files changed, 104 insertions, 64 deletions

diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux
index 4d5d88548..7b3235c06 100644
--- a/lux-jvm/source/luxc/lang/directive/jvm.lux
+++ b/lux-jvm/source/luxc/lang/directive/jvm.lux
@@ -369,7 +369,7 @@
     (#/.Return instruction) (..return instruction)))
 
 (def: (instruction instruction)
-  (-> (/.Instruction org/objectweb/asm/Label) Inst)
+  (-> (/.Instruction Inst org/objectweb/asm/Label) Inst)
   (case instruction
     #/.NOP _.NOP
     (#/.Constant instruction) (..constant instruction)
@@ -381,7 +381,8 @@
     (#/.Local instruction) (..local instruction)
     (#/.Stack instruction) (..stack instruction)
     (#/.Comparison instruction) (..comparison instruction)
-    (#/.Control instruction) (..control instruction)))
+    (#/.Control instruction) (..control instruction)
+    (#/.Embedded embedded) embedded))
 
 (type: Mapping
   (Dictionary /.Label org/objectweb/asm/Label))
@@ -460,9 +461,13 @@
     ))
 
 (def: (relabel_instruction [mapping instruction])
-  (Re_labeler /.Instruction)
+  (Re_labeler (/.Instruction Inst))
   (case instruction
-    #/.NOP [mapping #/.NOP]
+    (#/.Embedded embedded)
+    [mapping (#/.Embedded embedded)]
+
+    #/.NOP
+    [mapping #/.NOP]
 
     (^template [<tag>]
       [(<tag> instruction)
@@ -482,10 +487,10 @@
       [mapping (#/.Control instruction)])))
 
 (def: (relabel_bytecode [mapping bytecode])
-  (Re_labeler /.Bytecode)
+  (Re_labeler (/.Bytecode Inst))
   (row@fold (function (_ input [mapping output])
-              (let [[mapping input] (..relabel_instruction [mapping input])]
-                [mapping (row.add input output)]))
+              (let [[mapping input'] (..relabel_instruction [mapping input])]
+                [mapping (row.add input' output)]))
             [mapping (row.row)]
             bytecode))
 
@@ -494,7 +499,7 @@
   (dictionary.new nat.hash))
 
 (def: bytecode
-  (-> (/.Bytecode /.Label) jvm.Inst)
+  (-> (/.Bytecode Inst /.Label) jvm.Inst)
   (|>> [..fresh]
        ..relabel_bytecode
        product.right
@@ -502,15 +507,28 @@
        row.to_list
        _.fuse))
 
-(type: Handler
-  (generation.Handler jvm.Anchor (/.Bytecode /.Label) jvm.Definition))
+(with_expansions [<anchor> (as_is jvm.Anchor)
+                  <expression> (as_is Inst)
+                  <directive> (as_is jvm.Definition)
+                  <type_vars> (as_is <anchor> <expression> <directive>)]
+  (type: Handler
+    ## (generation.Handler jvm.Anchor (/.Bytecode Inst /.Label) jvm.Definition)
+    (-> extension.Name
+        (phase.Phase [(extension.Bundle <type_vars>)
+                      (generation.State <type_vars>)]
+                     Synthesis
+                     <expression>)
+        (phase.Phase [(extension.Bundle <type_vars>)
+                      (generation.State <type_vars>)]
+                     (List Synthesis)
+                     (/.Bytecode Inst /.Label)))))
 
 (def: (true_handler extender pseudo)
   (-> jvm.Extender Any jvm.Handler)
   (function (_ extension_name phase archive inputs)
     (do phase.monad
       [bytecode ((extender pseudo) extension_name phase archive inputs)]
-      (wrap (..bytecode (:coerce (/.Bytecode /.Label) bytecode))))))
+      (wrap (..bytecode (:coerce (/.Bytecode Inst /.Label) bytecode))))))
 
 (def: (def::generation extender)
   (-> jvm.Extender
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
index dc579c970..96fa95363 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
@@ -7,8 +7,8 @@
     ["." exception (#+ exception:)]
     ["." function]
     ["<>" parser ("#@." monad)
-     ["<t>" text]
-     ["<s>" synthesis (#+ Parser)]]]
+     ["<.>" text]
+     ["<.>" synthesis (#+ Parser)]]]
    [data
     ["." product]
     ["." maybe ("#@." functor)]
@@ -66,7 +66,7 @@
 (template [<name> <category> <parser>]
   [(def: #export <name>
      (Parser (Type <category>))
-     (<t>.embed <parser> <s>.text))]
+     (<text>.embed <parser> <synthesis>.text))]
 
   [var Var parser.var]
   [class Class parser.class]
@@ -82,7 +82,7 @@
 (def: #export object_array
   (Parser (Type Object))
   (do <>.monad
-    [arrayJT (<t>.embed parser.array <s>.text)]
+    [arrayJT (<text>.embed parser.array <synthesis>.text)]
     (case (parser.array? arrayJT)
       (#.Some elementJT)
       (case (parser.object? elementJT)
@@ -339,7 +339,7 @@
 (def: (primitive_array_length_handler jvm_primitive)
   (-> (Type Primitive) Handler)
   (..custom
-   [<s>.any
+   [<synthesis>.any
     (function (_ extension_name generate archive arrayS)
       (do phase.monad
         [arrayI (generate archive arrayS)]
@@ -350,7 +350,7 @@
 (def: array::length::object
   Handler
   (..custom
-   [($_ <>.and ..object_array <s>.any)
+   [($_ <>.and ..object_array <synthesis>.any)
     (function (_ extension_name generate archive [elementJT arrayS])
       (do phase.monad
         [arrayI (generate archive arrayS)]
@@ -374,7 +374,7 @@
 (def: array::new::object
   Handler
   (..custom
-   [($_ <>.and ..object <s>.any)
+   [($_ <>.and ..object <synthesis>.any)
     (function (_ extension_name generate archive [objectJT lengthS])
       (do phase.monad
         [lengthI (generate archive lengthS)]
@@ -400,7 +400,7 @@
 (def: array::read::object
   Handler
   (..custom
-   [($_ <>.and ..object_array <s>.any <s>.any)
+   [($_ <>.and ..object_array <synthesis>.any <synthesis>.any)
     (function (_ extension_name generate archive [elementJT idxS arrayS])
       (do phase.monad
         [arrayI (generate archive arrayS)
@@ -432,7 +432,7 @@
 (def: array::write::object
   Handler
   (..custom
-   [($_ <>.and ..object_array <s>.any <s>.any <s>.any)
+   [($_ <>.and ..object_array <synthesis>.any <synthesis>.any <synthesis>.any)
     (function (_ extension_name generate archive [elementJT idxS valueS arrayS])
       (do phase.monad
         [arrayI (generate archive arrayS)
@@ -525,7 +525,8 @@
   (|>> exceptionI
        _.ATHROW))
 
-(def: $Class (type.class "java.lang.Class" (list)))
+(def: $Class
+  (type.class "java.lang.Class" (list)))
 
 (def: (object::class extension_name generate archive inputs)
   Handler
@@ -542,7 +543,7 @@
 (def: object::instance?
   Handler
   (..custom
-   [($_ <>.and <s>.text <s>.any)
+   [($_ <>.and <synthesis>.text <synthesis>.any)
     (function (_ extension_name generate archive [class objectS])
       (do phase.monad
         [objectI (generate archive objectS)]
@@ -611,7 +612,7 @@
 (def: get::static
   Handler
   (..custom
-   [($_ <>.and <s>.text <s>.text <s>.text)
+   [($_ <>.and <synthesis>.text <synthesis>.text <synthesis>.text)
     (function (_ extension_name generate archive [class field unboxed])
       (do phase.monad
         []
@@ -625,7 +626,7 @@
 (def: put::static
   Handler
   (..custom
-   [($_ <>.and <s>.text <s>.text <s>.text <s>.any)
+   [($_ <>.and <synthesis>.text <synthesis>.text <synthesis>.text <synthesis>.any)
     (function (_ extension_name generate archive [class field unboxed valueS])
       (do phase.monad
         [valueI (generate archive valueS)
@@ -645,7 +646,7 @@
 (def: get::virtual
   Handler
   (..custom
-   [($_ <>.and <s>.text <s>.text <s>.text <s>.any)
+   [($_ <>.and <synthesis>.text <synthesis>.text <synthesis>.text <synthesis>.any)
     (function (_ extension_name generate archive [class field unboxed objectS])
       (do phase.monad
         [objectI (generate archive objectS)
@@ -663,7 +664,7 @@
 (def: put::virtual
   Handler
   (..custom
-   [($_ <>.and <s>.text <s>.text <s>.text <s>.any <s>.any)
+   [($_ <>.and <synthesis>.text <synthesis>.text <synthesis>.text <synthesis>.any <synthesis>.any)
     (function (_ extension_name generate archive [class field unboxed valueS objectS])
       (do phase.monad
         [valueI (generate archive valueS)
@@ -683,11 +684,12 @@
                    valueI
                    putI))))]))
 
-(type: Input (Typed Synthesis))
+(type: Input
+  (Typed Synthesis))
 
 (def: input
   (Parser Input)
-  (<s>.tuple (<>.and ..value <s>.any)))
+  (<synthesis>.tuple (<>.and ..value <synthesis>.any)))
 
 (def: (generate_input generate archive [valueT valueS])
   (-> Phase Archive Input
@@ -702,7 +704,8 @@
       (wrap [valueT (|>> valueI
                          (_.CHECKCAST valueT))]))))
 
-(def: voidI (_.string synthesis.unit))
+(def: voidI
+  (_.string synthesis.unit))
 
 (def: (prepare_output outputT)
   (-> (Type Return) Inst)
@@ -716,7 +719,7 @@
 (def: invoke::static
   Handler
   (..custom
-   [($_ <>.and ..class <s>.text ..return (<>.some ..input))
+   [($_ <>.and ..class <synthesis>.text ..return (<>.some ..input))
     (function (_ extension_name generate archive [class method outputT inputsTS])
       (do {@ phase.monad}
         [inputsTI (monad.map @ (generate_input generate archive) inputsTS)]
@@ -728,7 +731,7 @@
   [(def: <name>
      Handler
      (..custom
-      [($_ <>.and ..class <s>.text ..return <s>.any (<>.some ..input))
+      [($_ <>.and ..class <synthesis>.text ..return <synthesis>.any (<>.some ..input))
        (function (_ extension_name generate archive [class method outputT objectS inputsTS])
          (do {@ phase.monad}
            [objectI (generate archive objectS)
@@ -782,37 +785,38 @@
 
 (def: annotation_parameter
   (Parser (/.Annotation_Parameter Synthesis))
-  (<s>.tuple (<>.and <s>.text <s>.any)))
+  (<synthesis>.tuple (<>.and <synthesis>.text <synthesis>.any)))
 
 (def: annotation
   (Parser (/.Annotation Synthesis))
-  (<s>.tuple (<>.and <s>.text (<>.some ..annotation_parameter))))
+  (<synthesis>.tuple (<>.and <synthesis>.text (<>.some ..annotation_parameter))))
 
 (def: argument
   (Parser Argument)
-  (<s>.tuple (<>.and <s>.text ..value)))
+  (<synthesis>.tuple (<>.and <synthesis>.text ..value)))
 
 (def: overriden_method_definition
   (Parser [(Environment Synthesis) (/.Overriden_Method Synthesis)])
-  (<s>.tuple (do <>.monad
-               [_ (<s>.text! /.overriden_tag)
-                ownerT ..class
-                name <s>.text
-                strict_fp? <s>.bit
-                annotations (<s>.tuple (<>.some ..annotation))
-                vars (<s>.tuple (<>.some ..var))
-                self_name <s>.text
-                arguments (<s>.tuple (<>.some ..argument))
-                returnT ..return
-                exceptionsT (<s>.tuple (<>.some ..class))
-                [environment _ _ body] (<s>.function 1
-                                         (<s>.loop (<>.exactly 0 <s>.any)
-                                           (<s>.tuple <s>.any)))]
-               (wrap [environment
-                      [ownerT name
-                       strict_fp? annotations vars
-                       self_name arguments returnT exceptionsT
-                       body]]))))
+  (<synthesis>.tuple
+   (do <>.monad
+     [_ (<synthesis>.text! /.overriden_tag)
+      ownerT ..class
+      name <synthesis>.text
+      strict_fp? <synthesis>.bit
+      annotations (<synthesis>.tuple (<>.some ..annotation))
+      vars (<synthesis>.tuple (<>.some ..var))
+      self_name <synthesis>.text
+      arguments (<synthesis>.tuple (<>.some ..argument))
+      returnT ..return
+      exceptionsT (<synthesis>.tuple (<>.some ..class))
+      [environment _ _ body] (<synthesis>.function 1
+                               (<synthesis>.loop (<>.exactly 0 <synthesis>.any)
+                                 (<synthesis>.tuple <synthesis>.any)))]
+     (wrap [environment
+            [ownerT name
+             strict_fp? annotations vars
+             self_name arguments returnT exceptionsT
+             body]]))))
 
 (def: (normalize_path normalize)
   (-> (-> Synthesis Synthesis)
@@ -978,9 +982,9 @@
   (..custom
    [($_ <>.and
         ..class
-        (<s>.tuple (<>.some ..class))
-        (<s>.tuple (<>.some ..input))
-        (<s>.tuple (<>.some ..overriden_method_definition)))
+        (<synthesis>.tuple (<>.some ..class))
+        (<synthesis>.tuple (<>.some ..input))
+        (<synthesis>.tuple (<>.some ..overriden_method_definition)))
     (function (_ extension_name generate archive [super_class super_interfaces
                                                   inputsTS
                                                   overriden_methods])
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
index 0b441c92f..a3583155b 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
@@ -30,7 +30,7 @@
       [lux
        [analysis (#+ Environment)]
        [synthesis (#+ Synthesis Abstraction Apply)]
-       ["." generation]]]
+       ["." generation (#+ Context)]]]
      [meta
       [archive (#+ Archive)]]]]]
   [luxc
@@ -301,13 +301,22 @@
       [instanceI (..instance generate archive classD arity env)]
       (wrap [functionD instanceI]))))
 
-(def: #export (function generate archive [env arity bodyS])
-  (Generator Abstraction)
-  (do phase.monad
+(def: #export (function' forced_context generate archive [env arity bodyS])
+  (-> (Maybe Context) (Generator Abstraction))
+  (do {! phase.monad}
     [@begin _.make_label
-     [function_context bodyI] (generation.with_new_context archive
-                                (generation.with_anchor [@begin 1]
-                                  (generate archive bodyS)))
+     [function_context bodyI] (case forced_context
+                                (#.Some function_context)
+                                (do !
+                                  [without_context (generation.with_anchor [@begin 1]
+                                                     (generate archive bodyS))]
+                                  (wrap [function_context
+                                         without_context]))
+                                
+                                #.None
+                                (generation.with_new_context archive
+                                  (generation.with_anchor [@begin 1]
+                                    (generate archive bodyS))))
      #let [function_class (//.class_name function_context)]
      [functionD instanceI] (..with_function generate archive @begin function_class env arity bodyI)
      #let [directive [function_class
@@ -316,9 +325,18 @@
                                  //.$Function (list)
                                  functionD)]]
      _ (generation.execute! directive)
-     _ (generation.save! (product.right function_context) directive)]
+     _ (case forced_context
+         #.None
+         (generation.save! (product.right function_context) directive)
+
+         (#.Some function_context)
+         (wrap []))]
     (wrap instanceI)))
 
+(def: #export function
+  (Generator Abstraction)
+  (..function' #.None))
+
 (def: #export (call generate archive [functionS argsS])
   (Generator Apply)
   (do {@ phase.monad}