diff options
Diffstat (limited to '')
7 files changed, 132 insertions, 124 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.lux b/new-luxc/source/luxc/lang/translation/jvm/case.lux index 048acbdab..0d8aaa91e 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/case.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/case.lux @@ -17,13 +17,15 @@ [tool [compiler ["." phase ("operation@." monad)] + [meta + [archive (#+ Archive)]] [language [lux ["." synthesis (#+ Path Synthesis)]]]]]] [luxc [lang [host - ["$" jvm (#+ Label Inst Operation Phase) + ["$" jvm (#+ Label Inst Operation Phase Generator) ["_" inst]]]]] ["." // ["." runtime]]) @@ -53,8 +55,8 @@ _.AALOAD (_.CHECKCAST runtime.$Stack))) -(def: (path' phase stack-depth @else @end path) - (-> Phase Nat Label Label Path (Operation Inst)) +(def: (path' stack-depth @else @end phase archive path) + (-> Nat Label Label Phase Archive Path (Operation Inst)) (.case path #synthesis.Pop (operation@wrap ..popI) @@ -93,7 +95,7 @@ (#synthesis.Then bodyS) (do phase.monad - [bodyI (phase bodyS)] + [bodyI (phase archive bodyS)] (wrap (|>> (pop-altI stack-depth) bodyI (_.GOTO @end)))) @@ -143,7 +145,7 @@ (synthesis.member/left 0) (synthesis.!bind-top register thenP))) (do phase.monad - [then! (path' phase stack-depth @else @end thenP)] + [then! (path' stack-depth @else @end phase archive thenP)] (wrap (|>> peekI (_.CHECKCAST //.$Tuple) (_.int +0) @@ -157,7 +159,7 @@ (<pm> lefts) (synthesis.!bind-top register thenP))) (do phase.monad - [then! (path' phase stack-depth @else @end thenP)] + [then! (path' stack-depth @else @end phase archive thenP)] (wrap (|>> peekI (_.CHECKCAST //.$Tuple) (_.int (.int lefts)) @@ -170,8 +172,8 @@ (#synthesis.Alt leftP rightP) (do phase.monad [@alt-else _.make-label - leftI (path' phase (inc stack-depth) @alt-else @end leftP) - rightI (path' phase stack-depth @else @end rightP)] + leftI (path' (inc stack-depth) @alt-else @end phase archive leftP) + rightI (path' stack-depth @else @end phase archive rightP)] (wrap (|>> _.DUP leftI (_.label @alt-else) @@ -180,17 +182,17 @@ (#synthesis.Seq leftP rightP) (do phase.monad - [leftI (path' phase stack-depth @else @end leftP) - rightI (path' phase stack-depth @else @end rightP)] + [leftI (path' stack-depth @else @end phase archive leftP) + rightI (path' stack-depth @else @end phase archive rightP)] (wrap (|>> leftI rightI))) )) -(def: (path phase path @end) - (-> Phase Path Label (Operation Inst)) +(def: (path @end phase archive path) + (-> Label Phase Archive Path (Operation Inst)) (do phase.monad [@else _.make-label - pathI (..path' phase 1 @else @end path)] + pathI (..path' 1 @else @end phase archive path)] (wrap (|>> pathI (_.label @else) _.POP @@ -198,12 +200,12 @@ _.NULL (_.GOTO @end))))) -(def: #export (if phase testS thenS elseS) - (-> Phase Synthesis Synthesis Synthesis (Operation Inst)) +(def: #export (if phase archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) (do phase.monad - [testI (phase testS) - thenI (phase thenS) - elseI (phase elseS)] + [testI (phase archive testS) + thenI (phase archive thenS) + elseI (phase archive elseS)] (wrap (<| _.with-label (function (_ @else)) _.with-label (function (_ @end)) (|>> testI @@ -215,21 +217,21 @@ elseI (_.label @end)))))) -(def: #export (let phase inputS register exprS) - (-> Phase Synthesis Nat Synthesis (Operation Inst)) +(def: #export (let phase archive [inputS register exprS]) + (Generator [Synthesis Nat Synthesis]) (do phase.monad - [inputI (phase inputS) - exprI (phase exprS)] + [inputI (phase archive inputS) + exprI (phase archive exprS)] (wrap (|>> inputI (_.ASTORE register) exprI)))) -(def: #export (case phase valueS path) - (-> Phase Synthesis Path (Operation Inst)) +(def: #export (case phase archive [valueS path]) + (Generator [Synthesis Path]) (do phase.monad [@end _.make-label - valueI (phase valueS) - pathI (..path phase path @end)] + valueI (phase archive valueS) + pathI (..path @end phase archive path)] (wrap (|>> _.NULL valueI pushI diff --git a/new-luxc/source/luxc/lang/translation/jvm/expression.lux b/new-luxc/source/luxc/lang/translation/jvm/expression.lux index ad2da41b6..800f79a41 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/expression.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/expression.lux @@ -20,7 +20,7 @@ ["." loop] ["." function]]) -(def: #export (translate synthesis) +(def: #export (translate archive synthesis) Phase (case synthesis (^ (synthesis.bit value)) @@ -35,11 +35,11 @@ (^ (synthesis.text value)) (primitive.text value) - (^ (synthesis.variant [lefts right? value])) - (structure.variant translate lefts right? value) + (^ (synthesis.variant data)) + (structure.variant translate archive data) (^ (synthesis.tuple members)) - (structure.tuple translate members) + (structure.tuple translate archive members) (^ (synthesis.variable variable)) (reference.variable variable) @@ -47,26 +47,26 @@ (^ (synthesis.constant constant)) (reference.constant constant) - (^ (synthesis.branch/let [input register expr])) - (case.let translate input register expr) + (^ (synthesis.branch/let data)) + (case.let translate archive data) - (^ (synthesis.branch/if [test then else])) - (case.if translate test then else) + (^ (synthesis.branch/if data)) + (case.if translate archive data) - (^ (synthesis.branch/case [input path])) - (case.case translate input path) + (^ (synthesis.branch/case data)) + (case.case translate archive data) (^ (synthesis.loop/recur data)) - (loop.recur translate data) + (loop.recur translate archive data) (^ (synthesis.loop/scope data)) - (loop.scope translate data) + (loop.scope translate archive data) - (^ (synthesis.function/apply apply)) - (function.call translate apply) + (^ (synthesis.function/apply data)) + (function.call translate archive data) - (^ (synthesis.function/abstraction abstraction)) - (function.function translate abstraction) + (^ (synthesis.function/abstraction data)) + (function.function translate archive data) (#synthesis.Extension extension) - (extension.apply translate extension))) + (extension.apply archive translate extension))) 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 cc703f17d..6d3cbbd46 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux @@ -19,6 +19,8 @@ [tool [compiler ["." phase] + [meta + [archive (#+ Archive)]] [language [lux ["." synthesis (#+ Synthesis %synthesis)] @@ -40,12 +42,12 @@ (def: #export (custom [parser handler]) (All [s] (-> [(Parser s) - (-> Text Phase s (Operation Inst))] + (-> Text Phase Archive s (Operation Inst))] Handler)) - (function (_ extension-name phase input) + (function (_ extension-name phase archive input) (case (<s>.run parser input) (#try.Success input') - (handler extension-name phase input') + (handler extension-name phase archive input') (#try.Failure error) (phase.throw extension.invalid-syntax [extension-name %synthesis input])))) @@ -87,17 +89,17 @@ (<>.some (<s>.tuple ($_ <>.and (<s>.tuple (<>.many <s>.i64)) <s>.any)))) - (function (_ extension-name phase [input else conditionals]) + (function (_ extension-name phase archive [input else conditionals]) (<| _.with-label (function (_ @end)) _.with-label (function (_ @else)) (do phase.monad - [inputG (phase input) - elseG (phase else) + [inputG (phase archive input) + elseG (phase archive else) conditionalsG+ (: (Operation (List [(List [Int Label]) Inst])) (monad.map @ (function (_ [chars branch]) (do @ - [branchG (phase branch)] + [branchG (phase archive branch)] (wrap (<| _.with-label (function (_ @branch)) [(list@map (function (_ char) [(.int char) @branch]) diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux index b5577cfcd..7569a825e 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux @@ -31,6 +31,8 @@ [compiler ["." reference (#+ Variable)] ["." phase ("#@." monad)] + [meta + [archive (#+ Archive)]] [language [lux [analysis (#+ Environment)] @@ -335,9 +337,9 @@ (-> (Type Primitive) Handler) (..custom [<s>.any - (function (_ extension-name generate arrayS) + (function (_ extension-name generate archive arrayS) (do phase.monad - [arrayI (generate arrayS)] + [arrayI (generate archive arrayS)] (wrap (|>> arrayI (_.CHECKCAST (type.array jvm-primitive)) _.ARRAYLENGTH))))])) @@ -346,20 +348,20 @@ Handler (..custom [($_ <>.and ..object-array <s>.any) - (function (_ extension-name generate [elementJT arrayS]) + (function (_ extension-name generate archive [elementJT arrayS]) (do phase.monad - [arrayI (generate arrayS)] + [arrayI (generate archive arrayS)] (wrap (|>> arrayI (_.CHECKCAST (type.array elementJT)) _.ARRAYLENGTH))))])) (def: (new-primitive-array-handler jvm-primitive) (-> (Type Primitive) Handler) - (function (_ extension-name generate inputs) + (function (_ extension-name generate archive inputs) (case inputs (^ (list lengthS)) (do phase.monad - [lengthI (generate lengthS)] + [lengthI (generate archive lengthS)] (wrap (|>> lengthI (_.array jvm-primitive)))) @@ -370,20 +372,20 @@ Handler (..custom [($_ <>.and ..object <s>.any) - (function (_ extension-name generate [objectJT lengthS]) + (function (_ extension-name generate archive [objectJT lengthS]) (do phase.monad - [lengthI (generate lengthS)] + [lengthI (generate archive lengthS)] (wrap (|>> lengthI (_.ANEWARRAY objectJT)))))])) (def: (read-primitive-array-handler jvm-primitive loadI) (-> (Type Primitive) Inst Handler) - (function (_ extension-name generate inputs) + (function (_ extension-name generate archive inputs) (case inputs (^ (list idxS arrayS)) (do phase.monad - [arrayI (generate arrayS) - idxI (generate idxS)] + [arrayI (generate archive arrayS) + idxI (generate archive idxS)] (wrap (|>> arrayI (_.CHECKCAST (type.array jvm-primitive)) idxI @@ -396,10 +398,10 @@ Handler (..custom [($_ <>.and ..object-array <s>.any <s>.any) - (function (_ extension-name generate [elementJT idxS arrayS]) + (function (_ extension-name generate archive [elementJT idxS arrayS]) (do phase.monad - [arrayI (generate arrayS) - idxI (generate idxS)] + [arrayI (generate archive arrayS) + idxI (generate archive idxS)] (wrap (|>> arrayI (_.CHECKCAST (type.array elementJT)) idxI @@ -407,13 +409,13 @@ (def: (write-primitive-array-handler jvm-primitive storeI) (-> (Type Primitive) Inst Handler) - (function (_ extension-name generate inputs) + (function (_ extension-name generate archive inputs) (case inputs (^ (list idxS valueS arrayS)) (do phase.monad - [arrayI (generate arrayS) - idxI (generate idxS) - valueI (generate valueS)] + [arrayI (generate archive arrayS) + idxI (generate archive idxS) + valueI (generate archive valueS)] (wrap (|>> arrayI (_.CHECKCAST (type.array jvm-primitive)) _.DUP @@ -428,11 +430,11 @@ Handler (..custom [($_ <>.and ..object-array <s>.any <s>.any <s>.any) - (function (_ extension-name generate [elementJT idxS valueS arrayS]) + (function (_ extension-name generate archive [elementJT idxS valueS arrayS]) (do phase.monad - [arrayI (generate arrayS) - idxI (generate idxS) - valueI (generate valueS)] + [arrayI (generate archive arrayS) + idxI (generate archive idxS) + valueI (generate archive valueS)] (wrap (|>> arrayI (_.CHECKCAST (type.array elementJT)) _.DUP @@ -522,7 +524,7 @@ (def: $Class (type.class "java.lang.Class" (list))) -(def: (object::class extension-name generate inputs) +(def: (object::class extension-name generate archive inputs) Handler (case inputs (^ (list (synthesis.text class))) @@ -538,19 +540,19 @@ Handler (..custom [($_ <>.and <s>.text <s>.any) - (function (_ extension-name generate [class objectS]) + (function (_ extension-name generate archive [class objectS]) (do phase.monad - [objectI (generate objectS)] + [objectI (generate archive objectS)] (wrap (|>> objectI (_.INSTANCEOF (type.class class (list))) (_.wrap type.boolean)))))])) -(def: (object::cast extension-name generate inputs) +(def: (object::cast extension-name generate archive inputs) Handler (case inputs (^ (list (synthesis.text from) (synthesis.text to) valueS)) (do phase.monad - [valueI (generate valueS)] + [valueI (generate archive valueS)] (`` (cond (~~ (template [<object> <type>] [(and (text@= (reflection.reflection (type.reflection <type>)) from) @@ -607,7 +609,7 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text) - (function (_ extension-name generate [class field unboxed]) + (function (_ extension-name generate archive [class field unboxed]) (do phase.monad [] (case (dictionary.get unboxed ..primitives) @@ -621,9 +623,9 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any) - (function (_ extension-name generate [class field unboxed valueS]) + (function (_ extension-name generate archive [class field unboxed valueS]) (do phase.monad - [valueI (generate valueS) + [valueI (generate archive valueS) #let [$class (type.class class (list))]] (case (dictionary.get unboxed ..primitives) (#.Some primitive) @@ -641,9 +643,9 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any) - (function (_ extension-name generate [class field unboxed objectS]) + (function (_ extension-name generate archive [class field unboxed objectS]) (do phase.monad - [objectI (generate objectS) + [objectI (generate archive objectS) #let [$class (type.class class (list)) getI (case (dictionary.get unboxed ..primitives) (#.Some primitive) @@ -659,10 +661,10 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any <s>.any) - (function (_ extension-name generate [class field unboxed valueS objectS]) + (function (_ extension-name generate archive [class field unboxed valueS objectS]) (do phase.monad - [valueI (generate valueS) - objectI (generate objectS) + [valueI (generate archive valueS) + objectI (generate archive objectS) #let [$class (type.class class (list)) putI (case (dictionary.get unboxed ..primitives) (#.Some primitive) @@ -684,11 +686,11 @@ (Parser Input) (<s>.tuple (<>.and ..value <s>.any))) -(def: (generate-input generate [valueT valueS]) - (-> (-> Synthesis (Operation Inst)) Input +(def: (generate-input generate archive [valueT valueS]) + (-> Phase Archive Input (Operation (Typed Inst))) (do phase.monad - [valueI (generate valueS)] + [valueI (generate archive valueS)] (case (type.primitive? valueT) (#.Right valueT) (wrap [valueT valueI]) @@ -712,9 +714,9 @@ Handler (..custom [($_ <>.and ..class <s>.text ..return (<>.some ..input)) - (function (_ extension-name generate [class method outputT inputsTS]) + (function (_ extension-name generate archive [class method outputT inputsTS]) (do phase.monad - [inputsTI (monad.map @ (generate-input generate) inputsTS)] + [inputsTI (monad.map @ (generate-input generate archive) inputsTS)] (wrap (|>> (_.fuse (list@map product.right inputsTI)) (_.INVOKESTATIC class method (type.method [(list@map product.left inputsTI) outputT (list)])) (prepare-output outputT)))))])) @@ -724,10 +726,10 @@ Handler (..custom [($_ <>.and ..class <s>.text ..return <s>.any (<>.some ..input)) - (function (_ extension-name generate [class method outputT objectS inputsTS]) + (function (_ extension-name generate archive [class method outputT objectS inputsTS]) (do phase.monad - [objectI (generate objectS) - inputsTI (monad.map @ (generate-input generate) inputsTS)] + [objectI (generate archive objectS) + inputsTI (monad.map @ (generate-input generate archive) inputsTS)] (wrap (|>> objectI (_.CHECKCAST class) (_.fuse (list@map product.right inputsTI)) @@ -746,9 +748,9 @@ Handler (..custom [($_ <>.and ..class (<>.some ..input)) - (function (_ extension-name generate [class inputsTS]) + (function (_ extension-name generate archive [class inputsTS]) (do phase.monad - [inputsTI (monad.map @ (generate-input generate) inputsTS)] + [inputsTI (monad.map @ (generate-input generate archive) inputsTS)] (wrap (|>> (_.NEW class) _.DUP (_.fuse (list@map product.right inputsTI)) @@ -953,10 +955,10 @@ (<s>.tuple (<>.some ..class)) (<s>.tuple (<>.some ..input)) (<s>.tuple (<>.some ..overriden-method-definition))) - (function (_ extension-name generate [class-name - super-class super-interfaces - inputsTS - overriden-methods]) + (function (_ extension-name generate archive [class-name + super-class super-interfaces + inputsTS + overriden-methods]) (do phase.monad [#let [class (type.class class-name (list)) total-environment (|> overriden-methods @@ -991,7 +993,7 @@ self-name arguments returnT exceptionsT (normalize-method-body local-mapping body)])) overriden-methods)] - inputsTI (monad.map @ (generate-input generate) inputsTS) + inputsTI (monad.map @ (generate-input generate archive) inputsTS) method-definitions (|> normalized-methods (monad.map @ (function (_ [ownerT name strict-fp? annotations vars @@ -999,7 +1001,7 @@ bodyS]) (do @ [bodyG (generation.with-specific-context class-name - (generate bodyS))] + (generate archive bodyS))] (wrap (_def.method #$.Public (if strict-fp? ($_ $.++M $.finalM $.strictM) diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux index ec5d9c61f..72c77f2a2 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.lux @@ -28,7 +28,7 @@ [luxc [lang [host - ["$" jvm (#+ Label Inst Def Operation Phase) + ["$" jvm (#+ Label Inst Def Operation Phase Generator) ["." def] ["_" inst]]]]] ["." // @@ -293,13 +293,13 @@ [instanceI (instance classD arity env)] (wrap [functionD instanceI])))) -(def: #export (function generate [env arity bodyS]) - (-> Phase Abstraction (Operation Inst)) +(def: #export (function generate archive [env arity bodyS]) + (Generator Abstraction) (do phase.monad [@begin _.make-label [function-class bodyI] (generation.with-context (generation.with-anchor [@begin 1] - (generate bodyS))) + (generate archive bodyS))) #let [function-class (//.class-name' function-class)] [functionD instanceI] (with-function @begin function-class env arity bodyI) _ (generation.save! true ["" function-class] @@ -310,11 +310,11 @@ functionD)])] (wrap instanceI))) -(def: #export (call generate [functionS argsS]) - (-> Phase Apply (Operation Inst)) +(def: #export (call generate archive [functionS argsS]) + (Generator Apply) (do phase.monad - [functionI (generate functionS) - argsI (monad.map @ generate argsS) + [functionI (generate archive functionS) + argsI (monad.map @ (generate archive) argsS) #let [applyI (|> argsI (list.split-all runtime.num-apply-variants) (list@map (.function (_ chunkI+) diff --git a/new-luxc/source/luxc/lang/translation/jvm/loop.lux b/new-luxc/source/luxc/lang/translation/jvm/loop.lux index a2c25e883..14b305843 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/loop.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/loop.lux @@ -20,7 +20,7 @@ [luxc [lang [host - [jvm (#+ Inst Operation Phase) + [jvm (#+ Inst Operation Phase Generator) ["_" inst]]]]] ["." //]) @@ -33,8 +33,8 @@ _ false)) -(def: #export (recur translate argsS) - (-> Phase (List Synthesis) (Operation Inst)) +(def: #export (recur translate archive argsS) + (Generator (List Synthesis)) (do phase.monad [[@begin start] generation.anchor #let [end (|> argsS list.size dec (n.+ start)) @@ -52,7 +52,7 @@ (: (Operation Inst) (if (invariant? register argS) (wrap function.identity) - (translate argS)))) + (translate archive argS)))) pairs) #let [storesI+ (list/map (function (_ [register argS]) (: Inst @@ -64,13 +64,13 @@ (_.fuse storesI+) (_.GOTO @begin))))) -(def: #export (scope translate [start initsS+ iterationS]) - (-> Phase [Nat (List Synthesis) Synthesis] (Operation Inst)) +(def: #export (scope translate archive [start initsS+ iterationS]) + (Generator [Nat (List Synthesis) Synthesis]) (do phase.monad [@begin _.make-label - initsI+ (monad.map @ translate initsS+) + initsI+ (monad.map @ (translate archive) initsS+) iterationI (generation.with-anchor [@begin start] - (translate iterationS)) + (translate archive iterationS)) #let [initializationI (|> (list.enumerate initsI+) (list/map (function (_ [register initI]) (|>> initI diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.lux index 9ce90085c..7cf9f4da0 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/structure.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/structure.lux @@ -20,13 +20,15 @@ [tool [compiler ["." phase] + [meta + [archive (#+ Archive)]] [language [lux [synthesis (#+ Synthesis)]]]]]] [luxc [lang [host - [jvm (#+ Inst Operation Phase) + [jvm (#+ Inst Operation Phase Generator) ["_" inst]]]]] ["." // ["#." runtime]]) @@ -35,8 +37,8 @@ (ex.report ["Expected size" ">= 2"] ["Actual size" (%.nat size)])) -(def: #export (tuple generate members) - (-> Phase (List Synthesis) (Operation Inst)) +(def: #export (tuple generate archive members) + (Generator (List Synthesis)) (do phase.monad [#let [size (list.size members)] _ (phase.assert not-a-tuple size @@ -45,7 +47,7 @@ list.enumerate (monad.map @ (function (_ [idx member]) (do @ - [memberI (generate member)] + [memberI (generate archive member)] (wrap (|>> _.DUP (_.int (.int idx)) memberI @@ -61,10 +63,10 @@ (_.string "") _.NULL)) -(def: #export (variant generate lefts right? member) - (-> Phase Nat Bit Synthesis (Operation Inst)) +(def: #export (variant generate archive [lefts right? member]) + (Generator [Nat Bit Synthesis]) (do phase.monad - [memberI (generate member)] + [memberI (generate archive member)] (wrap (|>> (_.int (.int (if right? (.inc lefts) lefts))) |