diff options
37 files changed, 720 insertions, 416 deletions
diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index 4d78d729c..b03cf6bbc 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -1,26 +1,35 @@ (.module: [library - [lux #* + [lux (#- Type) [ffi (#+ import:)] [type (#+ :share)] [abstract ["." monad (#+ do)]] [control - ["." try (#+ Try)]] + ["." try (#+ Try)] + ["<>" parser + ["<.>" code (#+ Parser)] + ["<.>" text]]] [data [identity (#+ Identity)] ["." product] [text ["%" format (#+ format)]] [collection - ["." list ("#@." fold)] + ["." list ("#\." fold functor)] ["." dictionary (#+ Dictionary)] - ["." row (#+ Row) ("#@." functor fold)]]] + ["." row (#+ Row) ("#\." functor fold)]]] [math [number ["." nat]]] [target - ["/" jvm]] + ["/" jvm + [encoding + ["." name (#+ External)]] + ["#." type (#+ Type) + [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter Declaration)] + ["." parser] + ["#/." signature]]]] [tool [compiler ["." phase] @@ -28,16 +37,19 @@ [lux [synthesis (#+ Synthesis)] ["." generation] - ["." directive] + ["." directive (#+ Requirements)] [phase ["." extension ["." bundle] [directive - ["./" lux]]]]]]]]]] + ["./" lux]]]]]] + [meta + [archive (#+ Archive)]]]]]] [/// [host ["." jvm (#+ Inst) - ["_" inst]]]]) + ["_" inst] + ["." def]]]]) (import: org/objectweb/asm/Label ["#::." @@ -416,7 +428,7 @@ (#/.TABLESWITCH min max default labels) (let [[mapping default] (..relabel [mapping default]) - [mapping labels] (list@fold (function (_ input [mapping output]) + [mapping labels] (list\fold (function (_ input [mapping output]) (let [[mapping input] (..relabel [mapping input])] [mapping (list& input output)])) [mapping (list)] labels)] @@ -424,7 +436,7 @@ (#/.LOOKUPSWITCH default keys+labels) (let [[mapping default] (..relabel [mapping default]) - [mapping keys+labels] (list@fold (function (_ [expected input] [mapping output]) + [mapping keys+labels] (list\fold (function (_ [expected input] [mapping output]) (let [[mapping input] (..relabel [mapping input])] [mapping (list& [expected input] output)])) [mapping (list)] keys+labels)] @@ -489,7 +501,7 @@ (def: (relabel_bytecode [mapping bytecode]) (Re_labeler (/.Bytecode Inst)) - (row@fold (function (_ input [mapping output]) + (row\fold (function (_ input [mapping output]) (let [[mapping input'] (..relabel_instruction [mapping input])] [mapping (row.add input' output)])) [mapping (row.row)] @@ -504,7 +516,7 @@ (|>> [..fresh] ..relabel_bytecode product.right - (row@map ..instruction) + (row\map ..instruction) row.to_list _.fuse)) @@ -512,7 +524,7 @@ <expression> (as_is Inst) <directive> (as_is jvm.Definition) <type_vars> (as_is <anchor> <expression> <directive>)] - (type: Handler + (type: Handler' ## (generation.Handler jvm.Anchor (/.Bytecode Inst /.Label) jvm.Definition) (-> extension.Name (phase.Phase [(extension.Bundle <type_vars>) @@ -531,15 +543,18 @@ (|>> (:as (/.Bytecode Inst /.Label)) ..bytecode) ((extender pseudo) extension_name phase archive inputs)))) +(type: Phase (directive.Phase jvm.Anchor jvm.Inst jvm.Definition)) +(type: Operation (directive.Operation jvm.Anchor jvm.Inst jvm.Definition)) +(type: Handler (directive.Handler jvm.Anchor jvm.Inst jvm.Definition)) + (def: (def::generation extender) - (-> jvm.Extender - (directive.Handler jvm.Anchor jvm.Inst jvm.Definition)) + (-> jvm.Extender ..Handler) (function (handler extension_name phase archive inputsC+) (case inputsC+ (^ (list nameC valueC)) (do phase.monad [[_ _ name] (lux/.evaluate! archive Text nameC) - [_ handlerV] (lux/.generator archive (:as Text name) ..Handler valueC) + [_ handlerV] (lux/.generator archive (:as Text name) ..Handler' valueC) _ (|> handlerV (..true_handler extender) (extension.install extender (:as Text name)) @@ -551,8 +566,93 @@ _ (phase.throw extension.invalid_syntax [extension_name %.code inputsC+])))) +(def: #export (custom [parser handler]) + (All [i] + (-> [(Parser i) + (-> Text ..Phase Archive i (..Operation Requirements))] + ..Handler)) + (function (_ extension_name phase archive input) + (case (<code>.run parser input) + (#try.Success input') + (handler extension_name phase archive input') + + (#try.Failure error) + (phase.throw extension.invalid_syntax [extension_name %.code input])))) + +(template [<name> <type> <parser>] + [(def: <name> + (Parser <type>) + (do {! <>.monad} + [raw <code>.text] + (<>.lift (<text>.run <parser> raw))))] + + [class_declaration [External (List (Type Var))] parser.declaration'] + [class (Type Class) parser.class] + [type_variable (Type Var) parser.var] + [value (Type Value) parser.value] + ) + +(def: annotation + (Parser Code) + <code>.any) + +(type: Method_Declaration + {#name Text + #annotations (List Code) + #type_variables (List (Type Var)) + #exceptions (List (Type Class)) + #arguments (List (Type Value)) + #return (Type Value)}) + +(def: method_declaration + (Parser Method_Declaration) + (<code>.form + ($_ <>.and + <code>.text + (<code>.tuple (<>.some ..annotation)) + (<code>.tuple (<>.some ..type_variable)) + (<code>.tuple (<>.some ..class)) + (<code>.tuple (<>.some ..value)) + ..value + ))) + +(def: java/lang/Object + (/type.class "java.lang.Object" (list))) + +(def: jvm::class::interface + ..Handler + (..custom + [($_ <>.and + ..class_declaration + (<code>.tuple (<>.some ..class)) + (<code>.tuple (<>.some ..annotation)) + (<>.some ..method_declaration)) + (function (_ extension_name phase archive [[class_name type_variables] supers annotations method_declarations]) + (do {! phase.monad} + [#let [constraints (list\map (function (_ tv) + {#/type.name (parser.name tv) + #/type.super_class java/lang/Object + #/type.super_interfaces (list)}) + type_variables) + directive [class_name + (def.interface #jvm.V1_6 #jvm.Public jvm.noneC class_name + constraints + supers + (|> method_declarations + (list\map (function (_ (^slots [#name #annotations #type_variables #exceptions #arguments #return])) + (def.abstract_method #jvm.Public jvm.noneM name + (/type.method [type_variables arguments return exceptions])))) + def.fuse))]]] + (directive.lift_generation + (do ! + [artifact_id (generation.learn_custom class_name) + _ (generation.execute! directive) + _ (generation.save! artifact_id (#.Some class_name) directive) + _ (generation.log! (format "JVM Interface " (%.text class_name)))] + (wrap directive.no_requirements)))))])) + (def: #export (bundle extender) - (-> jvm.Extender - (directive.Bundle jvm.Anchor jvm.Inst jvm.Definition)) + (-> jvm.Extender (directive.Bundle jvm.Anchor jvm.Inst jvm.Definition)) (|> bundle.empty - (dictionary.put "lux def generation" (..def::generation extender)))) + (dictionary.put "lux def generation" (..def::generation extender)) + (dictionary.put "jvm class interface" ..jvm::class::interface))) diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux index 58121502a..953dbf200 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/def.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/def.lux @@ -202,7 +202,7 @@ (let [writer (|> (do_to (org/objectweb/asm/ClassWriter::new class_computes) (org/objectweb/asm/ClassWriter::visit (version_flag version) ($_ i.+ - (org/objectweb/asm/Opcodes::ACC_SUPER) + (org/objectweb/asm/Opcodes::ACC_ABSTRACT) (org/objectweb/asm/Opcodes::ACC_INTERFACE) (visibility_flag visibility) (class_flags config)) diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux index 8427e23e1..9447861e3 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/inst.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux @@ -448,13 +448,13 @@ (def: #export (wrap type) (-> (Type Primitive) Inst) (let [wrapper (type.class (primitive_wrapper type) (list))] - (INVOKESTATIC wrapper "valueOf" (type.method [(list type) wrapper (list)])))) + (INVOKESTATIC wrapper "valueOf" (type.method [(list) (list type) wrapper (list)])))) (def: #export (unwrap type) (-> (Type Primitive) Inst) (let [wrapper (type.class (primitive_wrapper type) (list))] (|>> (CHECKCAST wrapper) - (INVOKEVIRTUAL wrapper (primitive_unwrap type) (type.method [(list) type (list)]))))) + (INVOKEVIRTUAL wrapper (primitive_unwrap type) (type.method [(list) (list) type (list)]))))) (def: #export (fuse insts) (-> (List Inst) Inst) diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux index 0f6ba6744..425a259aa 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm.lux @@ -122,7 +122,7 @@ ..value_field ..$Value) (def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM) "<clinit>" - (type.method [(list) type.void (list)]) + (type.method [(list) (list) type.void (list)]) (|>> valueI (inst.PUTSTATIC (type.class bytecode_name (list)) ..value_field ..$Value) inst.RETURN))))] @@ -155,35 +155,37 @@ value definition]))) (def: #export host - (IO Host) + (IO [java/lang/ClassLoader Host]) (io (let [library (loader.new_library []) loader (loader.memory library)] - (: Host - (implementation - (def: (evaluate! context valueI) - (\ try.monad map product.left - (..evaluate! library loader context valueI))) - - (def: execute! - (..execute! library loader)) - - (def: define! - (..define! library loader)) - - (def: (ingest context bytecode) - [(..class_name context) bytecode]) - - (def: (re_learn context custom [_ bytecode]) - (io.run - (loader.store (maybe.default (..class_name context) custom) bytecode library))) - - (def: (re_load context custom [_ bytecode]) - (io.run - (do (try.with io.monad) - [#let [class_name (maybe.default (..class_name context) custom)] - _ (loader.store class_name bytecode library) - class (loader.load class_name loader)] - (\ io.monad wrap (..class_value class_name class)))))))))) + [loader + (: Host + (implementation + (def: (evaluate! context valueI) + (\ try.monad map product.left + (..evaluate! library loader context valueI))) + + (def: execute! + (..execute! library loader)) + + (def: define! + (..define! library loader)) + + (def: (ingest context bytecode) + [(..class_name context) bytecode]) + + (def: (re_learn context custom [_ bytecode]) + (io.run + (loader.store (maybe.default (..class_name context) custom) bytecode library))) + + (def: (re_load context custom [directive_name bytecode]) + (io.run + (do (try.with io.monad) + [#let [class_name (maybe.default (..class_name context) + custom)] + _ (loader.store class_name bytecode library) + class (loader.load class_name loader)] + (\ io.monad wrap (..class_value class_name class)))))))]))) (def: #export $Variant (type.array ..$Value)) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux index 65e5dba62..b7b1d6b0f 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux @@ -53,7 +53,7 @@ (def: pushI Inst - (_.INVOKESTATIC //.$Runtime "pm_push" (type.method [(list runtime.$Stack //.$Value) runtime.$Stack (list)]))) + (_.INVOKESTATIC //.$Runtime "pm_push" (type.method [(list) (list runtime.$Stack //.$Value) runtime.$Stack (list)]))) (def: popI (|>> (_.int +1) @@ -80,7 +80,7 @@ lefts [(leftsI lefts) - (_.INVOKESTATIC //.$Runtime "tuple_left" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]))])] + (_.INVOKESTATIC //.$Runtime "tuple_left" (type.method [(list) (list //.$Tuple runtime.$Index) //.$Value (list)]))])] (|>> (_.CHECKCAST //.$Tuple) indexI accessI))) @@ -89,7 +89,7 @@ (-> Nat Inst) (|>> (_.CHECKCAST //.$Tuple) (leftsI lefts) - (_.INVOKESTATIC //.$Runtime "tuple_right" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)])))) + (_.INVOKESTATIC //.$Runtime "tuple_right" (type.method [(list) (list //.$Tuple runtime.$Index) //.$Value (list)])))) (def: (path' stack_depth @else @end phase archive path) (-> Nat Label Label Phase Archive Path (Operation Inst)) @@ -144,7 +144,7 @@ ([#synthesis.I64_Fork (_.unwrap type.long) _.DUP2 _.POP2 (|>> .int _.long) _.LCMP _.IFNE] [#synthesis.F64_Fork (_.unwrap type.double) _.DUP2 _.POP2 _.double _.DCMPL _.IFNE] [#synthesis.Text_Fork (|>) _.DUP _.POP _.string - (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list)) "equals" (type.method [(list //.$Value) type.boolean (list)])) + (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list)) "equals" (type.method [(list) (list //.$Value) type.boolean (list)])) _.IFEQ]) (#synthesis.Then bodyS) @@ -162,7 +162,7 @@ (_.CHECKCAST //.$Variant) (structure.tagI lefts <right?>) (structure.flagI <right?>) - (_.INVOKESTATIC //.$Runtime "pm_variant" (type.method [(list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)])) + (_.INVOKESTATIC //.$Runtime "pm_variant" (type.method [(list) (list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)])) _.DUP (_.IFNULL @fail) (_.GOTO @success) @@ -220,7 +220,7 @@ (wrap (|>> pathI (_.label @else) _.POP - (_.INVOKESTATIC //.$Runtime "pm_fail" (type.method [(list) type.void (list)])) + (_.INVOKESTATIC //.$Runtime "pm_fail" (type.method [(list) (list) type.void (list)])) _.NULL (_.GOTO @end))))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux index d79362d79..70175b636 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux @@ -216,20 +216,20 @@ [i64::f64 (_.unwrap type.long) (<| (_.wrap type.double) _.L2D)] [i64::char (_.unwrap type.long) - ((|>> _.L2I _.I2C (_.INVOKESTATIC (type.class "java.lang.Character" (list)) "toString" (type.method [(list type.char) $String (list)]))))] + ((|>> _.L2I _.I2C (_.INVOKESTATIC (type.class "java.lang.Character" (list)) "toString" (type.method [(list) (list type.char) $String (list)]))))] [f64::i64 (_.unwrap type.double) (<| (_.wrap type.long) _.D2L)] [f64::encode (_.unwrap type.double) - (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "toString" (type.method [(list type.double) $String (list)]))] + (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "toString" (type.method [(list) (list type.double) $String (list)]))] [f64::decode ..check_stringI - (_.INVOKESTATIC ///.$Runtime "decode_frac" (type.method [(list $String) ///.$Variant (list)]))] + (_.INVOKESTATIC ///.$Runtime "decode_frac" (type.method [(list) (list $String) ///.$Variant (list)]))] ) (def: (text::size inputI) (Unary Inst) (|>> inputI ..check_stringI - (_.INVOKEVIRTUAL $String "length" (type.method [(list) type.int (list)])) + (_.INVOKEVIRTUAL $String "length" (type.method [(list) (list) type.int (list)])) lux_intI)) (template [<name> <pre_subject> <pre_param> <op> <post>] @@ -240,13 +240,13 @@ <op> <post>))] [text::= (<|) (<|) - (_.INVOKEVIRTUAL $Object "equals" (type.method [(list $Object) type.boolean (list)])) + (_.INVOKEVIRTUAL $Object "equals" (type.method [(list) (list $Object) type.boolean (list)])) (_.wrap type.boolean)] [text::< ..check_stringI ..check_stringI - (_.INVOKEVIRTUAL $String "compareTo" (type.method [(list $String) type.int (list)])) + (_.INVOKEVIRTUAL $String "compareTo" (type.method [(list) (list $String) type.int (list)])) (predicateI _.IFLT)] [text::char ..check_stringI jvm_intI - (_.INVOKEVIRTUAL $String "charAt" (type.method [(list type.int) type.char (list)])) + (_.INVOKEVIRTUAL $String "charAt" (type.method [(list) (list type.int) type.char (list)])) lux_intI] ) @@ -254,7 +254,7 @@ (Binary Inst) (|>> leftI ..check_stringI rightI ..check_stringI - (_.INVOKEVIRTUAL $String "concat" (type.method [(list $String) $String (list)])))) + (_.INVOKEVIRTUAL $String "concat" (type.method [(list) (list $String) $String (list)])))) (def: (text::clip [offsetI lengthI subjectI]) (Trinary Inst) @@ -263,9 +263,9 @@ _.DUP lengthI jvm_intI _.IADD - (_.INVOKEVIRTUAL $String "substring" (type.method [(list type.int type.int) $String (list)])))) + (_.INVOKEVIRTUAL $String "substring" (type.method [(list) (list type.int type.int) $String (list)])))) -(def: index_method (type.method [(list $String type.int) type.int (list)])) +(def: index_method (type.method [(list) (list $String type.int) type.int (list)])) (def: (text::index [startI partI textI]) (Trinary Inst) (<| _.with_label (function (_ @not_found)) @@ -285,7 +285,7 @@ runtime.noneI (_.label @end)))) -(def: string_method (type.method [(list $String) type.void (list)])) +(def: string_method (type.method [(list) (list $String) type.void (list)])) (def: (io::log messageI) (Unary Inst) (let [$PrintStream (type.class "java.io.PrintStream" (list))] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux index 441a415ee..a9727fc9a 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux @@ -536,7 +536,7 @@ (do phase.monad [] (wrap (|>> (_.string class) - (_.INVOKESTATIC $Class "forName" (type.method [(list (type.class "java.lang.String" (list))) $Class (list)]))))) + (_.INVOKESTATIC $Class "forName" (type.method [(list) (list (type.class "java.lang.String" (list))) $Class (list)]))))) _ (phase.throw extension.invalid_syntax [extension_name %synthesis inputs]))) @@ -725,7 +725,7 @@ (do {@ phase.monad} [inputsTI (monad.map @ (generate_input generate archive) inputsTS)] (wrap (|>> (_.fuse (list@map product.right inputsTI)) - (_.INVOKESTATIC class method (type.method [(list@map product.left inputsTI) outputT (list)])) + (_.INVOKESTATIC class method (type.method [(list) (list@map product.left inputsTI) outputT (list)])) (prepare_output outputT)))))])) (template [<name> <invoke>] @@ -741,7 +741,8 @@ (_.CHECKCAST class) (_.fuse (list@map product.right inputsTI)) (<invoke> class method - (type.method [(list@map product.left inputsTI) + (type.method [(list) + (list@map product.left inputsTI) outputT (list)])) (prepare_output outputT)))))]))] @@ -761,7 +762,7 @@ (wrap (|>> (_.NEW class) _.DUP (_.fuse (list@map product.right inputsTI)) - (_.INVOKESPECIAL class "<init>" (type.method [(list@map product.left inputsTI) type.void (list)]))))))])) + (_.INVOKESPECIAL class "<init>" (type.method [(list) (list@map product.left inputsTI) type.void (list)]))))))])) (def: member Bundle @@ -919,7 +920,8 @@ (def: (anonymous_init_method env) (-> (Environment Synthesis) (Type Method)) - (type.method [(list.repeat (list.size env) $Object) + (type.method [(list) + (list.repeat (list.size env) $Object) type.void (list)])) @@ -936,7 +938,7 @@ (_def.method #$.Public $.noneM "<init>" (anonymous_init_method env) (|>> (_.ALOAD 0) ((_.fuse (list@map product.right inputsTI))) - (_.INVOKESPECIAL super_class "<init>" (type.method [(list@map product.left inputsTI) type.void (list)])) + (_.INVOKESPECIAL super_class "<init>" (type.method [(list) (list@map product.left inputsTI) type.void (list)])) store_capturedI _.RETURN)))) @@ -986,7 +988,8 @@ (<synthesis>.tuple (<>.some ..class)) (<synthesis>.tuple (<>.some ..input)) (<synthesis>.tuple (<>.some ..overriden_method_definition))) - (function (_ extension_name generate archive [super_class super_interfaces + (function (_ extension_name generate archive [super_class + super_interfaces inputsTS overriden_methods]) (do {@ phase.monad} @@ -1040,7 +1043,8 @@ ($_ $.++M $.finalM $.strictM) $.finalM) name - (type.method [(list@map product.right arguments) + (type.method [(list) + (list@map product.right arguments) returnT exceptionsT]) (|>> bodyG (returnI returnT))))))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux index 394b0b7b5..9e0f9f225 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux @@ -57,15 +57,16 @@ (def: (init_method env arity) (-> (Environment Synthesis) Arity (Type Method)) (if (poly_arg? arity) - (type.method [(list.concat (list (captured_args env) + (type.method [(list) + (list.concat (list (captured_args env) (list type.int) (list.repeat (dec arity) //.$Value))) type.void (list)]) - (type.method [(captured_args env) type.void (list)]))) + (type.method [(list) (captured_args env) type.void (list)]))) (def: (implementation_method arity) - (type.method [(list.repeat arity //.$Value) //.$Value (list)])) + (type.method [(list) (list.repeat arity //.$Value) //.$Value (list)])) (def: get_amount_of_partialsI Inst @@ -122,7 +123,7 @@ (def: (reset_method return) (-> (Type Class) (Type Method)) - (type.method [(list) return (list)])) + (type.method [(list) (list) return (list)])) (def: (with_reset class arity env) (-> (Type Class) Arity (Environment Synthesis) Def) @@ -156,7 +157,7 @@ _.ARETURN))) (def: function_init_method - (type.method [(list type.int) type.void (list)])) + (type.method [(list) (list type.int) type.void (list)])) (def: (function_init arity env_size) (-> Arity Nat Inst) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/program.lux b/lux-jvm/source/luxc/lang/translation/jvm/program.lux index 1ebdf33f0..9cd8eeb82 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/program.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/program.lux @@ -73,7 +73,8 @@ run_ioI (|>> ($i.CHECKCAST jvm.$Function) $i.NULL ($i.INVOKEVIRTUAL jvm.$Function runtime.apply_method (runtime.apply_signature 1))) - main_type ($t.method [(list ($t.array ($t.class "java.lang.String" (list)))) + main_type ($t.method [(list) + (list ($t.array ($t.class "java.lang.String" (list)))) $t.void (list)]) class (artifact_name context)] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux index e0426f363..cccdf42bf 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux @@ -48,22 +48,22 @@ (def: $Throwable (type.class "java.lang.Throwable" (list))) (def: nullary_init_methodT - (type.method [(list) type.void (list)])) + (type.method [(list) (list) type.void (list)])) (def: throw_methodT - (type.method [(list) type.void (list)])) + (type.method [(list) (list) type.void (list)])) (def: #export logI Inst (let [PrintStream (type.class "java.io.PrintStream" (list)) outI (_.GETSTATIC (type.class "java.lang.System" (list)) "out" PrintStream) printI (function (_ method) - (_.INVOKEVIRTUAL PrintStream method (type.method [(list $Value) type.void (list)])))] + (_.INVOKEVIRTUAL PrintStream method (type.method [(list) (list $Value) type.void (list)])))] (|>> outI (_.string "LOG: ") (printI "print") outI _.SWAP (printI "println")))) (def: variant_method - (type.method [(list $Tag $Flag $Value) //.$Variant (list)])) + (type.method [(list) (list $Tag $Flag $Value) //.$Variant (list)])) (def: #export variantI Inst @@ -115,7 +115,7 @@ (def: #export (apply_signature arity) (-> Arity (Type Method)) - (type.method [(list.repeat arity $Value) $Value (list)])) + (type.method [(list) (list.repeat arity $Value) $Value (list)])) (def: adt_methods Def @@ -123,7 +123,7 @@ store_flagI (|>> _.DUP _.ICONST_1 (_.ALOAD 1) _.AASTORE) store_valueI (|>> _.DUP _.ICONST_2 (_.ALOAD 2) _.AASTORE)] (|>> ($d.method #$.Public $.staticM "variant_make" - (type.method [(list $Tag $Flag $Value) //.$Variant (list)]) + (type.method [(list) (list $Tag $Flag $Value) //.$Variant (list)]) (|>> _.ICONST_3 (_.ANEWARRAY $Value) store_tagI @@ -133,10 +133,10 @@ (def: frac_methods Def - (|>> ($d.method #$.Public $.staticM "decode_frac" (type.method [(list $Text) //.$Variant (list)]) + (|>> ($d.method #$.Public $.staticM "decode_frac" (type.method [(list) (list $Text) //.$Variant (list)]) (tryI (|>> (_.ALOAD 0) - (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "parseDouble" (type.method [(list $Text) type.double (list)])) + (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "parseDouble" (type.method [(list) (list $Text) type.double (list)])) (_.wrap type.double)))) )) @@ -146,7 +146,7 @@ (|>> (_.NEW IllegalStateException) _.DUP (_.string message) - (_.INVOKESPECIAL IllegalStateException "<init>" (type.method [(list $Text) type.void (list)]))))) + (_.INVOKESPECIAL IllegalStateException "<init>" (type.method [(list) (list $Text) type.void (list)]))))) (def: pm_methods Def @@ -175,7 +175,7 @@ ($d.method #$.Public $.staticM "apply_fail" throw_methodT (|>> (illegal_state_exception "Error while applying function.") _.ATHROW)) - ($d.method #$.Public $.staticM "pm_push" (type.method [(list $Stack $Value) $Stack (list)]) + ($d.method #$.Public $.staticM "pm_push" (type.method [(list) (list $Stack $Value) $Stack (list)]) (|>> _.ICONST_2 (_.ANEWARRAY $Value) _.DUP @@ -187,7 +187,7 @@ (_.ALOAD 1) _.AASTORE _.ARETURN)) - ($d.method #$.Public $.staticM "pm_variant" (type.method [(list //.$Variant $Tag $Flag) $Value (list)]) + ($d.method #$.Public $.staticM "pm_variant" (type.method [(list) (list //.$Variant $Tag $Flag) $Value (list)]) (<| _.with_label (function (_ @loop)) _.with_label (function (_ @perfect_match!)) _.with_label (function (_ @tags_match!)) @@ -247,7 +247,7 @@ ## _.POP2 not_found _.ARETURN))) - ($d.method #$.Public $.staticM "tuple_left" (type.method [(list //.$Tuple $Index) $Value (list)]) + ($d.method #$.Public $.staticM "tuple_left" (type.method [(list) (list //.$Tuple $Index) $Value (list)]) (<| _.with_label (function (_ @loop)) _.with_label (function (_ @recursive)) (let [left_accessI (|>> (_.ALOAD 0) left_indexI _.AALOAD)]) @@ -258,7 +258,7 @@ (_.label @recursive) ## Recursive (recurI @loop)))) - ($d.method #$.Public $.staticM "tuple_right" (type.method [(list //.$Tuple $Index) $Value (list)]) + ($d.method #$.Public $.staticM "tuple_right" (type.method [(list) (list //.$Tuple $Index) $Value (list)]) (<| _.with_label (function (_ @loop)) _.with_label (function (_ @not_tail)) _.with_label (function (_ @slice)) @@ -272,7 +272,8 @@ right_indexI tuple_sizeI (_.INVOKESTATIC (type.class "java.util.Arrays" (list)) "copyOfRange" - (type.method [(list //.$Tuple $Index $Index) + (type.method [(list) + (list //.$Tuple $Index $Index) //.$Tuple (list)])))]) (|>> (_.label @loop) @@ -291,7 +292,7 @@ ))) ))) -(def: #export try (type.method [(list //.$Function) //.$Variant (list)])) +(def: #export try (type.method [(list) (list //.$Function) //.$Variant (list)])) (def: io_methods Def @@ -306,7 +307,7 @@ _.POP _.SWAP (_.boolean true) - (_.INVOKESPECIAL PrintWriter "<init>" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) + (_.INVOKESPECIAL PrintWriter "<init>" (type.method [(list) (list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) )] (|>> ($d.method #$.Public $.staticM "try" ..try (<| _.with_label (function (_ @from)) @@ -324,8 +325,8 @@ string_writerI ## TW _.DUP2 ## TWTW print_writerI ## TWTP - (_.INVOKEVIRTUAL $Throwable "printStackTrace" (type.method [(list (type.class "java.io.PrintWriter" (list))) type.void (list)])) ## TW - (_.INVOKEVIRTUAL StringWriter "toString" (type.method [(list) $Text (list)])) ## TS + (_.INVOKEVIRTUAL $Throwable "printStackTrace" (type.method [(list) (list (type.class "java.io.PrintWriter" (list))) type.void (list)])) ## TW + (_.INVOKEVIRTUAL StringWriter "toString" (type.method [(list) (list) $Text (list)])) ## TS _.SWAP _.POP leftI _.ARETURN))) ))) @@ -375,7 +376,7 @@ function_class (..reflection //.$Function) bytecode ($d.abstract #$.V1_6 #$.Public $.noneC function_class (list) $Object (list) (|>> ($d.field #$.Public $.finalF partials_field type.int) - ($d.method #$.Public $.noneM "<init>" (type.method [(list type.int) type.void (list)]) + ($d.method #$.Public $.noneM "<init>" (type.method [(list) (list type.int) type.void (list)]) (|>> (_.ALOAD 0) (_.INVOKESPECIAL $Object "<init>" nullary_init_methodT) (_.ALOAD 0) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux index 16b320b6d..a9666958b 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux @@ -114,6 +114,7 @@ memberI (_.INVOKESTATIC //.$Runtime "variant_make" - (type.method [(list //runtime.$Tag //runtime.$Flag //runtime.$Value) + (type.method [(list) + (list //runtime.$Tag //runtime.$Flag //runtime.$Value) //.$Variant (list)])))))) diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux index 185d2d9ba..13979573d 100644 --- a/lux-jvm/source/program.lux +++ b/lux-jvm/source/program.lux @@ -78,6 +78,8 @@ ["#::." (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object)]) +(import: java/lang/ClassLoader) + (import: (java/lang/Class c) ["#::." (getMethod [java/lang/String [(java/lang/Class java/lang/Object)]] #try java/lang/reflect/Method)]) @@ -226,18 +228,20 @@ (def: #export platform ## (IO (Platform Anchor (Bytecode Any) Definition)) - (IO (Platform _.Anchor _.Inst _.Definition)) + (IO [java/lang/ClassLoader + (Platform _.Anchor _.Inst _.Definition)]) (do io.monad [## host jvm/host.host - host jvm.host] - (wrap {#platform.&file_system (file.async file.default) - #platform.host host - ## #platform.phase jvm.generate - #platform.phase expression.translate - ## #platform.runtime runtime.generate - #platform.runtime runtime.translate - #platform.phase_wrapper ..phase_wrapper - #platform.write product.right}))) + [loader host] jvm.host] + (wrap [loader + {#platform.&file_system (file.async file.default) + #platform.host host + ## #platform.phase jvm.generate + #platform.phase expression.translate + ## #platform.runtime runtime.generate + #platform.runtime runtime.translate + #platform.phase_wrapper ..phase_wrapper + #platform.write product.right}]))) (def: (extender phase_wrapper) (-> platform.Phase_Wrapper Extender) @@ -278,13 +282,14 @@ #/static.target (/cli.target service) #/static.artifact_extension ".class"}] (exec (do promise.monad - [_ (/.compiler {#/static.host @.jvm + [[loader platform] (promise.future ..platform) + _ (/.compiler {#/static.host @.jvm #/static.host_module_extension ".jvm" #/static.target (/cli.target service) #/static.artifact_extension ".class"} ..expander - analysis.bundle - ..platform + (analysis.bundle loader) + (io.io platform) ## generation.bundle translation.bundle (|>> ..extender directive.bundle) diff --git a/stdlib/commands.md b/stdlib/commands.md index 29af59778..375800f92 100644 --- a/stdlib/commands.md +++ b/stdlib/commands.md @@ -6,6 +6,10 @@ cd ~/lux/stdlib/ \ && lein clean \ && lein with-profile bibliotheca lux auto test + +cd ~/lux/stdlib/ \ +&& lux clean \ +&& lux auto test ``` ## Deploy @@ -42,6 +46,11 @@ cd ~/lux/stdlib/ \ cd ~/lux/stdlib/ \ && lein clean \ && lein with-profile aedifex lux auto build + +cd ~/lux/stdlib/ \ +&& lein clean \ +&& lein with-profile aedifex lux build \ +&& mv target/program.jar aedifex.jar ``` ## Test diff --git a/stdlib/project.lux b/stdlib/project.lux new file mode 100644 index 000000000..919e9e489 --- /dev/null +++ b/stdlib/project.lux @@ -0,0 +1,11 @@ +{#identity ["com.github.luxlang" "stdlib" "0.6.0-SNAPSHOT"] + + #deploy_repositories {"snapshots" "https://oss.sonatype.org/content/repositories/snapshots/" + "releases" "https://oss.sonatype.org/service/local/staging/deploy/maven2/"} + + #repositories ["https://oss.sonatype.org/content/repositories/snapshots/" + "https://oss.sonatype.org/service/local/staging/deploy/maven2/"] + + #compiler ["com.github.luxlang" "lux-jvm" "0.6.0-SNAPSHOT" "jar"] + + #test "test/lux"} diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 881c3f79d..b265e3e42 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -720,11 +720,12 @@ (-> (List (Type Var)) (Parser [Member_Declaration MethodDecl])) (<code>.form (do <>.monad [tvars (<>.default (list) ..vars^) + #let [total_vars (list\compose tvars type_vars)] name <code>.local_identifier anns ..annotations^ - inputs (<code>.tuple (<>.some (..type^ type_vars))) - output (..return^ type_vars) - exs (throws_decl^ type_vars)] + inputs (<code>.tuple (<>.some (..type^ total_vars))) + output (..return^ total_vars) + exs (throws_decl^ total_vars)] (wrap [[name #PublicP anns] {#method_tvars tvars #method_inputs inputs #method_output output @@ -1203,7 +1204,8 @@ (#private baz java/lang/Object) ## Methods (#public [] (new [value A]) [] - (exec (:= ::foo #1) + (exec + (:= ::foo #1) (:= ::bar value) (:= ::baz "") [])) @@ -1225,15 +1227,14 @@ "(::resolve! container [value]) for calling the 'resolve' method." )} (do meta.monad - [current_module meta.current_module_name - #let [fully_qualified_class_name (name.qualify current_module full_class_name) + [#let [fully_qualified_class_name full_class_name field_parsers (list\map (field->parser fully_qualified_class_name) fields) method_parsers (list\map (method->parser fully_qualified_class_name) methods) replacer (parser->replacer (list\fold <>.either (<>.fail "") (list\compose field_parsers method_parsers)))]] (wrap (list (` ("jvm class" - (~ (declaration$ (type.declaration (name.qualify current_module full_class_name) class_vars))) + (~ (declaration$ (type.declaration full_class_name class_vars))) (~ (class$ super)) [(~+ (list\map class$ interfaces))] (~ (inheritance_modifier$ im)) @@ -1251,13 +1252,11 @@ {#.doc (doc "Allows defining JVM interfaces." (interface: TestInterface ([] foo [boolean String] void #throws [Exception])))} - (do meta.monad - [current_module meta.current_module_name] - (wrap (list (` ("jvm class interface" - (~ (declaration$ (type.declaration (name.qualify current_module full_class_name) class_vars))) - [(~+ (list\map class$ supers))] - [(~+ (list\map annotation$ annotations))] - (~+ (list\map method_decl$ members)))))))) + (wrap (list (` ("jvm class interface" + (~ (declaration$ (type.declaration full_class_name class_vars))) + [(~+ (list\map class$ supers))] + [(~+ (list\map annotation$ annotations))] + (~+ (list\map method_decl$ members))))))) (syntax: #export (object {class_vars ..vars^} diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index c50278c28..82b2d30db 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -967,7 +967,7 @@ (template [<static?> <name> <instruction> <method>] [(def: #export (<name> class method type) (-> (Type Class) Text (Type Method) (Bytecode Any)) - (let [[inputs output exceptions] (parser.method type)] + (let [[type_variables inputs output exceptions] (parser.method type)] (do ..monad [index (<| ..lift (<method> (..reflection class)) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux index 05872be60..090fc64fe 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux @@ -36,7 +36,7 @@ (def: (minimal type) (-> (Type Method) Nat) - (let [[inputs output exceptions] (/////type/parser.method type)] + (let [[type_variables inputs output exceptions] (/////type/parser.method type)] (|> inputs (list\map (function (_ input) (if (or (is? /////type.long input) diff --git a/stdlib/source/library/lux/target/jvm/loader.lux b/stdlib/source/library/lux/target/jvm/loader.lux index 8b86321ca..c76ff1310 100644 --- a/stdlib/source/library/lux/target/jvm/loader.lux +++ b/stdlib/source/library/lux/target/jvm/loader.lux @@ -2,6 +2,7 @@ [library [lux #* ["@" target] + ["." ffi (#+ import: object do_to)] [abstract [monad (#+ do)]] [control @@ -16,8 +17,7 @@ ["%" format (#+ format)]] [collection ["." array] - ["." dictionary (#+ Dictionary)]]] - ["." ffi (#+ import: object do_to)]]]) + ["." dictionary (#+ Dictionary)]]]]]) (type: #export Library (Atom (Dictionary Text Binary))) diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux index e2297f313..50bb2b974 100644 --- a/stdlib/source/library/lux/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/reflection.lux @@ -96,9 +96,11 @@ (getGenericParameterTypes [] [java/lang/reflect/Type]) (getGenericExceptionTypes [] [java/lang/reflect/Type])]) +(import: java/lang/ClassLoader) + (import: (java/lang/Class c) ["#::." - (#static forName [java/lang/String] #try (java/lang/Class java/lang/Object)) + (#static forName [java/lang/String boolean java/lang/ClassLoader] #try (java/lang/Class java/lang/Object)) (getName [] java/lang/String) (getModifiers [] int) (isAssignableFrom [(java/lang/Class java/lang/Object)] boolean) @@ -123,20 +125,20 @@ [cannot_convert_to_a_lux_type] ) -(def: #export (load name) - (-> External (Try (java/lang/Class java/lang/Object))) - (case (java/lang/Class::forName name) +(def: #export (load class_loader name) + (-> java/lang/ClassLoader External (Try (java/lang/Class java/lang/Object))) + (case (java/lang/Class::forName name false class_loader) (#try.Success class) (#try.Success class) (#try.Failure _) (exception.throw ..unknown_class name))) -(def: #export (sub? super sub) - (-> External External (Try Bit)) +(def: #export (sub? class_loader super sub) + (-> java/lang/ClassLoader External External (Try Bit)) (do try.monad - [super (..load super) - sub (..load sub)] + [super (..load class_loader super) + sub (..load class_loader sub)] (wrap (java/lang/Class::isAssignableFrom sub super)))) (def: (class' parameter reflection) diff --git a/stdlib/source/library/lux/target/jvm/type.lux b/stdlib/source/library/lux/target/jvm/type.lux index e11ef5c99..9b29382c7 100644 --- a/stdlib/source/library/lux/target/jvm/type.lux +++ b/stdlib/source/library/lux/target/jvm/type.lux @@ -130,13 +130,15 @@ (/descriptor.upper descriptor) (/reflection.upper reflection)]))) - (def: #export (method [inputs output exceptions]) - (-> [(List (Type Value)) + (def: #export (method [type_variables inputs output exceptions]) + (-> [(List (Type Var)) + (List (Type Value)) (Type Return) (List (Type Class))] (Type Method)) (:abstraction - [(/signature.method [(list\map ..signature inputs) + [(/signature.method [(list\map ..signature type_variables) + (list\map ..signature inputs) (..signature output) (list\map ..signature exceptions)]) (/descriptor.method [(list\map ..descriptor inputs) diff --git a/stdlib/source/library/lux/target/jvm/type/alias.lux b/stdlib/source/library/lux/target/jvm/type/alias.lux index 56ffbe127..d52051f04 100644 --- a/stdlib/source/library/lux/target/jvm/type/alias.lux +++ b/stdlib/source/library/lux/target/jvm/type/alias.lux @@ -7,7 +7,7 @@ ["." try] ["." exception (#+ exception:)] ["<>" parser - ["<t>" text (#+ Parser)]]] + ["<.>" text (#+ Parser)]]] [data ["." maybe] ["." text @@ -45,17 +45,17 @@ (|> (do <>.monad [name //parser.class_name parameters (|> (<>.some parameter) - (<>.after (<t>.this //signature.parameters_start)) - (<>.before (<t>.this //signature.parameters_end)) + (<>.after (<text>.this //signature.parameters_start)) + (<>.before (<text>.this //signature.parameters_end)) (<>.default (list)))] (wrap (//.class name parameters))) - (<>.after (<t>.this //descriptor.class_prefix)) - (<>.before (<t>.this //descriptor.class_suffix)))) + (<>.after (<text>.this //descriptor.class_prefix)) + (<>.before (<text>.this //descriptor.class_suffix)))) (template [<name> <prefix> <bound> <constructor>] [(def: <name> (-> (Parser (Type Class)) (Parser (Type Parameter))) - (|>> (<>.after (<t>.this <prefix>)) + (|>> (<>.after (<text>.this <prefix>)) (\ <>.monad map <bound>)))] [lower //signature.lower_prefix //.lower ..Lower] @@ -88,8 +88,8 @@ (def: (inputs aliasing) (-> Aliasing (Parser (List (Type Value)))) (|> (<>.some (..value aliasing)) - (<>.after (<t>.this //signature.arguments_start)) - (<>.before (<t>.this //signature.arguments_end)))) + (<>.after (<text>.this //signature.arguments_start)) + (<>.before (<text>.this //signature.arguments_end)))) (def: (return aliasing) (-> Aliasing (Parser (Type Return))) @@ -101,16 +101,20 @@ (def: (exception aliasing) (-> Aliasing (Parser (Type Class))) (|> (..class (..parameter aliasing)) - (<>.after (<t>.this //signature.exception_prefix)))) + (<>.after (<text>.this //signature.exception_prefix)))) (def: #export (method aliasing type) (-> Aliasing (Type Method) (Type Method)) (|> type //.signature //signature.signature - (<t>.run (do <>.monad - [inputs (..inputs aliasing) - return (..return aliasing) - exceptions (<>.some (..exception aliasing))] - (wrap (//.method [inputs return exceptions])))) + (<text>.run (do <>.monad + [type_variables (|> (<>.some (..var aliasing)) + (<>.after (<text>.this //signature.parameters_start)) + (<>.before (<text>.this //signature.parameters_end)) + (<>.default (list))) + inputs (..inputs aliasing) + return (..return aliasing) + exceptions (<>.some (..exception aliasing))] + (wrap (//.method [type_variables inputs return exceptions])))) try.assume)) diff --git a/stdlib/source/library/lux/target/jvm/type/parser.lux b/stdlib/source/library/lux/target/jvm/type/parser.lux index 5b9a3e1af..eac2f5fcb 100644 --- a/stdlib/source/library/lux/target/jvm/type/parser.lux +++ b/stdlib/source/library/lux/target/jvm/type/parser.lux @@ -7,7 +7,7 @@ ["." try] ["." function] ["<>" parser ("#\." monad) - ["<t>" text (#+ Parser)]]] + ["<.>" text (#+ Parser)]]] [data ["." product] [text @@ -25,7 +25,7 @@ (template [<category> <name> <signature> <type>] [(def: #export <name> (Parser (Type <category>)) - (<>.after (<t>.this (//signature.signature <signature>)) + (<>.after (<text>.this (//signature.signature <signature>)) (<>\wrap <type>)))] [Void void //signature.void //.void] @@ -69,8 +69,8 @@ [(def: #export <name> (Parser <type>) (\ <>.functor map <adapter> - (<t>.slice (<t>.and! (<t>.one_of! <head>) - (<t>.some! (<t>.one_of! <tail>))))))] + (<text>.slice (<text>.and! (<text>.one_of! <head>) + (<text>.some! (<text>.one_of! <tail>))))))] [External class_name class/set class/set (|>> //name.internal //name.external)] [Text var_name var/head var/tail function.identity] @@ -79,8 +79,8 @@ (def: #export var' (Parser Text) (|> ..var_name - (<>.after (<t>.this //signature.var_prefix)) - (<>.before (<t>.this //descriptor.class_suffix)))) + (<>.after (<text>.this //signature.var_prefix)) + (<>.before (<text>.this //descriptor.class_suffix)))) (def: #export var (Parser (Type Var)) @@ -90,20 +90,20 @@ (-> (Type Value) (Maybe Text)) (|>> //.signature //signature.signature - (<t>.run ..var') + (<text>.run ..var') try.to_maybe)) (def: #export name (-> (Type Var) Text) (|>> //.signature //signature.signature - (<t>.run ..var') + (<text>.run ..var') try.assume)) (template [<name> <prefix> <constructor>] [(def: <name> (-> (Parser (Type Class)) (Parser (Type Parameter))) - (|>> (<>.after (<t>.this <prefix>)) + (|>> (<>.after (<text>.this <prefix>)) (<>\map <constructor>)))] [lower //signature.lower_prefix //.lower] @@ -115,12 +115,12 @@ (|> (do <>.monad [name ..class_name parameters (|> (<>.some parameter) - (<>.after (<t>.this //signature.parameters_start)) - (<>.before (<t>.this //signature.parameters_end)) + (<>.after (<text>.this //signature.parameters_start)) + (<>.before (<text>.this //signature.parameters_end)) (<>.default (list)))] (wrap [name parameters])) - (<>.after (<t>.this //descriptor.class_prefix)) - (<>.before (<t>.this //descriptor.class_suffix)))) + (<>.after (<text>.this //descriptor.class_prefix)) + (<>.before (<text>.this //descriptor.class_suffix)))) (def: class' (-> (Parser (Type Parameter)) (Parser (Type Class))) @@ -142,7 +142,7 @@ (def: #export array' (-> (Parser (Type Value)) (Parser (Type Array))) - (|>> (<>.after (<t>.this //descriptor.array_prefix)) + (|>> (<>.after (<text>.this //descriptor.array_prefix)) (<>\map //.array))) (def: #export class @@ -154,7 +154,7 @@ (-> (Type Value) (Maybe (Type Class))) (|>> //.signature //signature.signature - (<t>.run (<>.after (<t>.this <prefix>) ..class)) + (<text>.run (<>.after (<text>.this <prefix>) ..class)) try.to_maybe))] [lower? //signature.lower_prefix //.lower] @@ -165,7 +165,7 @@ (-> (Type Class) [External (List (Type Parameter))]) (|>> //.signature //signature.signature - (<t>.run (..class'' ..parameter)) + (<text>.run (..class'' ..parameter)) try.assume)) (def: #export value @@ -190,8 +190,8 @@ (def: inputs (|> (<>.some ..value) - (<>.after (<t>.this //signature.arguments_start)) - (<>.before (<t>.this //signature.arguments_end)))) + (<>.after (<text>.this //signature.arguments_start)) + (<>.before (<text>.this //signature.arguments_end)))) (def: #export return (Parser (Type Return)) @@ -201,19 +201,29 @@ (def: exception (Parser (Type Class)) (|> (..class' ..parameter) - (<>.after (<t>.this //signature.exception_prefix)))) + (<>.after (<text>.this //signature.exception_prefix)))) (def: #export method (-> (Type Method) - [(List (Type Value)) (Type Return) (List (Type Class))]) - (let [parser (do <>.monad - [inputs ..inputs - return ..return - exceptions (<>.some ..exception)] - (wrap [inputs return exceptions]))] + [(List (Type Var)) + (List (Type Value)) + (Type Return) + (List (Type Class))]) + (let [parser (: (Parser [(List (Type Var)) + (List (Type Value)) + (Type Return) + (List (Type Class))]) + ($_ <>.and + (|> (<>.some ..var) + (<>.after (<text>.this //signature.parameters_start)) + (<>.before (<text>.this //signature.parameters_end)) + (<>.default (list))) + ..inputs + ..return + (<>.some ..exception)))] (|>> //.signature //signature.signature - (<t>.run parser) + (<text>.run parser) try.assume))) (template [<name> <category> <parser>] @@ -221,12 +231,12 @@ (-> (Type Value) (Maybe <category>)) (|>> //.signature //signature.signature - (<t>.run <parser>) + (<text>.run <parser>) try.to_maybe))] [array? (Type Value) (do <>.monad - [_ (<t>.this //descriptor.array_prefix)] + [_ (<text>.this //descriptor.array_prefix)] ..value)] [class? [External (List (Type Parameter))] (..class'' ..parameter)] @@ -237,17 +247,19 @@ [object? (Type Object) ..object] ) +(def: #export declaration' + (Parser [External (List (Type Var))]) + (|> (<>.and ..class_name + (|> (<>.some ..var) + (<>.after (<text>.this //signature.parameters_start)) + (<>.before (<text>.this //signature.parameters_end)) + (<>.default (list)))) + (<>.after (<text>.this //descriptor.class_prefix)) + (<>.before (<text>.this //descriptor.class_suffix)))) + (def: #export declaration (-> (Type Declaration) [External (List (Type Var))]) - (let [declaration' (: (Parser [External (List (Type Var))]) - (|> (<>.and ..class_name - (|> (<>.some ..var) - (<>.after (<t>.this //signature.parameters_start)) - (<>.before (<t>.this //signature.parameters_end)) - (<>.default (list)))) - (<>.after (<t>.this //descriptor.class_prefix)) - (<>.before (<t>.this //descriptor.class_suffix))))] - (|>> //.signature - //signature.signature - (<t>.run declaration') - try.assume))) + (|>> //.signature + //signature.signature + (<text>.run ..declaration') + try.assume)) diff --git a/stdlib/source/library/lux/target/jvm/type/signature.lux b/stdlib/source/library/lux/target/jvm/type/signature.lux index 0b21807dd..89cce34e0 100644 --- a/stdlib/source/library/lux/target/jvm/type/signature.lux +++ b/stdlib/source/library/lux/target/jvm/type/signature.lux @@ -103,13 +103,23 @@ (def: #export exception_prefix "^") - (def: #export (method [inputs output exceptions]) - (-> [(List (Signature Value)) + (def: #export (method [type_variables inputs output exceptions]) + (-> [(List (Signature Var)) + (List (Signature Value)) (Signature Return) (List (Signature Class))] (Signature Method)) (:abstraction - (format (|> inputs + (format (case type_variables + #.Nil + "" + _ + (|> type_variables + (list\map ..signature) + (text.join_with "") + (text.enclose [..parameters_start + ..parameters_end]))) + (|> inputs (list\map ..signature) (text.join_with "") (text.enclose [..arguments_start diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux index 02adbd2bd..29796ead6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -246,6 +246,7 @@ id]))))] [learn artifact.definition] + [learn_custom artifact.custom] [learn_analyser artifact.analyser] [learn_synthesizer artifact.synthesizer] [learn_generator artifact.generator] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 76bcd528e..0dcb22927 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -58,6 +58,8 @@ [archive (#+ Archive) [descriptor (#+ Module)]]]]]]]]) +(import: java/lang/ClassLoader) + (import: java/lang/Object ["#::." (equals [java/lang/Object] boolean)]) @@ -132,10 +134,10 @@ (exception.report ["Class" (%.text class)])) -(def: (ensure_fresh_class! name) - (-> External (Operation Any)) +(def: (ensure_fresh_class! class_loader name) + (-> java/lang/ClassLoader External (Operation Any)) (do phase.monad - [class (phase.lift (reflection!.load name))] + [class (phase.lift (reflection!.load class_loader name))] (phase.assert ..deprecated_class [name] (|> class java/lang/Class::getDeclaredAnnotations @@ -785,8 +787,8 @@ _ (/////analysis.throw ///.incorrect_arity [extension_name 2 (list.size args)])))) -(def: object::throw - Handler +(def: (object::throw class_loader) + (-> java/lang/ClassLoader Handler) (function (_ extension_name analyse archive args) (case args (^ (list exceptionC)) @@ -795,7 +797,7 @@ [exceptionT exceptionA] (typeA.with_inference (analyse archive exceptionC)) exception_class (check_object exceptionT) - ? (phase.lift (reflection!.sub? "java.lang.Throwable" exception_class)) + ? (phase.lift (reflection!.sub? class_loader "java.lang.Throwable" exception_class)) _ (: (Operation Any) (if ? (wrap []) @@ -805,17 +807,17 @@ _ (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) -(def: object::class - Handler +(def: (object::class class_loader) + (-> java/lang/ClassLoader Handler) (function (_ extension_name analyse archive args) (case args (^ (list classC)) (case classC [_ (#.Text class)] (do phase.monad - [_ (..ensure_fresh_class! class) + [_ (..ensure_fresh_class! class_loader class) _ (typeA.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list))))) - _ (phase.lift (reflection!.load class))] + _ (phase.lift (reflection!.load class_loader class))] (wrap (#/////analysis.Extension extension_name (list (/////analysis.text class))))) _ @@ -824,18 +826,18 @@ _ (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) -(def: object::instance? - Handler +(def: (object::instance? class_loader) + (-> java/lang/ClassLoader Handler) (..custom [($_ <>.and <code>.text <code>.any) (function (_ extension_name analyse archive [sub_class objectC]) (do phase.monad - [_ (..ensure_fresh_class! sub_class) + [_ (..ensure_fresh_class! class_loader sub_class) _ (typeA.infer Bit) [objectT objectA] (typeA.with_inference (analyse archive objectC)) object_class (check_object objectT) - ? (phase.lift (reflection!.sub? object_class sub_class))] + ? (phase.lift (reflection!.sub? class_loader object_class sub_class))] (if ? (wrap (#/////analysis.Extension extension_name (list (/////analysis.text sub_class) objectA))) (/////analysis.throw cannot_possibly_be_an_instance (format sub_class " !<= " object_class)))))])) @@ -855,17 +857,17 @@ [reflection_return Return luxT.return] ) -(def: (class_candidate_parents from_name fromT to_name to_class) - (-> External .Type External (java/lang/Class java/lang/Object) (Operation (List [[Text .Type] Bit]))) +(def: (class_candidate_parents class_loader from_name fromT to_name to_class) + (-> java/lang/ClassLoader External .Type External (java/lang/Class java/lang/Object) (Operation (List [[Text .Type] Bit]))) (do {! phase.monad} - [from_class (phase.lift (reflection!.load from_name)) + [from_class (phase.lift (reflection!.load class_loader from_name)) mapping (phase.lift (reflection!.correspond from_class fromT))] (monad.map ! (function (_ superJT) (do ! [superJT (phase.lift (reflection!.type superJT)) #let [super_name (|> superJT ..reflection)] - super_class (phase.lift (reflection!.load super_name)) + super_class (phase.lift (reflection!.load class_loader super_name)) superT (reflection_type mapping superJT)] (wrap [[super_name superT] (java/lang/Class::isAssignableFrom super_class to_class)]))) (case (java/lang/Class::getGenericSuperclass from_class) @@ -878,15 +880,15 @@ (array.to_list (java/lang/Class::getGenericInterfaces from_class))) (array.to_list (java/lang/Class::getGenericInterfaces from_class))))))) -(def: (inheritance_candidate_parents fromT to_class toT fromC) - (-> .Type (java/lang/Class java/lang/Object) .Type Code (Operation (List [[Text .Type] Bit]))) +(def: (inheritance_candidate_parents class_loader fromT to_class toT fromC) + (-> java/lang/ClassLoader .Type (java/lang/Class java/lang/Object) .Type Code (Operation (List [[Text .Type] Bit]))) (case fromT (^ (#.Primitive _ (list& self_classT super_classT super_interfacesT+))) (monad.map phase.monad (function (_ superT) (do {! phase.monad} [super_name (\ ! map ..reflection (check_jvm superT)) - super_class (phase.lift (reflection!.load super_name))] + super_class (phase.lift (reflection!.load class_loader super_name))] (wrap [[super_name superT] (java/lang/Class::isAssignableFrom super_class to_class)]))) (list& super_classT super_interfacesT+)) @@ -894,8 +896,8 @@ _ (/////analysis.throw ..cannot_cast [fromT toT fromC]))) -(def: object::cast - Handler +(def: (object::cast class_loader) + (-> java/lang/ClassLoader Handler) (function (_ extension_name analyse archive args) (case args (^ (list fromC)) @@ -930,11 +932,11 @@ (not (dictionary.key? ..boxes from_name))) _ (phase.assert ..primitives_are_not_objects [to_name] (not (dictionary.key? ..boxes to_name))) - to_class (phase.lift (reflection!.load to_name)) + to_class (phase.lift (reflection!.load class_loader to_name)) _ (if (text\= ..inheritance_relationship_type_name from_name) (wrap []) (do ! - [from_class (phase.lift (reflection!.load from_name))] + [from_class (phase.lift (reflection!.load class_loader from_name))] (phase.assert ..cannot_cast [fromT toT fromC] (java/lang/Class::isAssignableFrom from_class to_class))))] (loop [[current_name currentT] [from_name fromT]] @@ -943,8 +945,8 @@ (do ! [candidate_parents (: (Operation (List [[Text .Type] Bit])) (if (text\= ..inheritance_relationship_type_name current_name) - (inheritance_candidate_parents currentT to_class toT fromC) - (class_candidate_parents current_name currentT to_name to_class)))] + (inheritance_candidate_parents class_loader currentT to_class toT fromC) + (class_candidate_parents class_loader current_name currentT to_name to_class)))] (case (|> candidate_parents (list.filter product.right) (list\map product.left)) @@ -962,29 +964,29 @@ _ (/////analysis.throw ///.invalid_syntax [extension_name %.code args])))) -(def: bundle::object - Bundle +(def: (bundle::object class_loader) + (-> java/lang/ClassLoader Bundle) (<| (///bundle.prefix "object") (|> ///bundle.empty (///bundle.install "null" object::null) (///bundle.install "null?" object::null?) (///bundle.install "synchronized" object::synchronized) - (///bundle.install "throw" object::throw) - (///bundle.install "class" object::class) - (///bundle.install "instance?" object::instance?) - (///bundle.install "cast" object::cast) + (///bundle.install "throw" (object::throw class_loader)) + (///bundle.install "class" (object::class class_loader)) + (///bundle.install "instance?" (object::instance? class_loader)) + (///bundle.install "cast" (object::cast class_loader)) ))) -(def: get::static - Handler +(def: (get::static class_loader) + (-> java/lang/ClassLoader Handler) (..custom [..member (function (_ extension_name analyse archive [class field]) (do phase.monad - [_ (..ensure_fresh_class! class) + [_ (..ensure_fresh_class! class_loader class) [final? deprecated? fieldJT] (phase.lift (do try.monad - [class (reflection!.load class)] + [class (reflection!.load class_loader class)] (reflection!.static_field field class))) _ (phase.assert ..deprecated_field [class field] (not deprecated?)) @@ -995,17 +997,17 @@ (/////analysis.text field) (/////analysis.text (|> fieldJT ..reflection)))))))])) -(def: put::static - Handler +(def: (put::static class_loader) + (-> java/lang/ClassLoader Handler) (..custom [($_ <>.and ..member <code>.any) (function (_ extension_name analyse archive [[class field] valueC]) (do phase.monad - [_ (..ensure_fresh_class! class) + [_ (..ensure_fresh_class! class_loader class) _ (typeA.infer Any) [final? deprecated? fieldJT] (phase.lift (do try.monad - [class (reflection!.load class)] + [class (reflection!.load class_loader class)] (reflection!.static_field field class))) _ (phase.assert ..deprecated_field [class field] (not deprecated?)) @@ -1019,18 +1021,18 @@ (/////analysis.text field) valueA)))))])) -(def: get::virtual - Handler +(def: (get::virtual class_loader) + (-> java/lang/ClassLoader Handler) (..custom [($_ <>.and ..member <code>.any) (function (_ extension_name analyse archive [[class field] objectC]) (do phase.monad - [_ (..ensure_fresh_class! class) + [_ (..ensure_fresh_class! class_loader class) [objectT objectA] (typeA.with_inference (analyse archive objectC)) [deprecated? mapping fieldJT] (phase.lift (do try.monad - [class (reflection!.load class) + [class (reflection!.load class_loader class) [final? deprecated? fieldJT] (reflection!.virtual_field field class) mapping (reflection!.correspond class objectT)] (wrap [deprecated? mapping fieldJT]))) @@ -1043,19 +1045,19 @@ (/////analysis.text field) objectA)))))])) -(def: put::virtual - Handler +(def: (put::virtual class_loader) + (-> java/lang/ClassLoader Handler) (..custom [($_ <>.and ..member <code>.any <code>.any) (function (_ extension_name analyse archive [[class field] valueC objectC]) (do phase.monad - [_ (..ensure_fresh_class! class) + [_ (..ensure_fresh_class! class_loader class) [objectT objectA] (typeA.with_inference (analyse archive objectC)) _ (typeA.infer objectT) [final? deprecated? mapping fieldJT] (phase.lift (do try.monad - [class (reflection!.load class) + [class (reflection!.load class_loader class) [final? deprecated? fieldJT] (reflection!.virtual_field field class) mapping (reflection!.correspond class objectT)] (wrap [final? deprecated? mapping fieldJT]))) @@ -1276,10 +1278,10 @@ (list\map jvm_parser.name expected)) (dictionary.from_list text.hash))) -(def: (method_candidate actual_class_tvars class_name actual_method_tvars method_name method_style inputsJT) - (-> (List (Type Var)) External (List (Type Var)) Text Method_Style (List (Type Value)) (Operation Method_Signature)) +(def: (method_candidate class_loader actual_class_tvars class_name actual_method_tvars method_name method_style inputsJT) + (-> java/lang/ClassLoader (List (Type Var)) External (List (Type Var)) Text Method_Style (List (Type Value)) (Operation Method_Signature)) (do {! phase.monad} - [class (phase.lift (reflection!.load class_name)) + [class (phase.lift (reflection!.load class_loader class_name)) #let [expected_class_tvars (class_type_variables class)] candidates (|> class java/lang/Class::getDeclaredMethods @@ -1309,10 +1311,10 @@ (def: constructor_method "<init>") -(def: (constructor_candidate actual_class_tvars class_name actual_method_tvars inputsJT) - (-> (List (Type Var)) External (List (Type Var)) (List (Type Value)) (Operation Method_Signature)) +(def: (constructor_candidate class_loader actual_class_tvars class_name actual_method_tvars inputsJT) + (-> java/lang/ClassLoader (List (Type Var)) External (List (Type Var)) (List (Type Value)) (Operation Method_Signature)) (do {! phase.monad} - [class (phase.lift (reflection!.load class_name)) + [class (phase.lift (reflection!.load class_loader class_name)) #let [expected_class_tvars (class_type_variables class)] candidates (|> class java/lang/Class::getConstructors @@ -1361,15 +1363,15 @@ (def: type_vars (<code>.tuple (<>.some ..var))) -(def: invoke::static - Handler +(def: (invoke::static class_loader) + (-> java/lang/ClassLoader Handler) (..custom [($_ <>.and ..type_vars ..member ..type_vars (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars argsTC]) (do phase.monad - [_ (..ensure_fresh_class! class) + [_ (..ensure_fresh_class! class_loader class) #let [argsT (list\map product.left argsTC)] - [methodT deprecated? exceptionsT] (..method_candidate class_tvars class method_tvars method #Static argsT) + [methodT deprecated? exceptionsT] (..method_candidate class_loader class_tvars class method_tvars method #Static argsT) _ (phase.assert ..deprecated_method [class method methodT] (not deprecated?)) [outputT argsA] (inferenceA.general archive analyse methodT (list\map product.right argsTC)) @@ -1379,15 +1381,15 @@ (/////analysis.text (..signature outputJT)) (decorate_inputs argsT argsA))))))])) -(def: invoke::virtual - Handler +(def: (invoke::virtual class_loader) + (-> java/lang/ClassLoader Handler) (..custom [($_ <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars objectC argsTC]) (do phase.monad - [_ (..ensure_fresh_class! class) + [_ (..ensure_fresh_class! class_loader class) #let [argsT (list\map product.left argsTC)] - [methodT deprecated? exceptionsT] (..method_candidate class_tvars class method_tvars method #Virtual argsT) + [methodT deprecated? exceptionsT] (..method_candidate class_loader class_tvars class method_tvars method #Virtual argsT) _ (phase.assert ..deprecated_method [class method methodT] (not deprecated?)) [outputT allA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) @@ -1404,15 +1406,15 @@ objectA (decorate_inputs argsT argsA))))))])) -(def: invoke::special - Handler +(def: (invoke::special class_loader) + (-> java/lang/ClassLoader Handler) (..custom [($_ <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars objectC argsTC]) (do phase.monad - [_ (..ensure_fresh_class! class) + [_ (..ensure_fresh_class! class_loader class) #let [argsT (list\map product.left argsTC)] - [methodT deprecated? exceptionsT] (..method_candidate class_tvars class method_tvars method #Special argsT) + [methodT deprecated? exceptionsT] (..method_candidate class_loader class_tvars class method_tvars method #Special argsT) _ (phase.assert ..deprecated_method [class method methodT] (not deprecated?)) [outputT argsA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) @@ -1422,18 +1424,18 @@ (/////analysis.text (..signature outputJT)) (decorate_inputs argsT argsA))))))])) -(def: invoke::interface - Handler +(def: (invoke::interface class_loader) + (-> java/lang/ClassLoader Handler) (..custom [($_ <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class_name method] method_tvars objectC argsTC]) (do phase.monad - [_ (..ensure_fresh_class! class_name) + [_ (..ensure_fresh_class! class_loader class_name) #let [argsT (list\map product.left argsTC)] - class (phase.lift (reflection!.load class_name)) + class (phase.lift (reflection!.load class_loader class_name)) _ (phase.assert non_interface class_name (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class))) - [methodT deprecated? exceptionsT] (..method_candidate class_tvars class_name method_tvars method #Interface argsT) + [methodT deprecated? exceptionsT] (..method_candidate class_loader class_tvars class_name method_tvars method #Interface argsT) _ (phase.assert ..deprecated_method [class_name method methodT] (not deprecated?)) [outputT allA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) @@ -1451,39 +1453,40 @@ objectA (decorate_inputs argsT argsA))))))])) -(def: invoke::constructor +(def: (invoke::constructor class_loader) + (-> java/lang/ClassLoader Handler) (..custom [($_ <>.and ..type_vars <code>.text ..type_vars (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars class method_tvars argsTC]) (do phase.monad - [_ (..ensure_fresh_class! class) + [_ (..ensure_fresh_class! class_loader class) #let [argsT (list\map product.left argsTC)] - [methodT deprecated? exceptionsT] (..constructor_candidate class_tvars class method_tvars argsT) + [methodT deprecated? exceptionsT] (..constructor_candidate class_loader class_tvars class method_tvars argsT) _ (phase.assert ..deprecated_method [class ..constructor_method methodT] (not deprecated?)) [outputT argsA] (inferenceA.general archive analyse methodT (list\map product.right argsTC))] (wrap (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) (decorate_inputs argsT argsA))))))])) -(def: bundle::member - Bundle +(def: (bundle::member class_loader) + (-> java/lang/ClassLoader Bundle) (<| (///bundle.prefix "member") (|> ///bundle.empty (dictionary.merge (<| (///bundle.prefix "get") (|> ///bundle.empty - (///bundle.install "static" get::static) - (///bundle.install "virtual" get::virtual)))) + (///bundle.install "static" (get::static class_loader)) + (///bundle.install "virtual" (get::virtual class_loader))))) (dictionary.merge (<| (///bundle.prefix "put") (|> ///bundle.empty - (///bundle.install "static" put::static) - (///bundle.install "virtual" put::virtual)))) + (///bundle.install "static" (put::static class_loader)) + (///bundle.install "virtual" (put::virtual class_loader))))) (dictionary.merge (<| (///bundle.prefix "invoke") (|> ///bundle.empty - (///bundle.install "static" invoke::static) - (///bundle.install "virtual" invoke::virtual) - (///bundle.install "special" invoke::special) - (///bundle.install "interface" invoke::interface) - (///bundle.install "constructor" invoke::constructor) + (///bundle.install "static" (invoke::static class_loader)) + (///bundle.install "virtual" (invoke::virtual class_loader)) + (///bundle.install "special" (invoke::special class_loader)) + (///bundle.install "interface" (invoke::interface class_loader)) + (///bundle.install "constructor" (invoke::constructor class_loader)) ))) ))) @@ -1545,7 +1548,11 @@ (monad.map try.monad (function (_ method) (do {! try.monad} - [inputs (|> (java/lang/reflect/Method::getGenericParameterTypes method) + [#let [type_variables (|> (java/lang/reflect/Method::getTypeParameters method) + array.to_list + (list\map (|>> java/lang/reflect/TypeVariable::getName + jvm.var)))] + inputs (|> (java/lang/reflect/Method::getGenericParameterTypes method) array.to_list (monad.map ! reflection!.type)) return (|> method @@ -1555,7 +1562,7 @@ array.to_list (monad.map ! reflection!.class))] (wrap [(java/lang/reflect/Method::getName method) - (jvm.method [inputs return exceptions])]))))))] + (jvm.method [type_variables inputs return exceptions])]))))))] [abstract_methods (list.filter (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract))] [methods (<|)] @@ -1564,9 +1571,9 @@ (def: jvm_package_separator ".") (template [<name> <methods>] - [(def: <name> - (-> (List (Type Class)) (Try (List [Text (Type Method)]))) - (|>> (monad.map try.monad (|>> ..reflection reflection!.load)) + [(def: (<name> class_loader) + (-> java/lang/ClassLoader (List (Type Class)) (Try (List [Text (Type Method)]))) + (|>> (monad.map try.monad (|>> ..reflection (reflection!.load class_loader))) (try\map (monad.map try.monad <methods>)) try\join (try\map list\join)))] @@ -1954,11 +1961,11 @@ ["Actual (amount)" (%.nat (list.size actual))] ["Actual (parameters)" (exception.enumerate ..signature actual)])) -(def: (super_aliasing class) - (-> (Type Class) (Operation Aliasing)) +(def: (super_aliasing class_loader class) + (-> java/lang/ClassLoader (Type Class) (Operation Aliasing)) (do phase.monad [#let [[name actual_parameters] (jvm_parser.read_class class)] - class (phase.lift (reflection!.load name)) + class (phase.lift (reflection!.load class_loader name)) #let [expected_parameters (|> (java/lang/Class::getTypeParameters class) array.to_list (list\map (|>> java/lang/reflect/TypeVariable::getName)))] @@ -1981,8 +1988,8 @@ local (format "anonymous-class" (%.nat id))] (format global ..jvm_package_separator local))) -(def: class::anonymous - Handler +(def: (class::anonymous class_loader) + (-> java/lang/ClassLoader Handler) (..custom [($_ <>.and (<code>.tuple (<>.some ..var)) @@ -1996,8 +2003,8 @@ constructor_args methods]) (do {! phase.monad} - [_ (..ensure_fresh_class! (..reflection super_class)) - _ (monad.map ! (|>> ..reflection ..ensure_fresh_class!) super_interfaces) + [_ (..ensure_fresh_class! class_loader (..reflection super_class)) + _ (monad.map ! (|>> ..reflection (..ensure_fresh_class! class_loader)) super_interfaces) parameters (typeA.with_env (..parameter_types parameters)) #let [mapping (list\fold (function (_ [parameterJ parameterT] mapping) @@ -2027,15 +2034,16 @@ (wrap [type termA]))) constructor_args) methodsA (monad.map ! (analyse_overriden_method analyse archive selfT mapping) methods) - required_abstract_methods (phase.lift (all_abstract_methods (list& super_class super_interfaces))) - available_methods (phase.lift (all_methods (list& super_class super_interfaces))) + required_abstract_methods (phase.lift (all_abstract_methods class_loader (list& super_class super_interfaces))) + available_methods (phase.lift (all_methods class_loader (list& super_class super_interfaces))) overriden_methods (monad.map ! (function (_ [parent_type method_name - strict_fp? annotations vars + strict_fp? annotations type_vars self_name arguments return exceptions body]) (do ! - [aliasing (super_aliasing parent_type)] - (wrap [method_name (|> (jvm.method [(list\map product.right arguments) + [aliasing (super_aliasing class_loader parent_type)] + (wrap [method_name (|> (jvm.method [type_vars + (list\map product.right arguments) return exceptions]) (jvm_alias.method aliasing))]))) @@ -2052,15 +2060,15 @@ (/////analysis.tuple (list\map typed_analysis constructor_argsA+)) (/////analysis.tuple methodsA))))))])) -(def: bundle::class - Bundle +(def: (bundle::class class_loader) + (-> java/lang/ClassLoader Bundle) (<| (///bundle.prefix "class") (|> ///bundle.empty - (///bundle.install "anonymous" class::anonymous) + (///bundle.install "anonymous" (class::anonymous class_loader)) ))) -(def: #export bundle - Bundle +(def: #export (bundle class_loader) + (-> java/lang/ClassLoader Bundle) (<| (///bundle.prefix "jvm") (|> ///bundle.empty (dictionary.merge bundle::conversion) @@ -2070,7 +2078,7 @@ (dictionary.merge bundle::double) (dictionary.merge bundle::char) (dictionary.merge bundle::array) - (dictionary.merge bundle::object) - (dictionary.merge bundle::member) - (dictionary.merge bundle::class) + (dictionary.merge (bundle::object class_loader)) + (dictionary.merge (bundle::member class_loader)) + (dictionary.merge (bundle::class class_loader)) ))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux index fea8a985e..eb1f78ed9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux @@ -21,4 +21,4 @@ (def: #export init (Type Method) - (type.method [(list arity.type) type.void (list)])) + (type.method [(list) (list arity.type) type.void (list)])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index edfa6d78d..28d9b81cd 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -130,7 +130,7 @@ (def: #export unit (_.string synthesis.unit)) (def: variant::name "variant") -(def: variant::type (type.method [(list //type.tag //type.flag //type.value) //type.variant (list)])) +(def: variant::type (type.method [(list) (list //type.tag //type.flag //type.value) //type.variant (list)])) (def: #export variant (..procedure ..variant::name ..variant::type)) (def: variant_tag _.iconst_0) @@ -204,7 +204,7 @@ ))) (def: decode_frac::name "decode_frac") -(def: decode_frac::type (type.method [(list //type.text) //type.variant (list)])) +(def: decode_frac::type (type.method [(list) (list //type.text) //type.variant (list)])) (def: #export decode_frac (..procedure ..decode_frac::name ..decode_frac::type)) (def: decode_frac::method @@ -215,7 +215,7 @@ (..risky ($_ _.compose _.aload_0 - (_.invokestatic //type.frac "parseDouble" (type.method [(list //type.text) type.double (list)])) + (_.invokestatic //type.frac "parseDouble" (type.method [(list) (list //type.text) type.double (list)])) (//value.wrap type.double) ))))) @@ -224,13 +224,13 @@ (let [^PrintStream (type.class "java.io.PrintStream" (list)) ^System (type.class "java.lang.System" (list)) out (_.getstatic ^System "out" ^PrintStream) - print_type (type.method [(list //type.value) type.void (list)]) + print_type (type.method [(list) (list //type.value) type.void (list)]) print! (function (_ method) (_.invokevirtual ^PrintStream method print_type))] ($_ _.compose out (_.string "LUX LOG: ") (print! "print") out _.swap (print! "println")))) -(def: exception_constructor (type.method [(list //type.text) type.void (list)])) +(def: exception_constructor (type.method [(list) (list //type.text) type.void (list)])) (def: (illegal_state_exception message) (-> Text (Bytecode Any)) (let [^IllegalStateException (type.class "java.lang.IllegalStateException" (list))] @@ -241,7 +241,7 @@ (_.invokespecial ^IllegalStateException "<init>" ..exception_constructor)))) (def: failure::type - (type.method [(list) type.void (list)])) + (type.method [(list) (list) type.void (list)])) (def: (failure name message) (-> Text Text (Resource Method)) @@ -263,7 +263,7 @@ (def: #export stack_tail _.iconst_1) (def: push::name "push") -(def: push::type (type.method [(list //type.stack //type.value) //type.stack (list)])) +(def: push::type (type.method [(list) (list //type.stack //type.value) //type.stack (list)])) (def: #export push (..procedure ..push::name ..push::type)) (def: push::method @@ -283,7 +283,7 @@ _.areturn))))) (def: case::name "case") -(def: case::type (type.method [(list //type.variant //type.tag //type.flag) //type.value (list)])) +(def: case::type (type.method [(list) (list //type.variant //type.tag //type.flag) //type.value (list)])) (def: #export case (..procedure ..case::name ..case::type)) (def: case::method @@ -358,7 +358,7 @@ _.areturn ))))) -(def: projection_type (type.method [(list //type.tuple //type.offset) //type.value (list)])) +(def: projection_type (type.method [(list) (list //type.tuple //type.offset) //type.value (list)])) (def: left_projection::name "left") (def: #export left_projection (..procedure ..left_projection::name ..projection_type)) @@ -427,7 +427,7 @@ $right $tuple::size (_.invokestatic (type.class "java.util.Arrays" (list)) "copyOfRange" - (type.method [(list //type.tuple //type.index //type.index) //type.tuple (list)])))]] + (type.method [(list) (list //type.tuple //type.index //type.index) //type.tuple (list)])))]] ($_ _.compose (_.set_label @loop) $last_right $right @@ -449,13 +449,13 @@ (def: #export (apply::type arity) (-> Arity (Type category.Method)) - (type.method [(list.repeat arity //type.value) //type.value (list)])) + (type.method [(list) (list.repeat arity //type.value) //type.value (list)])) (def: #export apply (_.invokevirtual //function.class ..apply::name (..apply::type 1))) (def: try::name "try") -(def: try::type (type.method [(list //function.class) //type.variant (list)])) +(def: try::type (type.method [(list) (list //function.class) //type.variant (list)])) (def: #export try (..procedure ..try::name ..try::type)) (def: false _.iconst_0) @@ -475,7 +475,7 @@ string_writer ($_ _.compose (_.new ^StringWriter) _.dup - (_.invokespecial ^StringWriter "<init>" (type.method [(list) type.void (list)]))) + (_.invokespecial ^StringWriter "<init>" (type.method [(list) (list) type.void (list)]))) ^PrintWriter (type.class "java.io.PrintWriter" (list)) print_writer ($_ _.compose @@ -484,7 +484,7 @@ _.dup_x1 ## WTPWP _.swap ## WTPPW ..true ## WTPPWZ - (_.invokespecial ^PrintWriter "<init>" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) + (_.invokespecial ^PrintWriter "<init>" (type.method [(list) (list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) ## WTP )]] ($_ _.compose @@ -496,8 +496,8 @@ string_writer ## TW _.dup_x1 ## WTW print_writer ## WTP - (_.invokevirtual //type.error "printStackTrace" (type.method [(list ^PrintWriter) type.void (list)])) ## W - (_.invokevirtual ^StringWriter "toString" (type.method [(list) //type.text (list)])) ## S + (_.invokevirtual //type.error "printStackTrace" (type.method [(list) (list ^PrintWriter) type.void (list)])) ## W + (_.invokevirtual ^StringWriter "toString" (type.method [(list) (list) //type.text (list)])) ## S ..left_injection _.areturn ))))) @@ -568,7 +568,7 @@ (let [$partials _.iload_1] ($_ _.compose ..this - (_.invokespecial ^Object "<init>" (type.method [(list) type.void (list)])) + (_.invokespecial ^Object "<init>" (type.method [(list) (list) type.void (list)])) ..this $partials (_.putfield //function.class //function/count.field //function/count.type) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux index ef82a6257..3e2ff3d09 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux @@ -39,11 +39,11 @@ (-> (Type Primitive) (Bytecode Any)) (let [wrapper (type.class (primitive-wrapper type) (list))] (_.invokestatic wrapper "valueOf" - (type.method [(list type) wrapper (list)])))) + (type.method [(list) (list type) wrapper (list)])))) (def: #export (unwrap type) (-> (Type Primitive) (Bytecode Any)) (let [wrapper (type.class (primitive-wrapper type) (list))] ($_ _.compose (_.checkcast wrapper) - (_.invokevirtual wrapper (primitive-unwrap type) (type.method [(list) type (list)]))))) + (_.invokevirtual wrapper (primitive-unwrap type) (type.method [(list) (list) type (list)]))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux index cd7b7169a..b41b272f5 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -305,7 +305,7 @@ (#artifact.Custom name) (do ! [#let [output (row.add [artifact_id (#.Some name) data] output)] - value (\ host re_load context (#.Some name) directive)] + _ (\ host re_learn context (#.Some name) directive)] (wrap [definitions [analysers synthesizers diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux index c5756ee97..be03d36f5 100644 --- a/stdlib/source/program/aedifex/pom.lux +++ b/stdlib/source/program/aedifex/pom.lux @@ -18,7 +18,9 @@ [collection ["." list ("#\." monoid functor fold)] ["." set] - ["." dictionary]]]]] + ["." dictionary]]] + [world + ["." file]]]] ["." // #_ ["/" profile] ["#." dependency (#+ Dependency)] @@ -40,6 +42,7 @@ (def: version_tag "version") (def: #export file + file.Path "pom.xml") (def: version diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux index 93e9096e7..7ae07e9b5 100644 --- a/stdlib/source/program/aedifex/repository.lux +++ b/stdlib/source/program/aedifex/repository.lux @@ -49,6 +49,7 @@ (implementation (def: description (\ mock the_description)) + (def: (download uri) (stm.commit (do {! stm.monad} diff --git a/stdlib/source/test/aedifex/metadata/artifact.lux b/stdlib/source/test/aedifex/metadata/artifact.lux index 5e5f67bec..5ba4bdbe4 100644 --- a/stdlib/source/test/aedifex/metadata/artifact.lux +++ b/stdlib/source/test/aedifex/metadata/artifact.lux @@ -9,8 +9,19 @@ [control ["." try ("#\." functor)] [parser - ["<.>" xml]]] + ["." environment] + ["<.>" xml]] + [concurrency + ["." promise]]] + [data + ["." maybe] + ["." text ("#\." equivalence)] + [collection + ["." list]]] + [macro + ["." code]] [math + ["." random (#+ Random)] [number ["n" nat]]] ["." time @@ -19,12 +30,16 @@ ["." month] ["." instant] ["." duration]] - [math - ["." random (#+ Random)]] - [macro - ["." code]]]] + [world + ["." file] + ["." program]]]] [\\program - ["." /]]) + ["." / + ["/#" // + ["/#" // #_ + ["#." artifact] + ["#." repository #_ + ["#/." local]]]]]]) (def: #export random (Random /.Metadata) @@ -55,16 +70,47 @@ Test (<| (_.covering /._) (_.for [/.Metadata]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (do random.monad - [expected ..random] - (_.cover [/.format /.parser] - (|> expected - /.format - list - (<xml>.run /.parser) - (try\map (\ /.equivalence = expected)) - (try.default false)))) - ))) + (do random.monad + [expected ..random + #let [artifact {#///artifact.group (get@ #/.group expected) + #///artifact.name (get@ #/.name expected) + #///artifact.version (|> expected + (get@ #/.versions) + list.head + (maybe.default ""))}]] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (|> expected + /.format + list + (<xml>.run /.parser) + (try\map (\ /.equivalence = expected)) + (try.default false)))) + (_.cover [/.uri] + (text\= (//.remote_project_uri artifact) + (/.uri artifact))) + (do random.monad + [home (random.ascii/lower 5) + working_directory (random.ascii/lower 5) + #let [program (program.async (program.mock environment.empty home working_directory)) + fs (file.mock (\ file.default separator)) + repository (///repository/local.repository program fs)]] + (wrap (do promise.monad + [wrote? (/.write repository artifact expected) + actual (/.read repository artifact)] + (_.cover' [/.write /.read] + (and (case wrote? + (#try.Success _) true + (#try.Failure _) false) + (case actual + (#try.Success actual) + (\ /.equivalence = expected actual) + + (#try.Failure _) + false)))))) + )))) diff --git a/stdlib/source/test/aedifex/metadata/snapshot.lux b/stdlib/source/test/aedifex/metadata/snapshot.lux index 5a821c452..431370048 100644 --- a/stdlib/source/test/aedifex/metadata/snapshot.lux +++ b/stdlib/source/test/aedifex/metadata/snapshot.lux @@ -9,8 +9,19 @@ [control ["." try ("#\." functor)] [parser - ["<.>" xml]]] + ["." environment] + ["<.>" xml]] + [concurrency + ["." promise]]] + [data + ["." maybe] + ["." text ("#\." equivalence)] + [collection + ["." list]]] + [macro + ["." code]] [math + ["." random (#+ Random) ("#\." monad)] [number ["n" nat]]] ["." time @@ -19,10 +30,9 @@ ["." month] ["." instant (#+ Instant)] ["." duration]] - [math - ["." random (#+ Random) ("#\." monad)]] - [macro - ["." code]]]] + [world + ["." file] + ["." program]]]] ["$." /// #_ ["#." artifact ["#/." type] @@ -31,10 +41,13 @@ ["#/." version]]]] [\\program ["." / - [/// - [artifact - [versioning (#+ Versioning)] - ["#." snapshot]]]]]) + ["/#" // + ["/#" // #_ + [artifact + [versioning (#+ Versioning)] + ["#." snapshot]] + ["#." repository #_ + ["#/." local]]]]]]) (def: random_instant (Random Instant) @@ -60,7 +73,7 @@ (def: random_versioning (Random Versioning) ($_ random.and - (random\wrap #/snapshot.Local) + (random\wrap #///snapshot.Local) $///artifact/time.random (random.list 5 $///artifact/snapshot/version.random) )) @@ -76,16 +89,40 @@ Test (<| (_.covering /._) (_.for [/.Metadata]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (do random.monad - [expected ..random] + (do random.monad + [expected ..random + #let [artifact (get@ #/.artifact expected)]] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.cover [/.format /.parser] (|> expected /.format list (<xml>.run /.parser) (try\map (\ /.equivalence = expected)) - (try.default false)))) - ))) + (try.default false))) + (_.cover [/.uri] + (text\= (//.remote_artifact_uri artifact) + (/.uri artifact))) + (do random.monad + [home (random.ascii/lower 5) + working_directory (random.ascii/lower 5) + #let [program (program.async (program.mock environment.empty home working_directory)) + fs (file.mock (\ file.default separator)) + repository (///repository/local.repository program fs)]] + (wrap (do promise.monad + [wrote? (/.write repository artifact expected) + actual (/.read repository artifact)] + (_.cover' [/.write /.read] + (and (case wrote? + (#try.Success _) true + (#try.Failure _) false) + (case actual + (#try.Success actual) + (\ /.equivalence = expected actual) + + (#try.Failure _) + false)))))) + )))) diff --git a/stdlib/source/test/aedifex/pom.lux b/stdlib/source/test/aedifex/pom.lux index 24ca3c3c6..01b90c33e 100644 --- a/stdlib/source/test/aedifex/pom.lux +++ b/stdlib/source/test/aedifex/pom.lux @@ -10,6 +10,7 @@ ["<>" parser ["<.>" xml]]] [data + ["." text ("#\." equivalence)] [format ["." xml]]] [math @@ -24,27 +25,33 @@ (def: #export test Test (<| (_.covering /._) - (do random.monad - [expected @profile.random] - (_.cover [/.write /.parser] - (case [(/.write expected) - (get@ #//.identity expected)] - [(#try.Success pom) - (#.Some _)] - (case (<xml>.run /.parser (list pom)) - (#try.Success actual) - (\ //.equivalence = - (|> (\ //.monoid identity) - (set@ #//.dependencies (get@ #//.dependencies expected)) - (set@ #//.repositories (get@ #//.repositories expected))) - actual) + ($_ _.and + (_.cover [/.file] + (|> /.file + (text\= "") + not)) + (do random.monad + [expected @profile.random] + (_.cover [/.write /.parser] + (case [(/.write expected) + (get@ #//.identity expected)] + [(#try.Success pom) + (#.Some _)] + (case (<xml>.run /.parser (list pom)) + (#try.Success actual) + (\ //.equivalence = + (|> (\ //.monoid identity) + (set@ #//.dependencies (get@ #//.dependencies expected)) + (set@ #//.repositories (get@ #//.repositories expected))) + actual) - (#try.Failure error) - false) + (#try.Failure error) + false) - [(#try.Failure error) - #.None] - (exception.match? //.no_identity error) + [(#try.Failure error) + #.None] + (exception.match? //.no_identity error) - _ - false))))) + _ + false))) + ))) diff --git a/stdlib/source/test/aedifex/project.lux b/stdlib/source/test/aedifex/project.lux index bdeee7993..5b6de5403 100644 --- a/stdlib/source/test/aedifex/project.lux +++ b/stdlib/source/test/aedifex/project.lux @@ -46,6 +46,10 @@ (_.for [/.monoid] ($monoid.spec /.equivalence /.monoid ..random)) + (_.cover [/.file] + (|> /.file + (text\= "") + not)) (do random.monad [[super_name super_profile] ..profile [dummy_name dummy_profile] (random.filter (|>> product.left (text\= super_name) not) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 1e9976f4e..dffa24069 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -277,16 +277,20 @@ false)) ))) -(interface: (Returner a) +(/.interface: (Returner a) (: (-> Any a) return)) -(implementation: (global_returner value) +(/.implementation: (global_returner value) (All [a] (-> a (Returner a))) (def: (return _) value)) +(def: static_return 123) + +(/.open: "global\." (..global_returner ..static_return)) + (def: for_interface Test (do random.monad @@ -301,6 +305,13 @@ (n.= expected (\ (global_returner expected) return []))) (_.cover [/.implementation] (n.= expected (\ local_returner return []))) + (_.cover [/.open:] + (n.= static_return (global\return []))) + (_.cover [/.^open] + (let [(/.^open "local\.") local_returner] + (n.= expected (local\return [])))) + (_.cover [/.\] + (n.= expected (/.\ local_returner return []))) )))) (def: for_module @@ -587,6 +598,27 @@ false))) ))) +(def: option/0 "0") +(def: option/1 "1") +(def: static_char "@") + +(def: for_static + Test + (do random.monad + [sample (random.either (wrap option/0) + (wrap option/1))] + ($_ _.and + (_.cover [/.static] + (case sample + (^ (/.static option/0)) true + (^ (/.static option/1)) true + _ false)) + (_.cover [/.char] + (|> (`` (/.char (~~ (/.static static_char)))) + text.from_code + (text\= static_char))) + ))) + (def: test Test (<| (_.covering /._) @@ -612,6 +644,7 @@ ..for_i64 ..for_function ..for_template + ..for_static ..sub_tests ))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 3486821ce..d7d9030df 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -115,7 +115,7 @@ (list) (list (/method.method ..method_modifier method_name - (/type.method [(list) ..$Object (list)]) + (/type.method [(list) (list) ..$Object (list)]) (list) (#.Some (do /.monad [_ bytecode] @@ -143,7 +143,7 @@ (def: $Boolean (/type.class "java.lang.Boolean" (list))) (def: $Boolean::wrap - (/.invokestatic ..$Boolean "valueOf" (/type.method [(list /type.boolean) ..$Boolean (list)]))) + (/.invokestatic ..$Boolean "valueOf" (/type.method [(list) (list /type.boolean) ..$Boolean (list)]))) (def: $Boolean::random (:as (Random java/lang/Boolean) random.bit)) (def: !false (|> 0 .i64 i32.i32 /.int)) (def: !true (|> 1 .i64 i32.i32 /.int)) @@ -163,7 +163,7 @@ (def: $Byte (/type.class "java.lang.Byte" (list))) (def: $Byte::wrap - (/.invokestatic ..$Byte "valueOf" (/type.method [(list /type.byte) ..$Byte (list)]))) + (/.invokestatic ..$Byte "valueOf" (/type.method [(list) (list /type.byte) ..$Byte (list)]))) (def: $Byte::random (Random java/lang/Byte) (\ random.monad map (|>> (:as java/lang/Long) ffi.long_to_byte) random.int)) @@ -181,7 +181,7 @@ (def: $Short (/type.class "java.lang.Short" (list))) (def: $Short::wrap - (/.invokestatic ..$Short "valueOf" (/type.method [(list /type.short) ..$Short (list)]))) + (/.invokestatic ..$Short "valueOf" (/type.method [(list) (list /type.short) ..$Short (list)]))) (def: $Short::random (Random java/lang/Short) (\ random.monad map (|>> (:as java/lang/Long) ffi.long_to_short) random.int)) @@ -199,7 +199,7 @@ (def: $Integer (/type.class "java.lang.Integer" (list))) (def: $Integer::wrap - (/.invokestatic ..$Integer "valueOf" (/type.method [(list /type.int) ..$Integer (list)]))) + (/.invokestatic ..$Integer "valueOf" (/type.method [(list) (list /type.int) ..$Integer (list)]))) (def: $Integer::random (Random java/lang/Integer) (\ random.monad map (|>> (:as java/lang/Long) ffi.long_to_int) random.int)) @@ -215,7 +215,7 @@ #literal ..$Integer::literal}) (def: $Long (/type.class "java.lang.Long" (list))) -(def: $Long::wrap (/.invokestatic ..$Long "valueOf" (/type.method [(list /type.long) ..$Long (list)]))) +(def: $Long::wrap (/.invokestatic ..$Long "valueOf" (/type.method [(list) (list /type.long) ..$Long (list)]))) (def: $Long::random (:as (Random java/lang/Long) random.int)) (def: $Long::literal (-> java/lang/Long (Bytecode Any)) (|>> (:as Int) /.long)) (def: $Long::primitive @@ -227,7 +227,7 @@ #literal ..$Long::literal}) (def: $Float (/type.class "java.lang.Float" (list))) -(def: $Float::wrap (/.invokestatic ..$Float "valueOf" (/type.method [(list /type.float) ..$Float (list)]))) +(def: $Float::wrap (/.invokestatic ..$Float "valueOf" (/type.method [(list) (list /type.float) ..$Float (list)]))) (def: $Float::random (Random java/lang/Float) (\ random.monad map @@ -247,7 +247,7 @@ #literal ..$Float::literal}) (def: $Double (/type.class "java.lang.Double" (list))) -(def: $Double::wrap (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)]))) +(def: $Double::wrap (/.invokestatic ..$Double "valueOf" (/type.method [(list) (list /type.double) ..$Double (list)]))) (def: $Double::random (:as (Random java/lang/Double) random.frac)) (def: $Double::literal (-> java/lang/Double (Bytecode Any)) @@ -267,7 +267,7 @@ (def: $Character (/type.class "java.lang.Character" (list))) (def: $Character::wrap - (/.invokestatic ..$Character "valueOf" (/type.method [(list /type.char) ..$Character (list)]))) + (/.invokestatic ..$Character "valueOf" (/type.method [(list) (list /type.char) ..$Character (list)]))) (def: $Character::random (Random java/lang/Character) (\ random.monad map (|>> (:as java/lang/Long) ffi.long_to_int ffi.int_to_char) random.int)) @@ -747,7 +747,7 @@ (do /.monad [_ (/.new ..$Object) _ /.dup] - (/.invokespecial ..$Object "<init>" (/type.method [(list) /type.void (list)]))))] + (/.invokespecial ..$Object "<init>" (/type.method [(list) (list) /type.void (list)]))))] ($_ _.and (<| (_.lift "ACONST_NULL") (..bytecode (|>> (:as Bit) not)) @@ -796,7 +796,7 @@ (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))})) (do /.monad [_ (/.double expected)] - (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)])))) + (/.invokestatic ..$Double "valueOf" (/type.method [(list) (list /type.double) ..$Double (list)])))) (<| (_.lift "INVOKEVIRTUAL") (do random.monad [expected ..$Double::random]) @@ -804,7 +804,7 @@ (do /.monad [_ (/.double expected) _ ..$Double::wrap - _ (/.invokevirtual ..$Double "isNaN" (/type.method [(list) /type.boolean (list)]))] + _ (/.invokevirtual ..$Double "isNaN" (/type.method [(list) (list) /type.boolean (list)]))] ..$Boolean::wrap)) (<| (_.lift "INVOKESPECIAL") (do random.monad @@ -819,14 +819,14 @@ [_ (/.new ..$Double) _ /.dup _ (/.double expected)] - (/.invokespecial ..$Double "<init>" (/type.method [(list /type.double) /type.void (list)])))) + (/.invokespecial ..$Double "<init>" (/type.method [(list) (list /type.double) /type.void (list)])))) (<| (_.lift "INVOKEINTERFACE") (do random.monad [subject ..$String::random]) (..bytecode (|>> (:as Nat) (n.= (text.size (:as Text subject))))) (do /.monad [_ (/.string (:as Text subject)) - _ (/.invokeinterface (/type.class "java.lang.CharSequence" (list)) "length" (/type.method [(list) /type.int (list)])) + _ (/.invokeinterface (/type.class "java.lang.CharSequence" (list)) "length" (/type.method [(list) (list) /type.int (list)])) _ /.i2l] ..$Long::wrap)) )) @@ -848,7 +848,7 @@ class_field "class_field" object_field "object_field" constructor "<init>" - constructor::type (/type.method [(list /type.long) /type.void (list)]) + constructor::type (/type.method [(list) (list /type.long) /type.void (list)]) static_method "static_method" bytecode (|> (/class.class /version.v6_0 /class.public (/name.internal class_name) @@ -862,7 +862,7 @@ (list) (#.Some (do /.monad [_ /.aload_0 - _ (/.invokespecial ..$Object constructor (/type.method [(list) /type.void (list)])) + _ (/.invokespecial ..$Object constructor (/type.method [(list) (list) /type.void (list)])) _ (..$Long::literal part0) _ (/.putstatic $Self class_field /type.long) _ /.aload_0 @@ -873,7 +873,7 @@ /method.public /method.static) static_method - (/type.method [(list) ..$Long (list)]) + (/type.method [(list) (list) ..$Long (list)]) (list) (#.Some (do /.monad [_ (/.new $Self) @@ -1321,7 +1321,7 @@ (do random.monad [class_name ..class_name primitive_method_name (random.ascii/upper 10) - #let [primitive_method_type (/type.method [(list) (get@ #unboxed primitive) (list)])] + #let [primitive_method_type (/type.method [(list) (list) (get@ #unboxed primitive) (list)])] object_method_name (|> (random.ascii/upper 10) (random.filter (|>> (text\= primitive_method_name) not))) expected (get@ #random primitive) @@ -1341,7 +1341,7 @@ return))) (/method.method ..method_modifier object_method_name - (/type.method [(list) (get@ #boxed primitive) (list)]) + (/type.method [(list) (list) (get@ #boxed primitive) (list)]) (list) (#.Some (do /.monad [_ (/.invokestatic $Self primitive_method_name primitive_method_type) @@ -1433,7 +1433,7 @@ (do /.monad [_ (/.new ..$Object) _ /.dup] - (/.invokespecial ..$Object "<init>" (/type.method [(list) /type.void (list)])))) + (/.invokespecial ..$Object "<init>" (/type.method [(list) (list) /type.void (list)])))) reference_comparison ($_ _.and (_.lift "IF_ACMPEQ" (if! /.if_acmpeq (do /.monad [_ new_object] /.dup))) (_.lift "IF_ACMPNE" (if! /.if_acmpne (do /.monad [_ new_object] new_object))) @@ -1543,7 +1543,7 @@ _ (/.new $Exception) _ /.dup _ (..$String::literal exception) - _ (/.invokespecial $Exception "<init>" (/type.method [(list ..$String) /type.void (list)])) + _ (/.invokespecial $Exception "<init>" (/type.method [(list) (list ..$String) /type.void (list)])) _ /.athrow _ (/.set_label @skipped) _ (..$Long::literal dummy) @@ -1606,8 +1606,8 @@ $Abstract (/type.class abstract_class (list)) $Interface (/type.class interface_class (list)) - constructor::type (/type.method [(list) /type.void (list)]) - method::type (/type.method [(list) /type.long (list)]) + constructor::type (/type.method [(list) (list) /type.void (list)]) + method::type (/type.method [(list) (list) /type.long (list)]) inherited_method "inherited_method" overriden_method "overriden_method" @@ -1682,7 +1682,7 @@ /method.public /method.static) static_method - (/type.method [(list) ..$Long (list)]) + (/type.method [(list) (list) ..$Long (list)]) (list) (#.Some (do /.monad [_ (/.new $Concrete) |