diff options
author | Eduardo Julian | 2018-07-18 23:44:29 -0400 |
---|---|---|
committer | Eduardo Julian | 2018-07-18 23:44:29 -0400 |
commit | 8b4f0ded7bddaa42cf432f74523bfd6aa1e76fed (patch) | |
tree | 27840fac3765bf9f3411ca65dc1ef5d8de0b044b /new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux | |
parent | c99909d6f03d9968cdd81c8a5c7e254372a3afcd (diff) |
WIP: Fix new-luxc's JVM back-end.
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.lux | 227 |
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] |