diff options
Diffstat (limited to 'new-luxc/source/luxc/lang')
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm.lux | 47 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/def.lux | 38 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/inst.lux | 74 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/type.lux | 154 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm.lux | 41 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/case.lux | 32 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/function.lux | 16 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/primitive.lux | 16 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux | 70 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux | 112 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/reference.lux | 7 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/runtime.lux | 38 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/structure.lux | 10 |
13 files changed, 242 insertions, 413 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux index 01ec36624..4966038c6 100644 --- a/new-luxc/source/luxc/lang/host/jvm.lux +++ b/new-luxc/source/luxc/lang/host/jvm.lux @@ -1,5 +1,6 @@ (.module: - [lux (#- Type Definition) + [lux (#- Definition) + [host (#+ import:)] [abstract monad] [control @@ -11,16 +12,17 @@ [macro ["." code] [syntax (#+ syntax:)]] - [host (#+ import:)] [world [binary (#+ Binary)]] + [target + [jvm + [type (#+ Class)]]] [tool [compiler [reference (#+ Register)] [phase ["." generation]]]]]) -## [Host] (import: org/objectweb/asm/MethodVisitor) (import: org/objectweb/asm/ClassWriter) @@ -28,42 +30,6 @@ (import: #long org/objectweb/asm/Label (new [])) -## [Type] -(type: #export Bound - #Upper - #Lower) - -(type: #export Primitive - #Boolean - #Byte - #Short - #Int - #Long - #Float - #Double - #Char) - -(type: #export #rec Generic - (#Var Text) - (#Wildcard (Maybe [Bound Generic])) - (#Class Text (List Generic))) - -(type: #export Class - [Text (List Generic)]) - -(type: #export Parameter - [Text Class (List Class)]) - -(type: #export #rec Type - (#Primitive Primitive) - (#Generic Generic) - (#Array Type)) - -(type: #export Method - {#args (List Type) - #return (Maybe Type) - #exceptions (List Generic)}) - (type: #export Def (-> ClassWriter ClassWriter)) @@ -109,7 +75,6 @@ [Bundle generation.Bundle] ) -## [Values] (syntax: (config: {type s.local-identifier} {none s.local-identifier} {++ s.local-identifier} @@ -145,12 +110,10 @@ g!options+)))) -## Configs (config: Class-Config noneC ++C [finalC]) (config: Method-Config noneM ++M [finalM staticM synchronizedM strictM]) (config: Field-Config noneF ++F [finalF staticF transientF volatileF]) -## Labels (def: #export new-label (-> Any Label) (function (_ _) diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux index 012d7ceee..06e6963a3 100644 --- a/new-luxc/source/luxc/lang/host/jvm/def.lux +++ b/new-luxc/source/luxc/lang/host/jvm/def.lux @@ -1,5 +1,6 @@ (.module: - [lux #* + [lux (#- Type) + ["." host (#+ import: do-to)] [control ["." function]] [data @@ -9,9 +10,10 @@ [collection ["." array (#+ Array)] ["." list ("#/." functor)]]] - ["." host (#+ import: do-to)]] - ["$" // - ["$t" type]]) + [target + [jvm + ["$t" type (#+ Method Class Type Parameter)]]]] + ["$" //]) (import: #long java/lang/Object) (import: #long java/lang/String) @@ -70,9 +72,9 @@ output))) (def: exceptions-array - (-> $.Method (Array Text)) - (|>> (get@ #$.exceptions) - (list/map (|>> #$.Generic $t.descriptor)) + (-> Method (Array Text)) + (|>> (get@ #$t.exceptions) + (list/map (|>> #$t.Generic $t.descriptor)) string-array)) (def: (version-flag version) @@ -117,15 +119,15 @@ (if (get@ #$.volatileF config) (Opcodes::ACC_VOLATILE) +0))) (def: class-to-type - (-> $.Class $.Type) - (|>> #$.Class #$.Generic)) + (-> Class Type) + (|>> #$t.Class #$t.Generic)) (def: param-signature - (-> $.Class Text) + (-> Class Text) (|>> class-to-type $t.signature (format ":"))) (def: (formal-param [name super interfaces]) - (-> $.Parameter Text) + (-> Parameter Text) (format name (param-signature super) (|> interfaces @@ -133,7 +135,7 @@ (text.join-with "")))) (def: (parameters-signature parameters super interfaces) - (-> (List $.Parameter) $.Class (List $.Class) + (-> (List Parameter) Class (List Class) Text) (let [formal-params (if (list.empty? parameters) "" @@ -158,7 +160,7 @@ (template [<name> <flag>] [(def: #export (<name> version visibility config name parameters super interfaces definitions) - (-> $.Version $.Visibility $.Class-Config Text (List $.Parameter) $.Class (List $.Class) $.Def + (-> $.Version $.Visibility $.Class-Config Text (List Parameter) Class (List Class) $.Def (host.type (Array byte))) (let [writer (|> (do-to (ClassWriter::new class-computes) (ClassWriter::visit (version-flag version) @@ -181,11 +183,11 @@ [abstract (Opcodes::ACC_ABSTRACT)] ) -(def: $Object $.Class ["java.lang.Object" (list)]) +(def: $Object Class ["java.lang.Object" (list)]) (def: #export (interface version visibility config name parameters interfaces definitions) - (-> $.Version $.Visibility $.Class-Config Text (List $.Parameter) (List $.Class) $.Def + (-> $.Version $.Visibility $.Class-Config Text (List Parameter) (List Class) $.Def (host.type (Array byte))) (let [writer (|> (do-to (ClassWriter::new class-computes) (ClassWriter::visit (version-flag version) @@ -205,7 +207,7 @@ (ClassWriter::toByteArray writer))) (def: #export (method visibility config name type then) - (-> $.Visibility $.Method-Config Text $.Method $.Inst + (-> $.Visibility $.Method-Config Text Method $.Inst $.Def) (function (_ writer) (let [=method (ClassWriter::visitMethod ($_ i/+ @@ -223,7 +225,7 @@ writer))) (def: #export (abstract-method visibility config name type) - (-> $.Visibility $.Method-Config Text $.Method + (-> $.Visibility $.Method-Config Text Method $.Def) (function (_ writer) (let [=method (ClassWriter::visitMethod ($_ i/+ @@ -239,7 +241,7 @@ writer))) (def: #export (field visibility config name type) - (-> $.Visibility $.Field-Config Text $.Type $.Def) + (-> $.Visibility $.Field-Config Text Type $.Def) (function (_ writer) (let [=field (do-to (ClassWriter::visitField ($_ i/+ (visibility-flag visibility) diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux index 7329dec1a..33aa290df 100644 --- a/new-luxc/source/luxc/lang/host/jvm/inst.lux +++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux @@ -1,5 +1,6 @@ (.module: - [lux (#- int char) + [lux (#- Type int char) + ["." host (#+ import: do-to)] [abstract [monad (#+ do)]] [control @@ -13,15 +14,16 @@ format] [collection ["." list ("#@." functor)]]] - ["." host (#+ import: do-to)] [macro ["." code] [syntax (#+ syntax:)]] + [target + [jvm + ["." type (#+ Primitive Method Type)]]] [tool [compiler [phase (#+ Operation)]]]] - ["." // (#+ Primitive Inst) - ["." type]]) + ["." // (#+ Inst)]) ## [Host] (import: #long java/lang/Object) @@ -229,7 +231,7 @@ (template [<name> <inst>] [(def: #export (<name> class field type) - (-> Text Text //.Type Inst) + (-> Text Text Type Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitFieldInsn (<inst>) (type.binary-name class) field (type.descriptor type)))))] @@ -260,18 +262,18 @@ (do-to visitor (MethodVisitor::visitIntInsn (Opcodes::NEWARRAY) (case type - #//.Boolean (Opcodes::T_BOOLEAN) - #//.Byte (Opcodes::T_BYTE) - #//.Short (Opcodes::T_SHORT) - #//.Int (Opcodes::T_INT) - #//.Long (Opcodes::T_LONG) - #//.Float (Opcodes::T_FLOAT) - #//.Double (Opcodes::T_DOUBLE) - #//.Char (Opcodes::T_CHAR)))))) + #type.Boolean (Opcodes::T_BOOLEAN) + #type.Byte (Opcodes::T_BYTE) + #type.Short (Opcodes::T_SHORT) + #type.Int (Opcodes::T_INT) + #type.Long (Opcodes::T_LONG) + #type.Float (Opcodes::T_FLOAT) + #type.Double (Opcodes::T_DOUBLE) + #type.Char (Opcodes::T_CHAR)))))) (template [<name> <inst>] [(def: #export (<name> class method-name method-signature interface?) - (-> Text Text //.Method Bit Inst) + (-> Text Text Method Bit Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitMethodInsn (<inst>) (type.binary-name class) method-name (type.method-descriptor method-signature) interface?))))] @@ -324,14 +326,14 @@ (MethodVisitor::visitLabel @label)))) (def: #export (array type) - (-> //.Type Inst) + (-> Type Inst) (case type - (#//.Primitive prim) + (#type.Primitive prim) (NEWARRAY prim) - (#//.Generic generic) + (#type.Generic generic) (let [elem-class (case generic - (#//.Class class params) + (#type.Class class params) (type.binary-name class) _ @@ -344,32 +346,32 @@ (def: (primitive-wrapper type) (-> Primitive Text) (case type - #//.Boolean "java.lang.Boolean" - #//.Byte "java.lang.Byte" - #//.Short "java.lang.Short" - #//.Int "java.lang.Integer" - #//.Long "java.lang.Long" - #//.Float "java.lang.Float" - #//.Double "java.lang.Double" - #//.Char "java.lang.Character")) + #type.Boolean "java.lang.Boolean" + #type.Byte "java.lang.Byte" + #type.Short "java.lang.Short" + #type.Int "java.lang.Integer" + #type.Long "java.lang.Long" + #type.Float "java.lang.Float" + #type.Double "java.lang.Double" + #type.Char "java.lang.Character")) (def: (primitive-unwrap type) (-> Primitive Text) (case type - #//.Boolean "booleanValue" - #//.Byte "byteValue" - #//.Short "shortValue" - #//.Int "intValue" - #//.Long "longValue" - #//.Float "floatValue" - #//.Double "doubleValue" - #//.Char "charValue")) + #type.Boolean "booleanValue" + #type.Byte "byteValue" + #type.Short "shortValue" + #type.Int "intValue" + #type.Long "longValue" + #type.Float "floatValue" + #type.Double "doubleValue" + #type.Char "charValue")) (def: #export (wrap type) (-> Primitive Inst) (let [class (primitive-wrapper type)] (|>> (INVOKESTATIC class "valueOf" - (type.method (list (#//.Primitive type)) + (type.method (list (#type.Primitive type)) (#.Some (type.class class (list))) (list)) #0)))) @@ -379,7 +381,7 @@ (let [class (primitive-wrapper type)] (|>> (CHECKCAST class) (INVOKEVIRTUAL class (primitive-unwrap type) - (type.method (list) (#.Some (#//.Primitive type)) (list)) + (type.method (list) (#.Some (#type.Primitive type)) (list)) #0)))) (def: #export (fuse insts) diff --git a/new-luxc/source/luxc/lang/host/jvm/type.lux b/new-luxc/source/luxc/lang/host/jvm/type.lux deleted file mode 100644 index 909344d24..000000000 --- a/new-luxc/source/luxc/lang/host/jvm/type.lux +++ /dev/null @@ -1,154 +0,0 @@ -(.module: - [lux (#- int char) - [data - ["." maybe ("#@." functor)] - ["." text - format] - [collection - ["." list ("#@." functor)]]]] - ["." //]) - -(template [<name> <primitive>] - [(def: #export <name> //.Type (#//.Primitive <primitive>))] - - [boolean #//.Boolean] - [byte #//.Byte] - [short #//.Short] - [int #//.Int] - [long #//.Long] - [float #//.Float] - [double #//.Double] - [char #//.Char] - ) - -(template: #export (class name params) - (#//.Generic (#//.Class name params))) - -(template: #export (var name) - (#//.Generic (#//.Var name))) - -(template: #export (wildcard bound) - (#//.Generic (#//.Wildcard bound))) - -(def: #export (array depth elemT) - (-> Nat //.Type //.Type) - (case depth - 0 elemT - _ (#//.Array (array (dec depth) elemT)))) - -(def: #export binary-name - (-> Text Text) - (text.replace-all "." "/")) - -(def: #export (descriptor type) - (-> //.Type Text) - (case type - (#//.Primitive prim) - (case prim - #//.Boolean "Z" - #//.Byte "B" - #//.Short "S" - #//.Int "I" - #//.Long "J" - #//.Float "F" - #//.Double "D" - #//.Char "C") - - (#//.Array sub) - (format "[" (descriptor sub)) - - (#//.Generic generic) - (case generic - (#//.Class class params) - (format "L" (binary-name class) ";") - - (^or (#//.Var name) (#//.Wildcard ?bound)) - (descriptor (#//.Generic (#//.Class "java.lang.Object" (list))))) - )) - -(def: #export (class-name type) - (-> //.Type (Maybe Text)) - (case type - (#//.Primitive prim) - #.None - - (#//.Array sub) - (#.Some (descriptor type)) - - (#//.Generic generic) - (case generic - (#//.Class class params) - (#.Some class) - - (^or (#//.Var name) (#//.Wildcard ?bound)) - (#.Some "java.lang.Object")) - )) - -(def: #export (signature type) - (-> //.Type Text) - (case type - (#//.Primitive prim) - (case prim - #//.Boolean "Z" - #//.Byte "B" - #//.Short "S" - #//.Int "I" - #//.Long "J" - #//.Float "F" - #//.Double "D" - #//.Char "C") - - (#//.Array sub) - (format "[" (signature sub)) - - (#//.Generic generic) - (case generic - (#//.Class class params) - (let [=params (if (list.empty? params) - "" - (format "<" - (|> params - (list@map (|>> #//.Generic signature)) - (text.join-with "")) - ">"))] - (format "L" (binary-name class) =params ";")) - - (#//.Var name) - (format "T" name ";") - - (#//.Wildcard #.None) - "*" - - (^template [<tag> <prefix>] - (#//.Wildcard (#.Some [<tag> bound])) - (format <prefix> (signature (#//.Generic bound)))) - ([#//.Upper "+"] - [#//.Lower "-"])) - )) - -(def: #export (method args return exceptions) - (-> (List //.Type) (Maybe //.Type) (List //.Generic) //.Method) - {#//.args args #//.return return #//.exceptions exceptions}) - -(def: #export (method-descriptor method) - (-> //.Method Text) - (format "(" (text.join-with "" (list@map descriptor (get@ #//.args method))) ")" - (case (get@ #//.return method) - #.None - "V" - - (#.Some return) - (descriptor return)))) - -(def: #export (method-signature method) - (-> //.Method Text) - (format "(" (|> (get@ #//.args method) (list@map signature) (text.join-with "")) ")" - (case (get@ #//.return method) - #.None - "V" - - (#.Some return) - (signature return)) - (|> (get@ #//.exceptions method) - (list@map (|>> #//.Generic signature (format "^"))) - (text.join-with "")))) diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux index 61c86ae10..b2822726c 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 (#- Definition) + [lux (#- Type Definition) + ["." host (#+ import: do-to object)] [abstract [monad (#+ do)]] [control pipe - ["ex" exception (#+ exception:)] + ["." exception (#+ exception:)] ["." io (#+ IO io)] [concurrency ["." atom (#+ Atom atom)]]] @@ -17,9 +18,10 @@ ["." array] [list ("#/." functor)] ["." dictionary (#+ Dictionary)]]] - ["." host (#+ import: do-to object) + [target [jvm - ["." loader (#+ Library)]]] + ["." loader (#+ Library)] + ["." type (#+ Type)]]] [world [binary (#+ Binary)]] [tool @@ -28,7 +30,6 @@ [/// [host ["." jvm (#+ Inst Definition Host State) - ["." type] ["." def] ["." inst]]]] ) @@ -49,19 +50,22 @@ (type: #export ByteCode Binary) (def: #export value-field Text "_value") -(def: #export $Object jvm.Type (type.class "java.lang.Object" (list))) +(def: #export $Object Type (type.class "java.lang.Object" (list))) (exception: #export (cannot-load {class Text} {error Text}) - (ex.report ["Class" class] - ["Error" error])) + (exception.report + ["Class" class] + ["Error" error])) (exception: #export (invalid-field {class Text} {field Text} {error Text}) - (ex.report ["Class" class] - ["Field" field] - ["Error" error])) + (exception.report + ["Class" class] + ["Field" field] + ["Error" error])) (exception: #export (invalid-value {class Text}) - (ex.report ["Class" class])) + (exception.report + ["Class" class])) (def: (class-value class-name class) (-> Text (Class Object) (Error Any)) @@ -74,13 +78,13 @@ (#error.Success value) #.None - (ex.throw invalid-value class-name)) + (exception.throw invalid-value class-name)) (#error.Failure error) - (ex.throw cannot-load [class-name error])) + (exception.throw cannot-load [class-name error])) (#error.Failure error) - (ex.throw invalid-field [class-name ..value-field error]))) + (exception.throw invalid-field [class-name ..value-field error]))) (def: class-path-separator ".") @@ -147,8 +151,7 @@ (def: #export runtime-class "LuxRuntime") (def: #export function-class "LuxFunction") -(def: #export runnable-class "LuxRunnable") -(def: #export $Variant jvm.Type (type.array 1 ..$Object)) -(def: #export $Tuple jvm.Type (type.array 1 ..$Object)) -(def: #export $Function jvm.Type (type.class ..function-class (list))) +(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))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.lux b/new-luxc/source/luxc/lang/translation/jvm/case.lux index 43d11c71e..3c50f6124 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/case.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/case.lux @@ -8,15 +8,17 @@ [data [text format]] + [target + [jvm + ["$t" type]]] [tool [compiler ["." synthesis (#+ Path Synthesis)] - ["." phase ("operation/." monad)]]]] + ["." phase ("operation@." monad)]]]] [luxc [lang [host ["$" jvm (#+ Label Inst Operation Phase) - ["$t" type] ["_" inst]]]]] ["." // (#+ $Object) ["." runtime]]) @@ -63,34 +65,34 @@ (-> Phase Nat Label Label Path (Operation Inst)) (.case path #synthesis.Pop - (operation/wrap popI) + (operation@wrap popI) (#synthesis.Bind register) - (operation/wrap (|>> peekI + (operation@wrap (|>> peekI (_.ASTORE register))) (^ (synthesis.path/bit value)) - (operation/wrap (.let [jumpI (.if value _.IFEQ _.IFNE)] + (operation@wrap (.let [jumpI (.if value _.IFEQ _.IFNE)] (|>> peekI - (_.unwrap #$.Boolean) + (_.unwrap #$t.Boolean) (jumpI @else)))) (^ (synthesis.path/i64 value)) - (operation/wrap (|>> peekI - (_.unwrap #$.Long) + (operation@wrap (|>> peekI + (_.unwrap #$t.Long) (_.long (.int value)) _.LCMP (_.IFNE @else))) (^ (synthesis.path/f64 value)) - (operation/wrap (|>> peekI - (_.unwrap #$.Double) + (operation@wrap (|>> peekI + (_.unwrap #$t.Double) (_.double value) _.DCMPL (_.IFNE @else))) (^ (synthesis.path/text value)) - (operation/wrap (|>> peekI + (operation@wrap (|>> peekI (_.string value) (_.INVOKEVIRTUAL "java.lang.Object" "equals" @@ -110,7 +112,7 @@ (^template [<pattern> <flag> <prepare>] (^ (<pattern> idx)) - (operation/wrap (<| _.with-label (function (_ @success)) + (operation@wrap (<| _.with-label (function (_ @success)) _.with-label (function (_ @fail)) (|>> peekI (_.CHECKCAST ($t.descriptor runtime.$Variant)) @@ -133,7 +135,7 @@ [synthesis.side/right (_.string "") .inc]) (^ (synthesis.member/left lefts)) - (operation/wrap (.let [accessI (.case lefts + (operation@wrap (.let [accessI (.case lefts 0 _.AALOAD @@ -151,7 +153,7 @@ pushI))) (^ (synthesis.member/right lefts)) - (operation/wrap (|>> peekI + (operation@wrap (|>> peekI (_.CHECKCAST ($t.descriptor runtime.$Tuple)) (_.int (.int lefts)) (_.INVOKESTATIC //.runtime-class @@ -205,7 +207,7 @@ (wrap (<| _.with-label (function (_ @else)) _.with-label (function (_ @end)) (|>> testI - (_.unwrap #$.Boolean) + (_.unwrap #$t.Boolean) (_.IFEQ @else) thenI (_.GOTO @end) diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux index 0fea18acd..ae876c3fc 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- function) + [lux (#- Type function) [abstract ["." monad (#+ do)]] [control @@ -10,6 +10,9 @@ format] [collection ["." list ("#/." functor monoid)]]] + [target + [jvm + ["." type (#+ Type Method)]]] [tool [compiler [analysis (#+ Arity)] @@ -21,7 +24,6 @@ [lang [host ["$" jvm (#+ Label Inst Def Operation Phase) - ["." type] ["." def] ["_" inst]]]]] ["." // @@ -30,22 +32,22 @@ (def: arity-field Text "arity") -(def: $Object $.Type (type.class "java.lang.Object" (list))) +(def: $Object Type (type.class "java.lang.Object" (list))) (def: (poly-arg? arity) (-> Arity Bit) (n/> 1 arity)) (def: (reset-method class) - (-> Text $.Method) + (-> Text Method) (type.method (list) (#.Some (type.class class (list))) (list))) (def: (captured-args env) - (-> (List Variable) (List $.Type)) + (-> (List Variable) (List Type)) (list.repeat (list.size env) $Object)) (def: (init-method env arity) - (-> (List Variable) Arity $.Method) + (-> (List Variable) Arity Method) (if (poly-arg? arity) (type.method (list.concat (list (captured-args env) (list type.int) @@ -158,7 +160,7 @@ _.ARETURN))) (def: function-init-method - $.Method + Method (type.method (list type.int) #.None (list))) (def: (function-init arity env-size) diff --git a/new-luxc/source/luxc/lang/translation/jvm/primitive.lux b/new-luxc/source/luxc/lang/translation/jvm/primitive.lux index f9d9034ea..b97e50419 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/primitive.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/primitive.lux @@ -5,19 +5,21 @@ [data [text format]] + [target + [jvm + ["$t" type]]] [tool [compiler - [phase ("operation/." monad)]]]] + [phase ("operation@." monad)]]]] [luxc [lang [host ["." jvm (#+ Inst Operation) - ["_" inst] - ["$t" type]]]]]) + ["_" inst]]]]]) (def: #export (bit value) (-> Bit (Operation Inst)) - (operation/wrap (_.GETSTATIC "java.lang.Boolean" + (operation@wrap (_.GETSTATIC "java.lang.Boolean" (if value "TRUE" "FALSE") ($t.class "java.lang.Boolean" (list))))) @@ -25,9 +27,9 @@ [(def: #export (<name> value) (-> <type> (Operation Inst)) (let [loadI (|> value <load>)] - (operation/wrap (|>> loadI <wrap>))))] + (operation@wrap (|>> loadI <wrap>))))] - [i64 (I64 Any) (<| _.long .int) (_.wrap #jvm.Long)] - [f64 Frac _.double (_.wrap #jvm.Double)] + [i64 (I64 Any) (<| _.long .int) (_.wrap #$t.Long)] + [f64 Frac _.double (_.wrap #$t.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 aeaa1d664..cead0848e 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux @@ -1,5 +1,5 @@ (.module: - [lux #* + [lux (#- Type) [abstract ["." monad (#+ do)]] [control @@ -10,6 +10,9 @@ format] [collection ["." dictionary]]] + [target + [jvm + ["_t" type (#+ Type Method)]]] [tool [compiler ["." synthesis (#+ Synthesis)] @@ -23,8 +26,7 @@ [luxc [lang [host - ["$" jvm (#+ Label Inst Method Bundle) - ["_t" type] + ["$" jvm (#+ Label Inst Bundle) ["_" inst]]]]] ["." /// ["." runtime]]) @@ -33,12 +35,12 @@ (#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: $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: lux-intI Inst (|>> _.I2L (_.wrap #$.Long))) -(def: jvm-intI Inst (|>> (_.unwrap #$.Long) _.L2I)) +(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: (predicateI tester) @@ -73,9 +75,9 @@ (template [<name> <op>] [(def: (<name> [maskI inputI]) (Binary Inst) - (|>> inputI (_.unwrap #$.Long) - maskI (_.unwrap #$.Long) - <op> (_.wrap #$.Long)))] + (|>> inputI (_.unwrap #_t.Long) + maskI (_.unwrap #_t.Long) + <op> (_.wrap #_t.Long)))] [bit::and _.LAND] [bit::or _.LOR] @@ -85,10 +87,10 @@ (template [<name> <op>] [(def: (<name> [shiftI inputI]) (Binary Inst) - (|>> inputI (_.unwrap #$.Long) + (|>> inputI (_.unwrap #_t.Long) shiftI jvm-intI <op> - (_.wrap #$.Long)))] + (_.wrap #_t.Long)))] [bit::left-shift _.LSHL] [bit::arithmetic-right-shift _.LSHR] @@ -100,9 +102,9 @@ (Nullary Inst) (|>> <const> (_.wrap <type>)))] - [frac::smallest (_.double (Double::MIN_VALUE)) #$.Double] - [frac::min (_.double (f/* -1.0 (Double::MAX_VALUE))) #$.Double] - [frac::max (_.double (Double::MAX_VALUE)) #$.Double] + [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] ) (template [<name> <type> <op>] @@ -113,17 +115,17 @@ <op> (_.wrap <type>)))] - [i64::+ #$.Long _.LADD] - [i64::- #$.Long _.LSUB] - [int::* #$.Long _.LMUL] - [int::/ #$.Long _.LDIV] - [int::% #$.Long _.LREM] + [i64::+ #_t.Long _.LADD] + [i64::- #_t.Long _.LSUB] + [int::* #_t.Long _.LMUL] + [int::/ #_t.Long _.LDIV] + [int::% #_t.Long _.LREM] - [frac::+ #$.Double _.DADD] - [frac::- #$.Double _.DSUB] - [frac::* #$.Double _.DMUL] - [frac::/ #$.Double _.DDIV] - [frac::% #$.Double _.DREM] + [frac::+ #_t.Double _.DADD] + [frac::- #_t.Double _.DSUB] + [frac::* #_t.Double _.DMUL] + [frac::/ #_t.Double _.DDIV] + [frac::% #_t.Double _.DREM] ) (template [<eq> <lt> <unwrap> <cmp>] @@ -139,8 +141,8 @@ [<eq> +0] [<lt> -1])] - [i64::= int::< (_.unwrap #$.Long) _.LCMP] - [frac::= frac::< (_.unwrap #$.Double) _.DCMPG] + [i64::= int::< (_.unwrap #_t.Long) _.LCMP] + [frac::= frac::< (_.unwrap #_t.Double) _.DCMPG] ) (template [<name> <prepare> <transform>] @@ -148,12 +150,12 @@ (Unary Inst) (|>> inputI <prepare> <transform>))] - [int::frac (_.unwrap #$.Long) (<| (_.wrap #$.Double) _.L2D)] - [int::char (_.unwrap #$.Long) + [int::frac (_.unwrap #_t.Long) (<| (_.wrap #_t.Double) _.L2D)] + [int::char (_.unwrap #_t.Long) ((|>> _.L2I _.I2C (_.INVOKESTATIC "java.lang.Character" "toString" (_t.method (list _t.char) (#.Some $String) (list)) #0)))] - [frac::int (_.unwrap #$.Double) (<| (_.wrap #$.Long) _.D2L)] - [frac::encode (_.unwrap #$.Double) + [frac::int (_.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)] @@ -175,7 +177,7 @@ [text::= (<|) (<|) (_.INVOKEVIRTUAL "java.lang.Object" "equals" (_t.method (list ///.$Object) (#.Some _t.boolean) (list)) #0) - (_.wrap #$.Boolean)] + (_.wrap #_t.Boolean)] [text::< ..check-stringI ..check-stringI (_.INVOKEVIRTUAL "java.lang.String" "compareTo" (_t.method (list $String) (#.Some _t.int) (list)) #0) (predicateI _.IFLT)] @@ -244,7 +246,7 @@ (def: (io::current-time _) (Nullary Inst) (|>> (_.INVOKESTATIC "java.lang.System" "currentTimeMillis" (_t.method (list) (#.Some _t.long) (list)) #0) - (_.wrap #$.Long))) + (_.wrap #_t.Long))) (def: bundle::lux 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 c4bc66923..7d9cd9cc5 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 (#- int char) + [lux (#- Type int char) [abstract ["." monad (#+ do)]] [control @@ -14,6 +14,9 @@ [collection ["." list ("#@." functor)] ["." dictionary (#+ Dictionary)]]] + [target + [jvm + ["_t" type (#+ Primitive Type Method)]]] [tool [compiler ["." synthesis (#+ Synthesis %synthesis)] @@ -27,8 +30,7 @@ [luxc [lang [host - ["$" jvm (#+ Primitive Label Inst Method Handler Bundle Operation) - ["_t" type] + ["$" jvm (#+ Label Inst Handler Bundle Operation) ["_" inst]]]]]) (template [<name>] @@ -57,30 +59,30 @@ (|>> inputI <conversion>)))] - [conversion::double-to-float #$.Double _.D2F #$.Float] - [conversion::double-to-int #$.Double _.D2I #$.Int] - [conversion::double-to-long #$.Double _.D2L #$.Long] - [conversion::float-to-double #$.Float _.F2D #$.Double] - [conversion::float-to-int #$.Float _.F2I #$.Int] - [conversion::float-to-long #$.Float _.F2L #$.Long] - [conversion::int-to-byte #$.Int _.I2B #$.Byte] - [conversion::int-to-char #$.Int _.I2C #$.Char] - [conversion::int-to-double #$.Int _.I2D #$.Double] - [conversion::int-to-float #$.Int _.I2F #$.Float] - [conversion::int-to-long #$.Int _.I2L #$.Long] - [conversion::int-to-short #$.Int _.I2S #$.Short] - [conversion::long-to-double #$.Long _.L2D #$.Double] - [conversion::long-to-float #$.Long _.L2F #$.Float] - [conversion::long-to-int #$.Long _.L2I #$.Int] - [conversion::long-to-short #$.Long L2S #$.Short] - [conversion::long-to-byte #$.Long L2B #$.Byte] - [conversion::long-to-char #$.Long L2C #$.Char] - [conversion::char-to-byte #$.Char _.I2B #$.Byte] - [conversion::char-to-short #$.Char _.I2S #$.Short] - [conversion::char-to-int #$.Char _.NOP #$.Int] - [conversion::char-to-long #$.Char _.I2L #$.Long] - [conversion::byte-to-long #$.Byte _.I2L #$.Long] - [conversion::short-to-long #$.Short _.I2L #$.Long] + [conversion::double-to-float #_t.Double _.D2F #_t.Float] + [conversion::double-to-int #_t.Double _.D2I #_t.Int] + [conversion::double-to-long #_t.Double _.D2L #_t.Long] + [conversion::float-to-double #_t.Float _.F2D #_t.Double] + [conversion::float-to-int #_t.Float _.F2I #_t.Int] + [conversion::float-to-long #_t.Float _.F2L #_t.Long] + [conversion::int-to-byte #_t.Int _.I2B #_t.Byte] + [conversion::int-to-char #_t.Int _.I2C #_t.Char] + [conversion::int-to-double #_t.Int _.I2D #_t.Double] + [conversion::int-to-float #_t.Int _.I2F #_t.Float] + [conversion::int-to-long #_t.Int _.I2L #_t.Long] + [conversion::int-to-short #_t.Int _.I2S #_t.Short] + [conversion::long-to-double #_t.Long _.L2D #_t.Double] + [conversion::long-to-float #_t.Long _.L2F #_t.Float] + [conversion::long-to-int #_t.Long _.L2I #_t.Int] + [conversion::long-to-short #_t.Long L2S #_t.Short] + [conversion::long-to-byte #_t.Long L2B #_t.Byte] + [conversion::long-to-char #_t.Long L2C #_t.Char] + [conversion::char-to-byte #_t.Char _.I2B #_t.Byte] + [conversion::char-to-short #_t.Char _.I2S #_t.Short] + [conversion::char-to-int #_t.Char _.NOP #_t.Int] + [conversion::char-to-long #_t.Char _.I2L #_t.Long] + [conversion::byte-to-long #_t.Byte _.I2L #_t.Long] + [conversion::short-to-long #_t.Short _.I2L #_t.Long] ) (def: conversion @@ -281,7 +283,7 @@ ))) (def: (array-java-type nesting elem-class) - (-> Nat Text $.Type) + (-> Nat Text Type) (_t.array nesting (case elem-class "boolean" _t.boolean @@ -447,7 +449,7 @@ [objectI (generate objectS)] (wrap (|>> objectI (_.INSTANCEOF class) - (_.wrap #$.Boolean)))) + (_.wrap #_t.Boolean)))) _ (phase.throw extension.invalid-syntax [proc %synthesis inputs]))) @@ -466,14 +468,14 @@ [<object> <primitive>] (wrap (|>> valueI (_.unwrap <type>)))) - (["boolean" "java.lang.Boolean" #$.Boolean] - ["byte" "java.lang.Byte" #$.Byte] - ["short" "java.lang.Short" #$.Short] - ["int" "java.lang.Integer" #$.Int] - ["long" "java.lang.Long" #$.Long] - ["float" "java.lang.Float" #$.Float] - ["double" "java.lang.Double" #$.Double] - ["char" "java.lang.Character" #$.Char]) + (["boolean" "java.lang.Boolean" #_t.Boolean] + ["byte" "java.lang.Byte" #_t.Byte] + ["short" "java.lang.Short" #_t.Short] + ["int" "java.lang.Integer" #_t.Int] + ["long" "java.lang.Long" #_t.Long] + ["float" "java.lang.Float" #_t.Float] + ["double" "java.lang.Double" #_t.Double] + ["char" "java.lang.Character" #_t.Char]) _ (wrap valueI))) @@ -496,14 +498,14 @@ (def: primitives (Dictionary Text Primitive) - (|> (list ["boolean" #$.Boolean] - ["byte" #$.Byte] - ["short" #$.Short] - ["int" #$.Int] - ["long" #$.Long] - ["float" #$.Float] - ["double" #$.Double] - ["char" #$.Char]) + (|> (list ["boolean" #_t.Boolean] + ["byte" #_t.Byte] + ["short" #_t.Short] + ["int" #_t.Int] + ["long" #_t.Long] + ["float" #_t.Float] + ["double" #_t.Double] + ["char" #_t.Char]) (dictionary.from-list text.hash))) (def: (static::get proc generate inputs) @@ -516,7 +518,7 @@ [] (case (dictionary.get unboxed primitives) (#.Some primitive) - (wrap (_.GETSTATIC class field (#$.Primitive primitive))) + (wrap (_.GETSTATIC class field (#_t.Primitive primitive))) #.None (wrap (_.GETSTATIC class field (_t.class unboxed (list)))))) @@ -536,7 +538,7 @@ (case (dictionary.get unboxed primitives) (#.Some primitive) (wrap (|>> valueI - (_.PUTSTATIC class field (#$.Primitive primitive)) + (_.PUTSTATIC class field (#_t.Primitive primitive)) (_.string synthesis.unit))) #.None @@ -561,7 +563,7 @@ (#.Some primitive) (wrap (|>> objectI (_.CHECKCAST class) - (_.GETFIELD class field (#$.Primitive primitive)))) + (_.GETFIELD class field (#_t.Primitive primitive)))) #.None (wrap (|>> objectI @@ -588,7 +590,7 @@ (_.CHECKCAST class) _.DUP valueI - (_.PUTFIELD class field (#$.Primitive primitive)))) + (_.PUTFIELD class field (#_t.Primitive primitive)))) #.None (wrap (|>> objectI @@ -602,7 +604,7 @@ (phase.throw extension.invalid-syntax [proc %synthesis inputs]))) (def: base-type - (l.Parser $.Type) + (l.Parser Type) ($_ p.either (p.after (l.this "boolean") (p@wrap _t.boolean)) (p.after (l.this "byte") (p@wrap _t.byte)) @@ -618,14 +620,14 @@ )) (def: java-type - (l.Parser $.Type) + (l.Parser Type) (do p.monad [raw base-type nesting (p.some (l.this "[]"))] (wrap (_t.array (list.size nesting) raw)))) (def: (generate-type argD) - (-> Text (Operation $.Type)) + (-> Text (Operation Type)) (case (l.run argD java-type) (#error.Failure error) (phase.throw invalid-syntax-for-jvm-type argD) @@ -635,7 +637,7 @@ (def: (generate-arg generate argS) (-> (-> Synthesis (Operation Inst)) Synthesis - (Operation [$.Type Inst])) + (Operation [Type Inst])) (case argS (^ (synthesis.tuple (list (synthesis.text argD) argS))) (do phase.monad @@ -647,7 +649,7 @@ (phase.throw invalid-syntax-for-argument-generation ""))) (def: (method-return-type description) - (-> Text (Operation (Maybe $.Type))) + (-> Text (Operation (Maybe Type))) (case description "void" (phase@wrap #.None) @@ -656,7 +658,7 @@ (phase@map (|>> #.Some) (generate-type description)))) (def: (prepare-argI [type argI]) - (-> [$.Type Inst] Inst) + (-> [Type Inst] Inst) (case (_t.class-name type) (#.Some class-name) (|>> argI diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.lux index c821a9de2..63fd0685a 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/reference.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/reference.lux @@ -9,13 +9,12 @@ [compiler ["." name] ["." reference (#+ Register Variable)] - ["." phase ("operation/." monad) + ["." phase ("operation@." monad) ["." generation]]]]] [luxc [lang [host [jvm (#+ Inst Operation) - ["$t" type] ["_" inst]]]]] ["." //]) @@ -39,7 +38,7 @@ (def: local (-> Register (Operation Inst)) - (|>> _.ALOAD operation/wrap)) + (|>> _.ALOAD operation@wrap)) (def: #export (variable variable) (-> Variable (Operation Inst)) @@ -54,4 +53,4 @@ (-> Name (Operation Inst)) (do phase.monad [bytecode-name (generation.remember name)] - (operation/wrap (_.GETSTATIC bytecode-name //.value-field //.$Object)))) + (operation@wrap (_.GETSTATIC bytecode-name //.value-field //.$Object)))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux index d21729d0e..fa250e2bf 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 #* + [lux (#- Type) [abstract [monad (#+ do)]] [data @@ -8,6 +8,9 @@ [collection ["." list ("#/." functor)]]] ["." math] + [target + [jvm + ["$t" type (#+ Type Method)]]] [tool [compiler [analysis (#+ Arity)] @@ -17,24 +20,23 @@ [luxc [lang [host - ["$" jvm (#+ Label Inst Method Def Operation) - ["$t" type] + ["$" jvm (#+ Label Inst Def Operation) ["$d" def] ["_" 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: $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: #export logI Inst @@ -105,7 +107,7 @@ (def: adt-methods Def - (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap #$.Int) _.AASTORE) + (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap #$t.Int) _.AASTORE) store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE) store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)] (|>> ($d.method #$.Public $.staticM "variant_make" @@ -127,7 +129,7 @@ (try-methodI (|>> (_.ALOAD 0) (_.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) #0) - (_.wrap #$.Double)))) + (_.wrap #$t.Double)))) )) (def: pm-methods @@ -191,7 +193,7 @@ (function (_ idx) (|>> (_.int (.int idx)) _.AALOAD))) tagI (: Inst - (|>> (variant-partI 0) (_.unwrap #$.Int))) + (|>> (variant-partI 0) (_.unwrap #$t.Int))) flagI (variant-partI 1) datumI (variant-partI 2) shortenI (|>> (_.ALOAD 0) tagI ## Get tag diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.lux index 527228c8e..5cfe233fe 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/structure.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/structure.lux @@ -1,5 +1,5 @@ (.module: - [lux #* + [lux (#- Type) [abstract ["." monad (#+ do)]] [control @@ -9,6 +9,9 @@ format] [collection ["." list]]] + [target + [jvm + ["$t" type (#+ Type)]]] [tool [compiler [synthesis (#+ Synthesis)] @@ -16,8 +19,7 @@ [luxc [lang [host - ["." jvm (#+ Inst Operation Phase) - ["$t" type] + [jvm (#+ Inst Operation Phase) ["_" inst]]]]] ["." //]) @@ -25,7 +27,7 @@ (ex.report ["Expected size" ">= 2"] ["Actual size" (%n size)])) -(def: $Object jvm.Type ($t.class "java.lang.Object" (list))) +(def: $Object ($t.class "java.lang.Object" (list))) (def: #export (tuple translate members) (-> Phase (List Synthesis) (Operation Inst)) |