From af7f85c4eb724f2888ecce9c8b52d6d3bb1cd807 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 27 Apr 2019 23:41:47 -0400 Subject: Moved JVM type machinery to stdlib. --- new-luxc/source/luxc/lang/host/jvm.lux | 47 +---- new-luxc/source/luxc/lang/host/jvm/def.lux | 38 ++-- new-luxc/source/luxc/lang/host/jvm/inst.lux | 74 ++++---- new-luxc/source/luxc/lang/host/jvm/type.lux | 154 ---------------- new-luxc/source/luxc/lang/translation/jvm.lux | 41 +++-- new-luxc/source/luxc/lang/translation/jvm/case.lux | 32 ++-- .../source/luxc/lang/translation/jvm/function.lux | 16 +- .../source/luxc/lang/translation/jvm/primitive.lux | 16 +- .../luxc/lang/translation/jvm/procedure/common.lux | 70 +++---- .../luxc/lang/translation/jvm/procedure/host.lux | 112 +++++------ .../source/luxc/lang/translation/jvm/reference.lux | 7 +- .../source/luxc/lang/translation/jvm/runtime.lux | 38 ++-- .../source/luxc/lang/translation/jvm/structure.lux | 10 +- new-luxc/source/program.lux | 4 +- stdlib/source/lux/target/jvm/type.lux | 205 +++++++++++++++++++++ .../source/lux/tool/compiler/meta/io/context.lux | 24 +-- stdlib/source/lux/world/console.lux | 118 ++++++------ stdlib/source/program/compositor.lux | 2 - 18 files changed, 522 insertions(+), 486 deletions(-) delete mode 100644 new-luxc/source/luxc/lang/host/jvm/type.lux create mode 100644 stdlib/source/lux/target/jvm/type.lux 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 [ ] [(def: #export ( 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 [ ] [(def: #export ( class field type) - (-> Text Text //.Type Inst) + (-> Text Text Type Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitFieldInsn () (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 [ ] [(def: #export ( class method-name method-signature interface?) - (-> Text Text //.Method Bit Inst) + (-> Text Text Method Bit Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitMethodInsn () (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 [ ] - [(def: #export //.Type (#//.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 [ ] - (#//.Wildcard (#.Some [ bound])) - (format (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 [ ] (^ ( 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 ( value) (-> (Operation Inst)) (let [loadI (|> value )] - (operation/wrap (|>> loadI ))))] + (operation@wrap (|>> loadI ))))] - [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 [ ] [(def: ( [maskI inputI]) (Binary Inst) - (|>> inputI (_.unwrap #$.Long) - maskI (_.unwrap #$.Long) - (_.wrap #$.Long)))] + (|>> inputI (_.unwrap #_t.Long) + maskI (_.unwrap #_t.Long) + (_.wrap #_t.Long)))] [bit::and _.LAND] [bit::or _.LOR] @@ -85,10 +87,10 @@ (template [ ] [(def: ( [shiftI inputI]) (Binary Inst) - (|>> inputI (_.unwrap #$.Long) + (|>> inputI (_.unwrap #_t.Long) shiftI jvm-intI - (_.wrap #$.Long)))] + (_.wrap #_t.Long)))] [bit::left-shift _.LSHL] [bit::arithmetic-right-shift _.LSHR] @@ -100,9 +102,9 @@ (Nullary Inst) (|>> (_.wrap )))] - [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 [ ] @@ -113,17 +115,17 @@ (_.wrap )))] - [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 [ ] @@ -139,8 +141,8 @@ [ +0] [ -1])] - [i64::= int::< (_.unwrap #$.Long) _.LCMP] - [frac::= frac::< (_.unwrap #$.Double) _.DCMPG] + [i64::= int::< (_.unwrap #_t.Long) _.LCMP] + [frac::= frac::< (_.unwrap #_t.Double) _.DCMPG] ) (template [ ] @@ -148,12 +150,12 @@ (Unary Inst) (|>> inputI ))] - [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 [] @@ -57,30 +59,30 @@ (|>> inputI )))] - [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 @@ [ ] (wrap (|>> valueI (_.unwrap )))) - (["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)) diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux index de4445d5f..46462ab34 100644 --- a/new-luxc/source/program.lux +++ b/new-luxc/source/program.lux @@ -14,6 +14,9 @@ ["." dictionary]]] [world ["." file]] + [target + [jvm + ["$t" type]]] [tool [compiler [phase @@ -27,7 +30,6 @@ [lang [host ["_" jvm - ["$t" type] ["$d" def] ["$i" inst]]] [translation diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux new file mode 100644 index 000000000..23925e468 --- /dev/null +++ b/stdlib/source/lux/target/jvm/type.lux @@ -0,0 +1,205 @@ +(.module: + [lux (#- Type int char) + [data + ["." maybe ("#@." functor)] + ["." text + format] + [collection + ["." list ("#@." functor)]]]]) + +(def: array-prefix "[") +(def: binary-void-name "V") +(def: binary-boolean-name "Z") +(def: binary-byte-name "B") +(def: binary-short-name "S") +(def: binary-int-name "I") +(def: binary-long-name "J") +(def: binary-float-name "F") +(def: binary-double-name "D") +(def: binary-char-name "C") +(def: binary-object-prefix "L") +(def: binary-object-suffix ";") +(def: object-class "java.lang.Object") + +(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)}) + +(template [ ] + [(def: #export Type (#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 ..binary-boolean-name + #Byte ..binary-byte-name + #Short ..binary-short-name + #Int ..binary-int-name + #Long ..binary-long-name + #Float ..binary-float-name + #Double ..binary-double-name + #Char ..binary-char-name) + + (#Array sub) + (format ..array-prefix (descriptor sub)) + + (#Generic generic) + (case generic + (#Class class params) + (format ..binary-object-prefix (binary-name class) ..binary-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 + (#Primitive prim) + (case prim + #Boolean ..binary-boolean-name + #Byte ..binary-byte-name + #Short ..binary-short-name + #Int ..binary-int-name + #Long ..binary-long-name + #Float ..binary-float-name + #Double ..binary-double-name + #Char ..binary-char-name) + + (#Array sub) + (format ..array-prefix (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 ..binary-object-prefix (binary-name class) =params ..binary-object-suffix)) + + (#Var name) + (format "T" name ..binary-object-suffix) + + (#Wildcard #.None) + "*" + + (^template [ ] + (#Wildcard (#.Some [ bound])) + (format (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: 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 + ..binary-void-name + + (#.Some return) + (descriptor return)))) + +(def: #export (method-signature method) + (-> Method Text) + (format (|> (get@ #args method) (list@map signature) (text.join-with "") ..method-args) + (case (get@ #return method) + #.None + ..binary-void-name + + (#.Some return) + (signature return)) + (|> (get@ #exceptions method) + (list@map (|>> #Generic signature (format "^"))) + (text.join-with "")))) diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux index b60616f03..bd1efd73b 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux @@ -1,5 +1,6 @@ (.module: [lux (#- Module Code) + ["@" target] [abstract [monad (#+ Monad do)]] [control @@ -19,8 +20,7 @@ ["#/" // #_ [archive [descriptor (#+ Module)]] - ["#/" // (#+ Input) - ["#." host]]]]) + ["#/" // (#+ Input)]]]) (template [] [(exception: #export ( {module Module}) @@ -38,16 +38,16 @@ (def: partial-host-extension Extension - (`` (for {(~~ (static ////host.common-lisp)) ".cl" - (~~ (static ////host.js)) ".js" - (~~ (static ////host.old)) ".jvm" - (~~ (static ////host.jvm)) ".jvm" - (~~ (static ////host.lua)) ".lua" - (~~ (static ////host.php)) ".php" - (~~ (static ////host.python)) ".py" - (~~ (static ////host.r)) ".r" - (~~ (static ////host.ruby)) ".rb" - (~~ (static ////host.scheme)) ".scm"}))) + (`` (for {(~~ (static @.common-lisp)) ".cl" + (~~ (static @.js)) ".js" + (~~ (static @.old)) ".jvm" + (~~ (static @.jvm)) ".jvm" + (~~ (static @.lua)) ".lua" + (~~ (static @.php)) ".php" + (~~ (static @.python)) ".py" + (~~ (static @.r)) ".r" + (~~ (static @.ruby)) ".rb" + (~~ (static @.scheme)) ".scm"}))) (def: full-host-extension Extension diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index effcff8a3..cc5258724 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -1,5 +1,7 @@ (.module: [lux #* + [host (#+ import:)] + ["@" target] [abstract [monad (#+ do)]] [control @@ -12,11 +14,7 @@ [data ["." error (#+ Error)] ["." text - format]] - [host (#+ import:)] - [tool - [compiler - ["." host]]]]) + format]]]) (template [] [(exception: #export () @@ -57,59 +55,63 @@ [can-write ..can-write] [can-close ..can-close]))))) -(`` (for {(~~ (static host.old)) - (as-is (import: java/lang/String) - - (import: #long java/io/Console - (readLine [] #io #try String)) - - (import: java/io/InputStream - (read [] #io #try int)) - - (import: java/io/PrintStream - (print [String] #io #try void)) - - (import: java/lang/System - (#static console [] #io #? java/io/Console) - (#static in java/io/InputStream) - (#static out java/io/PrintStream)) - - (def: #export system - (IO (Error (Console IO))) - (do io.monad - [?jvm-console (System::console)] - (case ?jvm-console - #.None - (wrap (ex.throw cannot-open [])) - - (#.Some jvm-console) - (let [jvm-input (System::in) - jvm-output (System::out)] - (<| wrap - ex.return - (: (Console IO)) ## TODO: Remove ASAP - (structure - (def: can-read - (..can-read - (function (_ _) - (|> jvm-input - InputStream::read - (:: (error.with io.monad) map .nat))))) - - (def: can-read-line - (..can-read - (function (_ _) - (java/io/Console::readLine jvm-console)))) - - (def: can-write - (..can-write - (function (_ message) - (PrintStream::print message jvm-output)))) - - (def: can-close - (..can-close - (|>> (ex.throw cannot-close) wrap)))))))))) - })) +(with-expansions [ (as-is (import: java/lang/String) + + (import: #long java/io/Console + (readLine [] #io #try String)) + + (import: java/io/InputStream + (read [] #io #try int)) + + (import: java/io/PrintStream + (print [String] #io #try void)) + + (import: java/lang/System + (#static console [] #io #? java/io/Console) + (#static in java/io/InputStream) + (#static out java/io/PrintStream)) + + (def: #export system + (IO (Error (Console IO))) + (do io.monad + [?jvm-console (System::console)] + (case ?jvm-console + #.None + (wrap (ex.throw cannot-open [])) + + (#.Some jvm-console) + (let [jvm-input (System::in) + jvm-output (System::out)] + (<| wrap + ex.return + (: (Console IO)) ## TODO: Remove ASAP + (structure + (def: can-read + (..can-read + (function (_ _) + (|> jvm-input + InputStream::read + (:: (error.with io.monad) map .nat))))) + + (def: can-read-line + (..can-read + (function (_ _) + (java/io/Console::readLine jvm-console)))) + + (def: can-write + (..can-write + (function (_ message) + (PrintStream::print message jvm-output)))) + + (def: can-close + (..can-close + (|>> (ex.throw cannot-close) wrap))))))))))] + (`` (for {(~~ (static @.old)) + (as-is ) + + (~~ (static @.jvm)) + (as-is ) + }))) (def: #export (write-line message console) (All [!] (-> Text (Console !) (! Any))) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 5dd2fd1ba..c39544019 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -20,8 +20,6 @@ ["." list ("#@." functor fold)]]] [time ["." instant (#+ Instant)]] - [host - ["_" js]] [world ["." file (#+ File)] ["." console]] -- cgit v1.2.3