From b4d0eba7485caf0c6cf58de1193a9114fa273d8b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 30 May 2020 15:19:28 -0400 Subject: Split new-luxc into lux-jvm and lux-r. --- lux-jvm/source/luxc/lang/host/jvm/def.lux | 298 ++++++++++++++++++++++++++++++ 1 file changed, 298 insertions(+) create mode 100644 lux-jvm/source/luxc/lang/host/jvm/def.lux (limited to 'lux-jvm/source/luxc/lang/host/jvm/def.lux') diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux new file mode 100644 index 000000000..f274da61f --- /dev/null +++ b/lux-jvm/source/luxc/lang/host/jvm/def.lux @@ -0,0 +1,298 @@ +(.module: + [lux (#- Type) + ["." host (#+ import: do-to)] + [control + ["." function]] + [data + ["." product] + [number + ["i" int]] + ["." text + ["%" format (#+ format)]] + [collection + ["." array (#+ Array)] + ["." list ("#@." functor)]]] + [target + [jvm + [encoding + ["." name]] + ["." type (#+ Type Constraint) + [category (#+ Class Value Method)] + ["." signature] + ["." descriptor]]]]] + ["." //]) + +(def: signature (|>> type.signature signature.signature)) +(def: descriptor (|>> type.descriptor descriptor.descriptor)) +(def: class-name (|>> type.descriptor descriptor.class-name name.read)) + +(import: #long java/lang/Object) +(import: #long java/lang/String) + +(import: org/objectweb/asm/Opcodes + (#static ACC_PUBLIC int) + (#static ACC_PROTECTED int) + (#static ACC_PRIVATE int) + + (#static ACC_TRANSIENT int) + (#static ACC_VOLATILE int) + + (#static ACC_ABSTRACT int) + (#static ACC_FINAL int) + (#static ACC_STATIC int) + (#static ACC_SYNCHRONIZED int) + (#static ACC_STRICT int) + + (#static ACC_SUPER int) + (#static ACC_INTERFACE int) + + (#static V1_1 int) + (#static V1_2 int) + (#static V1_3 int) + (#static V1_4 int) + (#static V1_5 int) + (#static V1_6 int) + (#static V1_7 int) + (#static V1_8 int) + ) + +(import: org/objectweb/asm/FieldVisitor + (visitEnd [] void)) + +(import: org/objectweb/asm/MethodVisitor + (visitCode [] void) + (visitMaxs [int int] void) + (visitEnd [] void)) + +(import: org/objectweb/asm/ClassWriter + (#static COMPUTE_MAXS int) + (#static COMPUTE_FRAMES int) + (new [int]) + (visit [int int String String String [String]] void) + (visitEnd [] void) + (visitField [int String String String Object] FieldVisitor) + (visitMethod [int String String String [String]] MethodVisitor) + (toByteArray [] [byte])) + +(def: (string-array values) + (-> (List Text) (Array Text)) + (let [output (host.array String (list.size values))] + (exec (list@map (function (_ [idx value]) + (host.array-write idx value output)) + (list.enumerate values)) + output))) + +(def: (version-flag version) + (-> //.Version Int) + (case version + #//.V1_1 (Opcodes::V1_1) + #//.V1_2 (Opcodes::V1_2) + #//.V1_3 (Opcodes::V1_3) + #//.V1_4 (Opcodes::V1_4) + #//.V1_5 (Opcodes::V1_5) + #//.V1_6 (Opcodes::V1_6) + #//.V1_7 (Opcodes::V1_7) + #//.V1_8 (Opcodes::V1_8))) + +(def: (visibility-flag visibility) + (-> //.Visibility Int) + (case visibility + #//.Public (Opcodes::ACC_PUBLIC) + #//.Protected (Opcodes::ACC_PROTECTED) + #//.Private (Opcodes::ACC_PRIVATE) + #//.Default +0)) + +(def: (class-flags config) + (-> //.Class-Config Int) + ($_ i.+ + (if (get@ #//.finalC config) (Opcodes::ACC_FINAL) +0))) + +(def: (method-flags config) + (-> //.Method-Config Int) + ($_ i.+ + (if (get@ #//.staticM config) (Opcodes::ACC_STATIC) +0) + (if (get@ #//.finalM config) (Opcodes::ACC_FINAL) +0) + (if (get@ #//.synchronizedM config) (Opcodes::ACC_SYNCHRONIZED) +0) + (if (get@ #//.strictM config) (Opcodes::ACC_STRICT) +0))) + +(def: (field-flags config) + (-> //.Field-Config Int) + ($_ i.+ + (if (get@ #//.staticF config) (Opcodes::ACC_STATIC) +0) + (if (get@ #//.finalF config) (Opcodes::ACC_FINAL) +0) + (if (get@ #//.transientF config) (Opcodes::ACC_TRANSIENT) +0) + (if (get@ #//.volatileF config) (Opcodes::ACC_VOLATILE) +0))) + +(def: param-signature + (-> (Type Class) Text) + (|>> ..signature (format ":"))) + +(def: (formal-param [name super interfaces]) + (-> Constraint Text) + (format name + (param-signature super) + (|> interfaces + (list@map param-signature) + (text.join-with "")))) + +(def: (constraints-signature constraints super interfaces) + (-> (List Constraint) (Type Class) (List (Type Class)) + Text) + (let [formal-params (if (list.empty? constraints) + "" + (format "<" + (|> constraints + (list@map formal-param) + (text.join-with "")) + ">"))] + (format formal-params + (..signature super) + (|> interfaces + (list@map ..signature) + (text.join-with ""))))) + +(def: class-computes + Int + ($_ i.+ + (ClassWriter::COMPUTE_MAXS) + ## (ClassWriter::COMPUTE_FRAMES) + )) + +(def: binary-name (|>> name.internal name.read)) + +(template [ ] + [(def: #export ( version visibility config name constraints super interfaces + definitions) + (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (Type Class) (List (Type Class)) //.Def + (host.type [byte])) + (let [writer (|> (do-to (ClassWriter::new class-computes) + (ClassWriter::visit (version-flag version) + ($_ i.+ + (Opcodes::ACC_SUPER) + + (visibility-flag visibility) + (class-flags config)) + (..binary-name name) + (constraints-signature constraints super interfaces) + (..class-name super) + (|> interfaces + (list@map ..class-name) + string-array))) + definitions) + _ (ClassWriter::visitEnd writer)] + (ClassWriter::toByteArray writer)))] + + [class +0] + [abstract (Opcodes::ACC_ABSTRACT)] + ) + +(def: $Object + (Type Class) + (type.class "java.lang.Object" (list))) + +(def: #export (interface version visibility config name constraints interfaces + definitions) + (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (List (Type Class)) //.Def + (host.type [byte])) + (let [writer (|> (do-to (ClassWriter::new class-computes) + (ClassWriter::visit (version-flag version) + ($_ i.+ + (Opcodes::ACC_SUPER) + (Opcodes::ACC_INTERFACE) + (visibility-flag visibility) + (class-flags config)) + (..binary-name name) + (constraints-signature constraints $Object interfaces) + (..class-name $Object) + (|> interfaces + (list@map ..class-name) + string-array))) + definitions) + _ (ClassWriter::visitEnd writer)] + (ClassWriter::toByteArray writer))) + +(def: #export (method visibility config name type then) + (-> //.Visibility //.Method-Config Text (Type Method) //.Inst + //.Def) + (function (_ writer) + (let [=method (ClassWriter::visitMethod ($_ i.+ + (visibility-flag visibility) + (method-flags config)) + (..binary-name name) + (..descriptor type) + (..signature type) + (string-array (list)) + writer) + _ (MethodVisitor::visitCode =method) + _ (then =method) + _ (MethodVisitor::visitMaxs +0 +0 =method) + _ (MethodVisitor::visitEnd =method)] + writer))) + +(def: #export (abstract-method visibility config name type) + (-> //.Visibility //.Method-Config Text (Type Method) + //.Def) + (function (_ writer) + (let [=method (ClassWriter::visitMethod ($_ i.+ + (visibility-flag visibility) + (method-flags config) + (Opcodes::ACC_ABSTRACT)) + (..binary-name name) + (..descriptor type) + (..signature type) + (string-array (list)) + writer) + _ (MethodVisitor::visitEnd =method)] + writer))) + +(def: #export (field visibility config name type) + (-> //.Visibility //.Field-Config Text (Type Value) //.Def) + (function (_ writer) + (let [=field (do-to (ClassWriter::visitField ($_ i.+ + (visibility-flag visibility) + (field-flags config)) + (..binary-name name) + (..descriptor type) + (..signature type) + (host.null) + writer) + (FieldVisitor::visitEnd))] + writer))) + +(template [ ] + [(def: #export ( visibility config name value) + (-> //.Visibility //.Field-Config Text //.Def) + (function (_ writer) + (let [=field (do-to (ClassWriter::visitField ($_ i.+ + (visibility-flag visibility) + (field-flags config)) + (..binary-name name) + (..descriptor ) + (..signature ) + ( value) + writer) + (FieldVisitor::visitEnd))] + writer)))] + + [boolean-field Bit type.boolean function.identity] + [byte-field Int type.byte host.long-to-byte] + [short-field Int type.short host.long-to-short] + [int-field Int type.int host.long-to-int] + [long-field Int type.long function.identity] + [float-field Frac type.float host.double-to-float] + [double-field Frac type.double function.identity] + [char-field Nat type.char (|>> .int host.long-to-int host.int-to-char)] + [string-field Text (type.class "java.lang.String" (list)) function.identity] + ) + +(def: #export (fuse defs) + (-> (List //.Def) //.Def) + (case defs + #.Nil + function.identity + + (#.Cons singleton #.Nil) + singleton + + (#.Cons head tail) + (function.compose (fuse tail) head))) -- cgit v1.2.3