aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/host
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/host')
-rw-r--r--new-luxc/source/luxc/lang/host/jvm.lux9
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux107
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux115
3 files changed, 126 insertions, 105 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux
index 7216a1708..d3ead1095 100644
--- a/new-luxc/source/luxc/lang/host/jvm.lux
+++ b/new-luxc/source/luxc/lang/host/jvm.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- Definition)
+ [lux (#- Definition Type)
[host (#+ import:)]
[abstract
monad]
@@ -15,7 +15,8 @@
[syntax (#+ syntax:)]]
[target
[jvm
- [type (#+ Class)]]]
+ ["." type (#+ Type)
+ [category (#+ Class)]]]]
[tool
[compiler
[reference (#+ Register)]
@@ -119,5 +120,5 @@
(org/objectweb/asm/Label::new)))
(def: #export (simple-class name)
- (-> Text Class)
- [name (list)])
+ (-> Text (Type Class))
+ (type.class name (list)))
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
index b663b9b31..08fccc640 100644
--- a/new-luxc/source/luxc/lang/host/jvm/def.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/def.lux
@@ -11,16 +11,21 @@
["%" format (#+ format)]]
[collection
["." array (#+ Array)]
- ["." list ("#/." functor)]]]
+ ["." list ("#@." functor)]]]
[target
[jvm
[encoding
["." name]]
- ["$t" type (#+ Method Class Type Parameter)
- ["." reflection]
+ ["." type (#+ Type Constraint)
+ [category (#+ Class Value Method)]
+ ["." signature (#+ Signature)]
["." descriptor (#+ 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)
@@ -72,7 +77,7 @@
(def: (string-array values)
(-> (List Text) (Array Text))
(let [output (host.array String (list.size values))]
- (exec (list/map (function (_ [idx value])
+ (exec (list@map (function (_ [idx value])
(host.array-write idx value output))
(list.enumerate values))
output)))
@@ -118,36 +123,32 @@
(if (get@ #//.transientF config) (Opcodes::ACC_TRANSIENT) +0)
(if (get@ #//.volatileF config) (Opcodes::ACC_VOLATILE) +0)))
-(def: class-to-type
- (-> Class Type)
- (|>> #$t.Class #$t.Generic))
-
(def: param-signature
- (-> Class Text)
- (|>> class-to-type $t.signature (format ":")))
+ (-> (Type Class) Text)
+ (|>> ..signature (format ":")))
(def: (formal-param [name super interfaces])
- (-> Parameter Text)
+ (-> Constraint Text)
(format name
(param-signature super)
(|> interfaces
- (list/map param-signature)
+ (list@map param-signature)
(text.join-with ""))))
-(def: (parameters-signature parameters super interfaces)
- (-> (List Parameter) Class (List Class)
+(def: (constraints-signature constraints super interfaces)
+ (-> (List Constraint) (Type Class) (List (Type Class))
Text)
- (let [formal-params (if (list.empty? parameters)
+ (let [formal-params (if (list.empty? constraints)
""
(format "<"
- (|> parameters
- (list/map formal-param)
+ (|> constraints
+ (list@map formal-param)
(text.join-with ""))
">"))]
(format formal-params
- (|> super class-to-type $t.signature)
+ (..signature super)
(|> interfaces
- (list/map (|>> class-to-type $t.signature))
+ (list@map ..signature)
(text.join-with "")))))
(def: class-computes
@@ -160,9 +161,9 @@
(def: binary-name (|>> name.internal name.read))
(template [<name> <flag>]
- [(def: #export (<name> version visibility config name parameters super interfaces
+ [(def: #export (<name> version visibility config name constraints super interfaces
definitions)
- (-> //.Version //.Visibility //.Class-Config Text (List Parameter) Class (List Class) //.Def
+ (-> //.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)
@@ -172,10 +173,10 @@
(visibility-flag visibility)
(class-flags config))
(..binary-name name)
- (parameters-signature parameters super interfaces)
- (|> super product.left ..binary-name)
+ (constraints-signature constraints super interfaces)
+ (..class-name super)
(|> interfaces
- (list/map (|>> product.left ..binary-name))
+ (list@map ..class-name)
string-array)))
definitions)
_ (ClassWriter::visitEnd writer)]
@@ -185,11 +186,13 @@
[abstract (Opcodes::ACC_ABSTRACT)]
)
-(def: $Object Class ["java.lang.Object" (list)])
+(def: $Object
+ (Type Class)
+ (type.class "java.lang.Object" (list)))
-(def: #export (interface version visibility config name parameters interfaces
+(def: #export (interface version visibility config name constraints interfaces
definitions)
- (-> //.Version //.Visibility //.Class-Config Text (List Parameter) (List Class) //.Def
+ (-> //.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)
@@ -199,25 +202,25 @@
(visibility-flag visibility)
(class-flags config))
(..binary-name name)
- (parameters-signature parameters $Object interfaces)
- (|> $Object product.left ..binary-name)
+ (constraints-signature constraints $Object interfaces)
+ (..class-name $Object)
(|> interfaces
- (list/map (|>> product.left ..binary-name))
+ (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 (Descriptor descriptor.Method) //.Inst
+(def: #export (method visibility config name [signature descriptor] then)
+ (-> //.Visibility //.Method-Config Text [(Signature Method) (Descriptor Method)] //.Inst
//.Def)
(function (_ writer)
(let [=method (ClassWriter::visitMethod ($_ i.+
(visibility-flag visibility)
(method-flags config))
(..binary-name name)
- (descriptor.descriptor type)
- (host.null)
+ (descriptor.descriptor descriptor)
+ (signature.signature signature)
(string-array (list))
writer)
_ (MethodVisitor::visitCode =method)
@@ -226,8 +229,8 @@
_ (MethodVisitor::visitEnd =method)]
writer)))
-(def: #export (abstract-method visibility config name type)
- (-> //.Visibility //.Method-Config Text (Descriptor descriptor.Method)
+(def: #export (abstract-method visibility config name [signature descriptor])
+ (-> //.Visibility //.Method-Config Text [(Signature Method) (Descriptor Method)]
//.Def)
(function (_ writer)
(let [=method (ClassWriter::visitMethod ($_ i.+
@@ -235,22 +238,22 @@
(method-flags config)
(Opcodes::ACC_ABSTRACT))
(..binary-name name)
- (descriptor.descriptor type)
- (host.null)
+ (descriptor.descriptor descriptor)
+ (signature.signature signature)
(string-array (list))
writer)
_ (MethodVisitor::visitEnd =method)]
writer)))
(def: #export (field visibility config name type)
- (-> //.Visibility //.Field-Config Text (Descriptor descriptor.Field) //.Def)
+ (-> //.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.descriptor type)
- (host.null)
+ (..descriptor type)
+ (..signature type)
(host.null)
writer)
(FieldVisitor::visitEnd))]
@@ -264,22 +267,22 @@
(visibility-flag visibility)
(field-flags config))
(..binary-name name)
- (descriptor.descriptor <jvm-type>)
- (host.null)
+ (..descriptor <jvm-type>)
+ (..signature <jvm-type>)
(<prepare> value)
writer)
(FieldVisitor::visitEnd))]
writer)))]
- [boolean-field Bit descriptor.boolean function.identity]
- [byte-field Int descriptor.byte host.long-to-byte]
- [short-field Int descriptor.short host.long-to-short]
- [int-field Int descriptor.int host.long-to-int]
- [long-field Int descriptor.long function.identity]
- [float-field Frac descriptor.float host.double-to-float]
- [double-field Frac descriptor.double function.identity]
- [char-field Nat descriptor.char (|>> .int host.long-to-int host.int-to-char)]
- [string-field Text (descriptor.class "java.lang.String") function.identity]
+ [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)
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index 8d5bd3b6e..72d7e58ca 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- int char)
+ [lux (#- Type int char)
["." host (#+ import: do-to)]
[abstract
[monad (#+ do)]]
@@ -23,15 +23,22 @@
[target
[jvm
[encoding
- ["." name]]
- [type
+ ["." name (#+ External)]]
+ ["." type (#+ Type) ("#@." equivalence)
+ [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
["." box]
- ["." descriptor (#+ Descriptor Primitive) ("#@." equivalence)]]]]
+ ["." signature (#+ Signature)]
+ ["." descriptor (#+ Descriptor)]
+ ["." reflection]]]]
[tool
[compiler
[phase (#+ Operation)]]]]
["." // (#+ Inst)])
+(def: class-name (|>> type.descriptor descriptor.class-name name.read))
+(def: descriptor (|>> type.descriptor descriptor.descriptor))
+(def: reflection (|>> type.reflection reflection.reflection))
+
## [Host]
(import: #long java/lang/Object)
(import: #long java/lang/String)
@@ -239,10 +246,10 @@
(template [<name> <inst>]
[(def: #export (<name> class field type)
- (-> (Descriptor descriptor.Class) Text (Descriptor descriptor.Field) Inst)
+ (-> (Type Class) Text (Type Value) Inst)
(function (_ visitor)
(do-to visitor
- (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (descriptor.class-name class) field (descriptor.descriptor type)))))]
+ (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (..class-name class) field (..descriptor type)))))]
[GETSTATIC org/objectweb/asm/Opcodes::GETSTATIC]
[PUTSTATIC org/objectweb/asm/Opcodes::PUTSTATIC]
@@ -251,44 +258,54 @@
[GETFIELD org/objectweb/asm/Opcodes::GETFIELD]
)
-(template [<name> <inst>]
- [(def: #export (<name> class)
- (-> (Descriptor descriptor.Object) Inst)
- (function (_ visitor)
- (do-to visitor
- (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (descriptor.class-name class)))))]
+(template [<category> <instructions>+]
+ [(`` (template [<name> <inst>]
+ [(def: #export (<name> class)
+ (-> (Type <category>) Inst)
+ (function (_ visitor)
+ (do-to visitor
+ (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (..class-name class)))))]
+
+ (~~ (template.splice <instructions>+))))]
+
+ [Object
+ [[CHECKCAST org/objectweb/asm/Opcodes::CHECKCAST]
+ [ANEWARRAY org/objectweb/asm/Opcodes::ANEWARRAY]]]
- [CHECKCAST org/objectweb/asm/Opcodes::CHECKCAST]
- [NEW org/objectweb/asm/Opcodes::NEW]
- [INSTANCEOF org/objectweb/asm/Opcodes::INSTANCEOF]
- [ANEWARRAY org/objectweb/asm/Opcodes::ANEWARRAY]
+ [Class
+ [[NEW org/objectweb/asm/Opcodes::NEW]
+ [INSTANCEOF org/objectweb/asm/Opcodes::INSTANCEOF]]]
)
(def: #export (NEWARRAY type)
- (-> (Descriptor Primitive) Inst)
+ (-> (Type Primitive) Inst)
(function (_ visitor)
(do-to visitor
(org/objectweb/asm/MethodVisitor::visitIntInsn (org/objectweb/asm/Opcodes::NEWARRAY)
(`` (cond (~~ (template [<descriptor> <opcode>]
- [(descriptor@= <descriptor> type) (<opcode>)]
+ [(type@= <descriptor> type) (<opcode>)]
- [descriptor.boolean org/objectweb/asm/Opcodes::T_BOOLEAN]
- [descriptor.byte org/objectweb/asm/Opcodes::T_BYTE]
- [descriptor.short org/objectweb/asm/Opcodes::T_SHORT]
- [descriptor.int org/objectweb/asm/Opcodes::T_INT]
- [descriptor.long org/objectweb/asm/Opcodes::T_LONG]
- [descriptor.float org/objectweb/asm/Opcodes::T_FLOAT]
- [descriptor.double org/objectweb/asm/Opcodes::T_DOUBLE]
- [descriptor.char org/objectweb/asm/Opcodes::T_CHAR]))
+ [type.boolean org/objectweb/asm/Opcodes::T_BOOLEAN]
+ [type.byte org/objectweb/asm/Opcodes::T_BYTE]
+ [type.short org/objectweb/asm/Opcodes::T_SHORT]
+ [type.int org/objectweb/asm/Opcodes::T_INT]
+ [type.long org/objectweb/asm/Opcodes::T_LONG]
+ [type.float org/objectweb/asm/Opcodes::T_FLOAT]
+ [type.double org/objectweb/asm/Opcodes::T_DOUBLE]
+ [type.char org/objectweb/asm/Opcodes::T_CHAR]))
## else
(undefined)))))))
(template [<name> <inst>]
- [(def: #export (<name> class method-name type interface?)
- (-> (Descriptor descriptor.Class) Text (Descriptor descriptor.Method) Bit Inst)
+ [(def: #export (<name> class method-name [method-signature method-descriptor] interface?)
+ (-> (Type Class) Text [(Signature Method) (Descriptor Method)] Bit Inst)
(function (_ visitor)
(do-to visitor
- (org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>) (descriptor.class-name class) method-name (descriptor.descriptor type) interface?))))]
+ (org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>)
+ (..class-name class)
+ method-name
+ (descriptor.descriptor method-descriptor)
+ interface?))))]
[INVOKESTATIC org/objectweb/asm/Opcodes::INVOKESTATIC]
[INVOKEVIRTUAL org/objectweb/asm/Opcodes::INVOKEVIRTUAL]
@@ -346,10 +363,10 @@
(org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels-array)))))
(def: #export (try @from @to @handler exception)
- (-> //.Label //.Label //.Label (Descriptor descriptor.Class) Inst)
+ (-> //.Label //.Label //.Label (Type Class) Inst)
(function (_ visitor)
(do-to visitor
- (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (descriptor.class-name exception)))))
+ (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (..class-name exception)))))
(def: #export (label @label)
(-> //.Label Inst)
@@ -358,8 +375,8 @@
(org/objectweb/asm/MethodVisitor::visitLabel @label))))
(def: #export (array type)
- (-> (Descriptor descriptor.Value) Inst)
- (case (descriptor.primitive? type)
+ (-> (Type Value) Inst)
+ (case (type.primitive? type)
(#.Left object)
(ANEWARRAY object)
@@ -368,18 +385,18 @@
(template [<name> <boolean> <byte> <short> <int> <long> <float> <double> <char>]
[(def: (<name> type)
- (-> (Descriptor Primitive) Text)
+ (-> (Type Primitive) Text)
(`` (cond (~~ (template [<descriptor> <output>]
- [(descriptor@= <descriptor> type) <output>]
+ [(type@= <descriptor> type) <output>]
- [descriptor.boolean <boolean>]
- [descriptor.byte <byte>]
- [descriptor.short <short>]
- [descriptor.int <int>]
- [descriptor.long <long>]
- [descriptor.float <float>]
- [descriptor.double <double>]
- [descriptor.char <char>]))
+ [type.boolean <boolean>]
+ [type.byte <byte>]
+ [type.short <short>]
+ [type.int <int>]
+ [type.long <long>]
+ [type.float <float>]
+ [type.double <double>]
+ [type.char <char>]))
## else
(undefined))))]
@@ -392,15 +409,15 @@
)
(def: #export (wrap type)
- (-> (Descriptor Primitive) Inst)
- (let [wrapper (descriptor.class (primitive-wrapper type))]
- (INVOKESTATIC wrapper "valueOf" (descriptor.method [(list type) wrapper]) #0)))
+ (-> (Type Primitive) Inst)
+ (let [wrapper (type.class (primitive-wrapper type) (list))]
+ (INVOKESTATIC wrapper "valueOf" (type.method [(list type) wrapper (list)]) #0)))
(def: #export (unwrap type)
- (-> (Descriptor Primitive) Inst)
- (let [wrapper (descriptor.class (primitive-wrapper type))]
+ (-> (Type Primitive) Inst)
+ (let [wrapper (type.class (primitive-wrapper type) (list))]
(|>> (CHECKCAST wrapper)
- (INVOKEVIRTUAL wrapper (primitive-unwrap type) (descriptor.method [(list) type]) #0))))
+ (INVOKEVIRTUAL wrapper (primitive-unwrap type) (type.method [(list) type (list)]) #0))))
(def: #export (fuse insts)
(-> (List Inst) Inst)