aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux105
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux146
-rw-r--r--new-luxc/source/luxc/lang/statement/jvm.lux45
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm.lux50
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/case.lux70
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/common.lux20
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/function.lux82
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/primitive.lux13
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux186
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux348
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/reference.lux9
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.lux147
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/structure.lux15
-rw-r--r--new-luxc/source/program.lux6
-rw-r--r--stdlib/source/lux/abstract/monad.lux9
-rw-r--r--stdlib/source/lux/control/try.lux2
-rw-r--r--stdlib/source/lux/data/collection/list.lux2
-rw-r--r--stdlib/source/lux/data/maybe.lux2
-rw-r--r--stdlib/source/lux/target/jvm/attribute/constant.lux2
-rw-r--r--stdlib/source/lux/target/jvm/descriptor.lux117
-rw-r--r--stdlib/source/lux/target/jvm/field.lux4
-rw-r--r--stdlib/source/lux/target/jvm/instruction.lux2
-rw-r--r--stdlib/source/lux/target/jvm/reflection.lux6
-rw-r--r--stdlib/source/lux/target/jvm/type.lux93
-rw-r--r--stdlib/source/lux/target/jvm/type/lux.lux13
-rw-r--r--stdlib/source/lux/target/jvm/type/reflection.lux11
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux14
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/foreign.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux2
-rw-r--r--stdlib/source/test/lux/target/jvm.lux10
36 files changed, 759 insertions, 790 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
index 138098929..9abf0db35 100644
--- a/new-luxc/source/luxc/lang/host/jvm/def.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/def.lux
@@ -14,6 +14,9 @@
["." list ("#/." functor)]]]
[target
[jvm
+ ["." descriptor (#+ Descriptor)]
+ [encoding
+ ["." name]]
["$t" type (#+ Method Class Type Parameter)
["." reflection]]]]]
["." //])
@@ -74,38 +77,6 @@
(list.enumerate values))
output)))
-(def: (exception-class-name type)
- (-> Type Text)
- (case type
- (#$t.Primitive prim)
- (case prim
- #$t.Boolean reflection.boolean
- #$t.Byte reflection.byte
- #$t.Short reflection.short
- #$t.Int reflection.int
- #$t.Long reflection.long
- #$t.Float reflection.float
- #$t.Double reflection.double
- #$t.Char reflection.char)
-
- (#$t.Array sub)
- (format $t.array-prefix (exception-class-name sub))
-
- (#$t.Generic generic)
- (case generic
- (#$t.Class class params)
- ($t.binary-name class)
-
- (^or (#$t.Var _) (#$t.Wildcard _))
- ($t.binary-name $t.object-class))
- ))
-
-(def: exceptions-array
- (-> Method (Array Text))
- (|>> (get@ #$t.exceptions)
- (list/map (|>> #$t.Generic ..exception-class-name))
- string-array))
-
(def: (version-flag version)
(-> //.Version Int)
(case version
@@ -186,6 +157,8 @@
## (ClassWriter::COMPUTE_FRAMES)
))
+(def: binary-name (|>> name.internal name.read))
+
(template [<name> <flag>]
[(def: #export (<name> version visibility config name parameters super interfaces
definitions)
@@ -198,18 +171,18 @@
<flag>
(visibility-flag visibility)
(class-flags config))
- ($t.binary-name name)
+ (..binary-name name)
(parameters-signature parameters super interfaces)
- (|> super product.left $t.binary-name)
+ (|> super product.left ..binary-name)
(|> interfaces
- (list/map (|>> product.left $t.binary-name))
+ (list/map (|>> product.left ..binary-name))
string-array)))
definitions)
_ (ClassWriter::visitEnd writer)]
(ClassWriter::toByteArray writer)))]
- [class +0]
- [abstract (Opcodes::ACC_ABSTRACT)]
+ [class +0]
+ [abstract (Opcodes::ACC_ABSTRACT)]
)
(def: $Object Class ["java.lang.Object" (list)])
@@ -225,27 +198,27 @@
(Opcodes::ACC_INTERFACE)
(visibility-flag visibility)
(class-flags config))
- ($t.binary-name name)
+ (..binary-name name)
(parameters-signature parameters $Object interfaces)
- (|> $Object product.left $t.binary-name)
+ (|> $Object product.left ..binary-name)
(|> interfaces
- (list/map (|>> product.left $t.binary-name))
+ (list/map (|>> product.left ..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
+ (-> //.Visibility //.Method-Config Text (Descriptor descriptor.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)
+ (..binary-name name)
+ (descriptor.descriptor type)
+ (host.null)
+ (string-array (list))
writer)
_ (MethodVisitor::visitCode =method)
_ (then =method)
@@ -254,30 +227,30 @@
writer)))
(def: #export (abstract-method visibility config name type)
- (-> //.Visibility //.Method-Config Text Method
+ (-> //.Visibility //.Method-Config Text (Descriptor descriptor.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)
+ (..binary-name name)
+ (descriptor.descriptor type)
+ (host.null)
+ (string-array (list))
writer)
_ (MethodVisitor::visitEnd =method)]
writer)))
(def: #export (field visibility config name type)
- (-> //.Visibility //.Field-Config Text Type //.Def)
+ (-> //.Visibility //.Field-Config Text (Descriptor descriptor.Field) //.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)
+ (..binary-name name)
+ (descriptor.descriptor type)
+ (host.null)
(host.null)
writer)
(FieldVisitor::visitEnd))]
@@ -290,23 +263,23 @@
(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>)
+ (..binary-name name)
+ (descriptor.descriptor <jvm-type>)
+ (host.null)
(<prepare> value)
writer)
(FieldVisitor::visitEnd))]
writer)))]
- [boolean-field Bit $t.boolean function.identity]
- [byte-field Int $t.byte host.long-to-byte]
- [short-field Int $t.short host.long-to-short]
- [int-field Int $t.int host.long-to-int]
- [long-field Int $t.long function.identity]
- [float-field Frac $t.float host.double-to-float]
- [double-field Frac $t.double function.identity]
- [char-field Nat $t.char (|>> .int host.long-to-int host.int-to-char)]
- [string-field Text ($t.class "java.lang.String" (list)) function.identity]
+ [boolean-field Bit descriptor.boolean function.identity]
+ [byte-field Int descriptor.byte host.long-to-byte]
+ [short-field Int descriptor.short host.long-to-short]
+ [int-field Int descriptor.int host.long-to-int]
+ [long-field Int descriptor.long function.identity]
+ [float-field Frac descriptor.float host.double-to-float]
+ [double-field Frac descriptor.double function.identity]
+ [char-field Nat descriptor.char (|>> .int host.long-to-int host.int-to-char)]
+ [string-field Text (descriptor.class "java.lang.String") function.identity]
)
(def: #export (fuse defs)
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index fcf28d4a7..a54367a72 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -1,16 +1,16 @@
(.module:
- [lux (#- Type int char)
+ [lux (#- int char)
["." host (#+ import: do-to)]
[abstract
[monad (#+ do)]]
[control
["." function]
+ ["." try]
["p" parser
["s" code]]]
[data
["." product]
["." maybe]
- ["." error]
[number
["n" nat]
["i" int]]
@@ -22,7 +22,11 @@
[syntax (#+ syntax:)]]
[target
[jvm
- ["." type (#+ Primitive Method Type)]]]
+ ["." descriptor (#+ Descriptor Primitive) ("#@." equivalence)]
+ [encoding
+ ["." name]]
+ [type
+ ["." box]]]]
[tool
[compiler
[phase (#+ Operation)]]]]
@@ -131,7 +135,7 @@
(def: #export make-label
(All [s] (Operation s org/objectweb/asm/Label))
(function (_ state)
- (#error.Success [state (org/objectweb/asm/Label::new)])))
+ (#try.Success [state (org/objectweb/asm/Label::new)])))
(def: #export (with-label action)
(All [a] (-> (-> org/objectweb/asm/Label a) a))
@@ -235,10 +239,10 @@
(template [<name> <inst>]
[(def: #export (<name> class field type)
- (-> Text Text Type Inst)
+ (-> (Descriptor descriptor.Class) Text (Descriptor descriptor.Field) Inst)
(function (_ visitor)
(do-to visitor
- (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (type.binary-name class) field (type.descriptor type)))))]
+ (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (descriptor.class-name class) field (descriptor.descriptor type)))))]
[GETSTATIC org/objectweb/asm/Opcodes::GETSTATIC]
[PUTSTATIC org/objectweb/asm/Opcodes::PUTSTATIC]
@@ -249,10 +253,10 @@
(template [<name> <inst>]
[(def: #export (<name> class)
- (-> Text Inst)
+ (-> (Descriptor descriptor.Object) Inst)
(function (_ visitor)
(do-to visitor
- (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (type.binary-name class)))))]
+ (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (descriptor.class-name class)))))]
[CHECKCAST org/objectweb/asm/Opcodes::CHECKCAST]
[NEW org/objectweb/asm/Opcodes::NEW]
@@ -261,26 +265,30 @@
)
(def: #export (NEWARRAY type)
- (-> Primitive Inst)
+ (-> (Descriptor Primitive) Inst)
(function (_ visitor)
(do-to visitor
(org/objectweb/asm/MethodVisitor::visitIntInsn (org/objectweb/asm/Opcodes::NEWARRAY)
- (case type
- #type.Boolean (org/objectweb/asm/Opcodes::T_BOOLEAN)
- #type.Byte (org/objectweb/asm/Opcodes::T_BYTE)
- #type.Short (org/objectweb/asm/Opcodes::T_SHORT)
- #type.Int (org/objectweb/asm/Opcodes::T_INT)
- #type.Long (org/objectweb/asm/Opcodes::T_LONG)
- #type.Float (org/objectweb/asm/Opcodes::T_FLOAT)
- #type.Double (org/objectweb/asm/Opcodes::T_DOUBLE)
- #type.Char (org/objectweb/asm/Opcodes::T_CHAR))))))
+ (`` (cond (~~ (template [<descriptor> <opcode>]
+ [(descriptor@= <descriptor> type) (<opcode>)]
+
+ [descriptor.boolean org/objectweb/asm/Opcodes::T_BOOLEAN]
+ [descriptor.byte org/objectweb/asm/Opcodes::T_BYTE]
+ [descriptor.short org/objectweb/asm/Opcodes::T_SHORT]
+ [descriptor.int org/objectweb/asm/Opcodes::T_INT]
+ [descriptor.long org/objectweb/asm/Opcodes::T_LONG]
+ [descriptor.float org/objectweb/asm/Opcodes::T_FLOAT]
+ [descriptor.double org/objectweb/asm/Opcodes::T_DOUBLE]
+ [descriptor.char org/objectweb/asm/Opcodes::T_CHAR]))
+ ## else
+ (undefined)))))))
(template [<name> <inst>]
- [(def: #export (<name> class method-name method-signature interface?)
- (-> Text Text Method Bit Inst)
+ [(def: #export (<name> class method-name type interface?)
+ (-> (Descriptor descriptor.Class) Text (Descriptor descriptor.Method) Bit Inst)
(function (_ visitor)
(do-to visitor
- (org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>) (type.binary-name class) method-name (type.method-descriptor method-signature) interface?))))]
+ (org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>) (descriptor.class-name class) method-name (descriptor.descriptor type) interface?))))]
[INVOKESTATIC org/objectweb/asm/Opcodes::INVOKESTATIC]
[INVOKEVIRTUAL org/objectweb/asm/Opcodes::INVOKEVIRTUAL]
@@ -338,10 +346,10 @@
(org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels-array)))))
(def: #export (try @from @to @handler exception)
- (-> //.Label //.Label //.Label Text Inst)
+ (-> //.Label //.Label //.Label (Descriptor descriptor.Class) Inst)
(function (_ visitor)
(do-to visitor
- (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (type.binary-name exception)))))
+ (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (descriptor.class-name exception)))))
(def: #export (label @label)
(-> //.Label Inst)
@@ -350,63 +358,49 @@
(org/objectweb/asm/MethodVisitor::visitLabel @label))))
(def: #export (array type)
- (-> Type Inst)
- (case type
- (#type.Primitive prim)
- (NEWARRAY prim)
-
- (#type.Generic generic)
- (let [elem-class (case generic
- (#type.Class class params)
- (type.binary-name class)
-
- _
- (type.binary-name "java.lang.Object"))]
- (ANEWARRAY elem-class))
-
- _
- (ANEWARRAY (type.descriptor type))))
-
-(def: (primitive-wrapper type)
- (-> Primitive Text)
- (case type
- #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
- #type.Boolean "booleanValue"
- #type.Byte "byteValue"
- #type.Short "shortValue"
- #type.Int "intValue"
- #type.Long "longValue"
- #type.Float "floatValue"
- #type.Double "doubleValue"
- #type.Char "charValue"))
+ (-> (Descriptor descriptor.Value) Inst)
+ (case (descriptor.primitive? type)
+ (#.Left object)
+ (ANEWARRAY object)
+
+ (#.Right primitive)
+ (NEWARRAY primitive)))
+
+(template [<name> <boolean> <byte> <short> <int> <long> <float> <double> <char>]
+ [(def: (<name> type)
+ (-> (Descriptor Primitive) Text)
+ (`` (cond (~~ (template [<descriptor> <output>]
+ [(descriptor@= <descriptor> type) <output>]
+
+ [descriptor.boolean <boolean>]
+ [descriptor.byte <byte>]
+ [descriptor.short <short>]
+ [descriptor.int <int>]
+ [descriptor.long <long>]
+ [descriptor.float <float>]
+ [descriptor.double <double>]
+ [descriptor.char <char>]))
+ ## else
+ (undefined))))]
+
+ [primitive-wrapper
+ box.boolean box.byte box.short box.int
+ box.long box.float box.double box.char]
+ [primitive-unwrap
+ "booleanValue" "byteValue" "shortValue" "intValue"
+ "longValue" "floatValue" "doubleValue" "charValue"]
+ )
(def: #export (wrap type)
- (-> Primitive Inst)
- (let [class (primitive-wrapper type)]
- (|>> (INVOKESTATIC class "valueOf"
- (type.method (list (#type.Primitive type))
- (#.Some (type.class class (list)))
- (list))
- #0))))
+ (-> (Descriptor Primitive) Inst)
+ (let [wrapper (descriptor.class (primitive-wrapper type))]
+ (INVOKESTATIC wrapper "valueOf" (descriptor.method [(list type) wrapper]) #0)))
(def: #export (unwrap type)
- (-> Primitive Inst)
- (let [class (primitive-wrapper type)]
- (|>> (CHECKCAST class)
- (INVOKEVIRTUAL class (primitive-unwrap type)
- (type.method (list) (#.Some (#type.Primitive type)) (list))
- #0))))
+ (-> (Descriptor Primitive) Inst)
+ (let [wrapper (descriptor.class (primitive-wrapper type))]
+ (|>> (CHECKCAST wrapper)
+ (INVOKEVIRTUAL wrapper (primitive-unwrap type) (descriptor.method [(list) type]) #0))))
(def: #export (fuse insts)
(-> (List Inst) Inst)
diff --git a/new-luxc/source/luxc/lang/statement/jvm.lux b/new-luxc/source/luxc/lang/statement/jvm.lux
index 9ded2083b..4ca0744db 100644
--- a/new-luxc/source/luxc/lang/statement/jvm.lux
+++ b/new-luxc/source/luxc/lang/statement/jvm.lux
@@ -16,6 +16,7 @@
["." check (#+ Check)]]
[target
[jvm
+ ["." descriptor (#+ Descriptor)]
["." type (#+ Var Parameter Class Argument Typed Return)
[".T" lux]]]]
[tool
@@ -35,7 +36,6 @@
[lang
[host
["$" jvm (#+ Anchor Inst Definition Operation Phase)
- ["_" inst]
["_." def]]]]])
(type: Declaration
@@ -75,8 +75,14 @@
(Parser Annotation)
<c>.any)
+(def: field-descriptor
+ (Parser (Descriptor descriptor.Field))
+ (:: <>.monad map
+ (|>> (:coerce (Descriptor descriptor.Field)))
+ <c>.text))
+
(type: Constant
- [Text (List Annotation) type.Type Code])
+ [Text (List Annotation) (Descriptor descriptor.Field) Code])
(def: constant
(Parser Constant)
@@ -85,12 +91,12 @@
($_ <>.and
<c>.text
(<c>.tuple (<>.some ..annotation))
- jvm.type
+ ..field-descriptor
<c>.any
)))
(type: Variable
- [Text jvm.Visibility State (List Annotation) type.Type])
+ [Text jvm.Visibility State (List Annotation) (Descriptor descriptor.Field)])
(def: variable
(Parser Variable)
@@ -101,7 +107,7 @@
jvm.visibility
..state
(<c>.tuple (<>.some ..annotation))
- jvm.type
+ ..field-descriptor
)))
(type: Field
@@ -134,8 +140,6 @@
(-> Text Parameter)
[name [type.object-class (list)] (list)])
-(def: string-descriptor (type.descriptor (type.class "java.lang.String" (list))))
-
(def: jvm::class
(Handler Anchor Inst Definition)
(/.custom
@@ -169,21 +173,20 @@
(case field
## TODO: Handle annotations.
(#Constant [name annotations type value])
- (case [(type.descriptor type) value]
- (^template [<descriptor> <tag> <field>]
- (^ [(static <descriptor>) [_ (<tag> value)]])
+ (case value
+ (^template [<tag> <field>]
+ [_ (<tag> value)]
(<field> #$.Public ($.++F $.staticF $.finalF) name value))
- ([type.boolean-descriptor #.Bit _def.boolean-field]
- [type.byte-descriptor #.Int _def.byte-field]
- [type.short-descriptor #.Int _def.short-field]
- [type.int-descriptor #.Int _def.int-field]
- [type.long-descriptor #.Int _def.long-field]
- [type.float-descriptor #.Frac _def.float-field]
- [type.double-descriptor #.Frac _def.double-field]
- [type.char-descriptor #.Nat _def.char-field]
- [string-descriptor #.Text _def.string-field])
-
- ## TODO: Handle constants better.
+ ([#.Bit _def.boolean-field]
+ [#.Int _def.byte-field]
+ [#.Int _def.short-field]
+ [#.Int _def.int-field]
+ [#.Int _def.long-field]
+ [#.Frac _def.float-field]
+ [#.Frac _def.double-field]
+ [#.Nat _def.char-field]
+ [#.Text _def.string-field])
+
_
(undefined))
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux
index b5d53aa4f..b56d285d2 100644
--- a/new-luxc/source/luxc/lang/translation/jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm.lux
@@ -1,10 +1,11 @@
(.module:
- [lux (#- Type Definition)
+ [lux (#- Definition)
["." host (#+ import: do-to object)]
[abstract
[monad (#+ do)]]
[control
pipe
+ ["." try (#+ Try)]
["." exception (#+ exception:)]
["." io (#+ IO io)]
[concurrency
@@ -12,7 +13,6 @@
[data
[binary (#+ Binary)]
["." product]
- ["." error (#+ Error)]
["." text ("#@." hash)
["%" format (#+ format)]]
[collection
@@ -21,7 +21,7 @@
[target
[jvm
["." loader (#+ Library)]
- ["." type (#+ Type)]]]
+ ["." descriptor]]]
[tool
[compiler
["." name]]]]
@@ -48,7 +48,7 @@
(type: #export ByteCode Binary)
(def: #export value-field Text "_value")
-(def: #export $Object Type (type.class "java.lang.Object" (list)))
+(def: #export $Value (descriptor.class "java.lang.Object"))
(exception: #export (cannot-load {class Text} {error Text})
(exception.report
@@ -66,28 +66,28 @@
["Class" class]))
(def: (class-value class-name class)
- (-> Text (Class Object) (Error Any))
+ (-> Text (Class Object) (Try Any))
(case (Class::getField ..value-field class)
- (#error.Success field)
+ (#try.Success field)
(case (Field::get #.None field)
- (#error.Success ?value)
+ (#try.Success ?value)
(case ?value
(#.Some value)
- (#error.Success value)
+ (#try.Success value)
#.None
(exception.throw invalid-value class-name))
- (#error.Failure error)
+ (#try.Failure error)
(exception.throw cannot-load [class-name error]))
- (#error.Failure error)
+ (#try.Failure error)
(exception.throw invalid-field [class-name ..value-field error])))
(def: class-path-separator ".")
(def: (evaluate! library loader eval-class valueI)
- (-> Library ClassLoader Text Inst (Error [Any Definition]))
+ (-> Library ClassLoader Text Inst (Try [Any Definition]))
(let [bytecode-name (text.replace-all class-path-separator .module-separator eval-class)
bytecode (def.class #jvm.V1_6
#jvm.Public jvm.noneC
@@ -95,14 +95,14 @@
(list) ["java.lang.Object" (list)]
(list)
(|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF)
- ..value-field ..$Object)
+ ..value-field ..$Value)
(def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM)
"<clinit>"
- (type.method (list) #.None (list))
+ (descriptor.method [(list) descriptor.void])
(|>> valueI
- (inst.PUTSTATIC bytecode-name ..value-field ..$Object)
+ (inst.PUTSTATIC (descriptor.class bytecode-name) ..value-field ..$Value)
inst.RETURN))))]
- (io.run (do (error.with io.monad)
+ (io.run (do (try.with io.monad)
[_ (loader.store eval-class bytecode library)
class (loader.load eval-class loader)
value (:: io.monad wrap (class-value eval-class class))]
@@ -110,23 +110,23 @@
[eval-class bytecode]])))))
(def: (execute! library loader temp-label [class-name class-bytecode])
- (-> Library ClassLoader Text Definition (Error Any))
- (io.run (do (error.with io.monad)
+ (-> Library ClassLoader Text Definition (Try Any))
+ (io.run (do (try.with io.monad)
[existing-class? (|> (atom.read library)
(:: io.monad map (dictionary.contains? class-name))
- (error.lift io.monad)
- (: (IO (Error Bit))))
+ (try.lift io.monad)
+ (: (IO (Try Bit))))
_ (if existing-class?
(wrap [])
(loader.store class-name class-bytecode library))]
(loader.load class-name loader))))
(def: (define! library loader [module name] valueI)
- (-> Library ClassLoader Name Inst (Error [Text Any Definition]))
+ (-> Library ClassLoader Name Inst (Try [Text Any Definition]))
(let [class-name (format (text.replace-all .module-separator class-path-separator module)
class-path-separator (name.normalize name)
"___" (%.nat (text@hash name)))]
- (do error.monad
+ (do try.monad
[[value definition] (evaluate! library loader class-name valueI)]
(wrap [class-name value definition]))))
@@ -138,7 +138,7 @@
(structure
(def: (evaluate! temp-label valueI)
(let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))]
- (:: error.monad map product.left
+ (:: try.monad map product.left
(..evaluate! library loader eval-class valueI))))
(def: execute!
@@ -150,6 +150,6 @@
(def: #export runtime-class "LuxRuntime")
(def: #export function-class "LuxFunction")
-(def: #export $Variant Type (type.array 1 ..$Object))
-(def: #export $Tuple Type (type.array 1 ..$Object))
-(def: #export $Function Type (type.class ..function-class (list)))
+(def: #export $Variant (descriptor.array ..$Value))
+(def: #export $Tuple (descriptor.array ..$Value))
+(def: #export $Function (descriptor.class ..function-class))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.lux b/new-luxc/source/luxc/lang/translation/jvm/case.lux
index 7cea61f14..1f3129cd2 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/case.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/case.lux
@@ -10,7 +10,7 @@
["n" nat]]]
[target
[jvm
- ["$t" type]]]
+ ["." descriptor]]]
[tool
[compiler
["." synthesis (#+ Path Synthesis)]
@@ -20,9 +20,11 @@
[host
["$" jvm (#+ Label Inst Operation Phase)
["_" inst]]]]]
- ["." // (#+ $Object)
+ ["." //
["." runtime]])
+(def: $Runtime (descriptor.class //.runtime-class))
+
(def: (pop-altI stack-depth)
(-> Nat Inst)
(.case stack-depth
@@ -40,12 +42,7 @@
(def: pushI
Inst
- (|>> (_.INVOKESTATIC //.runtime-class
- "pm_push"
- ($t.method (list runtime.$Stack $Object)
- (#.Some runtime.$Stack)
- (list))
- #0)))
+ (|>> (_.INVOKESTATIC $Runtime "pm_push" (descriptor.method [(list runtime.$Stack //.$Value) runtime.$Stack]) #0)))
(def: (path' phase stack-depth @else @end path)
(-> Phase Nat Label Label Path (Operation Inst))
@@ -60,19 +57,19 @@
(^ (synthesis.path/bit value))
(operation@wrap (.let [jumpI (.if value _.IFEQ _.IFNE)]
(|>> peekI
- (_.unwrap #$t.Boolean)
+ (_.unwrap descriptor.boolean)
(jumpI @else))))
(^ (synthesis.path/i64 value))
(operation@wrap (|>> peekI
- (_.unwrap #$t.Long)
+ (_.unwrap descriptor.long)
(_.long (.int value))
_.LCMP
(_.IFNE @else)))
(^ (synthesis.path/f64 value))
(operation@wrap (|>> peekI
- (_.unwrap #$t.Double)
+ (_.unwrap descriptor.double)
(_.double value)
_.DCMPL
(_.IFNE @else)))
@@ -80,11 +77,9 @@
(^ (synthesis.path/text value))
(operation@wrap (|>> peekI
(_.string value)
- (_.INVOKEVIRTUAL "java.lang.Object"
+ (_.INVOKEVIRTUAL (descriptor.class "java.lang.Object")
"equals"
- ($t.method (list $Object)
- (#.Some $t.boolean)
- (list))
+ (descriptor.method [(list //.$Value) descriptor.boolean])
#0)
(_.IFEQ @else)))
@@ -95,20 +90,15 @@
bodyI
(_.GOTO @end))))
-
(^template [<pattern> <flag> <prepare>]
(^ (<pattern> idx))
(operation@wrap (<| _.with-label (function (_ @success))
_.with-label (function (_ @fail))
(|>> peekI
- (_.CHECKCAST ($t.descriptor runtime.$Variant))
+ (_.CHECKCAST //.$Variant)
(_.int (.int (<prepare> idx)))
<flag>
- (_.INVOKESTATIC //.runtime-class "pm_variant"
- ($t.method (list runtime.$Variant runtime.$Tag runtime.$Flag)
- (#.Some runtime.$Datum)
- (list))
- #0)
+ (_.INVOKESTATIC $Runtime "pm_variant" (descriptor.method [(list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value]) #0)
_.DUP
(_.IFNULL @fail)
(_.GOTO @success)
@@ -126,28 +116,18 @@
_.AALOAD
lefts
- (_.INVOKESTATIC //.runtime-class
- "tuple_left"
- ($t.method (list runtime.$Tuple $t.int)
- (#.Some $Object)
- (list))
- #0))]
+ (_.INVOKESTATIC $Runtime "tuple_left" (descriptor.method [(list //.$Tuple runtime.$Index) //.$Value]) #0))]
(|>> peekI
- (_.CHECKCAST ($t.descriptor runtime.$Tuple))
+ (_.CHECKCAST //.$Tuple)
(_.int (.int lefts))
accessI
pushI)))
(^ (synthesis.member/right lefts))
(operation@wrap (|>> peekI
- (_.CHECKCAST ($t.descriptor runtime.$Tuple))
+ (_.CHECKCAST //.$Tuple)
(_.int (.int lefts))
- (_.INVOKESTATIC //.runtime-class
- "tuple_right"
- ($t.method (list runtime.$Tuple $t.int)
- (#.Some $Object)
- (list))
- #0)
+ (_.INVOKESTATIC $Runtime "tuple_right" (descriptor.method [(list //.$Tuple runtime.$Index) //.$Value]) #0)
pushI))
## Extra optimization
@@ -157,7 +137,7 @@
(do phase.monad
[then! (path' phase stack-depth @else @end thenP)]
(wrap (|>> peekI
- (_.CHECKCAST ($t.descriptor runtime.$Tuple))
+ (_.CHECKCAST //.$Tuple)
(_.int +0)
_.AALOAD
(_.ASTORE register)
@@ -171,14 +151,9 @@
(do phase.monad
[then! (path' phase stack-depth @else @end thenP)]
(wrap (|>> peekI
- (_.CHECKCAST ($t.descriptor runtime.$Tuple))
+ (_.CHECKCAST //.$Tuple)
(_.int (.int lefts))
- (_.INVOKESTATIC //.runtime-class
- <getter>
- ($t.method (list runtime.$Tuple $t.int)
- (#.Some $Object)
- (list))
- #0)
+ (_.INVOKESTATIC $Runtime <getter> (descriptor.method [(list //.$Tuple runtime.$Index) //.$Value]) #0)
(_.ASTORE register)
then!))))
([synthesis.member/left "tuple_left"]
@@ -211,10 +186,7 @@
(wrap (|>> pathI
(_.label @else)
_.POP
- (_.INVOKESTATIC //.runtime-class
- "pm_fail"
- ($t.method (list) #.None (list))
- #0)
+ (_.INVOKESTATIC $Runtime "pm_fail" (descriptor.method [(list) descriptor.void]) #0)
_.NULL
(_.GOTO @end)))))
@@ -227,7 +199,7 @@
(wrap (<| _.with-label (function (_ @else))
_.with-label (function (_ @end))
(|>> testI
- (_.unwrap #$t.Boolean)
+ (_.unwrap descriptor.boolean)
(_.IFEQ @else)
thenI
(_.GOTO @end)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.lux b/new-luxc/source/luxc/lang/translation/jvm/common.lux
index 26dbcfbc8..8b2a83526 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/common.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/common.lux
@@ -3,11 +3,11 @@
[abstract
[monad (#+ do)]]
[control
+ ["." try (#+ Try)]
["ex" exception (#+ exception:)]
["." io]]
[data
[binary (#+ Binary)]
- ["." error (#+ Error)]
["." text ("#/." hash)
format]
[collection
@@ -34,8 +34,8 @@
## (set@ #artifacts (dictionary.new text.hash))
## (:coerce Nothing))
## state))
-## (#error.Success [state' output])
-## (#error.Success [(update@ #.host
+## (#try.Success [state' output])
+## (#try.Success [(update@ #.host
## (|>> (:coerce Host)
## (set@ #artifacts (|> (get@ #.host state) (:coerce Host) (get@ #artifacts)))
## (:coerce Nothing))
@@ -43,11 +43,11 @@
## [(|> state' (get@ #.host) (:coerce Host) (get@ #artifacts))
## output]])
-## (#error.Error error)
-## (#error.Error error))))
+## (#try.Failure error)
+## (#try.Failure error))))
## (def: #export (load-definition state)
-## (-> Lux (-> Name Binary (Error Any)))
+## (-> Lux (-> Name Binary (Try Any)))
## (function (_ (^@ def-name [def-module def-name]) def-bytecode)
## (let [normal-name (format (name.normalize def-name) (%n (text/hash def-name)))
## class-name (format (text.replace-all "/" "." def-module) "." normal-name)]
@@ -55,16 +55,16 @@
## (do macro.monad
## [_ (..store-class class-name def-bytecode)
## class (..load-class class-name)]
-## (case (do error.monad
+## (case (do try.monad
## [field (Class::getField [..value-field] class)]
## (Field::get [#.None] field))
-## (#error.Success (#.Some def-value))
+## (#try.Success (#.Some def-value))
## (wrap def-value)
-## (#error.Success #.None)
+## (#try.Success #.None)
## (phase.throw invalid-definition-value (%name def-name))
-## (#error.Error error)
+## (#try.Failure error)
## (phase.throw cannot-load-definition
## (format "Definition: " (%name def-name) "\n"
## "Error:\n"
diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux
index ea9c4ef84..5da2839cd 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/function.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/function.lux
@@ -12,8 +12,8 @@
[collection
["." list ("#@." functor monoid)]]]
[target
- ["." jvm #_
- ["#" type (#+ Type Method)]]]
+ [jvm
+ ["." descriptor (#+ Descriptor Class Method Value)]]]
[tool
[compiler
[arity (#+ Arity)]
@@ -33,42 +33,40 @@
["." reference]])
(def: arity-field Text "arity")
-(def: $Object Type (jvm.class "java.lang.Object" (list)))
(def: (poly-arg? arity)
(-> Arity Bit)
(n.> 1 arity))
-(def: (reset-method class)
- (-> Text Method)
- (jvm.method (list) (#.Some (jvm.class class (list))) (list)))
+(def: reset-method
+ (-> (Descriptor Class) (Descriptor Method))
+ (|>> [(list)] descriptor.method))
(def: (captured-args env)
- (-> Environment (List Type))
- (list.repeat (list.size env) $Object))
+ (-> Environment (List (Descriptor Value)))
+ (list.repeat (list.size env) //.$Value))
(def: (init-method env arity)
- (-> Environment Arity Method)
+ (-> Environment Arity (Descriptor Method))
(if (poly-arg? arity)
- (jvm.method (list.concat (list (captured-args env)
- (list jvm.int)
- (list.repeat (dec arity) $Object)))
- #.None
- (list))
- (jvm.method (captured-args env) #.None (list))))
+ (descriptor.method [(list.concat (list (captured-args env)
+ (list descriptor.int)
+ (list.repeat (dec arity) //.$Value)))
+ descriptor.void])
+ (descriptor.method [(captured-args env) descriptor.void])))
(def: (implementation-method arity)
- (jvm.method (list.repeat arity $Object) (#.Some $Object) (list)))
+ (descriptor.method [(list.repeat arity //.$Value) //.$Value]))
(def: get-amount-of-partialsI
Inst
(|>> (_.ALOAD 0)
- (_.GETFIELD //.function-class runtime.partials-field jvm.int)))
+ (_.GETFIELD //.$Function runtime.partials-field descriptor.int)))
(def: (load-fieldI class field)
- (-> Text Text Inst)
+ (-> (Descriptor Class) Text Inst)
(|>> (_.ALOAD 0)
- (_.GETFIELD class field $Object)))
+ (_.GETFIELD class field //.$Value)))
(def: (inputsI start amount)
(-> Register Nat Inst)
@@ -82,9 +80,9 @@
later-applysI (if (n.> runtime.num-apply-variants amount)
(applysI (n.+ runtime.num-apply-variants start) (n.- runtime.num-apply-variants amount))
function.identity)]
- (|>> (_.CHECKCAST //.function-class)
+ (|>> (_.CHECKCAST //.$Function)
(inputsI start max-args)
- (_.INVOKEVIRTUAL //.function-class runtime.apply-method (runtime.apply-signature max-args) #0)
+ (_.INVOKEVIRTUAL //.$Function runtime.apply-method (runtime.apply-signature max-args) #0)
later-applysI)))
(def: (inc-intI by)
@@ -102,7 +100,7 @@
(-> Environment Def)
(|>> list.enumerate
(list@map (.function (_ [env-idx env-source])
- (def.field #$.Private $.finalF (reference.foreign-name env-idx) $Object)))
+ (def.field #$.Private $.finalF (reference.foreign-name env-idx) //.$Value)))
def.fuse))
(def: (with-partial arity)
@@ -110,12 +108,12 @@
(if (poly-arg? arity)
(|> (list.n/range 0 (n.- 2 arity))
(list@map (.function (_ idx)
- (def.field #$.Private $.finalF (reference.partial-name idx) $Object)))
+ (def.field #$.Private $.finalF (reference.partial-name idx) //.$Value)))
def.fuse)
function.identity))
(def: (instance class arity env)
- (-> Text Arity Environment (Operation Inst))
+ (-> (Descriptor Class) Arity Environment (Operation Inst))
(do phase.monad
[captureI+ (monad.map @ reference.variable env)
#let [argsI (if (poly-arg? arity)
@@ -130,7 +128,7 @@
(_.INVOKESPECIAL class "<init>" (init-method env arity) #0)))))
(def: (with-reset class arity env)
- (-> Text Arity Environment Def)
+ (-> (Descriptor Class) Arity Environment Def)
(def.method #$.Public $.noneM "reset" (reset-method class)
(if (poly-arg? arity)
(let [env-size (list.size env)
@@ -139,7 +137,7 @@
_ (list.n/range 0 (dec env-size)))
(list@map (.function (_ source)
(|>> (_.ALOAD 0)
- (_.GETFIELD class (reference.foreign-name source) $Object))))
+ (_.GETFIELD class (reference.foreign-name source) //.$Value))))
_.fuse)
argsI (|> (nullsI (dec arity))
(list (_.int +0))
@@ -161,19 +159,18 @@
_.ARETURN)))
(def: function-init-method
- Method
- (jvm.method (list jvm.int) #.None (list)))
+ (descriptor.method [(list descriptor.int) descriptor.void]))
(def: (function-init arity env-size)
(-> Arity Nat Inst)
(if (n.= 1 arity)
(|>> (_.int +0)
- (_.INVOKESPECIAL //.function-class "<init>" function-init-method #0))
+ (_.INVOKESPECIAL //.$Function "<init>" function-init-method #0))
(|>> (_.ILOAD (inc env-size))
- (_.INVOKESPECIAL //.function-class "<init>" function-init-method #0))))
+ (_.INVOKESPECIAL //.$Function "<init>" function-init-method #0))))
(def: (with-init class env arity)
- (-> Text Environment Arity Def)
+ (-> (Descriptor Class) Environment Arity Def)
(let [env-size (list.size env)
offset-partial (: (-> Nat Nat)
(|>> inc (n.+ env-size)))
@@ -183,7 +180,7 @@
(list@map (.function (_ register)
(|>> (_.ALOAD 0)
(_.ALOAD (inc register))
- (_.PUTFIELD class (reference.foreign-name register) $Object))))
+ (_.PUTFIELD class (reference.foreign-name register) //.$Value))))
_.fuse)
store-partialI (if (poly-arg? arity)
(|> (list.n/range 0 (n.- 2 arity))
@@ -191,7 +188,7 @@
(let [register (offset-partial idx)]
(|>> (_.ALOAD 0)
(_.ALOAD (inc register))
- (_.PUTFIELD class (reference.partial-name idx) $Object)))))
+ (_.PUTFIELD class (reference.partial-name idx) //.$Value)))))
_.fuse)
function.identity)]
(def.method #$.Public $.noneM "<init>" (init-method env arity)
@@ -202,7 +199,7 @@
_.RETURN))))
(def: (with-apply class env function-arity @begin bodyI apply-arity)
- (-> Text Environment Arity Label Inst Arity
+ (-> (Descriptor Class) Environment Arity Label Inst Arity
Def)
(let [num-partials (dec function-arity)
@default ($.new-label [])
@@ -263,7 +260,7 @@
(_.TABLESWITCH +0 (|> num-partials dec .int)
@default @labels)
casesI
- (_.INVOKESTATIC //.runtime-class "apply_fail" (jvm.method (list) #.None (list)) #0)
+ (_.INVOKESTATIC runtime.$Runtime "apply_fail" (descriptor.method [(list) descriptor.void]) #0)
_.NULL
_.ARETURN
))))
@@ -271,12 +268,13 @@
(def: #export (with-function @begin class env arity bodyI)
(-> Label Text Environment Arity Inst
(Operation [Def Inst]))
- (let [env-size (list.size env)
+ (let [classD (descriptor.class class)
+ env-size (list.size env)
applyD (: Def
(if (poly-arg? arity)
(|> (n.min arity runtime.num-apply-variants)
(list.n/range 1)
- (list@map (with-apply class env arity @begin bodyI))
+ (list@map (with-apply classD env arity @begin bodyI))
(list& (with-implementation arity @begin bodyI))
def.fuse)
(def.method #$.Public $.strictM runtime.apply-method (runtime.apply-signature 1)
@@ -287,12 +285,12 @@
(|>> (def.int-field #$.Public ($_ $.++F $.staticF $.finalF) arity-field (.int arity))
(with-environment env)
(with-partial arity)
- (with-init class env arity)
- (with-reset class arity env)
+ (with-init classD env arity)
+ (with-reset classD arity env)
applyD
))]
(do phase.monad
- [instanceI (instance class arity env)]
+ [instanceI (instance classD arity env)]
(wrap [functionD instanceI]))))
(def: #export (function generate [env arity bodyS])
@@ -319,9 +317,9 @@
#let [applyI (|> argsI
(list.split-all runtime.num-apply-variants)
(list@map (.function (_ chunkI+)
- (|>> (_.CHECKCAST //.function-class)
+ (|>> (_.CHECKCAST //.$Function)
(_.fuse chunkI+)
- (_.INVOKEVIRTUAL //.function-class runtime.apply-method (runtime.apply-signature (list.size chunkI+)) #0))))
+ (_.INVOKEVIRTUAL //.$Function runtime.apply-method (runtime.apply-signature (list.size chunkI+)) #0))))
_.fuse)]]
(wrap (|>> functionI
applyI))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/primitive.lux b/new-luxc/source/luxc/lang/translation/jvm/primitive.lux
index 85fed0a8e..6903b065d 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/primitive.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/primitive.lux
@@ -2,6 +2,7 @@
[lux (#- i64)
[target
[jvm
+ ["." descriptor]
["$t" type]]]
[tool
[compiler
@@ -12,11 +13,11 @@
["." jvm (#+ Inst Operation)
["_" inst]]]]])
-(def: #export (bit value)
+(def: #export bit
(-> Bit (Operation Inst))
- (operation@wrap (_.GETSTATIC "java.lang.Boolean"
- (if value "TRUE" "FALSE")
- ($t.class "java.lang.Boolean" (list)))))
+ (let [Boolean (descriptor.class "java.lang.Boolean")]
+ (function (_ value)
+ (operation@wrap (_.GETSTATIC Boolean (if value "TRUE" "FALSE") Boolean)))))
(template [<name> <type> <load> <wrap>]
[(def: #export (<name> value)
@@ -24,7 +25,7 @@
(let [loadI (|> value <load>)]
(operation@wrap (|>> loadI <wrap>))))]
- [i64 (I64 Any) (<| _.long .int) (_.wrap #$t.Long)]
- [f64 Frac _.double (_.wrap #$t.Double)]
+ [i64 (I64 Any) (<| _.long .int) (_.wrap descriptor.long)]
+ [f64 Frac _.double (_.wrap descriptor.double)]
[text Text _.string (<|)]
)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
index 93d4b6c0b..dbf3a13be 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
@@ -3,12 +3,12 @@
[abstract
["." monad (#+ do)]]
[control
+ ["." try]
["<>" parser
["<s>" synthesis (#+ Parser)]]
["ex" exception (#+ exception:)]]
[data
["." product]
- ["." error]
[number
["f" frac]]
[collection
@@ -16,7 +16,7 @@
["." dictionary]]]
[target
[jvm
- ["_t" type (#+ Type Method)]]]
+ ["." descriptor]]]
[tool
[compiler
["." synthesis (#+ Synthesis %synthesis)]
@@ -42,36 +42,38 @@
Handler))
(function (_ extension-name phase input)
(case (<s>.run input parser)
- (#error.Success input')
+ (#try.Success input')
(handler extension-name phase input')
- (#error.Failure error)
+ (#try.Failure error)
(phase.throw extension.invalid-syntax [extension-name %synthesis input]))))
(import: java/lang/Double
(#static MIN_VALUE Double)
(#static MAX_VALUE Double))
-(def: $Object-Array Type (_t.array 1 ///.$Object))
-(def: $String Type (_t.class "java.lang.String" (list)))
-(def: $CharSequence Type (_t.class "java.lang.CharSequence" (list)))
+(def: $String (descriptor.class "java.lang.String"))
+(def: $CharSequence (descriptor.class "java.lang.CharSequence"))
+(def: $System (descriptor.class "java.lang.System"))
+(def: $Object (descriptor.class "java.lang.Object"))
-(def: lux-intI Inst (|>> _.I2L (_.wrap #_t.Long)))
-(def: jvm-intI Inst (|>> (_.unwrap #_t.Long) _.L2I))
-(def: check-stringI Inst (_.CHECKCAST "java.lang.String"))
+(def: lux-intI Inst (|>> _.I2L (_.wrap descriptor.long)))
+(def: jvm-intI Inst (|>> (_.unwrap descriptor.long) _.L2I))
+(def: check-stringI Inst (_.CHECKCAST $String))
(def: (predicateI tester)
(-> (-> Label Inst)
Inst)
- (<| _.with-label (function (_ @then))
- _.with-label (function (_ @end))
- (|>> (tester @then)
- (_.GETSTATIC "java.lang.Boolean" "FALSE" (_t.class "java.lang.Boolean" (list)))
- (_.GOTO @end)
- (_.label @then)
- (_.GETSTATIC "java.lang.Boolean" "TRUE" (_t.class "java.lang.Boolean" (list)))
- (_.label @end)
- )))
+ (let [$Boolean (descriptor.class "java.lang.Boolean")]
+ (<| _.with-label (function (_ @then))
+ _.with-label (function (_ @end))
+ (|>> (tester @then)
+ (_.GETSTATIC $Boolean "FALSE" $Boolean)
+ (_.GOTO @end)
+ (_.label @then)
+ (_.GETSTATIC $Boolean "TRUE" $Boolean)
+ (_.label @end)
+ ))))
(def: unitI Inst (_.string synthesis.unit))
@@ -108,7 +110,7 @@
conditionalsG (|> conditionalsG+
(list@map product.right)
_.fuse)]]
- (wrap (|>> inputG (_.unwrap #_t.Long) _.L2I
+ (wrap (|>> inputG (_.unwrap descriptor.long) _.L2I
(_.LOOKUPSWITCH @else table)
conditionalsG
(_.label @else)
@@ -125,17 +127,17 @@
(def: (lux::try riskyI)
(Unary Inst)
(|>> riskyI
- (_.CHECKCAST ///.function-class)
- (_.INVOKESTATIC ///.runtime-class "try"
- (_t.method (list ///.$Function) (#.Some $Object-Array) (list))
+ (_.CHECKCAST ///.$Function)
+ (_.INVOKESTATIC runtime.$Runtime "try"
+ (descriptor.method [(list ///.$Function) ///.$Variant])
#0)))
(template [<name> <op>]
[(def: (<name> [maskI inputI])
(Binary Inst)
- (|>> inputI (_.unwrap #_t.Long)
- maskI (_.unwrap #_t.Long)
- <op> (_.wrap #_t.Long)))]
+ (|>> inputI (_.unwrap descriptor.long)
+ maskI (_.unwrap descriptor.long)
+ <op> (_.wrap descriptor.long)))]
[i64::and _.LAND]
[i64::or _.LOR]
@@ -145,10 +147,10 @@
(template [<name> <op>]
[(def: (<name> [shiftI inputI])
(Binary Inst)
- (|>> inputI (_.unwrap #_t.Long)
+ (|>> inputI (_.unwrap descriptor.long)
shiftI jvm-intI
<op>
- (_.wrap #_t.Long)))]
+ (_.wrap descriptor.long)))]
[i64::left-shift _.LSHL]
[i64::arithmetic-right-shift _.LSHR]
@@ -160,9 +162,9 @@
(Nullary Inst)
(|>> <const> (_.wrap <type>)))]
- [frac::smallest (_.double (Double::MIN_VALUE)) #_t.Double]
- [frac::min (_.double (f.* -1.0 (Double::MAX_VALUE))) #_t.Double]
- [frac::max (_.double (Double::MAX_VALUE)) #_t.Double]
+ [f64::smallest (_.double (Double::MIN_VALUE)) descriptor.double]
+ [f64::min (_.double (f.* -1.0 (Double::MAX_VALUE))) descriptor.double]
+ [f64::max (_.double (Double::MAX_VALUE)) descriptor.double]
)
(template [<name> <type> <op>]
@@ -173,25 +175,25 @@
<op>
(_.wrap <type>)))]
- [i64::+ #_t.Long _.LADD]
- [i64::- #_t.Long _.LSUB]
- [i64::* #_t.Long _.LMUL]
- [i64::/ #_t.Long _.LDIV]
- [i64::% #_t.Long _.LREM]
+ [i64::+ descriptor.long _.LADD]
+ [i64::- descriptor.long _.LSUB]
+ [i64::* descriptor.long _.LMUL]
+ [i64::/ descriptor.long _.LDIV]
+ [i64::% descriptor.long _.LREM]
- [frac::+ #_t.Double _.DADD]
- [frac::- #_t.Double _.DSUB]
- [frac::* #_t.Double _.DMUL]
- [frac::/ #_t.Double _.DDIV]
- [frac::% #_t.Double _.DREM]
+ [f64::+ descriptor.double _.DADD]
+ [f64::- descriptor.double _.DSUB]
+ [f64::* descriptor.double _.DMUL]
+ [f64::/ descriptor.double _.DDIV]
+ [f64::% descriptor.double _.DREM]
)
-(template [<eq> <lt> <unwrap> <cmp>]
+(template [<eq> <lt> <descriptor> <cmp>]
[(template [<name> <reference>]
[(def: (<name> [paramI subjectI])
(Binary Inst)
- (|>> subjectI <unwrap>
- paramI <unwrap>
+ (|>> subjectI (_.unwrap <descriptor>)
+ paramI (_.unwrap <descriptor>)
<cmp>
(_.int <reference>)
(predicateI _.IF_ICMPEQ)))]
@@ -199,8 +201,8 @@
[<eq> +0]
[<lt> -1])]
- [i64::= i64::< (_.unwrap #_t.Long) _.LCMP]
- [frac::= frac::< (_.unwrap #_t.Double) _.DCMPG]
+ [i64::= i64::< descriptor.long _.LCMP]
+ [f64::= f64::< descriptor.double _.DCMPG]
)
(template [<name> <prepare> <transform>]
@@ -208,22 +210,22 @@
(Unary Inst)
(|>> inputI <prepare> <transform>))]
- [i64::f64 (_.unwrap #_t.Long) (<| (_.wrap #_t.Double) _.L2D)]
- [i64::char (_.unwrap #_t.Long)
- ((|>> _.L2I _.I2C (_.INVOKESTATIC "java.lang.Character" "toString" (_t.method (list _t.char) (#.Some $String) (list)) #0)))]
+ [i64::f64 (_.unwrap descriptor.long) (<| (_.wrap descriptor.double) _.L2D)]
+ [i64::char (_.unwrap descriptor.long)
+ ((|>> _.L2I _.I2C (_.INVOKESTATIC (descriptor.class "java.lang.Character") "toString" (descriptor.method [(list descriptor.char) $String]) #0)))]
- [frac::i64 (_.unwrap #_t.Double) (<| (_.wrap #_t.Long) _.D2L)]
- [frac::encode (_.unwrap #_t.Double)
- (_.INVOKESTATIC "java.lang.Double" "toString" (_t.method (list _t.double) (#.Some $String) (list)) #0)]
- [frac::decode ..check-stringI
- (_.INVOKESTATIC ///.runtime-class "decode_frac" (_t.method (list $String) (#.Some $Object-Array) (list)) #0)]
+ [f64::i64 (_.unwrap descriptor.double) (<| (_.wrap descriptor.long) _.D2L)]
+ [f64::encode (_.unwrap descriptor.double)
+ (_.INVOKESTATIC (descriptor.class "java.lang.Double") "toString" (descriptor.method [(list descriptor.double) $String]) #0)]
+ [f64::decode ..check-stringI
+ (_.INVOKESTATIC runtime.$Runtime "decode_frac" (descriptor.method [(list $String) ///.$Variant]) #0)]
)
(def: (text::size inputI)
(Unary Inst)
(|>> inputI
..check-stringI
- (_.INVOKEVIRTUAL "java.lang.String" "length" (_t.method (list) (#.Some _t.int) (list)) #0)
+ (_.INVOKEVIRTUAL $String "length" (descriptor.method [(list) descriptor.int]) #0)
lux-intI))
(template [<name> <pre-subject> <pre-param> <op> <post>]
@@ -234,13 +236,13 @@
<op> <post>))]
[text::= (<|) (<|)
- (_.INVOKEVIRTUAL "java.lang.Object" "equals" (_t.method (list ///.$Object) (#.Some _t.boolean) (list)) #0)
- (_.wrap #_t.Boolean)]
+ (_.INVOKEVIRTUAL $Object "equals" (descriptor.method [(list $Object) descriptor.boolean]) #0)
+ (_.wrap descriptor.boolean)]
[text::< ..check-stringI ..check-stringI
- (_.INVOKEVIRTUAL "java.lang.String" "compareTo" (_t.method (list $String) (#.Some _t.int) (list)) #0)
+ (_.INVOKEVIRTUAL $String "compareTo" (descriptor.method [(list $String) descriptor.int]) #0)
(predicateI _.IFLT)]
[text::char ..check-stringI jvm-intI
- (_.INVOKEVIRTUAL "java.lang.String" "charAt" (_t.method (list _t.int) (#.Some _t.char) (list)) #0)
+ (_.INVOKEVIRTUAL $String "charAt" (descriptor.method [(list descriptor.int) descriptor.char]) #0)
lux-intI]
)
@@ -248,16 +250,16 @@
(Binary Inst)
(|>> leftI ..check-stringI
rightI ..check-stringI
- (_.INVOKEVIRTUAL "java.lang.String" "concat" (_t.method (list $String) (#.Some $String) (list)) #0)))
+ (_.INVOKEVIRTUAL $String "concat" (descriptor.method [(list $String) $String]) #0)))
(def: (text::clip [startI endI subjectI])
(Trinary Inst)
(|>> subjectI ..check-stringI
startI jvm-intI
endI jvm-intI
- (_.INVOKEVIRTUAL "java.lang.String" "substring" (_t.method (list _t.int _t.int) (#.Some $String) (list)) #0)))
+ (_.INVOKEVIRTUAL $String "substring" (descriptor.method [(list descriptor.int descriptor.int) $String]) #0)))
-(def: index-method Method (_t.method (list $String _t.int) (#.Some _t.int) (list)))
+(def: index-method (descriptor.method [(list $String descriptor.int) descriptor.int]))
(def: (text::index [startI partI textI])
(Trinary Inst)
(<| _.with-label (function (_ @not-found))
@@ -265,7 +267,7 @@
(|>> textI ..check-stringI
partI ..check-stringI
startI jvm-intI
- (_.INVOKEVIRTUAL "java.lang.String" "indexOf" index-method #0)
+ (_.INVOKEVIRTUAL $String "indexOf" index-method #0)
_.DUP
(_.int -1)
(_.IF_ICMPEQ @not-found)
@@ -277,34 +279,36 @@
runtime.noneI
(_.label @end))))
-(def: string-method Method (_t.method (list $String) #.None (list)))
+(def: string-method (descriptor.method [(list $String) descriptor.void]))
(def: (io::log messageI)
(Unary Inst)
- (|>> (_.GETSTATIC "java.lang.System" "out" (_t.class "java.io.PrintStream" (list)))
- messageI
- ..check-stringI
- (_.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method #0)
- unitI))
+ (let [$PrintStream (descriptor.class "java.io.PrintStream")]
+ (|>> (_.GETSTATIC $System "out" $PrintStream)
+ messageI
+ ..check-stringI
+ (_.INVOKEVIRTUAL $PrintStream "println" string-method #0)
+ unitI)))
(def: (io::error messageI)
(Unary Inst)
- (|>> (_.NEW "java.lang.Error")
- _.DUP
- messageI
- ..check-stringI
- (_.INVOKESPECIAL "java.lang.Error" "<init>" string-method #0)
- _.ATHROW))
+ (let [$Error (descriptor.class "java.lang.Error")]
+ (|>> (_.NEW $Error)
+ _.DUP
+ messageI
+ ..check-stringI
+ (_.INVOKESPECIAL $Error "<init>" string-method #0)
+ _.ATHROW)))
(def: (io::exit codeI)
(Unary Inst)
(|>> codeI jvm-intI
- (_.INVOKESTATIC "java.lang.System" "exit" (_t.method (list _t.int) #.None (list)) #0)
+ (_.INVOKESTATIC $System "exit" (descriptor.method [(list descriptor.int) descriptor.void]) #0)
_.NULL))
(def: (io::current-time _)
(Nullary Inst)
- (|>> (_.INVOKESTATIC "java.lang.System" "currentTimeMillis" (_t.method (list) (#.Some _t.long) (list)) #0)
- (_.wrap #_t.Long)))
+ (|>> (_.INVOKESTATIC $System "currentTimeMillis" (descriptor.method [(list) descriptor.long]) #0)
+ (_.wrap descriptor.long)))
(def: bundle::lux
Bundle
@@ -337,19 +341,19 @@
Bundle
(<| (bundle.prefix "f64")
(|> (: Bundle bundle.empty)
- (bundle.install "+" (binary frac::+))
- (bundle.install "-" (binary frac::-))
- (bundle.install "*" (binary frac::*))
- (bundle.install "/" (binary frac::/))
- (bundle.install "%" (binary frac::%))
- (bundle.install "=" (binary frac::=))
- (bundle.install "<" (binary frac::<))
- (bundle.install "smallest" (nullary frac::smallest))
- (bundle.install "min" (nullary frac::min))
- (bundle.install "max" (nullary frac::max))
- (bundle.install "i64" (unary frac::i64))
- (bundle.install "encode" (unary frac::encode))
- (bundle.install "decode" (unary frac::decode)))))
+ (bundle.install "+" (binary f64::+))
+ (bundle.install "-" (binary f64::-))
+ (bundle.install "*" (binary f64::*))
+ (bundle.install "/" (binary f64::/))
+ (bundle.install "%" (binary f64::%))
+ (bundle.install "=" (binary f64::=))
+ (bundle.install "<" (binary f64::<))
+ (bundle.install "smallest" (nullary f64::smallest))
+ (bundle.install "min" (nullary f64::min))
+ (bundle.install "max" (nullary f64::max))
+ (bundle.install "i64" (unary f64::i64))
+ (bundle.install "encode" (unary f64::encode))
+ (bundle.install "decode" (unary f64::decode)))))
(def: bundle::text
Bundle
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
index 1b3d3c345..62fd37fdb 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- Type primitive int char)
+ [lux (#- primitive int char)
[abstract
["." monad (#+ do)]]
[control
@@ -11,7 +11,6 @@
[data
["." product]
["." maybe]
- ["." error]
[number
["." nat]]
["." text]
@@ -21,7 +20,8 @@
["." set]]]
[target
["." jvm #_
- ["#" type (#+ Primitive Bound Generic Class Type Method Var Typed Argument Return)
+ ["." descriptor (#+ Descriptor Value Primitive Object Method)]
+ ["#" type (#+ Bound Generic Class Var Typed Argument Return)
["." box]
["." reflection]]]]
[tool
@@ -64,7 +64,7 @@
[L2C (|>> _.L2I _.I2C)]
)
-(template [<name> <unwrap> <conversion> <wrap>]
+(template [<conversion> <name>]
[(def: (<name> inputI)
(Unary Inst)
(if (is? _.NOP <conversion>)
@@ -72,30 +72,30 @@
(|>> inputI
<conversion>)))]
- [conversion::double-to-float #jvm.Double _.D2F #jvm.Float]
- [conversion::double-to-int #jvm.Double _.D2I #jvm.Int]
- [conversion::double-to-long #jvm.Double _.D2L #jvm.Long]
- [conversion::float-to-double #jvm.Float _.F2D #jvm.Double]
- [conversion::float-to-int #jvm.Float _.F2I #jvm.Int]
- [conversion::float-to-long #jvm.Float _.F2L #jvm.Long]
- [conversion::int-to-byte #jvm.Int _.I2B #jvm.Byte]
- [conversion::int-to-char #jvm.Int _.I2C #jvm.Char]
- [conversion::int-to-double #jvm.Int _.I2D #jvm.Double]
- [conversion::int-to-float #jvm.Int _.I2F #jvm.Float]
- [conversion::int-to-long #jvm.Int _.I2L #jvm.Long]
- [conversion::int-to-short #jvm.Int _.I2S #jvm.Short]
- [conversion::long-to-double #jvm.Long _.L2D #jvm.Double]
- [conversion::long-to-float #jvm.Long _.L2F #jvm.Float]
- [conversion::long-to-int #jvm.Long _.L2I #jvm.Int]
- [conversion::long-to-short #jvm.Long L2S #jvm.Short]
- [conversion::long-to-byte #jvm.Long L2B #jvm.Byte]
- [conversion::long-to-char #jvm.Long L2C #jvm.Char]
- [conversion::char-to-byte #jvm.Char _.I2B #jvm.Byte]
- [conversion::char-to-short #jvm.Char _.I2S #jvm.Short]
- [conversion::char-to-int #jvm.Char _.NOP #jvm.Int]
- [conversion::char-to-long #jvm.Char _.I2L #jvm.Long]
- [conversion::byte-to-long #jvm.Byte _.I2L #jvm.Long]
- [conversion::short-to-long #jvm.Short _.I2L #jvm.Long]
+ [_.D2F conversion::double-to-float]
+ [_.D2I conversion::double-to-int]
+ [_.D2L conversion::double-to-long]
+ [_.F2D conversion::float-to-double]
+ [_.F2I conversion::float-to-int]
+ [_.F2L conversion::float-to-long]
+ [_.I2B conversion::int-to-byte]
+ [_.I2C conversion::int-to-char]
+ [_.I2D conversion::int-to-double]
+ [_.I2F conversion::int-to-float]
+ [_.I2L conversion::int-to-long]
+ [_.I2S conversion::int-to-short]
+ [_.L2D conversion::long-to-double]
+ [_.L2F conversion::long-to-float]
+ [_.L2I conversion::long-to-int]
+ [..L2S conversion::long-to-short]
+ [..L2B conversion::long-to-byte]
+ [..L2C conversion::long-to-char]
+ [_.I2B conversion::char-to-byte]
+ [_.I2S conversion::char-to-short]
+ [_.NOP conversion::char-to-int]
+ [_.I2L conversion::char-to-long]
+ [_.I2L conversion::byte-to-long]
+ [_.I2L conversion::short-to-long]
)
(def: conversion
@@ -172,9 +172,9 @@
[double::% _.DREM]
)
-(def: boolean-class (jvm.class box.boolean (list)))
-(def: falseI (_.GETSTATIC "java.lang.Boolean" "FALSE" boolean-class))
-(def: trueI (_.GETSTATIC "java.lang.Boolean" "TRUE" boolean-class))
+(def: $Boolean (descriptor.class box.boolean))
+(def: falseI (_.GETSTATIC $Boolean "FALSE" $Boolean))
+(def: trueI (_.GETSTATIC $Boolean "TRUE" $Boolean))
(template [<name> <op>]
[(def: (<name> [xI yI])
@@ -296,28 +296,29 @@
)))
(def: (array-java-type nesting elem-class)
- (-> Nat Text Type)
- (jvm.array nesting
- (case elem-class
- (^ (static reflection.boolean)) jvm.boolean
- (^ (static reflection.byte)) jvm.byte
- (^ (static reflection.short)) jvm.short
- (^ (static reflection.int)) jvm.int
- (^ (static reflection.long)) jvm.long
- (^ (static reflection.float)) jvm.float
- (^ (static reflection.double)) jvm.double
- (^ (static reflection.char)) jvm.char
- _ (jvm.class elem-class (list)))))
+ (-> Nat Text (Descriptor Object))
+ (descriptor.array (case nesting
+ 1 (case elem-class
+ (^ (static reflection.boolean)) descriptor.boolean
+ (^ (static reflection.byte)) descriptor.byte
+ (^ (static reflection.short)) descriptor.short
+ (^ (static reflection.int)) descriptor.int
+ (^ (static reflection.long)) descriptor.long
+ (^ (static reflection.float)) descriptor.float
+ (^ (static reflection.double)) descriptor.double
+ (^ (static reflection.char)) descriptor.char
+ _ (descriptor.class elem-class))
+ _ (array-java-type (dec nesting) elem-class))))
(def: (primitive-array-length-handler jvm-primitive)
- (-> Type Handler)
+ (-> (Descriptor Primitive) Handler)
(..custom
[<s>.any
(function (_ extension-name generate arrayS)
(do phase.monad
[arrayI (generate arrayS)]
(wrap (|>> arrayI
- (_.CHECKCAST (jvm.descriptor (jvm.array 1 jvm-primitive)))
+ (_.CHECKCAST (descriptor.array jvm-primitive))
_.ARRAYLENGTH))))]))
(def: (array::length::object extension-name generate inputs)
@@ -329,14 +330,14 @@
(do phase.monad
[arrayI (generate arrayS)]
(wrap (|>> arrayI
- (_.CHECKCAST (jvm.descriptor (array-java-type (.nat nesting) elem-class)))
+ (_.CHECKCAST (array-java-type (.nat nesting) elem-class))
_.ARRAYLENGTH)))
_
(phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
(def: (new-primitive-array-handler jvm-primitive)
- (-> Type Handler)
+ (-> (Descriptor Primitive) Handler)
(function (_ extension-name generate inputs)
(case inputs
(^ (list lengthS))
@@ -363,7 +364,7 @@
(phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
(def: (read-primitive-array-handler jvm-primitive loadI)
- (-> Type Inst Handler)
+ (-> (Descriptor Primitive) Inst Handler)
(function (_ extension-name generate inputs)
(case inputs
(^ (list idxS arrayS))
@@ -371,7 +372,7 @@
[arrayI (generate arrayS)
idxI (generate idxS)]
(wrap (|>> arrayI
- (_.CHECKCAST (jvm.descriptor (jvm.array 1 jvm-primitive)))
+ (_.CHECKCAST (descriptor.array jvm-primitive))
idxI
loadI)))
@@ -389,7 +390,7 @@
[arrayI (generate arrayS)
idxI (generate idxS)]
(wrap (|>> arrayI
- (_.CHECKCAST (jvm.descriptor (array-java-type (.nat nesting) elem-class)))
+ (_.CHECKCAST (array-java-type (.nat nesting) elem-class))
idxI
_.AALOAD)))
@@ -397,7 +398,7 @@
(phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
(def: (write-primitive-array-handler jvm-primitive storeI)
- (-> Type Inst Handler)
+ (-> (Descriptor Primitive) Inst Handler)
(function (_ extension-name generate inputs)
(case inputs
(^ (list idxS valueS arrayS))
@@ -406,7 +407,7 @@
idxI (generate idxS)
valueI (generate valueS)]
(wrap (|>> arrayI
- (_.CHECKCAST (jvm.descriptor (jvm.array 1 jvm-primitive)))
+ (_.CHECKCAST (descriptor.array jvm-primitive))
_.DUP
idxI
valueI
@@ -428,7 +429,7 @@
idxI (generate idxS)
valueI (generate valueS)]
(wrap (|>> arrayI
- (_.CHECKCAST (jvm.descriptor (array-java-type (.nat nesting) elem-class)))
+ (_.CHECKCAST (array-java-type (.nat nesting) elem-class))
_.DUP
idxI
valueI
@@ -443,47 +444,47 @@
(|> bundle.empty
(dictionary.merge (<| (bundle.prefix "length")
(|> bundle.empty
- (bundle.install reflection.boolean (primitive-array-length-handler jvm.boolean))
- (bundle.install reflection.byte (primitive-array-length-handler jvm.byte))
- (bundle.install reflection.short (primitive-array-length-handler jvm.short))
- (bundle.install reflection.int (primitive-array-length-handler jvm.int))
- (bundle.install reflection.long (primitive-array-length-handler jvm.long))
- (bundle.install reflection.float (primitive-array-length-handler jvm.float))
- (bundle.install reflection.double (primitive-array-length-handler jvm.double))
- (bundle.install reflection.char (primitive-array-length-handler jvm.char))
+ (bundle.install reflection.boolean (primitive-array-length-handler descriptor.boolean))
+ (bundle.install reflection.byte (primitive-array-length-handler descriptor.byte))
+ (bundle.install reflection.short (primitive-array-length-handler descriptor.short))
+ (bundle.install reflection.int (primitive-array-length-handler descriptor.int))
+ (bundle.install reflection.long (primitive-array-length-handler descriptor.long))
+ (bundle.install reflection.float (primitive-array-length-handler descriptor.float))
+ (bundle.install reflection.double (primitive-array-length-handler descriptor.double))
+ (bundle.install reflection.char (primitive-array-length-handler descriptor.char))
(bundle.install "object" array::length::object))))
(dictionary.merge (<| (bundle.prefix "new")
(|> bundle.empty
- (bundle.install reflection.boolean (new-primitive-array-handler jvm.boolean))
- (bundle.install reflection.byte (new-primitive-array-handler jvm.byte))
- (bundle.install reflection.short (new-primitive-array-handler jvm.short))
- (bundle.install reflection.int (new-primitive-array-handler jvm.int))
- (bundle.install reflection.long (new-primitive-array-handler jvm.long))
- (bundle.install reflection.float (new-primitive-array-handler jvm.float))
- (bundle.install reflection.double (new-primitive-array-handler jvm.double))
- (bundle.install reflection.char (new-primitive-array-handler jvm.char))
+ (bundle.install reflection.boolean (new-primitive-array-handler descriptor.boolean))
+ (bundle.install reflection.byte (new-primitive-array-handler descriptor.byte))
+ (bundle.install reflection.short (new-primitive-array-handler descriptor.short))
+ (bundle.install reflection.int (new-primitive-array-handler descriptor.int))
+ (bundle.install reflection.long (new-primitive-array-handler descriptor.long))
+ (bundle.install reflection.float (new-primitive-array-handler descriptor.float))
+ (bundle.install reflection.double (new-primitive-array-handler descriptor.double))
+ (bundle.install reflection.char (new-primitive-array-handler descriptor.char))
(bundle.install "object" array::new::object))))
(dictionary.merge (<| (bundle.prefix "read")
(|> bundle.empty
- (bundle.install reflection.boolean (read-primitive-array-handler jvm.boolean _.BALOAD))
- (bundle.install reflection.byte (read-primitive-array-handler jvm.byte _.BALOAD))
- (bundle.install reflection.short (read-primitive-array-handler jvm.short _.SALOAD))
- (bundle.install reflection.int (read-primitive-array-handler jvm.int _.IALOAD))
- (bundle.install reflection.long (read-primitive-array-handler jvm.long _.LALOAD))
- (bundle.install reflection.float (read-primitive-array-handler jvm.float _.FALOAD))
- (bundle.install reflection.double (read-primitive-array-handler jvm.double _.DALOAD))
- (bundle.install reflection.char (read-primitive-array-handler jvm.char _.CALOAD))
+ (bundle.install reflection.boolean (read-primitive-array-handler descriptor.boolean _.BALOAD))
+ (bundle.install reflection.byte (read-primitive-array-handler descriptor.byte _.BALOAD))
+ (bundle.install reflection.short (read-primitive-array-handler descriptor.short _.SALOAD))
+ (bundle.install reflection.int (read-primitive-array-handler descriptor.int _.IALOAD))
+ (bundle.install reflection.long (read-primitive-array-handler descriptor.long _.LALOAD))
+ (bundle.install reflection.float (read-primitive-array-handler descriptor.float _.FALOAD))
+ (bundle.install reflection.double (read-primitive-array-handler descriptor.double _.DALOAD))
+ (bundle.install reflection.char (read-primitive-array-handler descriptor.char _.CALOAD))
(bundle.install "object" array::read::object))))
(dictionary.merge (<| (bundle.prefix "write")
(|> bundle.empty
- (bundle.install reflection.boolean (write-primitive-array-handler jvm.boolean _.BASTORE))
- (bundle.install reflection.byte (write-primitive-array-handler jvm.byte _.BASTORE))
- (bundle.install reflection.short (write-primitive-array-handler jvm.short _.SASTORE))
- (bundle.install reflection.int (write-primitive-array-handler jvm.int _.IASTORE))
- (bundle.install reflection.long (write-primitive-array-handler jvm.long _.LASTORE))
- (bundle.install reflection.float (write-primitive-array-handler jvm.float _.FASTORE))
- (bundle.install reflection.double (write-primitive-array-handler jvm.double _.DASTORE))
- (bundle.install reflection.char (write-primitive-array-handler jvm.char _.CASTORE))
+ (bundle.install reflection.boolean (write-primitive-array-handler descriptor.boolean _.BASTORE))
+ (bundle.install reflection.byte (write-primitive-array-handler descriptor.byte _.BASTORE))
+ (bundle.install reflection.short (write-primitive-array-handler descriptor.short _.SASTORE))
+ (bundle.install reflection.int (write-primitive-array-handler descriptor.int _.IASTORE))
+ (bundle.install reflection.long (write-primitive-array-handler descriptor.long _.LASTORE))
+ (bundle.install reflection.float (write-primitive-array-handler descriptor.float _.FASTORE))
+ (bundle.install reflection.double (write-primitive-array-handler descriptor.double _.DASTORE))
+ (bundle.install reflection.char (write-primitive-array-handler descriptor.char _.CASTORE))
(bundle.install "object" array::write::object))))
)))
@@ -517,6 +518,8 @@
(|>> exceptionI
_.ATHROW))
+(def: $Class (descriptor.class "java.lang.Class"))
+
(def: (object::class extension-name generate inputs)
Handler
(case inputs
@@ -524,10 +527,9 @@
(do phase.monad
[]
(wrap (|>> (_.string class)
- (_.INVOKESTATIC "java.lang.Class" "forName"
- (jvm.method (list (jvm.class "java.lang.String" (list)))
- (#.Some (jvm.class "java.lang.Class" (list)))
- (list))
+ (_.INVOKESTATIC $Class "forName"
+ (descriptor.method [(list (descriptor.class "java.lang.String"))
+ $Class])
false))))
_
@@ -541,8 +543,8 @@
(do phase.monad
[objectI (generate objectS)]
(wrap (|>> objectI
- (_.INSTANCEOF class)
- (_.wrap #jvm.Boolean)))))]))
+ (_.INSTANCEOF (descriptor.class class))
+ (_.wrap descriptor.boolean)))))]))
(def: (object::cast extension-name generate inputs)
Handler
@@ -558,14 +560,14 @@
(^ [(static <object>) (static <primitive>)])
(wrap (|>> valueI (_.unwrap <type>))))
- ([reflection.boolean box.boolean #jvm.Boolean]
- [reflection.byte box.byte #jvm.Byte]
- [reflection.short box.short #jvm.Short]
- [reflection.int box.int #jvm.Int]
- [reflection.long box.long #jvm.Long]
- [reflection.float box.float #jvm.Float]
- [reflection.double box.double #jvm.Double]
- [reflection.char box.char #jvm.Char])
+ ([reflection.boolean box.boolean descriptor.boolean]
+ [reflection.byte box.byte descriptor.byte]
+ [reflection.short box.short descriptor.short]
+ [reflection.int box.int descriptor.int]
+ [reflection.long box.long descriptor.long]
+ [reflection.float box.float descriptor.float]
+ [reflection.double box.double descriptor.double]
+ [reflection.char box.char descriptor.char])
_
(wrap valueI)))
@@ -587,15 +589,15 @@
)))
(def: primitives
- (Dictionary Text Primitive)
- (|> (list [reflection.boolean #jvm.Boolean]
- [reflection.byte #jvm.Byte]
- [reflection.short #jvm.Short]
- [reflection.int #jvm.Int]
- [reflection.long #jvm.Long]
- [reflection.float #jvm.Float]
- [reflection.double #jvm.Double]
- [reflection.char #jvm.Char])
+ (Dictionary Text (Descriptor Primitive))
+ (|> (list [reflection.boolean descriptor.boolean]
+ [reflection.byte descriptor.byte]
+ [reflection.short descriptor.short]
+ [reflection.int descriptor.int]
+ [reflection.long descriptor.long]
+ [reflection.float descriptor.float]
+ [reflection.double descriptor.double]
+ [reflection.char descriptor.char])
(dictionary.from-list text.hash)))
(def: (static::get extension-name generate inputs)
@@ -606,12 +608,12 @@
(synthesis.text unboxed)))
(do phase.monad
[]
- (case (dictionary.get unboxed primitives)
+ (case (dictionary.get unboxed ..primitives)
(#.Some primitive)
- (wrap (_.GETSTATIC class field (#jvm.Primitive primitive)))
+ (wrap (_.GETSTATIC (descriptor.class class) field primitive))
#.None
- (wrap (_.GETSTATIC class field (jvm.class unboxed (list))))))
+ (wrap (_.GETSTATIC (descriptor.class class) field (descriptor.class unboxed)))))
_
(phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
@@ -624,17 +626,18 @@
(synthesis.text unboxed)
valueS))
(do phase.monad
- [valueI (generate valueS)]
- (case (dictionary.get unboxed primitives)
+ [valueI (generate valueS)
+ #let [$class (descriptor.class class)]]
+ (case (dictionary.get unboxed ..primitives)
(#.Some primitive)
(wrap (|>> valueI
- (_.PUTSTATIC class field (#jvm.Primitive primitive))
+ (_.PUTSTATIC $class field primitive)
(_.string synthesis.unit)))
#.None
(wrap (|>> valueI
- (_.CHECKCAST class)
- (_.PUTSTATIC class field (jvm.class class (list)))
+ (_.CHECKCAST $class)
+ (_.PUTSTATIC $class field $class)
(_.string synthesis.unit)))))
_
@@ -648,17 +651,17 @@
(synthesis.text unboxed)
objectS))
(do phase.monad
- [objectI (generate objectS)]
- (case (dictionary.get unboxed primitives)
- (#.Some primitive)
- (wrap (|>> objectI
- (_.CHECKCAST class)
- (_.GETFIELD class field (#jvm.Primitive primitive))))
-
- #.None
- (wrap (|>> objectI
- (_.CHECKCAST class)
- (_.GETFIELD class field (jvm.class unboxed (list)))))))
+ [objectI (generate objectS)
+ #let [$class (descriptor.class class)
+ getI (case (dictionary.get unboxed ..primitives)
+ (#.Some primitive)
+ (_.GETFIELD $class field primitive)
+
+ #.None
+ (_.GETFIELD $class field (descriptor.class unboxed)))]]
+ (wrap (|>> objectI
+ (_.CHECKCAST $class)
+ getI)))
_
(phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
@@ -673,22 +676,21 @@
objectS))
(do phase.monad
[valueI (generate valueS)
- objectI (generate objectS)]
- (case (dictionary.get unboxed primitives)
- (#.Some primitive)
- (wrap (|>> objectI
- (_.CHECKCAST class)
- _.DUP
- valueI
- (_.PUTFIELD class field (#jvm.Primitive primitive))))
-
- #.None
- (wrap (|>> objectI
- (_.CHECKCAST class)
- _.DUP
- valueI
- (_.CHECKCAST unboxed)
- (_.PUTFIELD class field (jvm.class unboxed (list)))))))
+ objectI (generate objectS)
+ #let [$class (descriptor.class class)
+ putI (case (dictionary.get unboxed ..primitives)
+ (#.Some primitive)
+ (_.PUTFIELD $class field primitive)
+
+ #.None
+ (let [$unboxed (descriptor.class unboxed)]
+ (|>> (_.CHECKCAST $unboxed)
+ (_.PUTFIELD $class field $unboxed))))]]
+ (wrap (|>> objectI
+ (_.CHECKCAST $class)
+ _.DUP
+ valueI
+ putI)))
_
(phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
@@ -709,7 +711,7 @@
(def: (method-return-type description)
(-> Text (Operation Return))
(case description
- (^ (static jvm.void-descriptor))
+ (^ (static descriptor.void))
(phase@wrap #.None)
_
@@ -747,7 +749,8 @@
returnT (method-return-type unboxed)]
(wrap (|>> (_.fuse (list@map ..prepare-argI argsTI))
(_.INVOKESTATIC class method
- (jvm.method (list@map product.left argsTI) returnT (list))
+ (descriptor.method [(list@map product.left argsTI)
+ returnT])
false)
(prepare-returnI returnT)))))]))
@@ -765,7 +768,8 @@
(_.CHECKCAST class)
(_.fuse (list@map ..prepare-argI argsTI))
(<invoke> class method
- (jvm.method (list@map product.left argsTI) returnT (list))
+ (descriptor.method [(list@map product.left argsTI)
+ returnT])
<interface?>)
(prepare-returnI returnT)))))]))]
@@ -784,7 +788,8 @@
_.DUP
(_.fuse (list@map ..prepare-argI argsTI))
(_.INVOKESPECIAL class "<init>"
- (jvm.method (list@map product.left argsTI) #.None (list))
+ (descriptor.method [(list@map product.left argsTI)
+ descriptor.void])
false))))
_
@@ -840,16 +845,24 @@
(class' ..generic))
(def: primitive
- (Parser Primitive)
+ (Parser (Descriptor Primitive))
($_ <>.or
- (<s>.constant! ["" reflection.boolean])
- (<s>.constant! ["" reflection.byte])
- (<s>.constant! ["" reflection.short])
- (<s>.constant! ["" reflection.int])
- (<s>.constant! ["" reflection.long])
- (<s>.constant! ["" reflection.float])
- (<s>.constant! ["" reflection.double])
- (<s>.constant! ["" reflection.char])
+ (<>.after (<s>.constant! ["" reflection.boolean])
+ (<>@wrap descriptor.boolean))
+ (<>.after (<s>.constant! ["" reflection.byte])
+ (<>@wrap descriptor.byte))
+ (<>.after (<s>.constant! ["" reflection.short])
+ (<>@wrap descriptor.short))
+ (<>.after (<s>.constant! ["" reflection.int])
+ (<>@wrap descriptor.int))
+ (<>.after (<s>.constant! ["" reflection.long])
+ (<>@wrap descriptor.long))
+ (<>.after (<s>.constant! ["" reflection.float])
+ (<>@wrap descriptor.float))
+ (<>.after (<s>.constant! ["" reflection.double])
+ (<>@wrap descriptor.double))
+ (<>.after (<s>.constant! ["" reflection.char])
+ (<>@wrap descriptor.char))
))
(def: jvm-type
@@ -879,7 +892,7 @@
(def: return
(Parser Return)
- (<>.or (<s>.constant! ["" jvm.void-descriptor])
+ (<>.or (<s>.constant! ["" (descriptor.descriptor descriptor.void)])
..jvm-type))
(def: overriden-method-definition
@@ -976,13 +989,12 @@
(#synthesis.Extension [name inputsS+])
(#synthesis.Extension [name (list@map recur inputsS+)]))))
-(def: $Object (jvm.class jvm.object-class (list)))
+(def: $Object (descriptor.class "java.lang.Object"))
(def: (anonymous-init-method env)
- (-> Environment Method)
- (jvm.method (list.repeat (list.size env) $Object)
- #.None
- (list)))
+ (-> Environment (Descriptor Method))
+ (descriptor.method [(list.repeat (list.size env) $Object)
+ descriptor.void]))
(def: (with-anonymous-init class env super-class constructor-argsI)
(-> Text Environment Class (List (Typed Inst)) Def)
@@ -999,7 +1011,8 @@
((_.fuse (list@map product.right constructor-argsI)))
(_.INVOKESPECIAL (product.left super-class)
"<init>"
- (jvm.method (list@map product.left constructor-argsI) #.None (list))
+ (descriptor.method [(list@map product.left constructor-argsI)
+ descriptor.void])
#0)
store-capturedI
_.RETURN))))
@@ -1077,10 +1090,11 @@
($_ $.++M $.finalM $.strictM)
$.finalM)
name
- (jvm.method (list@map product.right arguments)
- returnT
- (list@map (|>> #jvm.Class)
- exceptionsT))
+ (descriptor.method [(list@map product.right arguments)
+ returnT]
+ ## (list@map (|>> #jvm.Class)
+ ## exceptionsT)
+ )
(let [returnI (case returnT
(#.Some returnT)
(case returnT
diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.lux
index 5fb0e0d63..8352c7d6f 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/reference.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/reference.lux
@@ -5,6 +5,9 @@
[data
[text
["%" format (#+ format)]]]
+ [target
+ [jvm
+ ["." descriptor]]]
[tool
[compiler
["." name]
@@ -32,9 +35,9 @@
(do phase.monad
[function-class generation.context]
(wrap (|>> (_.ALOAD 0)
- (_.GETFIELD function-class
+ (_.GETFIELD (descriptor.class function-class)
(|> variable .nat foreign-name)
- //.$Object)))))
+ //.$Value)))))
(def: local
(-> Register Inst)
@@ -53,4 +56,4 @@
(-> Name (Operation Inst))
(do phase.monad
[bytecode-name (generation.remember name)]
- (wrap (_.GETSTATIC bytecode-name //.value-field //.$Object))))
+ (wrap (_.GETSTATIC (descriptor.class bytecode-name) //.value-field //.$Value))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
index 05d43a367..755ae7a3b 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- Type)
+ [lux #*
[abstract
[monad (#+ do)]]
[data
@@ -8,7 +8,8 @@
["." math]
[target
[jvm
- ["$t" type (#+ Type Method)]]]
+ ["." descriptor (#+ Descriptor)]
+ ["$t" type]]]
[tool
[compiler
[arity (#+ Arity)]
@@ -23,33 +24,36 @@
["_" inst]]]]]
["." // (#+ ByteCode)])
-(def: $Object Type ($t.class "java.lang.Object" (list)))
-(def: $Object-Array Type ($t.array 1 $Object))
-(def: $String Type ($t.class "java.lang.String" (list)))
-(def: #export $Stack Type ($t.array 1 $Object))
-(def: #export $Tuple Type $Object-Array)
-(def: #export $Variant Type $Object-Array)
-(def: #export $Tag Type $t.int)
-(def: #export $Flag Type $Object)
-(def: #export $Datum Type $Object)
-(def: #export $Function Type ($t.class //.function-class (list)))
-(def: $Throwable Type ($t.class "java.lang.Throwable" (list)))
-(def: $Runtime Type ($t.class "java.lang.Runtime" (list)))
+(def: $Text (descriptor.class "java.lang.String"))
+(def: #export $Tag descriptor.int)
+(def: #export $Flag (descriptor.class "java.lang.Object"))
+(def: #export $Value (descriptor.class "java.lang.Object"))
+(def: #export $Index descriptor.int)
+(def: #export $Stack (descriptor.array $Value))
+(def: $Throwable (descriptor.class "java.lang.Throwable"))
+(def: #export $Runtime (descriptor.class "java.lang.Runtime"))
+
+(def: nullary-init-methodT
+ (descriptor.method [(list) descriptor.void]))
+
+(def: throw-methodT
+ (descriptor.method [(list) descriptor.void]))
(def: #export logI
Inst
- (let [outI (_.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list)))
- printI (function (_ method) (_.INVOKEVIRTUAL "java.io.PrintStream" method ($t.method (list $Object) #.None (list)) #0))]
+ (let [PrintStream (descriptor.class "java.io.PrintStream")
+ outI (_.GETSTATIC (descriptor.class "java.lang.System") "out" PrintStream)
+ printI (function (_ method)
+ (_.INVOKEVIRTUAL PrintStream method (descriptor.method [(list $Value) descriptor.void]) #0))]
(|>> outI (_.string "LOG: ") (printI "print")
outI _.SWAP (printI "println"))))
(def: variant-method
- Method
- ($t.method (list $t.int $Object $Object) (#.Some $Object-Array) (list)))
+ (descriptor.method [(list $Tag $Flag $Value) //.$Variant]))
(def: #export variantI
Inst
- (_.INVOKESTATIC //.runtime-class "variant_make" variant-method #0))
+ (_.INVOKESTATIC (descriptor.class //.runtime-class) "variant_make" variant-method #0))
(def: #export leftI
Inst
@@ -81,7 +85,7 @@
(<| _.with-label (function (_ @from))
_.with-label (function (_ @to))
_.with-label (function (_ @handler))
- (|>> (_.try @from @to @handler "java.lang.Exception")
+ (|>> (_.try @from @to @handler (descriptor.class "java.lang.Exception"))
(_.label @from)
unsafeI
someI
@@ -93,27 +97,25 @@
(def: #export string-concatI
Inst
- (_.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0))
+ (_.INVOKEVIRTUAL $Text "concat" (descriptor.method [(list $Text) $Text]) #0))
(def: #export partials-field Text "partials")
(def: #export apply-method Text "apply")
(def: #export num-apply-variants Nat 8)
(def: #export (apply-signature arity)
- (-> Arity Method)
- ($t.method (list.repeat arity $Object) (#.Some $Object) (list)))
+ (-> Arity (Descriptor descriptor.Method))
+ (descriptor.method [(list.repeat arity $Value) $Value]))
(def: adt-methods
Def
- (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap #$t.Int) _.AASTORE)
+ (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap descriptor.int) _.AASTORE)
store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE)
store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)]
(|>> ($d.method #$.Public $.staticM "variant_make"
- ($t.method (list $t.int $Object $Object)
- (#.Some $Variant)
- (list))
+ (descriptor.method [(list $Tag $Flag $Value) //.$Variant])
(|>> (_.int +3)
- (_.array $Object)
+ (_.array //.$Variant)
store-tagI
store-flagI
store-valueI
@@ -123,22 +125,30 @@
(def: frac-methods
Def
- (|>> ($d.method #$.Public $.staticM "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list))
+ (|>> ($d.method #$.Public $.staticM "decode_frac" (descriptor.method [(list $Text) //.$Variant])
(try-methodI
(|>> (_.ALOAD 0)
- (_.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) #0)
- (_.wrap #$t.Double))))
+ (_.INVOKESTATIC (descriptor.class "java.lang.Double") "parseDouble" (descriptor.method [(list $Text) descriptor.double]) #0)
+ (_.wrap descriptor.double))))
))
(def: #export popI
(|>> (_.int +1)
_.AALOAD
- (_.CHECKCAST ($t.descriptor $Stack))))
+ (_.CHECKCAST $Stack)))
(def: #export peekI
(|>> (_.int +0)
_.AALOAD))
+(def: (illegal-state-exception message)
+ (-> Text Inst)
+ (let [IllegalStateException (descriptor.class "java.lang.IllegalStateException")]
+ (|>> (_.NEW IllegalStateException)
+ _.DUP
+ (_.string message)
+ (_.INVOKESPECIAL IllegalStateException "<init>" (descriptor.method [(list $Text) descriptor.void]) #0))))
+
(def: pm-methods
Def
(let [tuple-sizeI (|>> (_.ALOAD 0) _.ARRAYLENGTH)
@@ -148,27 +158,21 @@
sub-leftsI (|>> leftsI
last-rightI
_.ISUB)
- sub-tupleI (|>> (_.ALOAD 0) last-rightI _.AALOAD (_.CHECKCAST ($t.descriptor $Tuple)))
+ sub-tupleI (|>> (_.ALOAD 0) last-rightI _.AALOAD (_.CHECKCAST //.$Tuple))
recurI (: (-> Label Inst)
(function (_ @loop)
(|>> sub-leftsI (_.ISTORE 1)
sub-tupleI (_.ASTORE 0)
(_.GOTO @loop))))]
- (|>> ($d.method #$.Public $.staticM "pm_fail" ($t.method (list) #.None (list))
- (|>> (_.NEW "java.lang.IllegalStateException")
- _.DUP
- (_.string "Invalid expression for pattern-matching.")
- (_.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0)
+ (|>> ($d.method #$.Public $.staticM "pm_fail" throw-methodT
+ (|>> (illegal-state-exception "Invalid expression for pattern-matching.")
_.ATHROW))
- ($d.method #$.Public $.staticM "apply_fail" ($t.method (list) #.None (list))
- (|>> (_.NEW "java.lang.IllegalStateException")
- _.DUP
- (_.string "Error while applying function.")
- (_.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0)
+ ($d.method #$.Public $.staticM "apply_fail" throw-methodT
+ (|>> (illegal-state-exception "Error while applying function.")
_.ATHROW))
- ($d.method #$.Public $.staticM "pm_push" ($t.method (list $Stack $Object) (#.Some $Stack) (list))
+ ($d.method #$.Public $.staticM "pm_push" (descriptor.method [(list $Stack $Value) $Stack])
(|>> (_.int +2)
- (_.ANEWARRAY "java.lang.Object")
+ (_.ANEWARRAY $Stack)
_.DUP
(_.int +1)
(_.ALOAD 0)
@@ -178,7 +182,7 @@
(_.ALOAD 1)
_.AASTORE
_.ARETURN))
- ($d.method #$.Public $.staticM "pm_variant" ($t.method (list $Variant $Tag $Flag) (#.Some $Object) (list))
+ ($d.method #$.Public $.staticM "pm_variant" (descriptor.method [(list //.$Variant $Tag $Flag) $Value])
(<| _.with-label (function (_ @loop))
_.with-label (function (_ @just-return))
_.with-label (function (_ @then))
@@ -189,7 +193,7 @@
(function (_ idx)
(|>> (_.int (.int idx)) _.AALOAD)))
tagI (: Inst
- (|>> (variant-partI 0) (_.unwrap #$t.Int)))
+ (|>> (variant-partI 0) (_.unwrap descriptor.int)))
flagI (variant-partI 1)
datumI (variant-partI 2)
shortenI (|>> (_.ALOAD 0) tagI ## Get tag
@@ -199,7 +203,7 @@
variantI ## Build sum
_.ARETURN)
update-tagI (|>> _.ISUB (_.ISTORE 1))
- update-variantI (|>> (_.ALOAD 0) datumI (_.CHECKCAST ($t.descriptor $Variant)) (_.ASTORE 0))
+ update-variantI (|>> (_.ALOAD 0) datumI (_.CHECKCAST //.$Variant) (_.ASTORE 0))
failureI (|>> _.NULL _.ARETURN)
return-datumI (|>> (_.ALOAD 0) datumI _.ARETURN)])
(|>> (_.label @loop)
@@ -230,7 +234,7 @@
(_.label @wrong) ## tag, sumT
## _.POP2
failureI)))
- ($d.method #$.Public $.staticM "tuple_left" ($t.method (list $Tuple $t.int) (#.Some $Object) (list))
+ ($d.method #$.Public $.staticM "tuple_left" (descriptor.method [(list //.$Tuple $Index) $Value])
(<| _.with-label (function (_ @loop))
_.with-label (function (_ @recursive))
(let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)])
@@ -241,7 +245,7 @@
(_.label @recursive)
## Recursive
(recurI @loop))))
- ($d.method #$.Public $.staticM "tuple_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list))
+ ($d.method #$.Public $.staticM "tuple_right" (descriptor.method [(list //.$Tuple $Index) $Value])
(<| _.with-label (function (_ @loop))
_.with-label (function (_ @not-tail))
_.with-label (function (_ @slice))
@@ -254,10 +258,9 @@
sub-rightI (|>> (_.ALOAD 0)
right-indexI
tuple-sizeI
- (_.INVOKESTATIC "java.util.Arrays" "copyOfRange"
- ($t.method (list $Object-Array $t.int $t.int)
- (#.Some $Object-Array)
- (list))
+ (_.INVOKESTATIC (descriptor.class "java.util.Arrays") "copyOfRange"
+ (descriptor.method [(list //.$Tuple $Index $Index)
+ //.$Tuple])
#0))])
(|>> (_.label @loop)
last-rightI right-indexI
@@ -277,26 +280,28 @@
(def: io-methods
Def
- (let [string-writerI (|>> (_.NEW "java.io.StringWriter")
+ (let [StringWriter (descriptor.class "java.io.StringWriter")
+ PrintWriter (descriptor.class "java.io.PrintWriter")
+ string-writerI (|>> (_.NEW StringWriter)
_.DUP
- (_.INVOKESPECIAL "java.io.StringWriter" "<init>" ($t.method (list) #.None (list)) #0))
- print-writerI (|>> (_.NEW "java.io.PrintWriter")
+ (_.INVOKESPECIAL StringWriter "<init>" nullary-init-methodT #0))
+ print-writerI (|>> (_.NEW PrintWriter)
_.SWAP
_.DUP2
_.POP
_.SWAP
- (_.boolean #1)
- (_.INVOKESPECIAL "java.io.PrintWriter" "<init>" ($t.method (list ($t.class "java.io.Writer" (list)) $t.boolean) #.None (list)) #0)
+ (_.boolean true)
+ (_.INVOKESPECIAL PrintWriter "<init>" (descriptor.method [(list (descriptor.class "java.io.Writer") descriptor.boolean) descriptor.void]) #0)
)]
- (|>> ($d.method #$.Public $.staticM "try" ($t.method (list $Function) (#.Some $Variant) (list))
+ (|>> ($d.method #$.Public $.staticM "try" (descriptor.method [(list //.$Function) //.$Variant])
(<| _.with-label (function (_ @from))
_.with-label (function (_ @to))
_.with-label (function (_ @handler))
- (|>> (_.try @from @to @handler "java.lang.Throwable")
+ (|>> (_.try @from @to @handler $Throwable)
(_.label @from)
(_.ALOAD 0)
_.NULL
- (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature 1) #0)
+ (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature 1) #0)
rightI
_.ARETURN
(_.label @to)
@@ -304,8 +309,8 @@
string-writerI ## TW
_.DUP2 ## TWTW
print-writerI ## TWTP
- (_.INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t.method (list ($t.class "java.io.PrintWriter" (list))) #.None (list)) #0) ## TW
- (_.INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t.method (list) (#.Some $String) (list)) #0) ## TS
+ (_.INVOKEVIRTUAL $Throwable "printStackTrace" (descriptor.method [(list (descriptor.class "java.io.PrintWriter")) descriptor.void]) #0) ## TW
+ (_.INVOKEVIRTUAL StringWriter "toString" (descriptor.method [(list) $Text]) #0) ## TS
_.SWAP _.POP leftI
_.ARETURN)))
)))
@@ -330,21 +335,21 @@
(list/map _.ALOAD)
_.fuse)]
(|>> preI
- (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature (dec arity)) #0)
- (_.CHECKCAST //.function-class)
+ (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature (dec arity)) #0)
+ (_.CHECKCAST //.$Function)
(_.ALOAD arity)
- (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature 1) #0)
+ (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature 1) #0)
_.ARETURN)))))
(list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature 1)))
$d.fuse)
bytecode ($d.abstract #$.V1_6 #$.Public $.noneC //.function-class (list) ["java.lang.Object" (list)] (list)
- (|>> ($d.field #$.Public $.finalF partials-field $t.int)
- ($d.method #$.Public $.noneM "<init>" ($t.method (list $t.int) #.None (list))
+ (|>> ($d.field #$.Public $.finalF partials-field descriptor.int)
+ ($d.method #$.Public $.noneM "<init>" (descriptor.method [(list descriptor.int) descriptor.void])
(|>> (_.ALOAD 0)
- (_.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0)
+ (_.INVOKESPECIAL (descriptor.class "java.lang.Object") "<init>" nullary-init-methodT #0)
(_.ALOAD 0)
(_.ILOAD 1)
- (_.PUTFIELD //.function-class partials-field $t.int)
+ (_.PUTFIELD //.$Function partials-field descriptor.int)
_.RETURN))
applyI))]
(do phase.monad
diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.lux
index 5e721f65a..92bf41256 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/structure.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/structure.lux
@@ -13,6 +13,7 @@
["." list]]]
[target
[jvm
+ ["." descriptor]
["$t" type (#+ Type)]]]
[tool
[compiler
@@ -23,14 +24,13 @@
[host
[jvm (#+ Inst Operation Phase)
["_" inst]]]]]
- ["." //])
+ ["." //
+ ["#." runtime]])
(exception: #export (not-a-tuple {size Nat})
(ex.report ["Expected size" ">= 2"]
["Actual size" (%.nat size)]))
-(def: $Object ($t.class "java.lang.Object" (list)))
-
(def: #export (tuple generate members)
(-> Phase (List Synthesis) (Operation Inst))
(do phase.monad
@@ -48,7 +48,7 @@
_.AASTORE)))))
(:: @ map _.fuse))]
(wrap (|>> (_.int (.int size))
- (_.array $Object)
+ (_.array //runtime.$Value)
membersI))))
(def: (flagI right?)
@@ -66,9 +66,8 @@
lefts)))
(flagI right?)
memberI
- (_.INVOKESTATIC //.runtime-class
+ (_.INVOKESTATIC (descriptor.class //.runtime-class)
"variant_make"
- ($t.method (list $t.int $Object $Object)
- (#.Some ($t.array 1 $Object))
- (list))
+ (descriptor.method [(list //runtime.$Tag //runtime.$Flag //runtime.$Value)
+ //.$Variant])
#0)))))
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index 2ec090903..1311392a9 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -6,10 +6,10 @@
[monad (#+ do)]]
[control
["." io (#+ IO)]
+ ["." try (#+ Try)]
[parser
[cli (#+ program:)]]]
[data
- ["." error (#+ Error)]
[collection
[array (#+ Array)]
["." dictionary]]]
@@ -67,12 +67,12 @@
(def: #export (expander macro inputs lux)
Expander
- (do error.monad
+ (do try.monad
[apply-method (|> macro
(:coerce java/lang/Object)
(java/lang/Object::getClass)
(java/lang/Class::getMethod "apply" _apply-args))]
- (:coerce (Error (Error [Lux (List Code)]))
+ (:coerce (Try (Try [Lux (List Code)]))
(java/lang/reflect/Method::invoke
(:coerce java/lang/Object macro)
(|> (host.array java/lang/Object 2)
diff --git a/stdlib/source/lux/abstract/monad.lux b/stdlib/source/lux/abstract/monad.lux
index 2d086fcf3..f0444a4cf 100644
--- a/stdlib/source/lux/abstract/monad.lux
+++ b/stdlib/source/lux/abstract/monad.lux
@@ -155,12 +155,3 @@
(do monad
[init' (f x init)]
(fold monad f init' xs'))))
-
-(def: #export (lift monad f)
- {#.doc "Lift a normal function into the space of monads."}
- (All [M a b]
- (-> (Monad M) (-> a b) (-> (M a) (M b))))
- (function (_ ma)
- (do monad
- [a ma]
- (wrap (f a)))))
diff --git a/stdlib/source/lux/control/try.lux b/stdlib/source/lux/control/try.lux
index e4e4cae4a..20d4dcab7 100644
--- a/stdlib/source/lux/control/try.lux
+++ b/stdlib/source/lux/control/try.lux
@@ -76,7 +76,7 @@
(def: #export (lift monad)
(All [M a] (-> (Monad M) (-> (M a) (M (Try a)))))
- (monad.lift monad (:: ..monad wrap)))
+ (:: monad map (:: ..monad wrap)))
(structure: #export (equivalence (^open ",@."))
(All [a] (-> (Equivalence a) (Equivalence (Try a))))
diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux
index cec488e95..dd8e3f09b 100644
--- a/stdlib/source/lux/data/collection/list.lux
+++ b/stdlib/source/lux/data/collection/list.lux
@@ -563,7 +563,7 @@
(def: #export (lift monad)
(All [M a] (-> (Monad M) (-> (M a) (M (List a)))))
- (monad.lift monad (:: ..monad wrap)))
+ (:: monad map (:: ..monad wrap)))
(def: (enumerate' idx xs)
(All [a] (-> Nat (List a) (List [Nat a])))
diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux
index 3ba5e87e9..3a8bc8497 100644
--- a/stdlib/source/lux/data/maybe.lux
+++ b/stdlib/source/lux/data/maybe.lux
@@ -84,7 +84,7 @@
(def: #export (lift monad)
(All [M a] (-> (Monad M) (-> (M a) (M (Maybe a)))))
- (monad.lift monad (:: ..monad wrap)))
+ (:: monad map (:: ..monad wrap)))
(macro: #export (default tokens state)
{#.doc (doc "Allows you to provide a default value that will be used"
diff --git a/stdlib/source/lux/target/jvm/attribute/constant.lux b/stdlib/source/lux/target/jvm/attribute/constant.lux
index dd8c7c395..debf07abe 100644
--- a/stdlib/source/lux/target/jvm/attribute/constant.lux
+++ b/stdlib/source/lux/target/jvm/attribute/constant.lux
@@ -12,7 +12,7 @@
["#." unsigned (#+ U2 U4)]]])
(type: #export Constant
- (Index (Value Any)))
+ (Index Value))
(def: #export equivalence
(Equivalence Constant)
diff --git a/stdlib/source/lux/target/jvm/descriptor.lux b/stdlib/source/lux/target/jvm/descriptor.lux
index 267835e1b..5452c16c7 100644
--- a/stdlib/source/lux/target/jvm/descriptor.lux
+++ b/stdlib/source/lux/target/jvm/descriptor.lux
@@ -1,7 +1,12 @@
(.module:
[lux (#- int char)
+ [abstract
+ [equivalence (#+ Equivalence)]]
[data
- ["." text
+ ["." maybe]
+ [number
+ ["n" nat]]
+ ["." text ("#@." equivalence)
["%" format (#+ format)]]
[collection
["." list ("#@." functor)]]]
@@ -25,53 +30,65 @@
Text
- (type: #export (Value kind) (Return (Value' kind)))
+ (type: #export Value (<| Return Value' Any))
(type: #export Void (Return Void'))
- (type: #export Field (Value Any))
+ (type: #export Field Value)
- (template [<refined>]
- [(with-expansions [<raw> (template.identifier [<refined> "'"])]
+ (abstract: #export (Object' brand) {} Any)
+ (type: #export Object (<| Return Value' Object' Any))
+
+ (template [<parents> <child>]
+ [(with-expansions [<raw> (template.identifier [<child> "'"])]
(abstract: #export <raw> {} Any)
- (type: #export <refined> (Value <raw>)))]
+ (type: #export <child>
+ (`` (<| Return Value' (~~ (template.splice <parents>)) <raw>))))]
- [Primitive]
- [Object]
- [Array]
+ [[] Primitive]
+ [[Object'] Class]
+ [[Object'] Array]
)
- (template [<sigil> <name> <kind>]
+ (template [<sigil> <kind> <name>]
[(def: #export <name>
(Descriptor <kind>)
(:abstraction <sigil>))]
- ["Z" boolean Primitive]
- ["B" byte Primitive]
- ["S" short Primitive]
- ["I" int Primitive]
- ["J" long Primitive]
- ["F" float Primitive]
- ["D" double Primitive]
- ["C" char Primitive]
- ["V" void Void]
+ ["Z" Primitive boolean]
+ ["B" Primitive byte]
+ ["S" Primitive short]
+ ["I" Primitive int]
+ ["J" Primitive long]
+ ["F" Primitive float]
+ ["D" Primitive double]
+ ["C" Primitive char]
+ ["V" Void void]
)
- (def: #export object
- (-> External (Descriptor Object))
+ (def: class-prefix "L")
+ (def: class-suffix ";")
+
+ (def: #export class
+ (-> External (Descriptor Class))
(|>> //name.internal
//name.read
- (text.enclose ["L" ";"])
+ (text.enclose [..class-prefix ..class-suffix])
:abstraction))
+ (def: #export var (..class "java.lang.Object"))
+ (def: #export wildcard (..class "java.lang.Object"))
+
+ (def: array-prefix "[")
+
(def: #export array
- (-> (Descriptor (Value Any))
+ (-> (Descriptor Value)
(Descriptor Array))
(|>> :representation
- (format "[")
+ (format ..array-prefix)
:abstraction))
(def: #export (method [inputs output])
- (-> [(List (Descriptor (Value Any)))
+ (-> [(List (Descriptor Value))
(Descriptor (Return Any))]
(Descriptor Method))
(:abstraction
@@ -84,4 +101,54 @@
(def: #export descriptor
(-> (Descriptor Any) Text)
(|>> :representation))
+
+ (structure: #export equivalence (All [brand] (Equivalence (Descriptor brand)))
+ (def: (= parameter subject)
+ (text@= (:representation parameter) (:representation subject))))
+
+ (def: #export (primitive? descriptor)
+ (-> (Descriptor Value) (Either (Descriptor Object)
+ (Descriptor Primitive)))
+ (if (`` (or (~~ (template [<descriptor>]
+ [(:: ..equivalence = <descriptor> descriptor)]
+
+ [..boolean]
+ [..byte]
+ [..short]
+ [..int]
+ [..long]
+ [..float]
+ [..double]
+ [..char]))))
+ (|> descriptor :transmutation #.Right)
+ (|> descriptor :transmutation #.Left)))
+
+ (def: #export (class? descriptor)
+ (-> (Descriptor Value) (Maybe Text))
+ (let [repr (:representation descriptor)]
+ (if (and (text.starts-with? ..class-prefix repr)
+ (text.ends-with? ..class-suffix repr))
+ (:: maybe.monad map
+ (|>> //name.internal //name.external)
+ (text.clip (text.size ..class-prefix)
+ (n.- (text.size ..class-suffix)
+ (text.size repr))
+ repr))
+ #.None)))
+
+ (def: #export class-name
+ (-> (Descriptor Object) Text)
+ (let [prefix-size (text.size ..class-prefix)
+ suffix-size (text.size ..class-suffix)]
+ (function (_ descriptor)
+ (let [repr (:representation descriptor)]
+ (if (text.starts-with? ..array-prefix repr)
+ repr
+ (|> repr
+ (text.clip prefix-size
+ (n.- suffix-size
+ (text.size repr)))
+ (:: maybe.monad map
+ (|>> //name.internal //name.external))
+ maybe.assume))))))
)
diff --git a/stdlib/source/lux/target/jvm/field.lux b/stdlib/source/lux/target/jvm/field.lux
index a2cc35f45..b6dc1b946 100644
--- a/stdlib/source/lux/target/jvm/field.lux
+++ b/stdlib/source/lux/target/jvm/field.lux
@@ -26,7 +26,7 @@
(type: #export #rec Field
{#modifier (Modifier Field)
#name (Index UTF8)
- #descriptor (Index (Descriptor (Value Any)))
+ #descriptor (Index (Descriptor Value))
#attributes (Row Attribute)})
(modifiers: Field
@@ -62,7 +62,7 @@
)))
(def: #export (field modifier name descriptor attributes)
- (-> (Modifier Field) UTF8 (Descriptor (Value Any)) (Row Attribute)
+ (-> (Modifier Field) UTF8 (Descriptor Value) (Row Attribute)
(State Pool Field))
(do state.monad
[@name (//constant/pool.utf8 name)
diff --git a/stdlib/source/lux/target/jvm/instruction.lux b/stdlib/source/lux/target/jvm/instruction.lux
index 628079110..36fa103dd 100644
--- a/stdlib/source/lux/target/jvm/instruction.lux
+++ b/stdlib/source/lux/target/jvm/instruction.lux
@@ -541,7 +541,7 @@
(template [<static?> <name> <bytecode>]
[(def: #export (<name> class method [inputs output])
- (-> External Text [(List (Descriptor (Value Any))) (Descriptor (Return Any))] (Instruction Any))
+ (-> External Text [(List (Descriptor Value)) (Descriptor (Return Any))] (Instruction Any))
(do ..monad
[index (<| ..lift
(//constant/pool.method class)
diff --git a/stdlib/source/lux/target/jvm/reflection.lux b/stdlib/source/lux/target/jvm/reflection.lux
index 89f759dcb..e6ee7e630 100644
--- a/stdlib/source/lux/target/jvm/reflection.lux
+++ b/stdlib/source/lux/target/jvm/reflection.lux
@@ -18,7 +18,9 @@
["." list ("#@." fold functor)]
["." array]
["." dictionary]]]]
- [//
+ ["." // #_
+ [encoding
+ ["#." name]]
["/" type
["#." lux (#+ Mapping)]
["." reflection]]])
@@ -205,7 +207,7 @@
class-name
(if (text.starts-with? /.array-prefix class-name)
- (<t>.run /.parse-signature (/.binary-name class-name))
+ (<t>.run /.parse-signature (|> class-name //name.internal //name.read))
(#try.Success (/.class class-name (list)))))
_)
(case (host.check java/lang/reflect/GenericArrayType reflection)
diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux
index fffac9b6e..4601003a8 100644
--- a/stdlib/source/lux/target/jvm/type.lux
+++ b/stdlib/source/lux/target/jvm/type.lux
@@ -12,7 +12,10 @@
["." text ("#@." equivalence)
["%" format (#+ format)]]
[collection
- ["." list ("#@." functor)]]]])
+ ["." list ("#@." functor)]]]]
+ ["." // #_
+ [encoding
+ ["#." name]]])
(template [<descriptor> <definition>]
[(def: #export <definition> <descriptor>)]
@@ -31,7 +34,7 @@
(def: #export array-prefix "[")
(def: object-prefix "L")
(def: var-prefix "T")
-(def: wildcard-descriptor "*")
+(def: wildcard-signature "*")
(def: lower-prefix "-")
(def: upper-prefix "+")
(def: object-suffix ";")
@@ -46,14 +49,11 @@
(format valid-var-characters/head
"0123456789"))
-(def: syntax-package-separator ".")
-(def: binary-package-separator "/")
-
(def: valid-class-characters/head
- (format valid-var-characters/head ..binary-package-separator))
+ (format valid-var-characters/head //name.internal-separator))
(def: valid-class-characters/tail
- (format valid-var-characters/tail ..binary-package-separator))
+ (format valid-var-characters/tail //name.internal-separator))
(type: #export Bound
#Lower
@@ -210,59 +210,6 @@
0 elemT
_ (#Array (array (dec depth) elemT))))
-(template [<name> <from> <to>]
- [(def: #export <name>
- (-> Text Text)
- (text.replace-all <from> <to>))]
-
- [binary-name ..syntax-package-separator ..binary-package-separator]
- [syntax-name ..binary-package-separator ..syntax-package-separator]
- )
-
-(def: #export (descriptor type)
- (-> Type Text)
- (case type
- (#Primitive prim)
- (case prim
- #Boolean ..boolean-descriptor
- #Byte ..byte-descriptor
- #Short ..short-descriptor
- #Int ..int-descriptor
- #Long ..long-descriptor
- #Float ..float-descriptor
- #Double ..double-descriptor
- #Char ..char-descriptor)
-
- (#Array sub)
- (format ..array-prefix (descriptor sub))
-
- (#Generic generic)
- (case generic
- (#Class class params)
- (format ..object-prefix (binary-name class) ..object-suffix)
-
- (^or (#Var name) (#Wildcard ?bound))
- (descriptor (#Generic (#Class ..object-class (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 ..object-class))
- ))
-
(def: #export (signature type)
(-> Type Text)
(case type
@@ -290,13 +237,13 @@
(list@map (|>> #Generic signature))
(text.join-with ""))
">"))]
- (format ..object-prefix (binary-name class) =params ..object-suffix))
+ (format ..object-prefix (|> class //name.internal //name.read) =params ..object-suffix))
(#Var name)
(format ..var-prefix name ..object-suffix)
(#Wildcard #.None)
- ..wildcard-descriptor
+ ..wildcard-signature
(^template [<tag> <prefix>]
(#Wildcard (#.Some [<tag> bound]))
@@ -312,7 +259,7 @@
(<t>.slice (<t>.and! (<t>.one-of! <head>)
(<t>.some! (<t>.one-of! <tail>))))))]
- [parse-class-name valid-class-characters/head valid-class-characters/tail ..syntax-name]
+ [parse-class-name valid-class-characters/head valid-class-characters/tail (|>> //name.internal //name.external)]
[parse-var-name valid-var-characters/head valid-var-characters/tail function.identity]
)
@@ -335,7 +282,7 @@
($_ <>.or
..parse-var
($_ <>.or
- (<t>.this ..wildcard-descriptor)
+ (<t>.this ..wildcard-signature)
(<>.and ..parse-bound recur)
)
(|> (<>.and ..parse-class-name
@@ -371,22 +318,12 @@
(-> (List Type) (Maybe Type) (List Generic) Method)
{#args args #return return #exceptions exceptions})
-(def: method-args
- (text.enclose ["(" ")"]))
-
-(def: #export (method-descriptor method)
- (-> Method Text)
- (format (|> (get@ #args method) (list@map descriptor) (text.join-with "") ..method-args)
- (case (get@ #return method)
- #.None
- ..void-descriptor
-
- (#.Some return)
- (descriptor return))))
-
(def: #export (method-signature method)
(-> Method Text)
- (format (|> (get@ #args method) (list@map signature) (text.join-with "") ..method-args)
+ (format (|> (get@ #args method)
+ (list@map signature)
+ (text.join-with "")
+ (text.enclose ["(" ")"]))
(case (get@ #return method)
#.None
..void-descriptor
diff --git a/stdlib/source/lux/target/jvm/type/lux.lux b/stdlib/source/lux/target/jvm/type/lux.lux
index cc207e1d6..1ebf4b74e 100644
--- a/stdlib/source/lux/target/jvm/type/lux.lux
+++ b/stdlib/source/lux/target/jvm/type/lux.lux
@@ -14,7 +14,10 @@
abstract
["." check (#+ Check) ("#@." monad)]]]
["." //
- ["#." reflection]])
+ ["#." reflection]
+ ["/#" // #_
+ [encoding
+ ["#." name]]]])
(template [<name>]
[(abstract: #export (<name> class) {} Any)]
@@ -95,12 +98,12 @@
(#//.Array elementT)
(case elementT
(#//.Primitive primitive)
- (check@wrap (#.Primitive (//.descriptor input) #.Nil))
+ (check@wrap (#.Primitive (|> input //reflection.class ///name.internal ///name.read) #.Nil))
_
- (do check.monad
- [elementT (type mapping elementT)]
- (wrap (.type (Array elementT)))))))
+ (:: check.monad map
+ (|>> Array .type)
+ (type mapping elementT)))))
(def: #export (return mapping input)
(-> Mapping //.Return (Check Type))
diff --git a/stdlib/source/lux/target/jvm/type/reflection.lux b/stdlib/source/lux/target/jvm/type/reflection.lux
index 6526256b7..b74a4ea30 100644
--- a/stdlib/source/lux/target/jvm/type/reflection.lux
+++ b/stdlib/source/lux/target/jvm/type/reflection.lux
@@ -1,5 +1,8 @@
(.module:
- [lux (#- int char)]
+ [lux (#- int char)
+ [data
+ [text
+ ["%" format (#+ format)]]]]
["." //])
(template [<name> <reflection>]
@@ -31,12 +34,12 @@
#//.Char ..char)
(#//.Array sub)
- (//.syntax-name (//.descriptor type))
+ (|> sub class (format //.array-prefix))
(#//.Generic generic)
(case generic
- (#//.Class class params)
- (//.syntax-name class)
+ (#//.Class name params)
+ name
(^or (#//.Var name)
(#//.Wildcard #.None)
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
index 85d7524f9..af85ebf1c 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
@@ -281,7 +281,7 @@
(^ (list arrayC))
(do ////.monad
[_ (typeA.infer ..int)
- arrayA (typeA.with-type (#.Primitive (jvm.descriptor (jvm.array 1 primitive-type)) (list))
+ arrayA (typeA.with-type (#.Primitive (reflection.class (jvm.array 1 primitive-type)) (list))
(analyse arrayC))]
(wrap (#/////analysis.Extension extension-name (list arrayA))))
@@ -315,7 +315,7 @@
(do ////.monad
[lengthA (typeA.with-type ..int
(analyse lengthC))
- _ (typeA.infer (#.Primitive (jvm.descriptor (jvm.array 1 primitive-type)) (list)))]
+ _ (typeA.infer (#.Primitive (reflection.class (jvm.array 1 primitive-type)) (list)))]
(wrap (#/////analysis.Extension extension-name (list lengthA))))
_
@@ -415,7 +415,7 @@
(-> .Type (Operation Text))
(if (is? .Any type)
(////@wrap jvm.void-descriptor)
- (////@map jvm.descriptor (check-jvm type))))
+ (////@map reflection.class (check-jvm type))))
(def: (read-primitive-array-handler lux-type jvm-type)
(-> .Type Type Handler)
@@ -426,7 +426,7 @@
[_ (typeA.infer lux-type)
idxA (typeA.with-type ..int
(analyse idxC))
- arrayA (typeA.with-type (#.Primitive (jvm.descriptor (jvm.array 1 jvm-type)) (list))
+ arrayA (typeA.with-type (#.Primitive (reflection.class (jvm.array 1 jvm-type)) (list))
(analyse arrayC))]
(wrap (#/////analysis.Extension extension-name (list idxA arrayA))))
@@ -458,7 +458,7 @@
(def: (write-primitive-array-handler lux-type jvm-type)
(-> .Type Type Handler)
- (let [array-type (#.Primitive (jvm.descriptor (jvm.array 1 jvm-type)) (list))]
+ (let [array-type (#.Primitive (reflection.class (jvm.array 1 jvm-type)) (list))]
(function (_ extension-name analyse args)
(case args
(^ (list idxC valueC arrayC))
@@ -924,7 +924,7 @@
[parameters (|> (java/lang/reflect/Method::getGenericParameterTypes method)
array.to-list
(monad.map try.monad reflection!.type)
- (:: try.monad map (list@map jvm.descriptor))
+ (:: try.monad map (list@map reflection.class))
////.lift)
#let [modifiers (java/lang/reflect/Method::getModifiers method)
correct-class? (java/lang/Object::equals class (java/lang/reflect/Method::getDeclaringClass method))
@@ -961,7 +961,7 @@
[parameters (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor)
array.to-list
(monad.map try.monad reflection!.type)
- (:: try.monad map (list@map jvm.descriptor))
+ (:: try.monad map (list@map reflection.class))
////.lift)]
(wrap (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor))
(n.= (list.size arg-classes) (list.size parameters))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/foreign.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/foreign.lux
index b4fa6727e..91e06c383 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/foreign.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/foreign.lux
@@ -20,7 +20,7 @@
[analysis (#+ Environment)]]]])
(def: #export (closure environment)
- (-> Environment (List (Descriptor (Value Any))))
+ (-> Environment (List (Descriptor Value)))
(list.repeat (list.size environment) ////value.type))
(def: #export fields
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux
index 3971610ff..d2f2b9380 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux
@@ -27,7 +27,7 @@
(def: #export name "apply")
(def: #export (type arity)
- (-> Arity [(List (Descriptor (Value Any))) (Descriptor (Return Any))])
+ (-> Arity [(List (Descriptor Value)) (Descriptor (Return Any))])
[(list.repeat arity ////value.type)
////value.type])
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux
index 0489b8f12..5a53ff9e0 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux
@@ -14,7 +14,7 @@
["." arity (#+ Arity)]]]])
(def: #export type
- [(List (Descriptor (Value Any)))
+ [(List (Descriptor Value))
(Descriptor (Return Any))]
[(list ///arity.type) descriptor.void])
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux
index c0bf6e44b..7196d60fd 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux
@@ -38,11 +38,11 @@
["." phase]]]]])
(def: (arguments arity)
- (-> Arity (List (Descriptor (Value Any))))
+ (-> Arity (List (Descriptor Value)))
(list.repeat (dec arity) ////value.type))
(def: #export (type environment arity)
- (-> Environment Arity [(List (Descriptor (Value Any)))
+ (-> Environment Arity [(List (Descriptor Value))
(Descriptor (Return Any))])
[(list@compose (///field/foreign.closure environment)
(if (arity.multiary? arity)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux
index 7aee9e428..df9ea0ae8 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux
@@ -35,7 +35,7 @@
(def: #export type
(-> External (Descriptor descriptor.Method))
- (|>> descriptor.object [(list)] descriptor.method))
+ (|>> descriptor.class [(list)] descriptor.method))
(def: #export (method class environment arity)
(-> External Environment Arity (State Pool Method))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux
index 27a02d7b4..d2d51d992 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux
@@ -16,7 +16,7 @@
(-> Bit (Instruction Any))
(_.getstatic "java.lang.Boolean"
(if value "TRUE" "FALSE")
- (|.object "java.lang.Boolean")))
+ (|.class "java.lang.Boolean")))
(template [<name> <inputT> <ldc> <class> <inputD>]
[(def: #export (<name> value)
@@ -25,7 +25,7 @@
[_ (`` (|> value (~~ (template.splice <ldc>))))]
(_.invokestatic <class> "valueOf"
[(list <inputD>)
- (|.object <class>)])))]
+ (|.class <class>)])))]
[i64 (I64 Any) [.int constant.long _.ldc/long] "java.lang.Long" |.long]
[f64 Frac [constant.double _.ldc/double] "java.lang.Double" |.double]
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux
index 8b2c6c270..380040fa5 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux
@@ -57,7 +57,7 @@
..unitG
_.aconst-null))
-(def: $Object (|.object "java.lang.Object"))
+(def: $Object (|.class "java.lang.Object"))
(def: #export (variant generate [lefts right? valueS])
(Generator (Variant Synthesis))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux
index a598b9997..c0634ac25 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux
@@ -6,4 +6,4 @@
(def: #export field "_value")
-(def: #export type (Descriptor (Value Any)) (descriptor.object "java.lang.Object"))
+(def: #export type (descriptor.class "java.lang.Object"))
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 4dd3ee4b3..9437fb38a 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -75,7 +75,7 @@
(#static TYPE (java/lang/Class java/lang/Long)))
(def: descriptor
- (Random (Descriptor (Value Any)))
+ (Random (Descriptor Value))
(random.rec
(function (_ descriptor)
($_ random.either
@@ -87,13 +87,13 @@
(random@wrap /descriptor.float)
(random@wrap /descriptor.double)
(random@wrap /descriptor.char)
- (random@map (|>> (text.join-with /name.external-separator) /descriptor.object)
+ (random@map (|>> (text.join-with /name.external-separator) /descriptor.class)
(random.list 3 (random.ascii/upper-alpha 10)))
(random@map /descriptor.array descriptor)
))))
(def: field
- (Random [Text (Descriptor (Value Any))])
+ (Random [Text (Descriptor Value)])
($_ random.and
(random.ascii/lower-alpha 10)
..descriptor
@@ -120,7 +120,7 @@
method-name (random.ascii/upper-alpha 10)
expected random.int
#let [inputsJT (list)
- outputJT (/descriptor.object "java.lang.Object")]]
+ outputJT (/descriptor.class "java.lang.Object")]]
(_.test "Can compile a method."
(let [bytecode (|> (/class.class /version.v6_0 /class.public
(/name.internal class-name)
@@ -137,7 +137,7 @@
[_ (/instruction.ldc/long (/constant.long expected))
_ (/instruction.invokestatic "java.lang.Long" "valueOf"
[(list /descriptor.long)
- (/descriptor.object "java.lang.Long")])]
+ (/descriptor.class "java.lang.Long")])]
/instruction.areturn)))
(row.row))
(binaryF.run /class.writer))