From b63ac226cc2ea843f08f7c72b18d22602462c624 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 7 Sep 2019 01:50:37 -0400 Subject: Modified compiler's machinery to use the new abstractions for descriptors and signatures. --- .../source/luxc/lang/translation/jvm/runtime.lux | 102 +++++++++++---------- 1 file changed, 53 insertions(+), 49 deletions(-) (limited to 'new-luxc/source/luxc/lang/translation/jvm/runtime.lux') diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux index 0f3a89faf..594964be0 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux @@ -1,5 +1,5 @@ (.module: - [lux #* + [lux (#- Type) [abstract [monad (#+ do)]] [data @@ -8,8 +8,10 @@ ["." math] [target [jvm - [type - ["." descriptor (#+ Descriptor)]]]] + ["." type (#+ Type) + ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)] + ["." descriptor (#+ Descriptor)] + ["." signature (#+ Signature)]]]] [tool [compiler [arity (#+ Arity)] @@ -24,36 +26,36 @@ ["_" inst]]]]] ["." // (#+ ByteCode)]) -(def: $Text (descriptor.class "java.lang.String")) -(def: #export $Tag descriptor.int) -(def: #export $Flag (descriptor.class "java.lang.Object")) -(def: #export $Value (descriptor.class "java.lang.Object")) -(def: #export $Index descriptor.int) -(def: #export $Stack (descriptor.array $Value)) -(def: $Throwable (descriptor.class "java.lang.Throwable")) -(def: #export $Runtime (descriptor.class "java.lang.Runtime")) +(def: $Text (type.class "java.lang.String" (list))) +(def: #export $Tag type.int) +(def: #export $Flag (type.class "java.lang.Object" (list))) +(def: #export $Value (type.class "java.lang.Object" (list))) +(def: #export $Index type.int) +(def: #export $Stack (type.array $Value)) +(def: $Throwable (type.class "java.lang.Throwable" (list))) +(def: #export $Runtime (type.class "java.lang.Runtime" (list))) (def: nullary-init-methodT - (descriptor.method [(list) descriptor.void])) + (type.method [(list) type.void (list)])) (def: throw-methodT - (descriptor.method [(list) descriptor.void])) + (type.method [(list) type.void (list)])) (def: #export logI Inst - (let [PrintStream (descriptor.class "java.io.PrintStream") - outI (_.GETSTATIC (descriptor.class "java.lang.System") "out" PrintStream) + (let [PrintStream (type.class "java.io.PrintStream" (list)) + outI (_.GETSTATIC (type.class "java.lang.System" (list)) "out" PrintStream) printI (function (_ method) - (_.INVOKEVIRTUAL PrintStream method (descriptor.method [(list $Value) descriptor.void]) #0))] + (_.INVOKEVIRTUAL PrintStream method (type.method [(list $Value) type.void (list)]) #0))] (|>> outI (_.string "LOG: ") (printI "print") outI _.SWAP (printI "println")))) (def: variant-method - (descriptor.method [(list $Tag $Flag $Value) //.$Variant])) + (type.method [(list $Tag $Flag $Value) //.$Variant (list)])) (def: #export variantI Inst - (_.INVOKESTATIC (descriptor.class //.runtime-class) "variant_make" variant-method #0)) + (_.INVOKESTATIC (type.class //.runtime-class (list)) "variant_make" variant-method #0)) (def: #export leftI Inst @@ -85,7 +87,7 @@ (<| _.with-label (function (_ @from)) _.with-label (function (_ @to)) _.with-label (function (_ @handler)) - (|>> (_.try @from @to @handler (descriptor.class "java.lang.Exception")) + (|>> (_.try @from @to @handler (type.class "java.lang.Exception" (list))) (_.label @from) unsafeI someI @@ -97,23 +99,23 @@ (def: #export string-concatI Inst - (_.INVOKEVIRTUAL $Text "concat" (descriptor.method [(list $Text) $Text]) #0)) + (_.INVOKEVIRTUAL $Text "concat" (type.method [(list $Text) $Text (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 (Descriptor descriptor.Method)) - (descriptor.method [(list.repeat arity $Value) $Value])) + (-> Arity [(Signature Method) (Descriptor Method)]) + (type.method [(list.repeat arity $Value) $Value (list)])) (def: adt-methods Def - (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap descriptor.int) _.AASTORE) + (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap type.int) _.AASTORE) store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE) store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)] (|>> ($d.method #$.Public $.staticM "variant_make" - (descriptor.method [(list $Tag $Flag $Value) //.$Variant]) + (type.method [(list $Tag $Flag $Value) //.$Variant (list)]) (|>> (_.int +3) (_.array //.$Variant) store-tagI @@ -125,11 +127,11 @@ (def: frac-methods Def - (|>> ($d.method #$.Public $.staticM "decode_frac" (descriptor.method [(list $Text) //.$Variant]) + (|>> ($d.method #$.Public $.staticM "decode_frac" (type.method [(list $Text) //.$Variant (list)]) (try-methodI (|>> (_.ALOAD 0) - (_.INVOKESTATIC (descriptor.class "java.lang.Double") "parseDouble" (descriptor.method [(list $Text) descriptor.double]) #0) - (_.wrap descriptor.double)))) + (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "parseDouble" (type.method [(list $Text) type.double (list)]) #0) + (_.wrap type.double)))) )) (def: #export popI @@ -143,11 +145,11 @@ (def: (illegal-state-exception message) (-> Text Inst) - (let [IllegalStateException (descriptor.class "java.lang.IllegalStateException")] + (let [IllegalStateException (type.class "java.lang.IllegalStateException" (list))] (|>> (_.NEW IllegalStateException) _.DUP (_.string message) - (_.INVOKESPECIAL IllegalStateException "" (descriptor.method [(list $Text) descriptor.void]) #0)))) + (_.INVOKESPECIAL IllegalStateException "" (type.method [(list $Text) type.void (list)]) #0)))) (def: pm-methods Def @@ -170,7 +172,7 @@ ($d.method #$.Public $.staticM "apply_fail" throw-methodT (|>> (illegal-state-exception "Error while applying function.") _.ATHROW)) - ($d.method #$.Public $.staticM "pm_push" (descriptor.method [(list $Stack $Value) $Stack]) + ($d.method #$.Public $.staticM "pm_push" (type.method [(list $Stack $Value) $Stack (list)]) (|>> (_.int +2) (_.ANEWARRAY $Stack) _.DUP @@ -182,7 +184,7 @@ (_.ALOAD 1) _.AASTORE _.ARETURN)) - ($d.method #$.Public $.staticM "pm_variant" (descriptor.method [(list //.$Variant $Tag $Flag) $Value]) + ($d.method #$.Public $.staticM "pm_variant" (type.method [(list //.$Variant $Tag $Flag) $Value (list)]) (<| _.with-label (function (_ @loop)) _.with-label (function (_ @just-return)) _.with-label (function (_ @then)) @@ -193,7 +195,7 @@ (function (_ idx) (|>> (_.int (.int idx)) _.AALOAD))) tagI (: Inst - (|>> (variant-partI 0) (_.unwrap descriptor.int))) + (|>> (variant-partI 0) (_.unwrap type.int))) flagI (variant-partI 1) datumI (variant-partI 2) shortenI (|>> (_.ALOAD 0) tagI ## Get tag @@ -234,7 +236,7 @@ (_.label @wrong) ## tag, sumT ## _.POP2 failureI))) - ($d.method #$.Public $.staticM "tuple_left" (descriptor.method [(list //.$Tuple $Index) $Value]) + ($d.method #$.Public $.staticM "tuple_left" (type.method [(list //.$Tuple $Index) $Value (list)]) (<| _.with-label (function (_ @loop)) _.with-label (function (_ @recursive)) (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)]) @@ -245,7 +247,7 @@ (_.label @recursive) ## Recursive (recurI @loop)))) - ($d.method #$.Public $.staticM "tuple_right" (descriptor.method [(list //.$Tuple $Index) $Value]) + ($d.method #$.Public $.staticM "tuple_right" (type.method [(list //.$Tuple $Index) $Value (list)]) (<| _.with-label (function (_ @loop)) _.with-label (function (_ @not-tail)) _.with-label (function (_ @slice)) @@ -258,9 +260,10 @@ sub-rightI (|>> (_.ALOAD 0) right-indexI tuple-sizeI - (_.INVOKESTATIC (descriptor.class "java.util.Arrays") "copyOfRange" - (descriptor.method [(list //.$Tuple $Index $Index) - //.$Tuple]) + (_.INVOKESTATIC (type.class "java.util.Arrays" (list)) "copyOfRange" + (type.method [(list //.$Tuple $Index $Index) + //.$Tuple + (list)]) #0))]) (|>> (_.label @loop) last-rightI right-indexI @@ -280,8 +283,8 @@ (def: io-methods Def - (let [StringWriter (descriptor.class "java.io.StringWriter") - PrintWriter (descriptor.class "java.io.PrintWriter") + (let [StringWriter (type.class "java.io.StringWriter" (list)) + PrintWriter (type.class "java.io.PrintWriter" (list)) string-writerI (|>> (_.NEW StringWriter) _.DUP (_.INVOKESPECIAL StringWriter "" nullary-init-methodT #0)) @@ -291,9 +294,9 @@ _.POP _.SWAP (_.boolean true) - (_.INVOKESPECIAL PrintWriter "" (descriptor.method [(list (descriptor.class "java.io.Writer") descriptor.boolean) descriptor.void]) #0) + (_.INVOKESPECIAL PrintWriter "" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)]) #0) )] - (|>> ($d.method #$.Public $.staticM "try" (descriptor.method [(list //.$Function) //.$Variant]) + (|>> ($d.method #$.Public $.staticM "try" (type.method [(list //.$Function) //.$Variant (list)]) (<| _.with-label (function (_ @from)) _.with-label (function (_ @to)) _.with-label (function (_ @handler)) @@ -309,15 +312,15 @@ string-writerI ## TW _.DUP2 ## TWTW print-writerI ## TWTP - (_.INVOKEVIRTUAL $Throwable "printStackTrace" (descriptor.method [(list (descriptor.class "java.io.PrintWriter")) descriptor.void]) #0) ## TW - (_.INVOKEVIRTUAL StringWriter "toString" (descriptor.method [(list) $Text]) #0) ## TS + (_.INVOKEVIRTUAL $Throwable "printStackTrace" (type.method [(list (type.class "java.io.PrintWriter" (list))) type.void (list)]) #0) ## TW + (_.INVOKEVIRTUAL StringWriter "toString" (type.method [(list) $Text (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) + (let [bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runtime-class (list) (type.class "java.lang.Object" (list)) (list) (|>> adt-methods frac-methods pm-methods @@ -342,14 +345,15 @@ _.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 descriptor.int) - ($d.method #$.Public $.noneM "" (descriptor.method [(list descriptor.int) descriptor.void]) + $Object (type.class "java.lang.Object" (list)) + bytecode ($d.abstract #$.V1_6 #$.Public $.noneC //.function-class (list) $Object (list) + (|>> ($d.field #$.Public $.finalF partials-field type.int) + ($d.method #$.Public $.noneM "" (type.method [(list type.int) type.void (list)]) (|>> (_.ALOAD 0) - (_.INVOKESPECIAL (descriptor.class "java.lang.Object") "" nullary-init-methodT #0) + (_.INVOKESPECIAL $Object "" nullary-init-methodT #0) (_.ALOAD 0) (_.ILOAD 1) - (_.PUTFIELD //.$Function partials-field descriptor.int) + (_.PUTFIELD //.$Function partials-field type.int) _.RETURN)) applyI))] (do phase.monad -- cgit v1.2.3