diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/host/jvm/def.lux')
-rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/def.lux | 305 |
1 files changed, 153 insertions, 152 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux index ec1de6b43..8e90172d5 100644 --- a/new-luxc/source/luxc/lang/host/jvm/def.lux +++ b/new-luxc/source/luxc/lang/host/jvm/def.lux @@ -1,19 +1,20 @@ -(;module: +(.module: lux (lux (data [text] text/format [product] (coll ["a" array] [list "list/" Functor<List>])) - [host #+ do-to]) + [host #+ do-to] + [function]) ["$" //] (// ["$t" type])) ## [Host] -(host;import #long java.lang.Object) -(host;import #long java.lang.String) +(host.import #long java/lang/Object) +(host.import #long java/lang/String) -(host;import org.objectweb.asm.Opcodes +(host.import org/objectweb/asm/Opcodes (#static ACC_PUBLIC int) (#static ACC_PROTECTED int) (#static ACC_PRIVATE int) @@ -40,15 +41,15 @@ (#static V1_8 int) ) -(host;import org.objectweb.asm.FieldVisitor +(host.import org/objectweb/asm/FieldVisitor (visitEnd [] void)) -(host;import org.objectweb.asm.MethodVisitor +(host.import org/objectweb/asm/MethodVisitor (visitCode [] void) (visitMaxs [int int] void) (visitEnd [] void)) -(host;import org.objectweb.asm.ClassWriter +(host.import org/objectweb/asm/ClassWriter (#static COMPUTE_MAXS int) (#static COMPUTE_FRAMES int) (new [int]) @@ -61,228 +62,228 @@ ## [Defs] (def: (string-array values) (-> (List Text) (Array Text)) - (let [output (host;array String (list;size values))] + (let [output (host.array String (list.size values))] (exec (list/map (function [[idx value]] - (host;array-write idx value output)) - (list;enumerate values)) + (host.array-write idx value output)) + (list.enumerate values)) output))) (def: exceptions-array - (-> $;Method (Array Text)) - (|>. (get@ #$;exceptions) - (list/map (|>. #$;Generic $t;descriptor)) + (-> $.Method (Array Text)) + (|>> (get@ #$.exceptions) + (list/map (|>> #$.Generic $t.descriptor)) string-array)) (def: (version-flag version) - (-> $;Version Int) + (-> $.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)) + #$.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) + (-> $.Visibility Int) (case visibility - #$;Public Opcodes.ACC_PUBLIC - #$;Protected Opcodes.ACC_PROTECTED - #$;Private Opcodes.ACC_PRIVATE - #$;Default 0)) + #$.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))) + (-> $.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))) + (-> $.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))) + (-> $.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: class-to-type - (-> $;Class $;Type) - (|>. #$;Class #$;Generic)) + (-> $.Class $.Type) + (|>> #$.Class #$.Generic)) (def: param-signature - (-> $;Class Text) - (|>. class-to-type $t;signature (format ":"))) + (-> $.Class Text) + (|>> class-to-type $t.signature (format ":"))) (def: (formal-param [name super interfaces]) - (-> $;Parameter Text) + (-> $.Parameter Text) (format name (param-signature super) (|> interfaces (list/map param-signature) - (text;join-with "")))) + (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) + (let [formal-params (if (list.empty? parameters) "" (format "<" (|> parameters (list/map formal-param) - (text;join-with "")) + (text.join-with "")) ">"))] (format formal-params - (|> super class-to-type $t;signature) + (|> super class-to-type $t.signature) (|> interfaces - (list/map (|>. class-to-type $t;signature)) - (text;join-with ""))))) + (list/map (|>> class-to-type $t.signature)) + (text.join-with ""))))) (def: class-computes Int - ($_ i.+ - ClassWriter.COMPUTE_MAXS - ## ClassWriter.COMPUTE_FRAMES + ($_ i/+ + ClassWriter::COMPUTE_MAXS + ## ClassWriter::COMPUTE_FRAMES )) (do-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 - (host;type (Array 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)) - ($t;binary-name name) - (parameters-signature parameters super interfaces) - (|> super product;left $t;binary-name) - (|> interfaces - (list/map (|>. product;left $t;binary-name)) - string-array)])) + (-> $.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) + ($_ i/+ + Opcodes::ACC_SUPER + <flag> + (visibility-flag visibility) + (class-flags config)) + ($t.binary-name name) + (parameters-signature parameters super interfaces) + (|> super product.left $t.binary-name) + (|> interfaces + (list/map (|>> product.left $t.binary-name)) + string-array)])) definitions) - _ (ClassWriter.visitEnd [] writer)] - (ClassWriter.toByteArray [] writer)))] + _ (ClassWriter::visitEnd [] writer)] + (ClassWriter::toByteArray [] writer)))] [class 0] - [abstract Opcodes.ACC_ABSTRACT] + [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 - (host;type (Array 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)) - ($t;binary-name name) - (parameters-signature parameters $Object interfaces) - (|> $Object product;left $t;binary-name) - (|> interfaces - (list/map (|>. product;left $t;binary-name)) - string-array)])) + (-> $.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) + ($_ i/+ + Opcodes::ACC_SUPER + Opcodes::ACC_INTERFACE + (visibility-flag visibility) + (class-flags config)) + ($t.binary-name name) + (parameters-signature parameters $Object interfaces) + (|> $Object product.left $t.binary-name) + (|> interfaces + (list/map (|>> product.left $t.binary-name)) + string-array)])) definitions) - _ (ClassWriter.visitEnd [] writer)] - (ClassWriter.toByteArray [] writer))) + _ (ClassWriter::visitEnd [] writer)] + (ClassWriter::toByteArray [] writer))) (def: #export (method visibility config name type then) - (-> $;Visibility $;Method-Config Text $;Method $;Inst - $;Def) + (-> $.Visibility $.Method-Config Text $.Method $.Inst + $.Def) (function [writer] - (let [=method (ClassWriter.visitMethod [($_ i.+ - (visibility-flag visibility) - (method-flags config)) - ($t;binary-name name) - ($t;method-descriptor type) - ($t;method-signature type) - (exceptions-array type)] - writer) - _ (MethodVisitor.visitCode [] =method) + (let [=method (ClassWriter::visitMethod [($_ i/+ + (visibility-flag visibility) + (method-flags config)) + ($t.binary-name name) + ($t.method-descriptor type) + ($t.method-signature type) + (exceptions-array type)] + writer) + _ (MethodVisitor::visitCode [] =method) _ (then =method) - _ (MethodVisitor.visitMaxs [0 0] =method) - _ (MethodVisitor.visitEnd [] =method)] + _ (MethodVisitor::visitMaxs [0 0] =method) + _ (MethodVisitor::visitEnd [] =method)] writer))) (def: #export (abstract-method visibility config name type) - (-> $;Visibility $;Method-Config Text $;Method - $;Def) + (-> $.Visibility $.Method-Config Text $.Method + $.Def) (function [writer] - (let [=method (ClassWriter.visitMethod [($_ i.+ - (visibility-flag visibility) - (method-flags config) - Opcodes.ACC_ABSTRACT) - ($t;binary-name name) - ($t;method-descriptor type) - ($t;method-signature type) - (exceptions-array type)] - writer) - _ (MethodVisitor.visitEnd [] =method)] + (let [=method (ClassWriter::visitMethod [($_ i/+ + (visibility-flag visibility) + (method-flags config) + Opcodes::ACC_ABSTRACT) + ($t.binary-name name) + ($t.method-descriptor type) + ($t.method-signature type) + (exceptions-array type)] + writer) + _ (MethodVisitor::visitEnd [] =method)] 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) - (field-flags config)) - ($t;binary-name name) - ($t;descriptor type) - ($t;signature type) - (host;null)] writer) - (FieldVisitor.visitEnd []))] + (let [=field (do-to (ClassWriter::visitField [($_ i/+ + (visibility-flag visibility) + (field-flags config)) + ($t.binary-name name) + ($t.descriptor type) + ($t.signature type) + (host.null)] writer) + (FieldVisitor::visitEnd []))] writer))) (do-template [<name> <lux-type> <jvm-type> <prepare>] [(def: #export (<name> visibility config name value) - (-> $;Visibility $;Field-Config Text <lux-type> $;Def) + (-> $.Visibility $.Field-Config Text <lux-type> $.Def) (function [writer] - (let [=field (do-to (ClassWriter.visitField [($_ i.+ - (visibility-flag visibility) - (field-flags config)) - ($t;binary-name name) - ($t;descriptor <jvm-type>) - ($t;signature <jvm-type>) - (<prepare> value)] - writer) - (FieldVisitor.visitEnd []))] + (let [=field (do-to (ClassWriter::visitField [($_ i/+ + (visibility-flag visibility) + (field-flags config)) + ($t.binary-name name) + ($t.descriptor <jvm-type>) + ($t.signature <jvm-type>) + (<prepare> value)] + writer) + (FieldVisitor::visitEnd []))] writer)))] - [boolean-field Bool $t;boolean id] - [byte-field Int $t;byte host;l2b] - [short-field Int $t;short host;l2s] - [int-field Int $t;int host;l2i] - [long-field Int $t;long id] - [float-field Frac $t;float host;d2f] - [double-field Frac $t;double id] - [char-field Nat $t;char (|>. nat-to-int host;l2i host;i2c)] - [string-field Text ($t;class "java.lang.String" (list)) id] + [boolean-field Bool $t.boolean id] + [byte-field Int $t.byte host.l2b] + [short-field Int $t.short host.l2s] + [int-field Int $t.int host.l2i] + [long-field Int $t.long id] + [float-field Frac $t.float host.d2f] + [double-field Frac $t.double id] + [char-field Nat $t.char (|>> nat-to-int host.l2i host.i2c)] + [string-field Text ($t.class "java.lang.String" (list)) id] ) (def: #export (fuse defs) - (-> (List $;Def) $;Def) + (-> (List $.Def) $.Def) (case defs - #;Nil + #.Nil id - (#;Cons singleton #;Nil) + (#.Cons singleton #.Nil) singleton - (#;Cons head tail) - (. (fuse tail) head))) + (#.Cons head tail) + (function.compose (fuse tail) head))) |