(.module: [library [lux {"-" [Definition]} [program {"+" [program:]}] ["@" target] ["." ffi {"+" [import:]}] [abstract [monad {"+" [do]}]] [control ["." io {"+" [IO]}] ["." try {"+" [Try]}] [concurrency ["." async {"+" [Async]}]]] [data ["." product] [text ["%" format {"+" [format]}]] [collection [array {"+" [Array]}] ["." dictionary]]] ["." world "_" ["." file] ["#/." program]] [target ["." jvm "_" [bytecode {"+" [Bytecode]}] ["#/." type ["#/." box]]]] [tool [compiler [reference {"+" []}] ["." phase] [default ["." platform {"+" [Platform]}]] [meta [archive {"+" [Archive]}] ["." packager "_" ["#" jvm]]] [language [lux ["$" synthesis {"+" [Synthesis]}] ["." generation] [analysis [macro {"+" [Expander]}]] [phase [extension {"+" [Phase Bundle Operation Handler Extender]} ["." analysis "_" ["#" jvm]] ... ["." generation "_" ... ["#" jvm]] ... ["." directive "_" ... ["#" jvm]] ] [generation ["." jvm "_" ["#/." runtime] ... ["#/." host] ]]]]]]]]] [program ["/" compositor ["/." cli] ["/." static]]] [luxc [lang [host ["_" jvm]] ["." directive "_" ["#" jvm]] [translation ["." jvm ["." runtime] ["." expression] ["." function] ["#/." program] ["translation" extension]]]]]) (import: java/lang/reflect/Method ["#::." (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)]) (import: java/lang/Object ["#::." (getClass [] (java/lang/Class java/lang/Object))]) (def: _object_class (java/lang/Class java/lang/Object) (ffi.class_for java/lang/Object)) (def: _apply1_args (Array (java/lang/Class java/lang/Object)) (|> (ffi.array (java/lang/Class java/lang/Object) 1) (ffi.write! 0 _object_class))) (def: _apply2_args (Array (java/lang/Class java/lang/Object)) (|> (ffi.array (java/lang/Class java/lang/Object) 2) (ffi.write! 0 _object_class) (ffi.write! 1 _object_class))) (def: _apply5_args (Array (java/lang/Class java/lang/Object)) (|> (ffi.array (java/lang/Class java/lang/Object) 5) (ffi.write! 0 _object_class) (ffi.write! 1 _object_class) (ffi.write! 2 _object_class) (ffi.write! 3 _object_class) (ffi.write! 4 _object_class))) (def: .public (expander macro inputs lux) Expander (do try.monad [apply_method (|> macro (:as java/lang/Object) (java/lang/Object::getClass) (java/lang/Class::getMethod "apply" _apply2_args))] (:as (Try (Try [Lux (List Code)])) (java/lang/reflect/Method::invoke (:as java/lang/Object macro) (|> (ffi.array java/lang/Object 2) (ffi.write! 0 (:as java/lang/Object inputs)) (ffi.write! 1 (:as java/lang/Object lux))) apply_method)))) (def: how_to_wrap_a_phase Synthesis (let [java/lang/String (jvm/type.class "java.lang.String" (list)) (jvm/type.array (jvm/type.class "java.lang.Class" (list))) java/lang/Object (jvm/type.class "java.lang.Object" (list)) (jvm/type.array java/lang/Object) jvm_type (: (All (_ c) (-> (jvm/type.Type c) Synthesis)) (|>> jvm/type.format $.text)) class_type (: (-> Text Synthesis) (function (_ name) (|> (jvm/type.class name (list)) jvm_type))) unwrap_long (: (-> Synthesis Synthesis) (|>> (list ($.text jvm/type/box.long) ($.text "long")) (#$.Extension "jvm object cast"))) long_to_int (: (-> Synthesis Synthesis) (|>> (list) (#$.Extension "jvm conversion long-to-int"))) literal_nat (: (-> Nat Synthesis) (|>> .i64 $.i64 unwrap_long long_to_int)) write! (: (-> Text Nat Synthesis Synthesis Synthesis) (function (_ element_class index value array) ((#$.Extension "jvm array write object" (list (jvm_type (jvm/type.array (jvm/type.class element_class (list)))) (literal_nat index) value array))))) object_array (: (-> Text Nat Synthesis) (function (_ class_name size) (#$.Extension "jvm array new object" (list (class_type class_name) (literal_nat size))))) class_of (: (-> Synthesis Synthesis) (function (_ object) (#$.Extension "jvm member invoke virtual" (list& (class_type "java.lang.Object") ($.text "getClass") (class_type "java.lang.Class") object (list))))) input (: (All (_ c) (-> (jvm/type.Type c) Synthesis Synthesis)) (function (_ value_type value) ($.tuple (list (jvm_type value_type) value)))) example_object (#$.Extension "jvm member invoke constructor" (list& (class_type "java.lang.Object") (list))) phase_arity 3 $phase ($.variable/local 1) $archive ($.variable/local 2) $input ($.variable/local 3) $state ($.variable/local 4) apply_method (#$.Extension "jvm member invoke virtual" (list& (class_type "java.lang.Class") ($.text "getMethod") (class_type "java.lang.reflect.Method") (class_of $phase) (list (input java/lang/String ($.text runtime.apply_method)) (input (|> (object_array "java.lang.Class" phase_arity) (write! "java.lang.Class" 0 (class_of example_object)) (write! "java.lang.Class" 1 (class_of example_object)) (write! "java.lang.Class" 2 (class_of example_object)))))))] (#$.Extension "jvm member invoke virtual" (list& (class_type "java.lang.reflect.Method") ($.text "invoke") (class_type "java.lang.Object") apply_method (list (input java/lang/Object $phase) (input (|> (object_array "java.lang.Object" phase_arity) (write! "java.lang.Object" 0 $archive) (write! "java.lang.Object" 1 $input) (write! "java.lang.Object" 2 $state)))))))) (def: (phase_wrapper archive) (-> Archive (generation.Operation _.Anchor _.Inst _.Definition phase.Wrapper)) (do phase.monad [instanceG (function.function' (#.Some [0 (.nat -1)]) expression.translate archive [(list) 4 ..how_to_wrap_a_phase]) phase_wrapper (generation.evaluate! [0 (.nat -2)] instanceG)] (in (function (_ phase) (<| try.trusted (: (Try java/lang/Object)) (do try.monad [apply_method (|> phase_wrapper (:as java/lang/Object) (java/lang/Object::getClass) (java/lang/Class::getMethod runtime.apply_method _apply1_args))] (java/lang/reflect/Method::invoke (:as java/lang/Object phase_wrapper) (|> (ffi.array java/lang/Object 1) (ffi.write! 0 (:as java/lang/Object phase))) apply_method))))))) (def: .public platform ... (IO (Platform Anchor (Bytecode Any) Definition)) (IO [java/lang/ClassLoader (Platform _.Anchor _.Inst _.Definition)]) (do io.monad [... host jvm/host.host [loader host] jvm.host] (in [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) (-> phase.Wrapper Extender) ... TODO: Stop relying on coercions ASAP. (<| (:as Extender) (function (@self handler)) (:as Handler) (function (@self name phase)) (:as Phase) (function (@self archive parameters)) (:as Operation) (function (@self state)) (:as Try) try.trusted (:as Try) (do try.monad [method (|> handler (:as java/lang/Object) (java/lang/Object::getClass) (java/lang/Class::getMethod "apply" _apply5_args))] (java/lang/reflect/Method::invoke (:as java/lang/Object handler) (|> (ffi.array java/lang/Object 5) (ffi.write! 0 (:as java/lang/Object name)) (ffi.write! 1 (:as java/lang/Object (phase_wrapper phase))) (ffi.write! 2 (:as java/lang/Object archive)) (ffi.write! 3 (:as java/lang/Object parameters)) (ffi.write! 4 (:as java/lang/Object state))) method)))) (def: (declare_success! _) (-> Any (Async Any)) (async.future (\ world/program.default exit +0))) (program: [service /cli.service] (let [static [#/static.host @.jvm #/static.host_module_extension ".jvm" #/static.target (/cli.target service) #/static.artifact_extension ".class"]] (exec (do async.monad [[loader platform] (async.future ..platform) _ (/.compiler [#/static.host @.jvm #/static.host_module_extension ".jvm" #/static.target (/cli.target service) #/static.artifact_extension ".class"] ..expander (analysis.bundle loader) (io.io platform) ... generation.bundle translation.bundle (|>> ..extender (directive.bundle loader)) (jvm/program.program jvm/runtime.class_name) [_.Anchor _.Inst _.Definition] ..extender service [(packager.package static) (format (/cli.target service) (\ file.default separator) "program.jar")])] (..declare_success! [])) (io.io []))))