diff options
author | Eduardo Julian | 2019-04-16 20:53:41 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-04-16 20:53:41 -0400 |
commit | 697707d8560a5735be38fd9b1ff91a02c289d48f (patch) | |
tree | 7f9e81974c9ec3ede82e7f2392ebba037e3e9df8 /new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux | |
parent | 42248854f0cb5e3364e6aae25527cee65cbda3e8 (diff) |
Made some new-luxc modules "old".
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 | 361 |
1 files changed, 0 insertions, 361 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 deleted file mode 100644 index d21729d0e..000000000 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ /dev/null @@ -1,361 +0,0 @@ -(.module: - [lux #* - [abstract - [monad (#+ do)]] - [data - [text - format] - [collection - ["." list ("#/." functor)]]] - ["." math] - [tool - [compiler - [analysis (#+ Arity)] - ["." synthesis] - ["." phase - ["." generation]]]]] - [luxc - [lang - [host - ["$" jvm (#+ Label Inst Method Def Operation) - ["$t" type] - ["$d" def] - ["_" inst]]]]] - ["." // (#+ ByteCode)]) - -(def: $Object $.Type ($t.class "java.lang.Object" (list))) -(def: $Object-Array $.Type ($t.array 1 $Object)) -(def: $String $.Type ($t.class "java.lang.String" (list))) -(def: #export $Stack $.Type ($t.array 1 $Object)) -(def: #export $Tuple $.Type $Object-Array) -(def: #export $Variant $.Type $Object-Array) -(def: #export $Tag $.Type $t.int) -(def: #export $Flag $.Type $Object) -(def: #export $Datum $.Type $Object) -(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: #export logI - Inst - (let [outI (_.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list))) - printI (function (_ method) (_.INVOKEVIRTUAL "java.io.PrintStream" method ($t.method (list $Object) #.None (list)) #0))] - (|>> outI (_.string "LOG: ") (printI "print") - outI _.SWAP (printI "println")))) - -(def: variant-method - Method - ($t.method (list $t.int $Object $Object) (#.Some $Object-Array) (list))) - -(def: #export variantI - Inst - (_.INVOKESTATIC //.runtime-class "variant_make" variant-method #0)) - -(def: #export leftI - Inst - (|>> (_.int +0) - _.NULL - _.DUP2_X1 - _.POP2 - variantI)) - -(def: #export rightI - Inst - (|>> (_.int +1) - (_.string "") - _.DUP2_X1 - _.POP2 - variantI)) - -(def: #export someI Inst rightI) - -(def: #export noneI - Inst - (|>> (_.int +0) - _.NULL - (_.string synthesis.unit) - variantI)) - -(def: (try-methodI unsafeI) - (-> Inst Inst) - (<| _.with-label (function (_ @from)) - _.with-label (function (_ @to)) - _.with-label (function (_ @handler)) - (|>> (_.try @from @to @handler "java.lang.Exception") - (_.label @from) - unsafeI - someI - _.ARETURN - (_.label @to) - (_.label @handler) - noneI - _.ARETURN))) - -(def: #export string-concatI - Inst - (_.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0)) - -(def: #export partials-field Text "partials") -(def: #export apply-method Text "apply") -(def: #export num-apply-variants Nat 8) - -(def: #export (apply-signature arity) - (-> Arity Method) - ($t.method (list.repeat arity $Object) (#.Some $Object) (list))) - -(def: adt-methods - Def - (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap #$.Int) _.AASTORE) - store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE) - store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)] - (|>> ($d.method #$.Public $.staticM "variant_make" - ($t.method (list $t.int $Object $Object) - (#.Some $Variant) - (list)) - (|>> (_.int +3) - (_.array $Object) - store-tagI - store-flagI - store-valueI - _.ARETURN))))) - -(def: frac-shiftI Inst (_.double (math.pow +32.0 +2.0))) - -(def: frac-methods - Def - (|>> ($d.method #$.Public $.staticM "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) - (try-methodI - (|>> (_.ALOAD 0) - (_.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) #0) - (_.wrap #$.Double)))) - )) - -(def: pm-methods - Def - (let [tuple-sizeI (|>> (_.ALOAD 0) _.ARRAYLENGTH) - last-rightI (|>> tuple-sizeI (_.int +1) _.ISUB) - leftsI (_.ILOAD 1) - left-indexI leftsI - sub-leftsI (|>> leftsI - last-rightI - _.ISUB) - sub-tupleI (|>> (_.ALOAD 0) last-rightI _.AALOAD (_.CHECKCAST ($t.descriptor $Tuple))) - recurI (: (-> Label Inst) - (function (_ @loop) - (|>> sub-leftsI (_.ISTORE 1) - sub-tupleI (_.ASTORE 0) - (_.GOTO @loop))))] - (|>> ($d.method #$.Public $.staticM "pm_fail" ($t.method (list) #.None (list)) - (|>> (_.NEW "java.lang.IllegalStateException") - _.DUP - (_.string "Invalid expression for pattern-matching.") - (_.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0) - _.ATHROW)) - ($d.method #$.Public $.staticM "apply_fail" ($t.method (list) #.None (list)) - (|>> (_.NEW "java.lang.IllegalStateException") - _.DUP - (_.string "Error while applying function.") - (_.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0) - _.ATHROW)) - ($d.method #$.Public $.staticM "pm_push" ($t.method (list $Stack $Object) (#.Some $Stack) (list)) - (|>> (_.int +2) - (_.ANEWARRAY "java.lang.Object") - _.DUP - (_.int +0) - (_.ALOAD 0) - _.AASTORE - _.DUP - (_.int +1) - (_.ALOAD 1) - _.AASTORE - _.ARETURN)) - ($d.method #$.Public $.staticM "pm_pop" ($t.method (list $Stack) (#.Some $Stack) (list)) - (|>> (_.ALOAD 0) - (_.int +0) - _.AALOAD - (_.CHECKCAST ($t.descriptor $Stack)) - _.ARETURN)) - ($d.method #$.Public $.staticM "pm_peek" ($t.method (list $Stack) (#.Some $Object) (list)) - (|>> (_.ALOAD 0) - (_.int +1) - _.AALOAD - _.ARETURN)) - ($d.method #$.Public $.staticM "pm_variant" ($t.method (list $Variant $Tag $Flag) (#.Some $Object) (list)) - (<| _.with-label (function (_ @loop)) - _.with-label (function (_ @just-return)) - _.with-label (function (_ @then)) - _.with-label (function (_ @further)) - _.with-label (function (_ @shorten)) - _.with-label (function (_ @wrong)) - (let [variant-partI (: (-> Nat Inst) - (function (_ idx) - (|>> (_.int (.int idx)) _.AALOAD))) - tagI (: Inst - (|>> (variant-partI 0) (_.unwrap #$.Int))) - flagI (variant-partI 1) - datumI (variant-partI 2) - shortenI (|>> (_.ALOAD 0) tagI ## Get tag - (_.ILOAD 1) _.ISUB ## Shorten tag - (_.ALOAD 0) flagI ## Get flag - (_.ALOAD 0) datumI ## Get value - variantI ## Build sum - _.ARETURN) - update-tagI (|>> _.ISUB (_.ISTORE 1)) - update-variantI (|>> (_.ALOAD 0) datumI (_.CHECKCAST ($t.descriptor $Variant)) (_.ASTORE 0)) - failureI (|>> _.NULL _.ARETURN) - return-datumI (|>> (_.ALOAD 0) datumI _.ARETURN)]) - (|>> (_.label @loop) - (_.ILOAD 1) ## tag - (_.ALOAD 0) tagI ## tag, sumT - _.DUP2 (_.IF_ICMPEQ @then) - _.DUP2 (_.IF_ICMPGT @further) - _.DUP2 (_.IF_ICMPLT @shorten) - ## _.POP2 - failureI - (_.label @then) ## tag, sumT - (_.ALOAD 2) ## tag, sumT, wants-last? - (_.ALOAD 0) flagI ## tag, sumT, wants-last?, is-last? - (_.IF_ACMPEQ @just-return) ## tag, sumT - (_.label @further) ## tag, sumT - (_.ALOAD 0) flagI ## tag, sumT, last? - (_.IFNULL @wrong) ## tag, sumT - update-tagI - update-variantI - (_.GOTO @loop) - (_.label @just-return) ## tag, sumT - ## _.POP2 - return-datumI - (_.label @shorten) ## tag, sumT - (_.ALOAD 2) (_.IFNULL @wrong) - ## _.POP2 - shortenI - (_.label @wrong) ## tag, sumT - ## _.POP2 - failureI))) - ($d.method #$.Public $.staticM "tuple_left" ($t.method (list $Tuple $t.int) (#.Some $Object) (list)) - (<| _.with-label (function (_ @loop)) - _.with-label (function (_ @recursive)) - (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)]) - (|>> (_.label @loop) - leftsI last-rightI (_.IF_ICMPGE @recursive) - left-accessI - _.ARETURN - (_.label @recursive) - ## Recursive - (recurI @loop)))) - ($d.method #$.Public $.staticM "tuple_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list)) - (<| _.with-label (function (_ @loop)) - _.with-label (function (_ @not-tail)) - _.with-label (function (_ @slice)) - (let [right-indexI (|>> leftsI - (_.int +1) - _.IADD) - right-accessI (|>> (_.ALOAD 0) - _.SWAP - _.AALOAD) - sub-rightI (|>> (_.ALOAD 0) - right-indexI - tuple-sizeI - (_.INVOKESTATIC "java.util.Arrays" "copyOfRange" - ($t.method (list $Object-Array $t.int $t.int) - (#.Some $Object-Array) - (list)) - #0))]) - (|>> (_.label @loop) - last-rightI right-indexI - _.DUP2 (_.IF_ICMPNE @not-tail) - ## _.POP - right-accessI - _.ARETURN - (_.label @not-tail) - (_.IF_ICMPGT @slice) - ## Must recurse - (recurI @loop) - (_.label @slice) - sub-rightI - _.ARETURN - ))) - ))) - -(def: io-methods - Def - (let [string-writerI (|>> (_.NEW "java.io.StringWriter") - _.DUP - (_.INVOKESPECIAL "java.io.StringWriter" "<init>" ($t.method (list) #.None (list)) #0)) - print-writerI (|>> (_.NEW "java.io.PrintWriter") - _.SWAP - _.DUP2 - _.POP - _.SWAP - (_.boolean #1) - (_.INVOKESPECIAL "java.io.PrintWriter" "<init>" ($t.method (list ($t.class "java.io.Writer" (list)) $t.boolean) #.None (list)) #0) - )] - (|>> ($d.method #$.Public $.staticM "try" ($t.method (list $Function) (#.Some $Variant) (list)) - (<| _.with-label (function (_ @from)) - _.with-label (function (_ @to)) - _.with-label (function (_ @handler)) - (|>> (_.try @from @to @handler "java.lang.Throwable") - (_.label @from) - (_.ALOAD 0) - _.NULL - (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature 1) #0) - rightI - _.ARETURN - (_.label @to) - (_.label @handler) - string-writerI ## TW - _.DUP2 ## TWTW - print-writerI ## TWTP - (_.INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t.method (list ($t.class "java.io.PrintWriter" (list))) #.None (list)) #0) ## TW - (_.INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t.method (list) (#.Some $String) (list)) #0) ## TS - _.SWAP _.POP leftI - _.ARETURN))) - ))) - -(def: translate-runtime - (Operation ByteCode) - (let [bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runtime-class (list) ["java.lang.Object" (list)] (list) - (|>> adt-methods - frac-methods - pm-methods - io-methods))] - (do phase.monad - [_ (generation.execute! //.runtime-class [//.runtime-class bytecode])] - (wrap bytecode)))) - -(def: translate-function - (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 _.ALOAD) - _.fuse)] - (|>> preI - (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature (dec arity)) #0) - (_.CHECKCAST //.function-class) - (_.ALOAD arity) - (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature 1) #0) - _.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)) - (|>> (_.ALOAD 0) - (_.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0) - (_.ALOAD 0) - (_.ILOAD 1) - (_.PUTFIELD //.function-class partials-field $t.int) - _.RETURN)) - applyI))] - (do phase.monad - [_ (generation.execute! //.function-class [//.function-class bytecode])] - (wrap bytecode)))) - -(def: #export translate - (Operation Any) - (do phase.monad - [runtime-bc translate-runtime - function-bc translate-function] - (wrap []))) |