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. --- new-luxc/source/luxc/lang/host/jvm/def.lux | 298 ----------------------------- 1 file changed, 298 deletions(-) delete mode 100644 new-luxc/source/luxc/lang/host/jvm/def.lux (limited to 'new-luxc/source/luxc/lang/host/jvm/def.lux') diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux deleted file mode 100644 index f274da61f..000000000 --- a/new-luxc/source/luxc/lang/host/jvm/def.lux +++ /dev/null @@ -1,298 +0,0 @@ -(.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