aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/host/jvm
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/host/jvm.lux47
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux38
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux74
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/type.lux154
4 files changed, 63 insertions, 250 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux
index 01ec36624..4966038c6 100644
--- a/new-luxc/source/luxc/lang/host/jvm.lux
+++ b/new-luxc/source/luxc/lang/host/jvm.lux
@@ -1,5 +1,6 @@
(.module:
- [lux (#- Type Definition)
+ [lux (#- Definition)
+ [host (#+ import:)]
[abstract
monad]
[control
@@ -11,16 +12,17 @@
[macro
["." code]
[syntax (#+ syntax:)]]
- [host (#+ import:)]
[world
[binary (#+ Binary)]]
+ [target
+ [jvm
+ [type (#+ Class)]]]
[tool
[compiler
[reference (#+ Register)]
[phase
["." generation]]]]])
-## [Host]
(import: org/objectweb/asm/MethodVisitor)
(import: org/objectweb/asm/ClassWriter)
@@ -28,42 +30,6 @@
(import: #long org/objectweb/asm/Label
(new []))
-## [Type]
-(type: #export Bound
- #Upper
- #Lower)
-
-(type: #export Primitive
- #Boolean
- #Byte
- #Short
- #Int
- #Long
- #Float
- #Double
- #Char)
-
-(type: #export #rec Generic
- (#Var Text)
- (#Wildcard (Maybe [Bound Generic]))
- (#Class Text (List Generic)))
-
-(type: #export Class
- [Text (List Generic)])
-
-(type: #export Parameter
- [Text Class (List Class)])
-
-(type: #export #rec Type
- (#Primitive Primitive)
- (#Generic Generic)
- (#Array Type))
-
-(type: #export Method
- {#args (List Type)
- #return (Maybe Type)
- #exceptions (List Generic)})
-
(type: #export Def
(-> ClassWriter ClassWriter))
@@ -109,7 +75,6 @@
[Bundle generation.Bundle]
)
-## [Values]
(syntax: (config: {type s.local-identifier}
{none s.local-identifier}
{++ s.local-identifier}
@@ -145,12 +110,10 @@
g!options+))))
-## Configs
(config: Class-Config noneC ++C [finalC])
(config: Method-Config noneM ++M [finalM staticM synchronizedM strictM])
(config: Field-Config noneF ++F [finalF staticF transientF volatileF])
-## Labels
(def: #export new-label
(-> Any Label)
(function (_ _)
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
index 012d7ceee..06e6963a3 100644
--- a/new-luxc/source/luxc/lang/host/jvm/def.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/def.lux
@@ -1,5 +1,6 @@
(.module:
- [lux #*
+ [lux (#- Type)
+ ["." host (#+ import: do-to)]
[control
["." function]]
[data
@@ -9,9 +10,10 @@
[collection
["." array (#+ Array)]
["." list ("#/." functor)]]]
- ["." host (#+ import: do-to)]]
- ["$" //
- ["$t" type]])
+ [target
+ [jvm
+ ["$t" type (#+ Method Class Type Parameter)]]]]
+ ["$" //])
(import: #long java/lang/Object)
(import: #long java/lang/String)
@@ -70,9 +72,9 @@
output)))
(def: exceptions-array
- (-> $.Method (Array Text))
- (|>> (get@ #$.exceptions)
- (list/map (|>> #$.Generic $t.descriptor))
+ (-> Method (Array Text))
+ (|>> (get@ #$t.exceptions)
+ (list/map (|>> #$t.Generic $t.descriptor))
string-array))
(def: (version-flag version)
@@ -117,15 +119,15 @@
(if (get@ #$.volatileF config) (Opcodes::ACC_VOLATILE) +0)))
(def: class-to-type
- (-> $.Class $.Type)
- (|>> #$.Class #$.Generic))
+ (-> Class Type)
+ (|>> #$t.Class #$t.Generic))
(def: param-signature
- (-> $.Class Text)
+ (-> Class Text)
(|>> class-to-type $t.signature (format ":")))
(def: (formal-param [name super interfaces])
- (-> $.Parameter Text)
+ (-> Parameter Text)
(format name
(param-signature super)
(|> interfaces
@@ -133,7 +135,7 @@
(text.join-with ""))))
(def: (parameters-signature parameters super interfaces)
- (-> (List $.Parameter) $.Class (List $.Class)
+ (-> (List Parameter) Class (List Class)
Text)
(let [formal-params (if (list.empty? parameters)
""
@@ -158,7 +160,7 @@
(template [<name> <flag>]
[(def: #export (<name> version visibility config name parameters super interfaces
definitions)
- (-> $.Version $.Visibility $.Class-Config Text (List $.Parameter) $.Class (List $.Class) $.Def
+ (-> $.Version $.Visibility $.Class-Config Text (List Parameter) Class (List Class) $.Def
(host.type (Array byte)))
(let [writer (|> (do-to (ClassWriter::new class-computes)
(ClassWriter::visit (version-flag version)
@@ -181,11 +183,11 @@
[abstract (Opcodes::ACC_ABSTRACT)]
)
-(def: $Object $.Class ["java.lang.Object" (list)])
+(def: $Object Class ["java.lang.Object" (list)])
(def: #export (interface version visibility config name parameters interfaces
definitions)
- (-> $.Version $.Visibility $.Class-Config Text (List $.Parameter) (List $.Class) $.Def
+ (-> $.Version $.Visibility $.Class-Config Text (List Parameter) (List Class) $.Def
(host.type (Array byte)))
(let [writer (|> (do-to (ClassWriter::new class-computes)
(ClassWriter::visit (version-flag version)
@@ -205,7 +207,7 @@
(ClassWriter::toByteArray writer)))
(def: #export (method visibility config name type then)
- (-> $.Visibility $.Method-Config Text $.Method $.Inst
+ (-> $.Visibility $.Method-Config Text Method $.Inst
$.Def)
(function (_ writer)
(let [=method (ClassWriter::visitMethod ($_ i/+
@@ -223,7 +225,7 @@
writer)))
(def: #export (abstract-method visibility config name type)
- (-> $.Visibility $.Method-Config Text $.Method
+ (-> $.Visibility $.Method-Config Text Method
$.Def)
(function (_ writer)
(let [=method (ClassWriter::visitMethod ($_ i/+
@@ -239,7 +241,7 @@
writer)))
(def: #export (field visibility config name type)
- (-> $.Visibility $.Field-Config Text $.Type $.Def)
+ (-> $.Visibility $.Field-Config Text Type $.Def)
(function (_ writer)
(let [=field (do-to (ClassWriter::visitField ($_ i/+
(visibility-flag visibility)
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index 7329dec1a..33aa290df 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -1,5 +1,6 @@
(.module:
- [lux (#- int char)
+ [lux (#- Type int char)
+ ["." host (#+ import: do-to)]
[abstract
[monad (#+ do)]]
[control
@@ -13,15 +14,16 @@
format]
[collection
["." list ("#@." functor)]]]
- ["." host (#+ import: do-to)]
[macro
["." code]
[syntax (#+ syntax:)]]
+ [target
+ [jvm
+ ["." type (#+ Primitive Method Type)]]]
[tool
[compiler
[phase (#+ Operation)]]]]
- ["." // (#+ Primitive Inst)
- ["." type]])
+ ["." // (#+ Inst)])
## [Host]
(import: #long java/lang/Object)
@@ -229,7 +231,7 @@
(template [<name> <inst>]
[(def: #export (<name> class field type)
- (-> Text Text //.Type Inst)
+ (-> Text Text Type Inst)
(function (_ visitor)
(do-to visitor
(MethodVisitor::visitFieldInsn (<inst>) (type.binary-name class) field (type.descriptor type)))))]
@@ -260,18 +262,18 @@
(do-to visitor
(MethodVisitor::visitIntInsn (Opcodes::NEWARRAY)
(case type
- #//.Boolean (Opcodes::T_BOOLEAN)
- #//.Byte (Opcodes::T_BYTE)
- #//.Short (Opcodes::T_SHORT)
- #//.Int (Opcodes::T_INT)
- #//.Long (Opcodes::T_LONG)
- #//.Float (Opcodes::T_FLOAT)
- #//.Double (Opcodes::T_DOUBLE)
- #//.Char (Opcodes::T_CHAR))))))
+ #type.Boolean (Opcodes::T_BOOLEAN)
+ #type.Byte (Opcodes::T_BYTE)
+ #type.Short (Opcodes::T_SHORT)
+ #type.Int (Opcodes::T_INT)
+ #type.Long (Opcodes::T_LONG)
+ #type.Float (Opcodes::T_FLOAT)
+ #type.Double (Opcodes::T_DOUBLE)
+ #type.Char (Opcodes::T_CHAR))))))
(template [<name> <inst>]
[(def: #export (<name> class method-name method-signature interface?)
- (-> Text Text //.Method Bit Inst)
+ (-> Text Text Method Bit Inst)
(function (_ visitor)
(do-to visitor
(MethodVisitor::visitMethodInsn (<inst>) (type.binary-name class) method-name (type.method-descriptor method-signature) interface?))))]
@@ -324,14 +326,14 @@
(MethodVisitor::visitLabel @label))))
(def: #export (array type)
- (-> //.Type Inst)
+ (-> Type Inst)
(case type
- (#//.Primitive prim)
+ (#type.Primitive prim)
(NEWARRAY prim)
- (#//.Generic generic)
+ (#type.Generic generic)
(let [elem-class (case generic
- (#//.Class class params)
+ (#type.Class class params)
(type.binary-name class)
_
@@ -344,32 +346,32 @@
(def: (primitive-wrapper type)
(-> Primitive Text)
(case type
- #//.Boolean "java.lang.Boolean"
- #//.Byte "java.lang.Byte"
- #//.Short "java.lang.Short"
- #//.Int "java.lang.Integer"
- #//.Long "java.lang.Long"
- #//.Float "java.lang.Float"
- #//.Double "java.lang.Double"
- #//.Char "java.lang.Character"))
+ #type.Boolean "java.lang.Boolean"
+ #type.Byte "java.lang.Byte"
+ #type.Short "java.lang.Short"
+ #type.Int "java.lang.Integer"
+ #type.Long "java.lang.Long"
+ #type.Float "java.lang.Float"
+ #type.Double "java.lang.Double"
+ #type.Char "java.lang.Character"))
(def: (primitive-unwrap type)
(-> Primitive Text)
(case type
- #//.Boolean "booleanValue"
- #//.Byte "byteValue"
- #//.Short "shortValue"
- #//.Int "intValue"
- #//.Long "longValue"
- #//.Float "floatValue"
- #//.Double "doubleValue"
- #//.Char "charValue"))
+ #type.Boolean "booleanValue"
+ #type.Byte "byteValue"
+ #type.Short "shortValue"
+ #type.Int "intValue"
+ #type.Long "longValue"
+ #type.Float "floatValue"
+ #type.Double "doubleValue"
+ #type.Char "charValue"))
(def: #export (wrap type)
(-> Primitive Inst)
(let [class (primitive-wrapper type)]
(|>> (INVOKESTATIC class "valueOf"
- (type.method (list (#//.Primitive type))
+ (type.method (list (#type.Primitive type))
(#.Some (type.class class (list)))
(list))
#0))))
@@ -379,7 +381,7 @@
(let [class (primitive-wrapper type)]
(|>> (CHECKCAST class)
(INVOKEVIRTUAL class (primitive-unwrap type)
- (type.method (list) (#.Some (#//.Primitive type)) (list))
+ (type.method (list) (#.Some (#type.Primitive type)) (list))
#0))))
(def: #export (fuse insts)
diff --git a/new-luxc/source/luxc/lang/host/jvm/type.lux b/new-luxc/source/luxc/lang/host/jvm/type.lux
deleted file mode 100644
index 909344d24..000000000
--- a/new-luxc/source/luxc/lang/host/jvm/type.lux
+++ /dev/null
@@ -1,154 +0,0 @@
-(.module:
- [lux (#- int char)
- [data
- ["." maybe ("#@." functor)]
- ["." text
- format]
- [collection
- ["." list ("#@." functor)]]]]
- ["." //])
-
-(template [<name> <primitive>]
- [(def: #export <name> //.Type (#//.Primitive <primitive>))]
-
- [boolean #//.Boolean]
- [byte #//.Byte]
- [short #//.Short]
- [int #//.Int]
- [long #//.Long]
- [float #//.Float]
- [double #//.Double]
- [char #//.Char]
- )
-
-(template: #export (class name params)
- (#//.Generic (#//.Class name params)))
-
-(template: #export (var name)
- (#//.Generic (#//.Var name)))
-
-(template: #export (wildcard bound)
- (#//.Generic (#//.Wildcard bound)))
-
-(def: #export (array depth elemT)
- (-> Nat //.Type //.Type)
- (case depth
- 0 elemT
- _ (#//.Array (array (dec depth) elemT))))
-
-(def: #export binary-name
- (-> Text Text)
- (text.replace-all "." "/"))
-
-(def: #export (descriptor type)
- (-> //.Type Text)
- (case type
- (#//.Primitive prim)
- (case prim
- #//.Boolean "Z"
- #//.Byte "B"
- #//.Short "S"
- #//.Int "I"
- #//.Long "J"
- #//.Float "F"
- #//.Double "D"
- #//.Char "C")
-
- (#//.Array sub)
- (format "[" (descriptor sub))
-
- (#//.Generic generic)
- (case generic
- (#//.Class class params)
- (format "L" (binary-name class) ";")
-
- (^or (#//.Var name) (#//.Wildcard ?bound))
- (descriptor (#//.Generic (#//.Class "java.lang.Object" (list)))))
- ))
-
-(def: #export (class-name type)
- (-> //.Type (Maybe Text))
- (case type
- (#//.Primitive prim)
- #.None
-
- (#//.Array sub)
- (#.Some (descriptor type))
-
- (#//.Generic generic)
- (case generic
- (#//.Class class params)
- (#.Some class)
-
- (^or (#//.Var name) (#//.Wildcard ?bound))
- (#.Some "java.lang.Object"))
- ))
-
-(def: #export (signature type)
- (-> //.Type Text)
- (case type
- (#//.Primitive prim)
- (case prim
- #//.Boolean "Z"
- #//.Byte "B"
- #//.Short "S"
- #//.Int "I"
- #//.Long "J"
- #//.Float "F"
- #//.Double "D"
- #//.Char "C")
-
- (#//.Array sub)
- (format "[" (signature sub))
-
- (#//.Generic generic)
- (case generic
- (#//.Class class params)
- (let [=params (if (list.empty? params)
- ""
- (format "<"
- (|> params
- (list@map (|>> #//.Generic signature))
- (text.join-with ""))
- ">"))]
- (format "L" (binary-name class) =params ";"))
-
- (#//.Var name)
- (format "T" name ";")
-
- (#//.Wildcard #.None)
- "*"
-
- (^template [<tag> <prefix>]
- (#//.Wildcard (#.Some [<tag> bound]))
- (format <prefix> (signature (#//.Generic bound))))
- ([#//.Upper "+"]
- [#//.Lower "-"]))
- ))
-
-(def: #export (method args return exceptions)
- (-> (List //.Type) (Maybe //.Type) (List //.Generic) //.Method)
- {#//.args args #//.return return #//.exceptions exceptions})
-
-(def: #export (method-descriptor method)
- (-> //.Method Text)
- (format "(" (text.join-with "" (list@map descriptor (get@ #//.args method))) ")"
- (case (get@ #//.return method)
- #.None
- "V"
-
- (#.Some return)
- (descriptor return))))
-
-(def: #export (method-signature method)
- (-> //.Method Text)
- (format "(" (|> (get@ #//.args method) (list@map signature) (text.join-with "")) ")"
- (case (get@ #//.return method)
- #.None
- "V"
-
- (#.Some return)
- (signature return))
- (|> (get@ #//.exceptions method)
- (list@map (|>> #//.Generic signature (format "^")))
- (text.join-with ""))))