diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm.lux | 47 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/def.lux | 38 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/inst.lux | 74 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/type.lux | 154 |
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 "")))) |