aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/host/jvm/def.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/host/jvm/def.lux')
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux298
1 files changed, 0 insertions, 298 deletions
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 [<name> <flag>]
- [(def: #export (<name> 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)
- <flag>
- (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 [<name> <lux-type> <jvm-type> <prepare>]
- [(def: #export (<name> visibility config name value)
- (-> //.Visibility //.Field-Config Text <lux-type> //.Def)
- (function (_ writer)
- (let [=field (do-to (ClassWriter::visitField ($_ i.+
- (visibility-flag visibility)
- (field-flags config))
- (..binary-name name)
- (..descriptor <jvm-type>)
- (..signature <jvm-type>)
- (<prepare> 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)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-12 13:32:52 +0000