diff options
author | Eduardo Julian | 2021-07-08 23:59:00 -0400 |
---|---|---|
committer | Eduardo Julian | 2021-07-08 23:59:00 -0400 |
commit | f3e869d0246e956399ec31a074c6c6299ff73602 (patch) | |
tree | ba67c7713bbe4ec48232f58a4b324bd364111f95 /lux-jvm/source/luxc/lang | |
parent | 2b909032e7a0bd10cd7db52067d2fb701bfa95e5 (diff) |
Made sure the "phase" parameter of extensions is always usable (even across language boundaries)
Diffstat (limited to 'lux-jvm/source/luxc/lang')
-rw-r--r-- | lux-jvm/source/luxc/lang/directive/jvm.lux | 40 | ||||
-rw-r--r-- | lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux | 94 | ||||
-rw-r--r-- | lux-jvm/source/luxc/lang/translation/jvm/function.lux | 34 |
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} |