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.lux60
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux305
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux212
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/type.lux148
4 files changed, 362 insertions, 363 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux
index f96b3e646..cfe71656c 100644
--- a/new-luxc/source/luxc/lang/host/jvm.lux
+++ b/new-luxc/source/luxc/lang/host/jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
[lux #- Type Def]
(lux (control monad
["p" parser])
@@ -9,11 +9,11 @@
[host]))
## [Host]
-(host;import org.objectweb.asm.MethodVisitor)
+(host.import org/objectweb/asm/MethodVisitor)
-(host;import org.objectweb.asm.ClassWriter)
+(host.import org/objectweb/asm/ClassWriter)
-(host;import #long org.objectweb.asm.Label
+(host.import #long org/objectweb/asm/Label
(new []))
## [Type]
@@ -59,7 +59,7 @@
(-> MethodVisitor MethodVisitor))
(type: #export Label
- org.objectweb.asm.Label)
+ org/objectweb/asm/Label)
(type: #export Register Nat)
@@ -70,45 +70,45 @@
#Default)
(type: #export Version
- #V1.1
- #V1.2
- #V1.3
- #V1.4
- #V1.5
- #V1.6
- #V1.7
- #V1.8)
+ #V1_1
+ #V1_2
+ #V1_3
+ #V1_4
+ #V1_5
+ #V1_6
+ #V1_7
+ #V1_8)
## [Values]
-(syntax: (config: [type s;local-symbol]
- [none s;local-symbol]
- [++ s;local-symbol]
- [options (s;tuple (p;many s;local-symbol))])
- (let [g!type (code;local-symbol type)
- g!none (code;local-symbol none)
- g!tags+ (list/map code;local-tag options)
- g!_left (code;local-symbol "_left")
- g!_right (code;local-symbol "_right")
+(syntax: (config: [type s.local-symbol]
+ [none s.local-symbol]
+ [++ s.local-symbol]
+ [options (s.tuple (p.many s.local-symbol))])
+ (let [g!type (code.local-symbol type)
+ g!none (code.local-symbol none)
+ g!tags+ (list/map code.local-tag options)
+ g!_left (code.local-symbol "_left")
+ g!_right (code.local-symbol "_right")
g!options+ (list/map (function [option]
- (` (def: (~' #export) (~ (code;local-symbol option))
+ (` (def: (~' #export) (~ (code.local-symbol option))
(~ g!type)
(|> (~ g!none)
- (set@ (~ (code;local-tag option)) true)))))
+ (set@ (~ (code.local-tag option)) true)))))
options)]
(wrap (list& (` (type: (~' #export) (~ g!type)
- (~ (code;record (list/map (function [tag]
- [tag (` ;Bool)])
+ (~ (code.record (list/map (function [tag]
+ [tag (` .Bool)])
g!tags+)))))
(` (def: (~' #export) (~ g!none)
(~ g!type)
- (~ (code;record (list/map (function [tag]
+ (~ (code.record (list/map (function [tag]
[tag (` false)])
g!tags+)))))
- (` (def: (~' #export) ((~ (code;local-symbol ++)) (~ g!_left) (~ g!_right))
+ (` (def: (~' #export) ((~ (code.local-symbol ++)) (~ g!_left) (~ g!_right))
(-> (~ g!type) (~ g!type) (~ g!type))
- (~ (code;record (list/map (function [tag]
+ (~ (code.record (list/map (function [tag]
[tag (` (or (get@ (~ tag) (~ g!_left))
(get@ (~ tag) (~ g!_right))))])
g!tags+)))))
@@ -123,7 +123,7 @@
## Labels
(def: #export new-label
(-> Unit Label)
- org.objectweb.asm.Label.new)
+ org/objectweb/asm/Label::new)
(def: #export (simple-class name)
(-> Text Class)
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)))
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index e0c10feca..5f3711bbd 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -1,28 +1,29 @@
-(;module:
+(.module:
[lux #- char]
(lux (control monad
["p" parser])
(data [maybe]
["e" error]
text/format
- (coll [list "L/" Functor<List>]))
+ (coll [list "list/" Functor<List>]))
[host #+ do-to]
[macro]
(macro [code]
- ["s" syntax #+ syntax:]))
+ ["s" syntax #+ syntax:])
+ [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)
-(syntax: (declare [codes (p;many s;local-symbol)])
+(syntax: (declare [codes (p.many s.local-symbol)])
(|> codes
- (L/map (function [code] (` ((~' #static) (~ (code;local-symbol code)) (~' int)))))
+ (list/map (function [code] (` ((~' #static) (~ (code.local-symbol code)) (~' int)))))
wrap))
-(`` (host;import org.objectweb.asm.Opcodes
+(`` (host.import org/objectweb/asm/Opcodes
(#static NOP int)
## Conversion
@@ -89,13 +90,10 @@
(~~ (declare RETURN IRETURN LRETURN DRETURN ARETURN))
))
-(host;import org.objectweb.asm.FieldVisitor
- (visitEnd [] void))
-
-(host;import org.objectweb.asm.Label
+(host.import org/objectweb/asm/Label
(new []))
-(host;import org.objectweb.asm.MethodVisitor
+(host.import org/objectweb/asm/MethodVisitor
(visitCode [] void)
(visitMaxs [int int] void)
(visitEnd [] void)
@@ -116,42 +114,42 @@
(def: #export make-label
(Meta Label)
(function [compiler]
- (#e;Success [compiler (Label.new [])])))
+ (#e.Success [compiler (Label::new [])])))
(def: #export (with-label action)
- (-> (-> Label $;Inst) $;Inst)
- (action (Label.new [])))
+ (-> (-> Label $.Inst) $.Inst)
+ (action (Label::new [])))
(do-template [<name> <type> <prepare>]
[(def: #export (<name> value)
- (-> <type> $;Inst)
+ (-> <type> $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitLdcInsn [(<prepare> value)]))))]
+ (MethodVisitor::visitLdcInsn [(<prepare> value)]))))]
[boolean Bool id]
- [int Int host;l2i]
+ [int Int host.l2i]
[long Int id]
[double Frac id]
- [char Nat (|>. nat-to-int host;l2i host;i2c)]
+ [char Nat (|>> nat-to-int host.l2i host.i2c)]
[string Text id]
)
-(syntax: (prefix [base s;local-symbol])
- (wrap (list (code;local-symbol (format "Opcodes." base)))))
+(syntax: (prefix [base s.local-symbol])
+ (wrap (list (code.local-symbol (format "Opcodes::" base)))))
(def: #export NULL
- $;Inst
+ $.Inst
(function [visitor]
(do-to visitor
- (MethodVisitor.visitInsn [(prefix ACONST_NULL)]))))
+ (MethodVisitor::visitInsn [(prefix ACONST_NULL)]))))
(do-template [<name>]
[(def: #export <name>
- $;Inst
+ $.Inst
(function [visitor]
(do-to visitor
- (MethodVisitor.visitInsn [(prefix <name>)]))))]
+ (MethodVisitor::visitInsn [(prefix <name>)]))))]
[NOP]
@@ -209,10 +207,10 @@
(do-template [<name>]
[(def: #export (<name> register)
- (-> Nat $;Inst)
+ (-> Nat $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitVarInsn [(prefix <name>) (nat-to-int register)]))))]
+ (MethodVisitor::visitVarInsn [(prefix <name>) (nat-to-int register)]))))]
[ILOAD] [LLOAD] [DLOAD] [ALOAD]
[ISTORE] [LSTORE] [ASTORE]
@@ -220,64 +218,64 @@
(do-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> ($t;binary-name class) field ($t;descriptor type)]))))]
+ (MethodVisitor::visitFieldInsn [<inst> ($t.binary-name class) field ($t.descriptor type)]))))]
- [GETSTATIC Opcodes.GETSTATIC]
- [PUTSTATIC Opcodes.PUTSTATIC]
+ [GETSTATIC Opcodes::GETSTATIC]
+ [PUTSTATIC Opcodes::PUTSTATIC]
- [PUTFIELD Opcodes.PUTFIELD]
- [GETFIELD Opcodes.GETFIELD]
+ [PUTFIELD Opcodes::PUTFIELD]
+ [GETFIELD Opcodes::GETFIELD]
)
(do-template [<name> <inst>]
[(def: #export (<name> class)
- (-> Text $;Inst)
+ (-> Text $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitTypeInsn [<inst> ($t;binary-name class)]))))]
+ (MethodVisitor::visitTypeInsn [<inst> ($t.binary-name class)]))))]
- [CHECKCAST Opcodes.CHECKCAST]
- [NEW Opcodes.NEW]
- [INSTANCEOF Opcodes.INSTANCEOF]
- [ANEWARRAY Opcodes.ANEWARRAY]
+ [CHECKCAST Opcodes::CHECKCAST]
+ [NEW Opcodes::NEW]
+ [INSTANCEOF Opcodes::INSTANCEOF]
+ [ANEWARRAY Opcodes::ANEWARRAY]
)
(def: #export (NEWARRAY type)
- (-> $;Primitive $;Inst)
+ (-> $.Primitive $.Inst)
(function [visitor]
(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)]))))
+ (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)]))))
(do-template [<name> <inst>]
[(def: #export (<name> class method-name method-signature interface?)
- (-> Text Text $;Method Bool $;Inst)
+ (-> Text Text $.Method Bool $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitMethodInsn [<inst> ($t;binary-name class) method-name ($t;method-descriptor method-signature) interface?]))))]
+ (MethodVisitor::visitMethodInsn [<inst> ($t.binary-name class) method-name ($t.method-descriptor method-signature) interface?]))))]
- [INVOKESTATIC Opcodes.INVOKESTATIC]
- [INVOKEVIRTUAL Opcodes.INVOKEVIRTUAL]
- [INVOKESPECIAL Opcodes.INVOKESPECIAL]
- [INVOKEINTERFACE Opcodes.INVOKEINTERFACE]
+ [INVOKESTATIC Opcodes::INVOKESTATIC]
+ [INVOKEVIRTUAL Opcodes::INVOKEVIRTUAL]
+ [INVOKESPECIAL Opcodes::INVOKESPECIAL]
+ [INVOKEINTERFACE Opcodes::INVOKEINTERFACE]
)
(do-template [<name>]
[(def: #export (<name> @where)
- (-> $;Label $;Inst)
+ (-> $.Label $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitJumpInsn [(prefix <name>) @where]))))]
+ (MethodVisitor::visitJumpInsn [(prefix <name>) @where]))))]
[IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] [IF_ACMPEQ] [IFNULL]
[IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE]
@@ -285,99 +283,99 @@
)
(def: #export (TABLESWITCH min max default labels)
- (-> Int Int $;Label (List $;Label) $;Inst)
+ (-> Int Int $.Label (List $.Label) $.Inst)
(function [visitor]
- (let [num-labels (list;size labels)
- labels-array (host;array Label num-labels)
+ (let [num-labels (list.size labels)
+ labels-array (host.array Label num-labels)
_ (loop [idx +0]
- (if (n.< num-labels idx)
- (exec (host;array-write idx
- (maybe;assume (list;nth idx labels))
+ (if (n/< num-labels idx)
+ (exec (host.array-write idx
+ (maybe.assume (list.nth idx labels))
labels-array)
- (recur (n.inc idx)))
+ (recur (n/inc idx)))
[]))]
(do-to visitor
- (MethodVisitor.visitTableSwitchInsn [min max default labels-array])))))
+ (MethodVisitor::visitTableSwitchInsn [min max default labels-array])))))
(def: #export (try @from @to @handler exception)
- (-> $;Label $;Label $;Label Text $;Inst)
+ (-> $.Label $.Label $.Label Text $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitTryCatchBlock [@from @to @handler ($t;binary-name exception)]))))
+ (MethodVisitor::visitTryCatchBlock [@from @to @handler ($t.binary-name exception)]))))
(def: #export (label @label)
- (-> $;Label $;Inst)
+ (-> $.Label $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitLabel [@label]))))
+ (MethodVisitor::visitLabel [@label]))))
(def: #export (array type)
- (-> $;Type $;Inst)
+ (-> $.Type $.Inst)
(case type
- (#$;Primitive prim)
+ (#$.Primitive prim)
(NEWARRAY prim)
- (#$;Generic generic)
+ (#$.Generic generic)
(let [elem-class (case generic
- (#$;Class class params)
- ($t;binary-name class)
+ (#$.Class class params)
+ ($t.binary-name class)
_
- ($t;binary-name "java.lang.Object"))]
+ ($t.binary-name "java.lang.Object"))]
(ANEWARRAY elem-class))
_
- (ANEWARRAY ($t;descriptor type))))
+ (ANEWARRAY ($t.descriptor type))))
(def: (primitive-wrapper type)
- (-> $;Primitive Text)
+ (-> $.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"))
+ #$.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"))
(def: (primitive-unwrap type)
- (-> $;Primitive Text)
+ (-> $.Primitive Text)
(case type
- #$;Boolean "booleanValue"
- #$;Byte "byteValue"
- #$;Short "shortValue"
- #$;Int "intValue"
- #$;Long "longValue"
- #$;Float "floatValue"
- #$;Double "doubleValue"
- #$;Char "charValue"))
+ #$.Boolean "booleanValue"
+ #$.Byte "byteValue"
+ #$.Short "shortValue"
+ #$.Int "intValue"
+ #$.Long "longValue"
+ #$.Float "floatValue"
+ #$.Double "doubleValue"
+ #$.Char "charValue"))
(def: #export (wrap type)
- (-> $;Primitive $;Inst)
+ (-> $.Primitive $.Inst)
(let [class (primitive-wrapper type)]
- (|>. (INVOKESTATIC class "valueOf"
- ($t;method (list (#$;Primitive type))
- (#;Some ($t;class class (list)))
+ (|>> (INVOKESTATIC class "valueOf"
+ ($t.method (list (#$.Primitive type))
+ (#.Some ($t.class class (list)))
(list))
false))))
(def: #export (unwrap type)
- (-> $;Primitive $;Inst)
+ (-> $.Primitive $.Inst)
(let [class (primitive-wrapper type)]
- (|>. (CHECKCAST class)
+ (|>> (CHECKCAST class)
(INVOKEVIRTUAL class (primitive-unwrap type)
- ($t;method (list) (#;Some (#$;Primitive type)) (list))
+ ($t.method (list) (#.Some (#$.Primitive type)) (list))
false))))
(def: #export (fuse insts)
- (-> (List $;Inst) $;Inst)
+ (-> (List $.Inst) $.Inst)
(case insts
- #;Nil
+ #.Nil
id
- (#;Cons singleton #;Nil)
+ (#.Cons singleton #.Nil)
singleton
- (#;Cons head tail)
- (. (fuse tail) head)))
+ (#.Cons head tail)
+ (function.compose (fuse tail) head)))
diff --git a/new-luxc/source/luxc/lang/host/jvm/type.lux b/new-luxc/source/luxc/lang/host/jvm/type.lux
index 03246540c..b29ffc4a0 100644
--- a/new-luxc/source/luxc/lang/host/jvm/type.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/type.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
[lux #- char]
(lux (data [text]
text/format
@@ -7,132 +7,132 @@
## Types
(do-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]
+ [(def: #export <name> $.Type (#$.Primitive <primitive>))]
+
+ [boolean #$.Boolean]
+ [byte #$.Byte]
+ [short #$.Short]
+ [int #$.Int]
+ [long #$.Long]
+ [float #$.Float]
+ [double #$.Double]
+ [char #$.Char]
)
(def: #export (class name params)
- (-> Text (List $;Generic) $;Type)
- (#$;Generic (#$;Class name params)))
+ (-> Text (List $.Generic) $.Type)
+ (#$.Generic (#$.Class name params)))
(def: #export (var name)
- (-> Text $;Type)
- (#$;Generic (#$;Var name)))
+ (-> Text $.Type)
+ (#$.Generic (#$.Var name)))
(def: #export (wildcard bound)
- (-> (Maybe [$;Bound $;Generic]) $;Type)
- (#$;Generic (#$;Wildcard bound)))
+ (-> (Maybe [$.Bound $.Generic]) $.Type)
+ (#$.Generic (#$.Wildcard bound)))
(def: #export (array depth elemT)
- (-> Nat $;Type $;Type)
+ (-> Nat $.Type $.Type)
(case depth
+0 elemT
- _ (#$;Array (array (n.dec depth) elemT))))
+ _ (#$.Array (array (n/dec depth) elemT))))
(def: #export (binary-name class)
(-> Text Text)
- (text;replace-all "." "/" class))
+ (text.replace-all "." "/" class))
(def: #export (descriptor type)
- (-> $;Type Text)
+ (-> $.Type Text)
(case type
- (#$;Primitive prim)
+ (#$.Primitive prim)
(case prim
- #$;Boolean "Z"
- #$;Byte "B"
- #$;Short "S"
- #$;Int "I"
- #$;Long "J"
- #$;Float "F"
- #$;Double "D"
- #$;Char "C")
-
- (#$;Array sub)
+ #$.Boolean "Z"
+ #$.Byte "B"
+ #$.Short "S"
+ #$.Int "I"
+ #$.Long "J"
+ #$.Float "F"
+ #$.Double "D"
+ #$.Char "C")
+
+ (#$.Array sub)
(format "[" (descriptor sub))
- (#$;Generic generic)
+ (#$.Generic generic)
(case generic
- (#$;Class class params)
+ (#$.Class class params)
(format "L" (binary-name class) ";")
- (^or (#$;Var name) (#$;Wildcard ?bound))
- (descriptor (#$;Generic (#$;Class "java.lang.Object" (list)))))
+ (^or (#$.Var name) (#$.Wildcard ?bound))
+ (descriptor (#$.Generic (#$.Class "java.lang.Object" (list)))))
))
(def: #export (signature type)
- (-> $;Type Text)
+ (-> $.Type Text)
(case type
- (#$;Primitive prim)
+ (#$.Primitive prim)
(case prim
- #$;Boolean "Z"
- #$;Byte "B"
- #$;Short "S"
- #$;Int "I"
- #$;Long "J"
- #$;Float "F"
- #$;Double "D"
- #$;Char "C")
-
- (#$;Array sub)
+ #$.Boolean "Z"
+ #$.Byte "B"
+ #$.Short "S"
+ #$.Int "I"
+ #$.Long "J"
+ #$.Float "F"
+ #$.Double "D"
+ #$.Char "C")
+
+ (#$.Array sub)
(format "[" (signature sub))
- (#$;Generic generic)
+ (#$.Generic generic)
(case generic
- (#$;Class class params)
- (let [=params (if (list;empty? params)
+ (#$.Class class params)
+ (let [=params (if (list.empty? params)
""
(format "<"
(|> params
- (list/map (|>. #$;Generic signature))
- (text;join-with ""))
+ (list/map (|>> #$.Generic signature))
+ (text.join-with ""))
">"))]
(format "L" (binary-name class) =params ";"))
- (#$;Var name)
+ (#$.Var name)
(format "T" name ";")
- (#$;Wildcard #;None)
+ (#$.Wildcard #.None)
"*"
(^template [<tag> <prefix>]
- (#$;Wildcard (#;Some [<tag> bound]))
- (format <prefix> (signature (#$;Generic bound))))
- ([#$;Upper "+"]
- [#$;Lower "-"]))
+ (#$.Wildcard (#.Some [<tag> bound]))
+ (format <prefix> (signature (#$.Generic bound))))
+ ([#$.Upper "+"]
+ [#$.Lower "-"]))
))
## Methods
(def: #export (method args return exceptions)
- (-> (List $;Type) (Maybe $;Type) (List $;Generic) $;Method)
- {#$;args args #$;return return #$;exceptions 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
+ (-> $.Method Text)
+ (format "(" (text.join-with "" (list/map descriptor (get@ #$.args method))) ")"
+ (case (get@ #$.return method)
+ #.None
"V"
- (#;Some return)
+ (#.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
+ (-> $.Method Text)
+ (format "(" (|> (get@ #$.args method) (list/map signature) (text.join-with "")) ")"
+ (case (get@ #$.return method)
+ #.None
"V"
- (#;Some return)
+ (#.Some return)
(signature return))
- (|> (get@ #$;exceptions method)
- (list/map (|>. #$;Generic signature (format "^")))
- (text;join-with ""))))
+ (|> (get@ #$.exceptions method)
+ (list/map (|>> #$.Generic signature (format "^")))
+ (text.join-with ""))))
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-31 01:58:19 +0000