From ecb53b05a226d8d3d8e612f949cb3ad6ac0600ce Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 28 Dec 2019 17:00:04 -0400 Subject: Implemented an alternative method for extensible JVM bytecode generation. --- stdlib/source/lux/target/jvm.lux | 282 +++++++++++++++++++++ .../compiler/phase/extension/directive/lux.lux | 2 +- stdlib/source/spec/compositor/common.lux | 20 +- stdlib/source/test/lux/extension.lux | 65 ++++- 4 files changed, 346 insertions(+), 23 deletions(-) create mode 100644 stdlib/source/lux/target/jvm.lux (limited to 'stdlib/source') diff --git a/stdlib/source/lux/target/jvm.lux b/stdlib/source/lux/target/jvm.lux new file mode 100644 index 000000000..4998f0f05 --- /dev/null +++ b/stdlib/source/lux/target/jvm.lux @@ -0,0 +1,282 @@ +(.module: + [lux (#- Type) + [data + [collection + [row (#+ Row)]]] + [target + [jvm + [type (#+ Type) + ["." category (#+ Primitive Class Value Method)]]]]]) + +(type: #export Literal + (#Boolean Bit) + (#Int Int) + (#Long Int) + (#Double Frac) + (#Char Nat) + (#String Text)) + +(type: #export Constant + (#BIPUSH Int) + + (#SIPUSH Int) + + #ICONST_M1 + #ICONST_0 + #ICONST_1 + #ICONST_2 + #ICONST_3 + #ICONST_4 + #ICONST_5 + + #LCONST_0 + #LCONST_1 + + #FCONST_0 + #FCONST_1 + #FCONST_2 + + #DCONST_0 + #DCONST_1 + + #ACONST_NULL + + (#LDC Literal)) + +(type: #export Int-Arithmetic + #IADD + #ISUB + #IMUL + #IDIV + #IREM + #INEG) + +(type: #export Long-Arithmetic + #LADD + #LSUB + #LMUL + #LDIV + #LREM + #LNEG) + +(type: #export Float-Arithmetic + #FADD + #FSUB + #FMUL + #FDIV + #FREM + #FNEG) + +(type: #export Double-Arithmetic + #DADD + #DSUB + #DMUL + #DDIV + #DREM + #DNEG) + +(type: #export Arithmetic + (#Int-Arithmetic Int-Arithmetic) + (#Long-Arithmetic Long-Arithmetic) + (#Float-Arithmetic Float-Arithmetic) + (#Double-Arithmetic Double-Arithmetic)) + +(type: #export Int-Bitwise + #IOR + #IXOR + #IAND + #ISHL + #ISHR + #IUSHR) + +(type: #export Long-Bitwise + #LOR + #LXOR + #LAND + #LSHL + #LSHR + #LUSHR) + +(type: #export Bitwise + (#Int-Bitwise Int-Bitwise) + (#Long-Bitwise Long-Bitwise)) + +(type: #export Conversion + #I2B + #I2S + #I2L + #I2F + #I2D + #I2C + + #L2I + #L2F + #L2D + + #F2I + #F2L + #F2D + + #D2I + #D2L + #D2F) + +(type: #export Array + #ARRAYLENGTH + + (#NEWARRAY (Type Primitive)) + (#ANEWARRAY (Type category.Object)) + + #BALOAD + #BASTORE + + #SALOAD + #SASTORE + + #IALOAD + #IASTORE + + #LALOAD + #LASTORE + + #FALOAD + #FASTORE + + #DALOAD + #DASTORE + + #CALOAD + #CASTORE + + #AALOAD + #AASTORE) + +(type: #export Object + (#GETSTATIC (Type Class) Text (Type Value)) + (#PUTSTATIC (Type Class) Text (Type Value)) + + (#NEW (Type Class)) + + (#INSTANCEOF (Type Class)) + (#CHECKCAST (Type category.Object)) + + (#GETFIELD (Type Class) Text (Type Value)) + (#PUTFIELD (Type Class) Text (Type Value)) + + (#INVOKEINTERFACE (Type Class) Text (Type Method)) + (#INVOKESPECIAL (Type Class) Text (Type Method)) + (#INVOKESTATIC (Type Class) Text (Type Method)) + (#INVOKEVIRTUAL (Type Class) Text (Type Method))) + +(type: #export Register Nat) + +(type: #export Local-Int + (#ILOAD Register) + (#ISTORE Register)) + +(type: #export Local-Long + (#LLOAD Register) + (#LSTORE Register)) + +(type: #export Local-Float + (#FLOAD Register) + (#FSTORE Register)) + +(type: #export Local-Double + (#DLOAD Register) + (#DSTORE Register)) + +(type: #export Local-Object + (#ALOAD Register) + (#ASTORE Register)) + +(type: #export Local + (#Local-Int Local-Int) + (#IINC Register) + (#Local-Long Local-Long) + (#Local-Float Local-Float) + (#Local-Double Local-Double) + (#Local-Object Local-Object)) + +(type: #export Stack + #DUP + #DUP_X1 + #DUP_X2 + #DUP2 + #DUP2_X1 + #DUP2_X2 + #SWAP + #POP + #POP2) + +(type: #export Comparison + #LCMP + + #FCMPG + #FCMPL + + #DCMPG + #DCMPL) + +(type: #export Label Nat) + +(type: #export (Branching label) + (#IF_ICMPEQ label) + (#IF_ICMPGE label) + (#IF_ICMPGT label) + (#IF_ICMPLE label) + (#IF_ICMPLT label) + (#IF_ICMPNE label) + (#IFEQ label) + (#IFNE label) + (#IFGE label) + (#IFGT label) + (#IFLE label) + (#IFLT label) + + (#TABLESWITCH Int Int label (List label)) + (#LOOKUPSWITCH label (List [Int label])) + + (#IF_ACMPEQ label) + (#IF_ACMPNE label) + (#IFNONNULL label) + (#IFNULL label)) + +(type: #export (Exception label) + (#Try label label label (Type Class)) + #ATHROW) + +(type: #export Concurrency + #MONITORENTER + #MONITOREXIT) + +(type: #export Return + #RETURN + #IRETURN + #LRETURN + #FRETURN + #DRETURN + #ARETURN) + +(type: #export (Control label) + (#GOTO label) + (#Branching (Branching label)) + (#Exception (Exception label)) + (#Concurrency Concurrency) + (#Return Return)) + +(type: #export (Instruction label) + #NOP + (#Constant Constant) + (#Arithmetic Arithmetic) + (#Bitwise Bitwise) + (#Conversion Conversion) + (#Array Array) + (#Object Object) + (#Local Local) + (#Stack Stack) + (#Comparison Comparison) + (#Control (Control label))) + +(type: #export (Bytecode label) + (Row (Instruction label))) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux index ccf8c8d96..856648097 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux @@ -65,7 +65,7 @@ codeV (////generation.evaluate! (format "evaluate" (%.nat id)) codeT)] (wrap [code//type codeT codeV])))) -(def: (evaluate! type codeC) +(def: #export (evaluate! type codeC) (All [anchor expression directive] (-> Type Code (Operation anchor expression directive [Type expression Any]))) (do ////.monad diff --git a/stdlib/source/spec/compositor/common.lux b/stdlib/source/spec/compositor/common.lux index 05fbe7fc2..df351c008 100644 --- a/stdlib/source/spec/compositor/common.lux +++ b/stdlib/source/spec/compositor/common.lux @@ -8,12 +8,13 @@ [tool [compiler ["." reference] + ["." analysis] ["." synthesis (#+ Synthesis)] ["." directive] ["." phase ["." macro (#+ Expander)] - ["." generation (#+ Operation Bundle)] - [extension + ["." generation (#+ Operation)] + [extension (#+ Extender) ["." bundle]]] [default ["." platform (#+ Platform)]]]]]) @@ -53,17 +54,20 @@ (phase (synthesis.constant lux-name))))] (:: host evaluate! "definer" definitionG)))) -(def: #export (executors platform bundle expander program) +(def: #export (executors target expander platform + analysis-bundle generation-bundle directive-bundle + program extender) (All [anchor expression directive] - (-> (Platform IO anchor expression directive) - (Bundle anchor expression directive) - Expander - (-> expression directive) + (-> Text Expander (Platform IO anchor expression directive) + analysis.Bundle + (generation.Bundle anchor expression directive) + (directive.Bundle anchor expression directive) + (-> expression directive) Extender (IO (Try [(directive.State+ anchor expression directive) Runner Definer])))) (do io.monad - [?state (platform.initialize expander platform bundle program)] + [?state (platform.initialize target expander analysis-bundle platform generation-bundle directive-bundle program extender)] (wrap (do try.monad [[directive-bundle directive-state] ?state #let [generation-state (get@ [#directive.generation diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 7b2d9ffd5..23c33c620 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -1,9 +1,11 @@ (.module: [lux #* - ["@" target] + ["@" target + ["." jvm]] [abstract [monad (#+ do)]] [control + ["." try] ["<>" parser ["" code] ["" analysis]]] @@ -20,33 +22,68 @@ ["." type]]]]] ["_" test (#+ Test)]] {1 - ["." / (#+ analysis: synthesis: directive:)]}) + ["." / (#+ analysis: synthesis: generation: directive:)]}) -(def: my-extension "example YOLO") +(def: my-analysis "my analysis") +(def: my-synthesis "my synthesis") +(def: my-generation "my generation") +(def: my-directive "my directive") (`` (for {(~~ (static @.old)) - (as-is)} - (as-is (analysis: (..my-extension self phase {parameters (<>.some .any)}) + (as-is) + + (~~ (static @.jvm)) + (as-is (generation: (..my-generation self phase {parameters (<>.some .any)}) + (#try.Success (#jvm.Constant (#jvm.LDC (#jvm.String Text))))))} + (as-is (analysis: (..my-analysis self phase {parameters (<>.some .any)}) + (do @ + [_ (type.infer .Text)] + (wrap (#analysis.Text self)))) + + ## Synthesis + (analysis: (..my-synthesis self phase {parameters (<>.some .any)}) (do @ [_ (type.infer .Text)] (wrap (#analysis.Extension self (list))))) - (synthesis: (..my-extension self phase {parameters (<>.some .any)}) + (synthesis: (..my-synthesis self phase {parameters (<>.some .any)}) (wrap (synthesis.text self))) + + ## Generation + (analysis: (..my-generation self phase {parameters (<>.some .any)}) + (do @ + [_ (type.infer .Text)] + (wrap (#analysis.Extension self (list))))) + + (synthesis: (..my-generation self phase {parameters (<>.some .any)}) + (wrap (#synthesis.Extension self (list)))) - (directive: (..my-extension self phase {parameters (<>.some .any)}) + ## Directive + (directive: (..my-directive self phase {parameters (<>.some .any)}) (do @ - [#let [_ (log! (format "directive: " (%.text self)))]] + [#let [_ (log! (format "Successfully installed directive " (%.text self) "!"))]] (wrap directive.no-requirements))) - ("example YOLO") + (`` ((~~ (static ..my-directive)))) ))) (def: #export test Test (<| (_.context (%.name (name-of /._))) - (_.test "Can define and use analysis & synthesis extensions." - (`` (for {(~~ (static @.old)) - false} - (text@= ("example YOLO") - "example YOLO")))))) + ($_ _.and + (_.test "Can define and use analysis extensions." + (`` (for {(~~ (static @.old)) + false} + (text@= ((~~ (static ..my-analysis))) + ..my-analysis)))) + (_.test "Can define and use synthesis extensions." + (`` (for {(~~ (static @.old)) + false} + (text@= ((~~ (static ..my-synthesis))) + ..my-synthesis)))) + (_.test "Can define and use generation extensions." + (`` (for {(~~ (static @.old)) + false} + (text@= ((~~ (static ..my-generation))) + ..my-generation)))) + ))) -- cgit v1.2.3