aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc')
-rw-r--r--new-luxc/source/luxc/lang/directive/jvm.lux8
-rw-r--r--new-luxc/source/luxc/lang/host/jvm.lux7
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/case.lux54
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/expression.lux34
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/extension/common.lux16
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/extension/host.lux104
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/function.lux16
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/loop.lux16
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/structure.lux16
9 files changed, 142 insertions, 129 deletions
diff --git a/new-luxc/source/luxc/lang/directive/jvm.lux b/new-luxc/source/luxc/lang/directive/jvm.lux
index 6d446e91d..7b437f246 100644
--- a/new-luxc/source/luxc/lang/directive/jvm.lux
+++ b/new-luxc/source/luxc/lang/directive/jvm.lux
@@ -505,7 +505,7 @@
(def: (true-handler pseudo)
(-> Pseudo-Handler jvm.Handler)
- (function (_ extension-name phase inputs)
+ (function (_ extension-name phase archive inputs)
(|> (pseudo extension-name inputs)
(:: try.monad map ..bytecode)
phase.lift)))
@@ -513,12 +513,12 @@
(def: (def::generation extender)
(All [anchor expression directive]
(-> Extender (directive.Handler anchor expression directive)))
- (function (handler extension-name phase inputsC+)
+ (function (handler extension-name phase archive inputsC+)
(case inputsC+
(^ (list nameC valueC))
(do phase.monad
- [[_ _ name] (lux/.evaluate! Text nameC)
- [_ _ pseudo-handlerV] (lux/.evaluate! ..Pseudo-Handler valueC)
+ [[_ _ name] (lux/.evaluate! archive Text nameC)
+ [_ _ pseudo-handlerV] (lux/.evaluate! archive ..Pseudo-Handler valueC)
_ (<| directive.lift-generation
(extension.install extender (:coerce Text name))
(:share [anchor expression directive]
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux
index 5bcc3eef0..a56eeeb56 100644
--- a/new-luxc/source/luxc/lang/host/jvm.lux
+++ b/new-luxc/source/luxc/lang/host/jvm.lux
@@ -22,7 +22,9 @@
[reference (#+ Register)]
[language
[lux
- ["." generation]]]]]])
+ ["." generation]]]
+ [meta
+ [archive (#+ Archive)]]]]])
(import: org/objectweb/asm/MethodVisitor)
@@ -76,6 +78,9 @@
[Bundle generation.Bundle]
)
+(type: #export (Generator i)
+ (-> Phase Archive i (Operation Inst)))
+
(syntax: (config: {type s.local-identifier}
{none s.local-identifier}
{++ s.local-identifier}
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)))