aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux227
1 files changed, 115 insertions, 112 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
index 0d37031e0..86fe53d1e 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -1,19 +1,25 @@
(.module:
- lux
- (lux (control monad)
- (data text/format
- (coll [list "list/" Functor<List>]))
- [math]
- [macro])
- (luxc ["&" lang]
- (lang [".L" host]
- (host ["$" jvm]
- (jvm ["$t" type]
- ["$d" def]
- ["$i" inst]))
- ["la" analysis]
- ["ls" synthesis]))
- (// [".T" common]))
+ [lux #*
+ [control
+ [monad (#+ do)]]
+ [data
+ [text
+ format]
+ [collection
+ [list ("list/" Functor<List>)]]]
+ ["." math]
+ [language
+ ["." compiler
+ [analysis (#+ Arity)]
+ ["." translation]]]]
+ [luxc
+ [lang
+ [host
+ ["$" jvm (#+ Inst Method Def Operation)
+ ["$t" type]
+ ["$d" def]
+ ["$i" inst]]]]]
+ ["." // (#+ ByteCode)])
(def: $Object $.Type ($t.class "java.lang.Object" (list)))
(def: $Object-Array $.Type ($t.array +1 $Object))
@@ -24,28 +30,28 @@
(def: #export $Tag $.Type $t.int)
(def: #export $Flag $.Type $Object)
(def: #export $Datum $.Type $Object)
-(def: #export $Function $.Type ($t.class hostL.function-class (list)))
+(def: #export $Function $.Type ($t.class //.function-class (list)))
(def: $Throwable $.Type ($t.class "java.lang.Throwable" (list)))
(def: $Runtime $.Type ($t.class "java.lang.Runtime" (list)))
(def: $Runnable $.Type ($t.class "java.lang.Runnable" (list)))
(def: #export logI
- $.Inst
+ Inst
(let [outI ($i.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list)))
printI (function (_ method) ($i.INVOKEVIRTUAL "java.io.PrintStream" method ($t.method (list $Object) #.None (list)) #0))]
(|>> outI ($i.string "LOG: ") (printI "print")
outI $i.SWAP (printI "println"))))
(def: variant-method
- $.Method
+ Method
($t.method (list $t.int $Object $Object) (#.Some $Object-Array) (list)))
(def: #export variantI
- $.Inst
- ($i.INVOKESTATIC hostL.runtime-class "variant_make" variant-method #0))
+ Inst
+ ($i.INVOKESTATIC //.runtime-class "variant_make" variant-method #0))
(def: #export leftI
- $.Inst
+ Inst
(|>> ($i.int 0)
$i.NULL
$i.DUP2_X1
@@ -53,24 +59,24 @@
variantI))
(def: #export rightI
- $.Inst
+ Inst
(|>> ($i.int 1)
($i.string "")
$i.DUP2_X1
$i.POP2
variantI))
-(def: #export someI $.Inst rightI)
+(def: #export someI Inst rightI)
(def: #export noneI
- $.Inst
+ Inst
(|>> ($i.int 0)
$i.NULL
- ($i.string hostL.unit)
+ ($i.string //.unit)
variantI))
(def: (try-methodI unsafeI)
- (-> $.Inst $.Inst)
+ (-> Inst Inst)
(<| $i.with-label (function (_ @from))
$i.with-label (function (_ @to))
$i.with-label (function (_ @handler))
@@ -85,7 +91,7 @@
$i.ARETURN)))
(def: #export string-concatI
- $.Inst
+ Inst
($i.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0))
(def: #export partials-field Text "partials")
@@ -93,11 +99,11 @@
(def: #export num-apply-variants Nat +8)
(def: #export (apply-signature arity)
- (-> ls.Arity $.Method)
+ (-> Arity Method)
($t.method (list.repeat arity $Object) (#.Some $Object) (list)))
(def: adt-methods
- $.Def
+ Def
(let [store-tagI (|>> $i.DUP ($i.int 0) ($i.ILOAD +0) ($i.wrap #$.Int) $i.AASTORE)
store-flagI (|>> $i.DUP ($i.int 1) ($i.ALOAD +1) $i.AASTORE)
store-valueI (|>> $i.DUP ($i.int 2) ($i.ALOAD +2) $i.AASTORE)
@@ -115,7 +121,7 @@
on-null-objectI ($i.string "NULL")
arrayI (|>> ($i.ALOAD +0)
($i.CHECKCAST ($t.descriptor $Object-Array)))
- recurseI ($i.INVOKESTATIC hostL.runtime-class "force_text" force-textMT #0)
+ recurseI ($i.INVOKESTATIC //.runtime-class "force_text" force-textMT #0)
force-elemI (|>> $i.DUP arrayI $i.SWAP $i.AALOAD recurseI)
swap2 (|>> $i.DUP2_X2 ## X,Y => Y,X,Y
$i.POP2 ## Y,X,Y => Y,X
@@ -164,13 +170,13 @@
$i.ARETURN)))))
(def: #export force-textI
- $.Inst
- ($i.INVOKESTATIC hostL.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) #0))
+ Inst
+ ($i.INVOKESTATIC //.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) #0))
-(def: frac-shiftI $.Inst ($i.double (math.pow 32.0 2.0)))
+(def: frac-shiftI Inst ($i.double (math.pow 32.0 2.0)))
(def: frac-methods
- $.Def
+ Def
(|>> ($d.method #$.Public $.staticM "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list))
(try-methodI
(|>> ($i.ALOAD +0)
@@ -178,10 +184,10 @@
($i.wrap #$.Double))))
))
-(def: clz-method $.Method ($t.method (list $t.long) (#.Some $t.int) (list)))
+(def: clz-method Method ($t.method (list $t.long) (#.Some $t.int) (list)))
(def: text-methods
- $.Def
+ Def
(|>> ($d.method #$.Public $.staticM "text_clip" ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list))
(try-methodI
(|>> ($i.ALOAD +0)
@@ -198,7 +204,7 @@
))
(def: pm-methods
- $.Def
+ Def
(let [tuple-sizeI (|>> ($i.ALOAD +0) $i.ARRAYLENGTH)
tuple-elemI (|>> ($i.ALOAD +0) ($i.ILOAD +1) $i.AALOAD)
expected-last-sizeI (|>> ($i.ILOAD +1) ($i.int 1) $i.IADD)
@@ -245,10 +251,10 @@
$i.with-label (function (_ @further))
$i.with-label (function (_ @shorten))
$i.with-label (function (_ @wrong))
- (let [variant-partI (: (-> Nat $.Inst)
+ (let [variant-partI (: (-> Nat Inst)
(function (_ idx)
(|>> ($i.int (.int idx)) $i.AALOAD)))
- tagI (: $.Inst
+ tagI (: Inst
(|>> (variant-partI +0) ($i.unwrap #$.Int)))
flagI (variant-partI +1)
datumI (variant-partI +2)
@@ -332,7 +338,7 @@
)))
(def: io-methods
- $.Def
+ Def
(let [string-writerI (|>> ($i.NEW "java.io.StringWriter")
$i.DUP
($i.INVOKESPECIAL "java.io.StringWriter" "<init>" ($t.method (list) #.None (list)) #0))
@@ -352,7 +358,7 @@
($i.label @from)
($i.ALOAD +0)
$i.NULL
- ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature +1) #0)
+ ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0)
rightI
$i.ARETURN
($i.label @to)
@@ -367,19 +373,19 @@
)))
(def: process-methods
- $.Def
+ Def
(let [executor-class "java.util.concurrent.ScheduledThreadPoolExecutor"
executorT ($t.class executor-class (list))
executor-field "executor"
- endI (|>> ($i.string hostL.unit)
+ endI (|>> ($i.string //.unit)
$i.ARETURN)
- runnableI (: (-> $.Inst $.Inst)
+ runnableI (: (-> Inst Inst)
(function (_ functionI)
- (|>> ($i.NEW hostL.runnable-class)
+ (|>> ($i.NEW //.runnable-class)
$i.DUP
functionI
- ($i.INVOKESPECIAL hostL.runnable-class "<init>" ($t.method (list $Function) #.None (list)) #0))))
- threadI (: (-> $.Inst $.Inst)
+ ($i.INVOKESPECIAL //.runnable-class "<init>" ($t.method (list $Function) #.None (list)) #0))))
+ threadI (: (-> Inst Inst)
(function (_ runnableI)
(|>> ($i.NEW "java.lang.Thread")
$i.DUP
@@ -394,7 +400,7 @@
parallelism-levelI
($i.INVOKESPECIAL executor-class "<init>" ($t.method (list $t.int) #.None (list)) #0))]
(|>> executorI
- ($i.PUTSTATIC hostL.runtime-class executor-field executorT)
+ ($i.PUTSTATIC //.runtime-class executor-field executorT)
$i.RETURN)))
($d.method #$.Public $.staticM "schedule"
($t.method (list $t.long $Function) (#.Some $Object) (list))
@@ -405,7 +411,7 @@
time-unit-class "java.util.concurrent.TimeUnit"
time-unitT ($t.class time-unit-class (list))
futureT ($t.class "java.util.concurrent.ScheduledFuture" (list))
- executorI ($i.GETSTATIC hostL.runtime-class executor-field executorT)
+ executorI ($i.GETSTATIC //.runtime-class executor-field executorT)
schedule-laterI (|>> executorI
(runnableI ($i.ALOAD +2))
delayI
@@ -425,77 +431,74 @@
)))
(def: translate-runtime
- (Meta commonT.Bytecode)
- (do macro.Monad<Meta>
- [_ (wrap [])
- #let [bytecode ($d.class #$.V1_6 #$.Public $.finalC hostL.runtime-class (list) ["java.lang.Object" (list)] (list)
- (|>> adt-methods
- frac-methods
- text-methods
- pm-methods
- io-methods
- process-methods))]
- _ (commonT.store-class hostL.runtime-class bytecode)]
- (wrap bytecode)))
+ (Operation ByteCode)
+ (let [bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runtime-class (list) ["java.lang.Object" (list)] (list)
+ (|>> adt-methods
+ frac-methods
+ text-methods
+ pm-methods
+ io-methods
+ process-methods))]
+ (do compiler.Monad<Operation>
+ [_ (translation.execute! [//.runtime-class bytecode])]
+ (wrap bytecode))))
(def: translate-function
- (Meta commonT.Bytecode)
- (do macro.Monad<Meta>
- [_ (wrap [])
- #let [applyI (|> (list.n/range +2 num-apply-variants)
- (list/map (function (_ arity)
- ($d.method #$.Public $.noneM apply-method (apply-signature arity)
- (let [preI (|> (list.n/range +0 (dec arity))
- (list/map $i.ALOAD)
- $i.fuse)]
- (|>> preI
- ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature (dec arity)) #0)
- ($i.CHECKCAST hostL.function-class)
- ($i.ALOAD arity)
- ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature +1) #0)
- $i.ARETURN)))))
- (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature +1)))
- $d.fuse)
- bytecode ($d.abstract #$.V1_6 #$.Public $.noneC hostL.function-class (list) ["java.lang.Object" (list)] (list)
- (|>> ($d.field #$.Public $.finalF partials-field $t.int)
- ($d.method #$.Public $.noneM "<init>" ($t.method (list $t.int) #.None (list))
- (|>> ($i.ALOAD +0)
- ($i.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0)
- ($i.ALOAD +0)
- ($i.ILOAD +1)
- ($i.PUTFIELD hostL.function-class partials-field $t.int)
- $i.RETURN))
- applyI))]
- _ (commonT.store-class hostL.function-class bytecode)]
- (wrap bytecode)))
-
-(def: translate-runnable
- (Meta commonT.Bytecode)
- (do macro.Monad<Meta>
- [_ (wrap [])
- #let [procedure-field "procedure"
- bytecode ($d.class #$.V1_6 #$.Public $.finalC hostL.runnable-class (list) ["java.lang.Object" (list)] (list ["java.lang.Runnable" (list)])
- (|>> ($d.field #$.Public $.finalF procedure-field $Function)
- ($d.method #$.Public $.noneM "<init>" ($t.method (list $Function) #.None (list))
+ (Operation ByteCode)
+ (let [applyI (|> (list.n/range +2 num-apply-variants)
+ (list/map (function (_ arity)
+ ($d.method #$.Public $.noneM apply-method (apply-signature arity)
+ (let [preI (|> (list.n/range +0 (dec arity))
+ (list/map $i.ALOAD)
+ $i.fuse)]
+ (|>> preI
+ ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature (dec arity)) #0)
+ ($i.CHECKCAST //.function-class)
+ ($i.ALOAD arity)
+ ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0)
+ $i.ARETURN)))))
+ (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature +1)))
+ $d.fuse)
+ bytecode ($d.abstract #$.V1_6 #$.Public $.noneC //.function-class (list) ["java.lang.Object" (list)] (list)
+ (|>> ($d.field #$.Public $.finalF partials-field $t.int)
+ ($d.method #$.Public $.noneM "<init>" ($t.method (list $t.int) #.None (list))
(|>> ($i.ALOAD +0)
($i.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0)
($i.ALOAD +0)
- ($i.ALOAD +1)
- ($i.PUTFIELD hostL.runnable-class procedure-field $Function)
- $i.RETURN))
- ($d.method #$.Public $.noneM "run" ($t.method (list) #.None (list))
- (|>> ($i.ALOAD +0)
- ($i.GETFIELD hostL.runnable-class procedure-field $Function)
- $i.NULL
- ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature +1) #0)
+ ($i.ILOAD +1)
+ ($i.PUTFIELD //.function-class partials-field $t.int)
$i.RETURN))
- ))]
- _ (commonT.store-class hostL.runnable-class bytecode)]
- (wrap bytecode)))
+ applyI))]
+ (do compiler.Monad<Operation>
+ [_ (translation.execute! [//.function-class bytecode])]
+ (wrap bytecode))))
+
+(def: translate-runnable
+ (Operation ByteCode)
+ (let [procedure-field "procedure"
+ bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runnable-class (list) ["java.lang.Object" (list)] (list ["java.lang.Runnable" (list)])
+ (|>> ($d.field #$.Public $.finalF procedure-field $Function)
+ ($d.method #$.Public $.noneM "<init>" ($t.method (list $Function) #.None (list))
+ (|>> ($i.ALOAD +0)
+ ($i.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0)
+ ($i.ALOAD +0)
+ ($i.ALOAD +1)
+ ($i.PUTFIELD //.runnable-class procedure-field $Function)
+ $i.RETURN))
+ ($d.method #$.Public $.noneM "run" ($t.method (list) #.None (list))
+ (|>> ($i.ALOAD +0)
+ ($i.GETFIELD //.runnable-class procedure-field $Function)
+ $i.NULL
+ ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0)
+ $i.RETURN))
+ ))]
+ (do compiler.Monad<Operation>
+ [_ (translation.execute! [//.runnable-class bytecode])]
+ (wrap bytecode))))
(def: #export translate
- (Meta [commonT.Bytecode commonT.Bytecode commonT.Bytecode])
- (do macro.Monad<Meta>
+ (Operation [ByteCode ByteCode ByteCode])
+ (do compiler.Monad<Operation>
[runtime-bc translate-runtime
function-bc translate-function
runnable-bc translate-runnable]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 12:08:44 +0000