diff options
author | Eduardo Julian | 2017-10-31 19:09:47 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-10-31 19:09:47 -0400 |
commit | 6c753288a89eadb3f7d70a8844e466c48c809051 (patch) | |
tree | fb2837b32df793a66f5d93cf5de34296e8dbabcb /new-luxc/source/luxc/generator/host/jvm/def.lux | |
parent | f4ca44d9e155da79632415dbbf9c4ca9eb210f56 (diff) |
- Moved the "host" directory from under "generator" to under "luxc".
Diffstat (limited to 'new-luxc/source/luxc/generator/host/jvm/def.lux')
-rw-r--r-- | new-luxc/source/luxc/generator/host/jvm/def.lux | 287 |
1 files changed, 0 insertions, 287 deletions
diff --git a/new-luxc/source/luxc/generator/host/jvm/def.lux b/new-luxc/source/luxc/generator/host/jvm/def.lux deleted file mode 100644 index 1d50ba9f6..000000000 --- a/new-luxc/source/luxc/generator/host/jvm/def.lux +++ /dev/null @@ -1,287 +0,0 @@ -(;module: - lux - (lux (data [text] - text/format - [product] - (coll ["a" array] - [list "list/" Functor<List>])) - [host #+ do-to]) - ["$" ..] - (.. ["$t" type])) - -## [Host] -(host;import #long java.lang.Object) -(host;import #long java.lang.String) - -(host;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) - ) - -(host;import org.objectweb.asm.FieldVisitor - (visitEnd [] void)) - -(host;import org.objectweb.asm.MethodVisitor - (visitCode [] void) - (visitMaxs [int int] void) - (visitEnd [] void)) - -(host;import org.objectweb.asm.ClassWriter - (#static COMPUTE_MAXS int) - (#static COMPUTE_FRAMES int) - (new [int]) - (visit [int int String String String (Array String)] void) - (visitEnd [] void) - (visitField [int String String String Object] FieldVisitor) - (visitMethod [int String String String (Array String)] MethodVisitor) - (toByteArray [] (Array byte))) - -## [Defs] -(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: exceptions-array - (-> $;Method (Array Text)) - (|>. (get@ #$;exceptions) - (list/map (|>. #$;Generic $t;descriptor)) - string-array)) - -(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: class-to-type - (-> $;Class $;Type) - (|>. #$;Class #$;Generic)) - -(def: param-signature - (-> $;Class Text) - (|>. class-to-type $t;signature (format ":"))) - -(def: (formal-param [name super interfaces]) - (-> $;Parameter Text) - (format name - (param-signature super) - (|> interfaces - (list/map param-signature) - (text;join-with "")))) - -(def: (parameters-signature parameters super interfaces) - (-> (List $;Parameter) $;Class (List $;Class) - Text) - (let [formal-params (if (list;empty? parameters) - "" - (format "<" - (|> parameters - (list/map formal-param) - (text;join-with "")) - ">"))] - (format formal-params - (|> super class-to-type $t;signature) - (|> interfaces - (list/map (|>. class-to-type $t;signature)) - (text;join-with ""))))) - -(def: class-computes - Int - ($_ 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)])) - definitions) - _ (ClassWriter.visitEnd [] writer)] - (ClassWriter.toByteArray [] writer)))] - - [class 0] - [abstract Opcodes.ACC_ABSTRACT] - ) - -(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)])) - definitions) - _ (ClassWriter.visitEnd [] writer)] - (ClassWriter.toByteArray [] writer))) - -(def: #export (method visibility config name type then) - (-> $;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) - _ (then =method) - _ (MethodVisitor.visitMaxs [0 0] =method) - _ (MethodVisitor.visitEnd [] =method)] - writer))) - -(def: #export (abstract-method visibility config name type) - (-> $;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)] - writer))) - -(def: #export (field visibility config name type) - (-> $;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 []))] - writer))) - -(do-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)) - ($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] - ) - -(def: #export (fuse defs) - (-> (List $;Def) $;Def) - (case defs - #;Nil - id - - (#;Cons singleton #;Nil) - singleton - - (#;Cons head tail) - (. (fuse tail) head))) |