diff options
Diffstat (limited to '')
42 files changed, 1449 insertions, 1030 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index e2ac5790e..bf922ec17 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -5,14 +5,6 @@ ["" 0 0] #0) -(.def# double_quote - (.int_char# +34) - #0) - -(.def# \n - (.int_char# +10) - #0) - (.def# prelude "library/lux" #1) @@ -981,18 +973,23 @@ ([_ full_name] ({[module name] ({"" name - _ (text#composite module (text#composite ..symbol_separator name))} + _ (.text_composite# module ..symbol_separator name)} module)} full_name))) #0) +(.def# \'' + (.is# Text + (.int_char# +34)) + #0) + ... TODO: Allow asking the compiler for the name of the definition ... currently being defined. That name can then be fed into ... 'wrong_syntax_error' for easier maintenance of the error_messages. (.def# wrong_syntax_error (.is# {#Function Symbol Text} ([_ it] - (text#composite "Wrong syntax for " (symbol#encoded it)))) + (.text_composite# "Wrong syntax for " \'' (symbol#encoded it) \'' "."))) #0) (.def# let'' @@ -1225,7 +1222,7 @@ syntax} syntax)) -(def' .private (n/* param subject) +(def' .private (n#* param subject) {#Function Nat {#Function Nat Nat}} (.as# Nat (.int_*# (.as# Int param) @@ -1262,9 +1259,7 @@ (def' .private quantification_level Text - (.text_composite# double_quote - "quantification_level" - double_quote)) + (.text_composite# \'' "quantification_level" \'')) (def' .private quantified {#Function Code Code} @@ -1879,15 +1874,15 @@ {#Right [state real_name]} {#Default _} - {#Left (all text#composite "Unknown definition: " (symbol#encoded full_name))}} + {#Left (.text_composite# "Unknown definition: " (symbol#encoded full_name))}} constant) {#None} - {#Left (all text#composite "Unknown definition: " (symbol#encoded full_name))}} + {#Left (.text_composite# "Unknown definition: " (symbol#encoded full_name))}} (property#value name definitions)) {#None} - {#Left (all text#composite "Unknown module: " module " @ " (symbol#encoded full_name))}} + {#Left (.text_composite# "Unknown module: " module " @ " (symbol#encoded full_name))}} (property#value module modules)))) (def' .private (|List<Code>| expression) @@ -1992,7 +1987,7 @@ ..#scope_type_vars scope_type_vars ..#eval _eval] state] ({{#None} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))} + {#Left (.text_composite# "Unknown definition: " (symbol#encoded name))} {#Some [..#definitions definitions ..#module_hash _ @@ -2000,7 +1995,7 @@ ..#imports _ ..#module_state _]} ({{#None} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))} + {#Left (.text_composite# "Unknown definition: " (symbol#encoded name))} {#Some [exported? definition]} ({{#Alias real_name} @@ -2009,10 +2004,10 @@ {#Definition [def_type def_value]} (if (available? expected_module current_module exported?) {#Right [state [def_type def_value]]} - {#Left (text#composite "Unavailable definition: " (symbol#encoded name))}) + {#Left (.text_composite# "Unavailable definition: " (symbol#encoded name))}) {#Default _} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))}} + {#Left (.text_composite# "Unknown definition: " (symbol#encoded name))}} definition)} (property#value expected_short definitions))} (property#value expected_module modules)))) @@ -2029,7 +2024,7 @@ (definition_value global lux) {#Some _} - {#Left (text#composite "Not a global value: " (symbol#encoded global))}} + {#Left (.text_composite# "Not a global value: " (symbol#encoded global))}} (in_env short lux)) _ @@ -2551,7 +2546,7 @@ (-> ($ I64 Any) I64) (.i64_and# low_mask value)) -(def' .private (n/< reference sample) +(def' .private (n#< reference sample) (-> Nat Nat Bit) (let' [referenceH (high_bits reference) sampleH (high_bits sample)] @@ -2602,10 +2597,10 @@ (failure (..wrong_syntax_error (symbol ..with_template)))} tokens))) -(def' .private (n// param subject) +(def' .private (n#/ param subject) (-> Nat Nat Nat) (if (.int_<# +0 (.as# Int param)) - (if (n/< param subject) + (if (n#< param subject) 0 1) (let' [quotient (|> subject @@ -2615,19 +2610,19 @@ flat (.int_*# (.as# Int param) (.as# Int quotient)) remainder (.i64_-# flat subject)] - (if (n/< param remainder) + (if (n#< param remainder) quotient (.i64_+# 1 quotient))))) -(def' .private (n/% param subject) +(def' .private (n#% param subject) (-> Nat Nat Nat) (let' [flat (.int_*# (.as# Int param) - (.as# Int (n// param subject)))] + (.as# Int (n#/ param subject)))] (.i64_-# flat subject))) -(def' .private (n/min left right) +(def' .private (n#min left right) (-> Nat Nat Nat) - (if (n/< right left) + (if (n#< right left) left right)) @@ -2651,9 +2646,9 @@ (function' again [input output] (if (.i64_=# 0 input) output - (again (n// 10 input) - (text#composite (|> input (n/% 10) digit::format) - output)))))] + (again (n#/ 10 input) + (.text_composite# (|> input (n#% 10) digit::format) + output)))))] (loop value ""))} value)) @@ -2673,10 +2668,10 @@ ((.is# (-> Int Text Text) (function' again [input output] (if (.i64_=# +0 input) - (text#composite sign output) + (.text_composite# sign output) (again (.int_/# +10 input) - (text#composite (|> input (.int_%# +10) (.as# Nat) digit::format) - output))))) + (.text_composite# (|> input (.int_%# +10) (.as# Nat) digit::format) + output))))) (|> value (.int_/# +10) int#abs) (|> value (.int_%# +10) int#abs (.as# Nat) digit::format))))) @@ -2758,7 +2753,7 @@ (def' .private (text#encoded original) (-> Text Text) - (all text#composite ..double_quote original ..double_quote)) + (.text_composite# \'' original \'')) (def' .private (code#encoded code) (-> Code Text) @@ -2784,25 +2779,34 @@ (symbol#encoded [module name]) [_ {#Form xs}] - (all text#composite "(" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) ")") + (.text_composite# + "(" + (|> xs + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite "")) + ")") [_ {#Tuple xs}] - (all text#composite "[" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) "]") + (.text_composite# + "[" + (|> xs + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite "")) + "]") [_ {#Variant xs}] - (all text#composite "{" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) "}")} + (.text_composite# + "{" + (|> xs + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite "")) + "}")} code)) (def' .private (single_expansion token) @@ -3135,7 +3139,7 @@ ..#seed (.i64_+# 1 seed) ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] - (local$ (all text#composite "__gensym__" prefix (nat#encoded seed)))}} + (local$ (.text_composite# "__gensym__" prefix (nat#encoded seed)))}} state)) (with_template [<name> <tag>] @@ -3166,44 +3170,44 @@ (def' .private (type#encoded type) (-> Type Text) ({{#Nominal name params} - (all text#composite - "(Nominal " (text#encoded name) - (|> params - (list#each (function' [it] (|> it type#encoded (text#composite " ")))) - list#reversed - (list#mix text#composite "")) - ")") + (.text_composite# + "(Nominal " (text#encoded name) + (|> params + (list#each (function' [it] (|> it type#encoded (.text_composite# " ")))) + list#reversed + (list#mix text#composite "")) + ")") {#Sum _} - (all text#composite "{" (|> (flat_variant type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "}") + (.text_composite# "{" (|> (flat_variant type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "}") {#Product _} - (all text#composite "[" (|> (flat_tuple type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "]") + (.text_composite# "[" (|> (flat_tuple type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "]") {#Function _} - (all text#composite "(-> " (|> (flat_lambda type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")") + (.text_composite# "(-> " (|> (flat_lambda type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")") {#Parameter id} (nat#encoded id) {#Var id} - (all text#composite "-" (nat#encoded id)) + (.text_composite# "-" (nat#encoded id)) {#Ex id} - (all text#composite "+" (nat#encoded id)) + (.text_composite# "+" (nat#encoded id)) {#UnivQ env body} - (all text#composite "(All " (type#encoded body) ")") + (.text_composite# "(All " (type#encoded body) ")") {#ExQ env body} - (all text#composite "(Ex " (type#encoded body) ")") + (.text_composite# "(Ex " (type#encoded body) ")") {#Apply _} (let' [[func args] (flat_application type)] - (all text#composite - "(" (type#encoded func) " " - (|> args (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) - ")")) + (.text_composite# + "(" (type#encoded func) " " + (|> args (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) + ")")) {#Named name _} (symbol#encoded name)} @@ -3263,9 +3267,8 @@ (in (symbol$ name)) _ - (failure (all text#composite - "Invalid static value: " (symbol#encoded name) - " : " (type#encoded type)))} + (failure (.text_composite# "Invalid static value: " (symbol#encoded name) + " : " (type#encoded type)))} (anonymous_type type))} type+value))))] (function' literal [only_global? token] @@ -3361,11 +3364,12 @@ (meta#in (list)) _ - (failure (all text#composite "'when' expects an even number of tokens: " (|> branches - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite ""))))} + (failure (.text_composite# "'when' expects an even number of tokens: " + (|> branches + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite ""))))} branches)) (def' .public when @@ -3939,7 +3943,7 @@ {#Right state module} _ - {#Left (all text#composite "Unknown module: " name)})))) + {#Left (.text_composite# "Unknown module: " name)})))) (def (type_slot [module name]) (-> Symbol (Meta [Bit Label])) @@ -3955,7 +3959,7 @@ (meta#in [exported (as Label value)]) _ - (failure (text#composite "Unknown slot: " (symbol#encoded [module name])))))) + (failure (.text_composite# "Unknown slot: " (symbol#encoded [module name])))))) (def (slot_family expected_module expected_record) (-> Text Type (Meta (Maybe (List Symbol)))) @@ -4060,9 +4064,8 @@ (meta#in tags) _ - (failure (all text#composite - "No tags available for type: " - (type#encoded implementation_type))))) + (failure (.text_composite# "No tags available for type: " + (type#encoded implementation_type))))) .let [tag_mappings (is (List [Text Code]) (list#each (function (_ tag) [(product#right tag) @@ -4077,7 +4080,7 @@ (in (list tag value)) _ - (failure (text#composite "Unknown implementation member: " slot_name))) + (failure (.text_composite# "Unknown implementation member: " slot_name))) _ (failure "Invalid implementation member.")))) @@ -4092,7 +4095,7 @@ {#Item head tail} (list#mix (function (_ right left) - (all text#composite left separator right)) + (.text_composite# left separator right)) head tail))) @@ -4391,7 +4394,7 @@ _ (when root "" hierarchy - _ (all text#composite root ..module_separator hierarchy)))) + _ (.text_composite# root ..module_separator hierarchy)))) (def (normal_parallel_path hierarchy root) (-> Text Text (Maybe Text)) @@ -4423,6 +4426,10 @@ [_ {#Item _ tail}] (list#after (.i64_-# 1 amount) tail))) +(def \n + Text + (.int_char# +10)) + (def (absolute_module_name nested? relative_root module) (-> Bit Text Text (Meta Text)) (when (relative_ups 0 module) @@ -4434,7 +4441,7 @@ relatives (let [parts (text#all_split_by ..module_separator relative_root) jumps (.i64_-# 1 relatives)] - (if (n/< (list#size parts) jumps) + (if (n#< (list#size parts) jumps) (let [prefix (|> parts list#reversed (list#after jumps) @@ -4443,7 +4450,7 @@ clean (.text_clip# relatives (|> module .text_size# (.i64_-# relatives)) module) output (when (.text_size# clean) 0 prefix - _ (all text#composite prefix ..module_separator clean))] + _ (.text_composite# prefix ..module_separator clean))] (meta#in output)) (failure (.text_composite# "Cannot climb the module hierarchy..." \n "Importing module: " module \n @@ -4513,9 +4520,8 @@ _ (do meta#monad [current_module current_module_name] - (failure (all text#composite - "Wrong syntax for import @ " current_module - \n (code#encoded token))))))) + (failure (.text_composite# "Wrong syntax for import @ " current_module + \n (code#encoded token))))))) imports)] (in (list#conjoint imports')))) @@ -4550,19 +4556,18 @@ {#Right state (list#conjoint to_alias)}) {#None} - {#Left (all text#composite - "Unknown module: " (text#encoded module) \n - "Current module: " (when current_module - {#Some current_module} - (text#encoded current_module) - - {#None} - "???") \n - "Known modules: " (|> modules - (list#each (function (_ [name module]) - (text$ name))) - tuple$ - code#encoded))}) + {#Left (.text_composite# "Unknown module: " (text#encoded module) \n + "Current module: " (when current_module + {#Some current_module} + (text#encoded current_module) + + {#None} + "???") \n + "Known modules: " (|> modules + (list#each (function (_ [name module]) + (text$ name))) + tuple$ + code#encoded))}) )) (def (list#only p xs) @@ -4592,7 +4597,7 @@ (function (_ _def) (if (is_member? all_defs _def) (meta#in []) - (failure (all text#composite _def " is not defined in module " imported_module " @ " current_module))))) + (failure (.text_composite# _def " is not defined in module " imported_module " @ " current_module))))) referred_defs)) (def (alias_definition imported_module def) @@ -4761,13 +4766,13 @@ {#Right [compiler implementation_type]} _ - {#Left (all text#composite "Unknown var: " (symbol#encoded full_name))})) + {#Left (.text_composite# "Unknown var: " (symbol#encoded full_name))})) (when (definition_type full_name compiler) {#Some implementation_type} {#Right [compiler implementation_type]} _ - {#Left (all text#composite "Unknown var: " (symbol#encoded full_name))})))] + {#Left (.text_composite# "Unknown var: " (symbol#encoded full_name))})))] (when temp {#Right [compiler temp]} (let [[..#info _ ..#source _ ..#current_module _ ..#modules _ @@ -4861,7 +4866,7 @@ implementation_evidence (record_slots init_type)] (when implementation_evidence {#None} - (failure (text#composite "Can only 'open' implementations: " (type#encoded init_type))) + (failure (.text_composite# "Can only 'open' implementations: " (type#encoded init_type))) {#Some tags,members} (do meta#monad @@ -5007,9 +5012,8 @@ (in (list#conjoint declarations))) _ - (failure (all text#composite - "Can only 'use' implementations: " (symbol#encoded implementation) - " : " (type#encoded interface)))))) + (failure (.text_composite# "Can only 'use' implementations: " (symbol#encoded implementation) + " : " (type#encoded interface)))))) (def (localized module global) (-> Text Symbol Symbol) @@ -5101,13 +5105,12 @@ (in referral) _ - (failure (all text#composite - (..wrong_syntax_error (symbol ..refer)) - \n "@ " current_module - \n (|> extra - (list#each code#encoded) - (list#interposed " ") - (list#mix text#composite ""))))))) + (failure (.text_composite# (..wrong_syntax_error (symbol ..refer)) + \n "@ " current_module + \n (|> extra + (list#each code#encoded) + (list#interposed " ") + (list#mix text#composite ""))))))) (def .public refer (macro (_ tokens) @@ -5475,10 +5478,9 @@ (single_expansion expr) _ - (failure (all text#composite - "Incorrect expansion in with_expansions" - " | Binding: " (text#encoded var_name) - " | Expression: " (code#encoded expr))))] + (failure (.text_composite# "Incorrect expansion in with_expansions" + " | Binding: " (text#encoded var_name) + " | Expression: " (code#encoded expr))))] (again &rest (property#with var_name expansion map))) {#End} @@ -5627,21 +5629,19 @@ (in (as ..Text value)) _ - (failure (all text#composite - "Invalid target platform (must be a value of type Text): " (symbol#encoded symbol) - " : " (..code#encoded (..type_code type)))))) + (failure (.text_composite# "Invalid target platform (must be a value of type Text): " (symbol#encoded symbol) + " : " (..code#encoded (..type_code type)))))) _ - (failure (all text#composite - "Invalid target platform syntax: " (..code#encoded choice) - \n "Must be either a text literal or a symbol."))))) + (failure (.text_composite# "Invalid target platform syntax: " (..code#encoded choice) + \n "Must be either a text literal or a symbol."))))) target_pick (is (-> Text (List [Code Code]) (Maybe Code) (Meta (List Code))) (function (target_pick target options default) (when options {#End} (when default {#None} - (failure (all text#composite "No code for target platform: " target)) + (failure (.text_composite# "No code for target platform: " target)) {#Some default} (meta#in (list default))) @@ -5685,7 +5685,7 @@ (in (list (` {.#Ex (, (nat$ var_id))}))) {#None} - (failure (text#composite "Indexed-type does not exist: " (nat#encoded idx))))) + (failure (.text_composite# "Indexed-type does not exist: " (nat#encoded idx))))) _ (failure (..wrong_syntax_error (symbol ..$))))))) @@ -5874,7 +5874,7 @@ Type (let [[_ short] (symbol <type>)] {#Named [..prelude short] - {.#Nominal (text#composite "#Extension/" short) (list)}}))] + {.#Nominal (.text_composite# "#Extension/" short) (list)}}))] [Analysis] [Synthesis] diff --git a/stdlib/source/library/lux/control/aspect.lux b/stdlib/source/library/lux/control/aspect.lux index 8feeaebc8..4fe5e1f6f 100644 --- a/stdlib/source/library/lux/control/aspect.lux +++ b/stdlib/source/library/lux/control/aspect.lux @@ -36,7 +36,8 @@ ["[0]" type]]]]]]]]) (type .public (Advice value) - (-> value value)) + (-> value + value)) (def .public (before pre) (All (_ input output) @@ -104,7 +105,8 @@ (List [Point_Cut Symbol])) (def (without_global [module short]) - (-> Symbol (analysis.Operation Any)) + (-> Symbol + (analysis.Operation Any)) (function (_ lux) (let [without_global (is (-> (property.List [Bit .Global]) (property.List [Bit .Global])) (property.lacks short)) @@ -118,7 +120,8 @@ []]}))) (def (global_reference name) - (-> Symbol (Meta [Bit .Global])) + (-> Symbol + (Meta [Bit .Global])) (do meta.monad [name (meta.normal name) current_module_name meta.current_module_name @@ -209,7 +212,8 @@ (in it))) (def (expression type term) - (-> Type analysis.Analysis Analysis) + (-> Type analysis.Term + Analysis) (analysis (_ phase archive []) (do phase.monad [_ (type.inference type)] @@ -217,7 +221,7 @@ (def (with_cached_expression [type term] then) (All (_ of) - (-> [Type analysis.Analysis] + (-> [Type analysis.Term] (-> (-> Code (analysis.Operation of)) (analysis.Operation of)))) (do phase.monad @@ -231,7 +235,8 @@ (with_template [<name> <parameters> <term> <scenario> <advised>] [(def (<name> original aspect) - (-> Code Aspect Analysis) + (-> Code Aspect + Analysis) (analysis (_ phase archive <parameters>) (do [! phase.monad] [[type term] (type.inferring diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index 1a8f77710..8dc9cea8a 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Analysis) + [lux (.except) [abstract ["[0]" monad (.only do)]] [control @@ -28,7 +28,7 @@ [language [lux ["[0]" phase (.use "[1]#[0]" monad)] - ["[0]" analysis (.only Analysis Operation Phase) + ["[0]" analysis (.only Operation Phase) ["[0]" type]]]] [meta [archive (.only Archive)]]]]]] @@ -48,7 +48,8 @@ (list ["Type" (%.type type)]))) (def (composite phase archive <+> last prevs) - (-> Phase Archive Code Analysis (List Analysis) (Operation Analysis)) + (-> Phase Archive Code analysis.Term (List analysis.Term) + (Operation analysis.Term)) (when <+> [_ {.#Symbol [.prelude $]}] (phase#in (list#mix (function (_ left right) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux index 04739b70c..9d95397d5 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Tuple Variant Pattern Analysis #Function #Apply nat int rev when local except) + [lux (.except Tuple Variant Pattern #Function #Apply nat int rev when local except) [abstract [equivalence (.only Equivalence)] [hash (.only Hash)] @@ -60,8 +60,8 @@ (type .public (Environment a) (List a)) -(with_expansions [@ ($ (Analysis' $))] - (type .public (Analysis' $) +(with_expansions [@ ($ (Term' $))] + (type .public (Term' $) (.Variant {#Simple Simple} {#Structure (Complex @)} @@ -71,18 +71,18 @@ {#Apply @ @} {#Extension (Extension @)}))) -(type .public Analysis +(type .public Term (Ann Location - (Analysis' (Ann Location)))) + (Term' (Ann Location)))) (type .public Branch - (Branch' Analysis)) + (Branch' Term)) (type .public Match - (Match' Analysis)) + (Match' Term)) (def (branch_equivalence equivalence) - (-> (Equivalence Analysis) + (-> (Equivalence Term) (Equivalence Branch)) (implementation (def (= [reference_pattern reference_body] [sample_pattern sample_body]) @@ -90,7 +90,7 @@ (of equivalence = reference_body sample_body))))) (def .public equivalence - (Equivalence Analysis) + (Equivalence Term) (implementation (def (= [_ reference] [_ sample]) (.when [reference sample] @@ -165,16 +165,18 @@ {..#Apply value} [@])])) (def .public (reified [[@ abstraction] inputs]) - (-> (Reification Analysis) Analysis) + (-> (Reification Term) + Term) (list#mix (function (_ input abstraction') [@ {#Apply input abstraction'}]) [@ abstraction] inputs)) (def .public (reification analysis) - (-> Analysis (Reification Analysis)) + (-> Term + (Reification Term)) (loop (again [[@ abstraction] analysis - inputs (is (List Analysis) + inputs (is (List Term) (list))]) (.when abstraction {#Apply input next} @@ -212,7 +214,7 @@ ) (def .public (format [@ analysis]) - (Format Analysis) + (Format Term) (.when analysis {#Simple it} (/simple.format it) @@ -264,11 +266,11 @@ (phase.Operation State)) (type .public Phase - (phase.Phase State Code Analysis)) + (phase.Phase State Code Term)) (with_template [<special> <general>] [(type .public <special> - (<general> State Code Analysis))] + (<general> State Code Term))] [Handler extension.Handler] [Bundle extension.Bundle] @@ -276,7 +278,9 @@ ) (def .public (with_source_code source action) - (All (_ a) (-> Source (Operation a) (Operation a))) + (All (_ of) + (-> Source (Operation of) + (Operation of))) (function (_ state) (let [old_source (the .#source state)] (.when (action (has .#source source state)) @@ -288,13 +292,17 @@ failure)))) (def .public (with_current_module name) - (All (_ a) (-> Text (Operation a) (Operation a))) + (All (_ of) + (-> Text (Operation of) + (Operation of))) (phase.localized (the .#current_module) (has .#current_module) (function.constant {.#Some name}))) (def .public (with_location location action) - (All (_ a) (-> Location (Operation a) (Operation a))) + (All (_ of) + (-> Location (Operation of) + (Operation of))) (if (text#= "" (product.left location)) action (function (_ state) @@ -308,17 +316,21 @@ failure))))) (def (located location error) - (-> Location Text Text) + (-> Location Text + Text) (%.format (%.location location) text.new_line error)) (def .public (failure error) - (-> Text Operation) + (-> Text + Operation) (function (_ state) {try.#Failure (located (the .#location state) error)})) (def .public (of_try it) - (All (_ a) (-> (Try a) (Operation a))) + (All (_ of) + (-> (Try of) + (Operation of))) (function (_ state) (.when it {try.#Failure error} @@ -328,17 +340,23 @@ {try.#Success [state it]}))) (def .public (except exception parameters) - (All (_ e) (-> (Exception e) e Operation)) + (All (_ ex) + (-> (Exception ex) ex + Operation)) (..failure (exception.error exception parameters))) (def .public (assertion exception parameters condition) - (All (_ e) (-> (Exception e) e Bit (Operation Any))) + (All (_ ex) + (-> (Exception ex) ex Bit + (Operation Any))) (if condition (of phase.monad in []) (..except exception parameters))) (def .public (with_exception exception message action) - (All (_ e o) (-> (Exception e) e (Operation o) (Operation o))) + (All (_ ex of) + (-> (Exception ex) ex (Operation of) + (Operation of))) (function (_ state) (.when (exception.with exception message (action state)) @@ -349,13 +367,15 @@ success))) (def .public (set_state state) - (-> .Lux (Operation Any)) + (-> .Lux + (Operation Any)) (function (_ _) {try.#Success [state []]})) (with_template [<name> <type> <field> <value>] [(def .public (<name> value) - (-> <type> (Operation Any)) + (-> <type> + (Operation Any)) (phase.update (has <field> <value>)))] [set_source_code Source .#source value] @@ -364,11 +384,13 @@ ) (def .public (location file) - (-> Text Location) + (-> Text + Location) [file 1 0]) (def .public (source file code) - (-> Text Text Source) + (-> Text Text + Source) [(location file) 0 code]) (def dummy_source @@ -382,14 +404,16 @@ .#var_bindings (list)]) (def .public (info version host configuration) - (-> Version Text Configuration Info) + (-> Version Text Configuration + Info) [.#target host .#version (version.format version) .#mode {.#Build} .#configuration configuration]) (def .public (state info) - (-> Info Lux) + (-> Info + Lux) [.#info info .#source ..dummy_source .#location location.dummy @@ -405,7 +429,8 @@ .#host []]) (def .public (delegated extender analysis archive extension parameters) - (-> Extender Phase Archive Symbol (List Code) (Operation Analysis)) + (-> Extender Phase Archive Symbol (List Code) + (Operation Term)) (do phase.monad [lux phase.state] (extension.application extender diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux index 3546065e4..8b06ca115 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Analysis) + [lux (.except) [abstract ["[0]" monad (.only do)]] [control @@ -25,7 +25,7 @@ ["[0]" template]] ["[0]" type (.only) ["[0]" check]]]]] - ["/" // (.only Analysis Operation Phase) + ["/" // (.only Operation Phase) ["[1][0]" type] [// ["[0]" phase (.use "[1]#[0]" monad) @@ -58,7 +58,8 @@ ) (def .public (quantified @var @parameter :it:) - (-> check.Var Nat Type Type) + (-> check.Var Nat Type + Type) (when :it: {.#Nominal name co_variant} {.#Nominal name (list#each (quantified @var @parameter) co_variant)} @@ -97,7 +98,11 @@ ... But, so long as the type being used for the inference can be treated ... as a function type, this method of inference should work. (def (general' vars archive analyse inferT args) - (-> (List check.Var) Archive Phase Type (List Code) (Operation [Type_Context (List check.Var) Type (List Analysis)])) + (-> (List check.Var) Archive Phase Type (List Code) + (Operation [Type_Context + (List check.Var) + Type + (List /.Term)])) (when args {.#End} (do phase.monad @@ -158,7 +163,8 @@ )) (def .public (general archive analyse inferT args) - (-> Archive Phase Type (List Code) (Operation [Type (List Analysis)])) + (-> Archive Phase Type (List Code) + (Operation [Type (List /.Term)])) (do [! phase.monad] [[just_before vars :inference: terms] (general' (list) archive analyse inferT args)] (in [:inference: terms]) @@ -192,7 +198,8 @@ )) (def (with_recursion @self recursion) - (-> Nat Type Type Type) + (-> Nat Type Type + Type) (function (again it) (when it (^.or {.#Parameter index} @@ -220,14 +227,16 @@ it))) (def parameters - (-> Nat (List Type)) + (-> Nat + (List Type)) (|>> list.indices (list#each (|>> (n.* 2) ++ {.#Parameter})) list.reversed)) (with_template [<name> <types> <inputs> <exception> <when> <then>] [(`` (def .public (<name> (,, (template.spliced <inputs>)) complex) - (-> (,, (template.spliced <types>)) Type (Operation Type)) + (-> (,, (template.spliced <types>)) Type + (Operation Type)) (loop (again [depth 0 it complex]) (when it diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux index aabb4c043..d3307a816 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Analysis) + [lux (.except) [abstract [monad (.only do)]] [control @@ -35,7 +35,7 @@ ["[0]" extension] [// ["//" phase] - ["/" analysis (.only Analysis Operation Phase Handler Extender) + ["/" analysis (.only Operation Phase Handler Extender) ["[1][0]" macro (.only Expander)] ["[1][0]" type]] [/// @@ -51,7 +51,7 @@ ... TODO: Replace with an inline function. (def variant_analysis (template (_ analysis archive tag values) - ... (-> Phase Archive Symbol (List Code) (Operation Analysis)) + ... (-> Phase Archive Symbol (List Code) (Operation /.Term)) [(when values (list value) (/complex.variant analysis tag archive value) @@ -62,7 +62,7 @@ ... TODO: Replace with an inline function. (def sum_analysis (template (_ analysis archive lefts right? values) - ... (-> Phase Archive Nat Bit (List Code) (Operation Analysis)) + ... (-> Phase Archive Nat Bit (List Code) (Operation /.Term)) [(when values (list value) (/complex.sum analysis lefts right? archive value) @@ -73,7 +73,7 @@ ... TODO: Replace with an inline function. (def when_analysis (template (_ analysis archive input branches code) - ... (-> Phase Archive Code (List Code) Code (Operation Analysis)) + ... (-> Phase Archive Code (List Code) Code (Operation /.Term)) [(when (list.pairs branches) {.#Some branches} (/when.when analysis branches archive input) @@ -88,7 +88,8 @@ (list ["Name" (%.symbol name)]))) (def (macro_application extender expander analysis archive def_name argsC+) - (-> Extender Expander Phase Archive Symbol (List Code) (Operation Analysis)) + (-> Extender Expander Phase Archive Symbol (List Code) + (Operation /.Term)) (do [! //.monad] [?macro (meta.macro def_name)] (when ?macro @@ -102,7 +103,8 @@ ... TODO: Replace with an inline function. (def (global_application extender expander analysis archive function_type function_analysis def_name functionC argsC+) - (-> Extender Expander Phase Archive Type Analysis Symbol Code (List Code) (Operation Analysis)) + (-> Extender Expander Phase Archive Type /.Term Symbol Code (List Code) + (Operation /.Term)) (<| (if (check.subsumes? .Macro function_type) (macro_application extender expander analysis archive def_name argsC+)) (if (check.subsumes? .Analysis function_type) @@ -117,7 +119,8 @@ ... TODO: Replace with an inline function. (def (term_application extender expander analysis archive functionC argsC+) - (-> Extender Expander Phase Archive Code (List Code) (Operation Analysis)) + (-> Extender Expander Phase Archive Code (List Code) + (Operation /.Term)) (do //.monad [[function_type function_analysis] (/type.inferring (analysis archive functionC))] @@ -131,7 +134,7 @@ ... TODO: Replace with an inline function. (def apply_analysis (template (_ extender expander analysis archive functionC argsC+) - ... (-> Extender Expander Phase Archive Code (List Code) (Operation Analysis)) + ... (-> Extender Expander Phase Archive Code (List Code) (Operation /.Term)) [(when functionC [_ {.#Symbol global}] (do //.monad @@ -147,7 +150,8 @@ (term_application extender expander analysis archive functionC argsC+))])) (def .public (phase extender expander) - (-> Extender Expander Phase) + (-> Extender Expander + Phase) (function (analysis archive code) (<| (let [[@ code'] code]) ... The location must be set in the state for the sake diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux index acb4a676e..46301fa0d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Tag Analysis) + [lux (.except Tag) [abstract ["[0]" monad (.only do)]] [control @@ -30,7 +30,7 @@ ["[1][0]" simple] [/// ["[0]" phase (.use "[1]#[0]" monad)] - ["/" analysis (.only Analysis Operation Phase) + ["/" analysis (.only Operation Phase) ["[1][0]" complex (.only Tag)] ["[1][0]" type] ["[1][0]" inference]] @@ -186,7 +186,8 @@ (/.except ..invalid_variant_type [expectedT lefts right? valueC]))))))) (def .public (variant analyse tag archive valueC) - (-> Phase Symbol Phase) + (-> Phase Symbol + Phase) (do [! phase.monad] [tag (meta.normal tag) [lefts,right? variantT] (meta.tag tag) @@ -210,11 +211,12 @@ (..sum analyse lefts right? archive valueC))))) (def (typed_product analyse expectedT archive members) - (-> Phase Type Archive (List Code) (Operation Analysis)) + (-> Phase Type Archive (List Code) + (Operation /.Term)) (<| (do [! phase.monad] [@ meta.location]) (of ! each (|>> (/.tuple @))) - (is (Operation (List Analysis))) + (is (Operation (List /.Term))) (loop (again [membersT+ (type.flat_tuple expectedT) membersC+ members]) (when [membersT+ membersC+] @@ -242,7 +244,8 @@ (/.except ..cannot_analyse_tuple [expectedT members]))))) (def .public (product analyse archive membersC) - (-> Phase Archive (List Code) (Operation Analysis)) + (-> Phase Archive (List Code) + (Operation /.Term)) (do [! phase.monad] [expectedT meta.expected_type] (/.with_exception ..cannot_analyse_tuple [expectedT membersC] @@ -314,7 +317,8 @@ ... Normalization just means that all the tags get resolved to their ... canonical form (with their corresponding module identified). (def .public (normal pattern_matching? record) - (-> Bit (List Code) (Operation (Maybe (List [Symbol Code])))) + (-> Bit (List Code) + (Operation (Maybe (List [Symbol Code])))) (loop (again [input record output (is (List [Symbol Code]) {.#End})]) @@ -338,23 +342,27 @@ (phase#in {.#None})))) (def (local_binding? name) - (-> Text (Meta Bit)) + (-> Text + (Meta Bit)) (of meta.monad each (list.any? (list.any? (|>> product.left (text#= name)))) meta.locals)) (def (slot it) - (-> Symbol (Meta Label)) + (-> Symbol + (Meta Label)) (do meta.monad [it (meta.normal it)] (meta.slot it))) (def (slot_type [[_ it] _]) - (-> [Label Code] Type) + (-> [Label Code] + Type) it) (def (same_record? it) - (-> (List [Label Code]) Bit) + (-> (List [Label Code]) + Bit) (when it (list.partial head tail) (let [expected (slot_type head)] @@ -364,7 +372,8 @@ false)) (def (complete_record? it) - (-> (List [Label Code]) Bit) + (-> (List [Label Code]) + Bit) (loop (again [expected_lefts 0 remaining it]) (when remaining @@ -382,7 +391,8 @@ false))) (def sorted_record - (-> (List [Label Code]) (List [Label Code])) + (-> (List [Label Code]) + (List [Label Code])) (list.sorted (function (_ left right) (when [left right] [[[{.#Some [leftsL right?L familyL]} typeL] valueL] @@ -398,7 +408,8 @@ ... re-implementing the same functionality for records makes no sense. ... Records, thus, get transformed into tuples by ordering the elements. (def (order' head_k original_record) - (-> Symbol (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type]))) + (-> Symbol (List [Symbol Code]) + (Operation (Maybe [Nat (List Code) Type]))) (do [! phase.monad] [record (<| meta.try (monad.each ! (function (_ [slot value]) @@ -424,7 +435,8 @@ (in {.#None})))) (def .public (order pattern_matching? record) - (-> Bit (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type]))) + (-> Bit (List [Symbol Code]) + (Operation (Maybe [Nat (List Code) Type]))) (when record ... empty_record = empty_tuple = unit/any = [] {.#End} @@ -445,7 +457,8 @@ (order' head_k record)))) (def .public (record analyse archive members) - (-> Phase Archive (List Code) (Operation Analysis)) + (-> Phase Archive (List Code) + (Operation /.Term)) (when members (list) //simple.unit diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux index 77928212a..dfb8f674b 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Analysis function) + [lux (.except function) [abstract [monad (.only do)]] [control @@ -24,7 +24,7 @@ ["[0]" check]]]]] [//// ["[0]" phase (.use "[1]#[0]" functor)] - ["/" analysis (.only Analysis Operation Phase) + ["/" analysis (.only Operation Phase) ["[1][0]" type] ["[1][0]" inference] ["[1][0]" scope]] @@ -52,7 +52,8 @@ (text.interposed text.new_line))]))) (def .public (function analyse function_name arg_name archive body) - (-> Phase Text Text Phase) + (-> Phase Text Text + Phase) (do [! phase.monad] [expectedT meta.expected_type] (loop (again [expectedT expectedT]) @@ -135,7 +136,8 @@ ))))) (def .public (apply analyse argsC+ :function: functionA archive functionC) - (-> Phase (List Code) Type Analysis Phase) + (-> Phase (List Code) Type /.Term + Phase) (|> (/inference.general archive analyse :function: argsC+) (phase#each (|>> product.right [functionA] /.reified)) (/.with_exception ..cannot_apply [:function: functionC argsC+]))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux index 7388c74ea..9a3ed8c7d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux @@ -3,21 +3,22 @@ (.require [library - [lux (.except Analysis) + [lux (.except) [abstract [monad (.only do)]] ["[0]" meta (.only) ["[0]" code]]]] [//// ["[0]" phase] - ["/" analysis (.only Analysis Operation Phase Extender) + ["/" analysis (.only Operation Phase Extender) ["[0]" scope]] [/// [meta [archive (.only Archive)]]]]) (def .public (reference extender analysis archive quoted_module it) - (-> Extender Phase Archive Text Symbol (Operation Analysis)) + (-> Extender Phase Archive Text Symbol + (Operation /.Term)) (when it ["" short] (do [! phase.monad] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux index 63312b699..2bec0f86f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux @@ -3,20 +3,20 @@ (.require [library - [lux (.except Analysis nat int rev) + [lux (.except nat int rev) ["[0]" meta] [abstract [monad (.only do)]]]] [//// ["[0]" phase] - ["/" analysis (.only Analysis Operation) + ["/" analysis (.only Operation) ["[1][0]" simple] ["[1][0]" type]]]) (with_template [<name> <type> <tag>] [(def .public (<name> value) (-> <type> - (Operation Analysis)) + (Operation /.Term)) (do phase.monad [_ (/type.inference <type>) @ meta.location] @@ -31,7 +31,7 @@ ) (def .public unit - (Operation Analysis) + (Operation /.Term) (do phase.monad [_ (/type.inference .Any) @ meta.location] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux index 592e986bd..cc0aa2dfe 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Pattern Analysis when) + [lux (.except Pattern when) [abstract ["[0]" monad (.only do)]] [control @@ -29,7 +29,7 @@ ["[1][0]" complex] [/// ["[0]" phase] - ["/" analysis (.only Analysis Operation Phase) + ["/" analysis (.only Operation Phase) ["[1][0]" simple] ["[1][0]" complex] ["[1][0]" pattern (.only Pattern)] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux index eaef3177d..9e1efe8e2 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Type Module Analysis Declaration Double #Default char int type) + [lux (.except Type Module Declaration Double #Default char int type) ["[0]" ffi (.only import)] [abstract ["[0]" monad (.only do)]] @@ -76,7 +76,7 @@ ["[0]" phase (.use "[1]#[0]" monad)] ["[0]" translation] ["[0]" declaration] - ["[1][0]" analysis (.only Analysis Operation Phase Handler Bundle) + ["[0]" analysis (.only Operation Phase Handler Bundle) ["[0]" complex] ["[0]" pattern] ["[0]" inference] @@ -148,7 +148,7 @@ ("static" forName [java/lang/String] "try" (java/lang/Class java/lang/Object)) (getName [] java/lang/String) (getModifiers [] int) - (isAssignableFrom [(java/lang/Class java/lang/Object)] boolean) + (isAssignableFrom [(java/lang/Class [? < java/lang/Object])] boolean) (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/Class c))]) (getGenericInterfaces [] [java/lang/reflect/Type]) (getGenericSuperclass [] "?" java/lang/reflect/Type) @@ -183,7 +183,8 @@ (list ["Class" (%.text class)]))) (def (ensure_fresh_class! class_loader name) - (-> java/lang/ClassLoader External (Operation Any)) + (-> java/lang/ClassLoader External + (Operation Any)) (do phase.monad [class (phase.of_try (reflection!.load class_loader name))] (phase.assertion ..deprecated_class [name] @@ -193,7 +194,9 @@ not)))) (def reflection - (All (_ category) (-> (Type (<| Return' Value' category)) Text)) + (All (_ category) + (-> (Type (<| Return' Value' category)) + Text)) (|>> jvm.reflection reflection.reflection)) (def signature (|>> jvm.signature signature.signature)) @@ -271,12 +274,17 @@ (with_template [<name>] [(exception.def .public (<name> [class_variables class method method_variables inputsJT hints]) - (exception.Exception [(List (Type Var)) External Text (List (Type Var)) (List (Type Value)) (List Method_Signature)]) + (exception.Exception [(List (Type Var)) + External + Text + (List (Type Var)) + (List (Type Value)) + (List Method_Signature)]) (exception.report - (list ["Class Variables" (exception.listing ..signature class_variables)] + (list ["Class variables" (exception.listing ..signature class_variables)] ["Class" class] ["Method" method] - ["Method Variables" (exception.listing ..signature method_variables)] + ["Method variables" (exception.listing ..signature method_variables)] ["Arguments" (exception.listing ..signature inputsJT)] ["Hints" (exception.listing %.type (list#each product.left hints))])))] @@ -302,7 +310,8 @@ ) (def with_conversion_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (install "jvm_conversion_double_to_float#" (//lux.unary ..double ..float)) (install "jvm_conversion_double_to_int#" (//lux.unary ..double ..int)) (install "jvm_conversion_double_to_long#" (//lux.unary ..double ..long)) @@ -330,7 +339,8 @@ (with_template [<name> <prefix> <type>] [(def <name> - (-> Bundle Bundle) + (-> Bundle + Bundle) (let [type (reflection.reflection <prefix>)] (|>> (install (%.format "jvm_" type "_" "+" "#") (//lux.binary <type> <type> <type>)) (install (%.format "jvm_" type "_" "-" "#") (//lux.binary <type> <type> <type>)) @@ -353,7 +363,8 @@ (with_template [<name> <prefix> <type>] [(def <name> - (-> Bundle Bundle) + (-> Bundle + Bundle) (let [type (reflection.reflection <prefix>)] (|>> (install (%.format "jvm_" type "_" "+" "#") (//lux.binary <type> <type> <type>)) (install (%.format "jvm_" type "_" "-" "#") (//lux.binary <type> <type> <type>)) @@ -369,7 +380,8 @@ ) (def with_char_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (let [type (reflection.reflection reflection.char)] (|>> (install (%.format "jvm_" type "_" "=" "#") (//lux.binary ..char ..char Bit)) (install (%.format "jvm_" type "_" "<" "#") (//lux.binary ..char ..char Bit)) @@ -403,7 +415,7 @@ (jvm_type outputT) {.#None} - (/////analysis.except ..non_jvm_type luxT)) + (analysis.except ..non_jvm_type luxT)) (lux_array_type elemT _) (phase#each jvm.array (jvm_type elemT)) @@ -416,7 +428,7 @@ (phase#in primitive_type) _ - (/////analysis.except ..primitives_cannot_have_type_parameters class)) + (analysis.except ..primitives_cannot_have_type_parameters class)) {.#None} (do [! phase.monad] @@ -430,7 +442,7 @@ (in parameterJT) {.#None} - (/////analysis.except ..non_parameter parameterT)))) + (analysis.except ..non_parameter parameterT)))) parametersT))] (in (jvm.class class parametersJT)))) @@ -441,10 +453,11 @@ (phase#in function.class) _ - (/////analysis.except ..non_jvm_type luxT))) + (analysis.except ..non_jvm_type luxT))) (def (jvm_array_type objectT) - (-> .Type (Operation (Type Array))) + (-> .Type + (Operation (Type Array))) (do phase.monad [objectJ (jvm_type objectT)] (|> objectJ @@ -453,7 +466,8 @@ phase.of_try))) (def (primitive_array_length_handler primitive_type) - (-> (Type Primitive) (-> Text Handler)) + (-> (Type Primitive) + (-> Text Handler)) (..custom [<code>.any (function (_ extension_name analyse archive [arrayC]) @@ -464,8 +478,8 @@ (list)}) (analyse archive arrayC)) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list arrayA)}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list arrayA)}])))])) (def array::length::object (-> Text Handler) @@ -484,12 +498,13 @@ :write: (typeA.check (check.clean (list) :write:)) arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:))) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list (/////analysis.text @ (..signature arrayJT)) - arrayA)}]))))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list (analysis.text @ (..signature arrayJT)) + arrayA)}]))))])) (def (new_primitive_array_handler primitive_type) - (-> (Type Primitive) (-> Text Handler)) + (-> (Type Primitive) + (-> Text Handler)) (..custom [<code>.any (function (_ extension_name analyse archive [lengthC]) @@ -499,8 +514,8 @@ _ (typeA.inference {.#Nominal (|> (jvm.array primitive_type) ..reflection) (list)}) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list lengthA)}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list lengthA)}])))])) (def array::new::object (-> Text Handler) @@ -517,17 +532,18 @@ (in elementJT) {.#None} - (/////analysis.except ..non_array expectedT)) + (analysis.except ..non_array expectedT)) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list (/////analysis.text @ (..signature elementJT)) - lengthA)}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list (analysis.text @ (..signature elementJT)) + lengthA)}])))])) (def (check_parameter objectT) - (-> .Type (Operation (Type Parameter))) + (-> .Type + (Operation (Type Parameter))) (when objectT (lux_array_type elementT _) - (/////analysis.except ..non_parameter objectT) + (analysis.except ..non_parameter objectT) {.#Nominal name parameters} (`` (cond (or (,, (with_template [<type>] @@ -542,7 +558,7 @@ [jvm.double] [jvm.char])) (text.starts_with? descriptor.array_prefix name)) - (/////analysis.except ..non_parameter objectT) + (analysis.except ..non_parameter objectT) ... else (phase#in (jvm.class name (list))))) @@ -576,16 +592,17 @@ (check_parameter outputT) {.#None} - (/////analysis.except ..non_parameter objectT)) + (analysis.except ..non_parameter objectT)) {.#Function _} (phase#in function.class) _ - (/////analysis.except ..non_parameter objectT))) + (analysis.except ..non_parameter objectT))) (def (check_jvm objectT) - (-> .Type (Operation (Type Value))) + (-> .Type + (Operation (Type Value))) (when objectT {.#Nominal name {.#End}} (`` (cond (,, (with_template [<type>] @@ -647,14 +664,15 @@ (check_jvm outputT) {.#None} - (/////analysis.except ..non_object objectT)) + (analysis.except ..non_object objectT)) _ (check_parameter objectT))) (with_template [<name> <category> <parser>] [(def .public (<name> mapping typeJ) - (-> Mapping (Type <category>) (Operation .Type)) + (-> Mapping (Type <category>) + (Operation .Type)) (when (|> typeJ ..signature (<text>.result (<parser> mapping))) {try.#Success check} (typeA.check check) @@ -669,24 +687,27 @@ ) (def (check_object objectT) - (-> .Type (Operation [External .Type])) + (-> .Type + (Operation [External .Type])) (do [! phase.monad] [:object: (check_jvm objectT) .let [name (..reflection :object:)]] (if (dictionary.key? ..boxes name) - (/////analysis.except ..primitives_are_not_objects [name]) + (analysis.except ..primitives_are_not_objects [name]) (do ! [:object: (reflection_type luxT.fresh :object:)] (phase#in [name :object:]))))) (def (check_return type) - (-> .Type (Operation (Type Return))) + (-> .Type + (Operation (Type Return))) (if (same? .Any type) (phase#in jvm.void) (check_jvm type))) (def (read_primitive_array_handler lux_type jvm_type) - (-> .Type (Type Primitive) (-> Text Handler)) + (-> .Type (Type Primitive) + (-> Text Handler)) (..custom [(<>.and <code>.any <code>.any) (function (_ extension_name analyse archive [idxC arrayC]) @@ -698,8 +719,8 @@ (list)}) (analyse archive arrayC)) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list idxA arrayA)}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list idxA arrayA)}])))])) (def array::read::object (-> Text Handler) @@ -720,13 +741,14 @@ :write: (typeA.check (check.clean (list) :write:)) arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:))) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list (/////analysis.text @ (..signature arrayJT)) - idxA - arrayA)}]))))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list (analysis.text @ (..signature arrayJT)) + idxA + arrayA)}]))))])) (def (write_primitive_array_handler lux_type jvm_type) - (-> .Type (Type Primitive) (-> Text Handler)) + (-> .Type (Type Primitive) + (-> Text Handler)) (let [array_type {.#Nominal (|> (jvm.array jvm_type) ..reflection) (list)}] (..custom @@ -741,10 +763,10 @@ arrayA (<| (typeA.expecting array_type) (analyse archive arrayC)) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list idxA - valueA - arrayA)}])))]))) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list idxA + valueA + arrayA)}])))]))) (def array::write::object (-> Text Handler) @@ -767,14 +789,15 @@ :write: (typeA.check (check.clean (list) :write:)) arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:))) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list (/////analysis.text @ (..signature arrayJT)) - idxA - valueA - arrayA)}]))))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list (analysis.text @ (..signature arrayJT)) + idxA + valueA + arrayA)}]))))])) (def with_array_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (install (%.format "jvm_" "array_" "length_" (reflection.reflection reflection.boolean) "#") (primitive_array_length_handler jvm.boolean)) (install (%.format "jvm_" "array_" "length_" (reflection.reflection reflection.byte) "#") (primitive_array_length_handler jvm.byte)) (install (%.format "jvm_" "array_" "length_" (reflection.reflection reflection.short) "#") (primitive_array_length_handler jvm.short)) @@ -826,8 +849,8 @@ [_ :object:] (check_object expectedT) _ (typeA.inference :object:) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list)}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list)}])))])) (def object::null? (-> Text Handler) @@ -840,8 +863,8 @@ (analyse archive objectC)) _ (check_object objectT) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list objectA)}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list objectA)}])))])) (def object::synchronized (-> Text Handler) @@ -854,11 +877,12 @@ _ (check_object monitorT) exprA (analyse archive exprC) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list monitorA exprA)}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list monitorA exprA)}])))])) (def (object::throw class_loader) - (-> java/lang/ClassLoader (-> Text Handler)) + (-> java/lang/ClassLoader + (-> Text Handler)) (..custom [<code>.any (function (_ extension_name analyse archive [exceptionC]) @@ -871,13 +895,14 @@ _ (is (Operation Any) (if ? (in []) - (/////analysis.except non_throwable exception_class))) + (analysis.except non_throwable exception_class))) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list exceptionA)}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list exceptionA)}])))])) (def (object::class class_loader) - (-> java/lang/ClassLoader (-> Text Handler)) + (-> java/lang/ClassLoader + (-> Text Handler)) (..custom [<code>.text (function (_ extension_name analyse archive [class]) @@ -886,11 +911,12 @@ _ (typeA.inference {.#Nominal "java.lang.Class" (list {.#Nominal class (list)})}) _ (phase.of_try (reflection!.load class_loader class)) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list (/////analysis.text @ class))}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list (analysis.text @ class))}])))])) (def (object::instance? class_loader) - (-> java/lang/ClassLoader (-> Text Handler)) + (-> java/lang/ClassLoader + (-> Text Handler)) (..custom [(all <>.and <code>.text <code>.any) (function (_ extension_name analyse archive [sub_class objectC]) @@ -903,12 +929,13 @@ ? (phase.of_try (reflection!.sub? class_loader object_class sub_class)) @ meta.location] (if ? - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list (/////analysis.text @ sub_class) objectA)}]) - (/////analysis.except cannot_possibly_be_an_instance (format sub_class " !<= " object_class)))))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list (analysis.text @ sub_class) objectA)}]) + (analysis.except cannot_possibly_be_an_instance (format sub_class " !<= " object_class)))))])) (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]))) + (-> java/lang/ClassLoader External .Type External (java/lang/Class java/lang/Object) + (Operation (List [[Text .Type] Bit]))) (do [! phase.monad] [from_class (phase.of_try (reflection!.load class_loader from_name)) mapping (phase.of_try (reflection!.correspond from_class fromT))] @@ -919,19 +946,21 @@ .let [super_name (..reflection superJT)] super_class (phase.of_try (reflection!.load class_loader super_name)) superT (reflection_type mapping superJT)] - (in [[super_name superT] (java/lang/Class::isAssignableFrom super_class to_class)]))) + (in [[super_name superT] + (ffi.of_boolean (java/lang/Class::isAssignableFrom super_class to_class))]))) (when (java/lang/Class::getGenericSuperclass from_class) {.#Some super} (list.partial super (array.list {.#None} (java/lang/Class::getGenericInterfaces from_class))) {.#None} - (if (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers from_class)) + (if (ffi.of_boolean (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers from_class))) {.#Item (as java/lang/reflect/Type (ffi.class_for java/lang/Object)) (array.list {.#None} (java/lang/Class::getGenericInterfaces from_class))} (array.list {.#None} (java/lang/Class::getGenericInterfaces from_class))))))) (def (object::cast class_loader) - (-> java/lang/ClassLoader (-> Text Handler)) + (-> java/lang/ClassLoader + (-> Text Handler)) (..custom [<code>.any (function (_ extension_name analyse archive [fromC]) @@ -970,7 +999,7 @@ (not (dictionary.key? ..boxes to_name))) to_class (phase.of_try (reflection!.load class_loader to_name)) from_class (phase.of_try (reflection!.load class_loader from_name))] - (if (java/lang/Class::isAssignableFrom from_class to_class) + (if (ffi.of_boolean (java/lang/Class::isAssignableFrom from_class to_class)) (loop (again [[current_name currentT] [from_name fromT]]) (if (text#= to_name current_name) (in true) @@ -994,14 +1023,15 @@ false))))))) @ meta.location] (if can_cast? - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list (/////analysis.text @ from_name) - (/////analysis.text @ to_name) - fromA)}]) - (/////analysis.except ..cannot_cast [fromJT toJT fromC]))))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list (analysis.text @ from_name) + (analysis.text @ to_name) + fromA)}]) + (analysis.except ..cannot_cast [fromJT toJT fromC]))))])) (def (with_object_extensions class_loader) - (-> java/lang/ClassLoader (-> Bundle Bundle)) + (-> java/lang/ClassLoader + (-> Bundle Bundle)) (|>> (install (%.format "jvm_" "object_" "null" "#") object::null) (install (%.format "jvm_" "object_" "null?" "#") object::null?) (install (%.format "jvm_" "object_" "synchronized" "#") object::synchronized) @@ -1012,7 +1042,8 @@ )) (def (get::static class_loader) - (-> java/lang/ClassLoader (-> Text Handler)) + (-> java/lang/ClassLoader + (-> Text Handler)) (..custom [..member (function (_ extension_name analyse archive [class field]) @@ -1027,13 +1058,14 @@ fieldT (reflection_type luxT.fresh fieldJT) _ (typeA.inference fieldT) @ meta.location] - (in (<| [@] {/////analysis.#Extension [.prelude (%.format extension_name "|translation")]} - (list (/////analysis.text @ class) - (/////analysis.text @ field) - (/////analysis.text @ (..signature fieldJT)))))))])) + (in (<| [@] {analysis.#Extension [.prelude (%.format extension_name "|translation")]} + (list (analysis.text @ class) + (analysis.text @ field) + (analysis.text @ (..signature fieldJT)))))))])) (def (put::static class_loader) - (-> java/lang/ClassLoader (-> Text Handler)) + (-> java/lang/ClassLoader + (-> Text Handler)) (..custom [(all <>.and ..member <code>.any) (function (_ extension_name analyse archive [[class field] valueC]) @@ -1052,14 +1084,15 @@ valueA (<| (typeA.expecting fieldT) (analyse archive valueC)) @ meta.location] - (in (<| [@] {/////analysis.#Extension [.prelude (%.format extension_name "|translation")]} - (list (/////analysis.text @ class) - (/////analysis.text @ field) - (/////analysis.text @ (..signature fieldJT)) + (in (<| [@] {analysis.#Extension [.prelude (%.format extension_name "|translation")]} + (list (analysis.text @ class) + (analysis.text @ field) + (analysis.text @ (..signature fieldJT)) valueA)))))])) (def (get::virtual class_loader) - (-> java/lang/ClassLoader (-> Text Handler)) + (-> java/lang/ClassLoader + (-> Text Handler)) (..custom [(all <>.and ..member <code>.any) (function (_ extension_name analyse archive [[class field] objectC]) @@ -1078,14 +1111,15 @@ fieldT (reflection_type mapping fieldJT) _ (typeA.inference fieldT) @ meta.location] - (in (<| [@] {/////analysis.#Extension [.prelude (%.format extension_name "|translation")]} - (list (/////analysis.text @ class) - (/////analysis.text @ field) - (/////analysis.text @ (..signature fieldJT)) + (in (<| [@] {analysis.#Extension [.prelude (%.format extension_name "|translation")]} + (list (analysis.text @ class) + (analysis.text @ field) + (analysis.text @ (..signature fieldJT)) objectA)))))])) (def (put::virtual class_loader) - (-> java/lang/ClassLoader (-> Text Handler)) + (-> java/lang/ClassLoader + (-> Text Handler)) (..custom [(all <>.and ..member <code>.any <code>.any) (function (_ extension_name analyse archive [[class field] valueC objectC]) @@ -1108,10 +1142,10 @@ valueA (<| (typeA.expecting fieldT) (analyse archive valueC)) @ meta.location] - (in (<| [@] {/////analysis.#Extension [.prelude (%.format extension_name "|translation")]} - (list (/////analysis.text @ class) - (/////analysis.text @ field) - (/////analysis.text @ (..signature fieldJT)) + (in (<| [@] {analysis.#Extension [.prelude (%.format extension_name "|translation")]} + (list (analysis.text @ class) + (analysis.text @ field) + (analysis.text @ (..signature fieldJT)) valueA objectA)))))])) @@ -1124,7 +1158,8 @@ {#Interface})) (def (de_aliased aliasing) - (-> Aliasing (Type Value) (Type Value)) + (-> Aliasing (Type Value) + (Type Value)) (function (again it) (`` (<| (when (parser.var? it) {.#Some name} @@ -1152,25 +1187,27 @@ it)))) (def (check_method aliasing class method_name method_style inputsJT method) - (-> Aliasing (java/lang/Class java/lang/Object) Text Method_Style (List (Type Value)) java/lang/reflect/Method (Operation Bit)) + (-> Aliasing (java/lang/Class java/lang/Object) Text Method_Style (List (Type Value)) java/lang/reflect/Method + (Operation Bit)) (do phase.monad [parameters (|> (java/lang/reflect/Method::getGenericParameterTypes method) (array.list {.#None}) (monad.each try.monad reflection!.type) phase.of_try) .let [modifiers (java/lang/reflect/Method::getModifiers method) - correct_class? (java/lang/Class::isAssignableFrom class (java/lang/reflect/Method::getDeclaringClass method)) - correct_method? (text#= method_name (java/lang/reflect/Method::getName method)) + correct_class? (ffi.of_boolean (java/lang/Class::isAssignableFrom class (java/lang/reflect/Method::getDeclaringClass method))) + correct_method? (text#= method_name + (ffi.of_string (java/lang/reflect/Method::getName method))) same_static? (when method_style {#Static} - (java/lang/reflect/Modifier::isStatic modifiers) + (ffi.of_boolean (java/lang/reflect/Modifier::isStatic modifiers)) _ true) same_special? (when method_style {#Special} - (not (or (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class)) - (java/lang/reflect/Modifier::isAbstract modifiers))) + (not (or (ffi.of_boolean (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class))) + (ffi.of_boolean (java/lang/reflect/Modifier::isAbstract modifiers)))) _ true) @@ -1186,24 +1223,27 @@ same_inputs?)))) (def (check_constructor aliasing class inputsJT constructor) - (-> Aliasing (java/lang/Class java/lang/Object) (List (Type Value)) (java/lang/reflect/Constructor java/lang/Object) (Operation Bit)) + (-> Aliasing (java/lang/Class java/lang/Object) (List (Type Value)) (java/lang/reflect/Constructor java/lang/Object) + (Operation Bit)) (do phase.monad [parameters (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor) (array.list {.#None}) (monad.each try.monad reflection!.type) phase.of_try)] - (in (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor)) + (in (and (ffi.of_boolean (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor))) (n.= (list.size inputsJT) (list.size parameters)) (list.every? (function (_ [expectedJC actualJC]) (jvm#= expectedJC (de_aliased aliasing actualJC))) (list.zipped_2 parameters inputsJT)))))) (def index_parameter - (-> Nat .Type) + (-> Nat + .Type) (|>> (n.* 2) ++ {.#Parameter})) (def (jvm_type_var_mapping owner_tvars method_tvars) - (-> (List Text) (List Text) [(List .Type) Mapping]) + (-> (List Text) (List Text) + [(List .Type) Mapping]) (let [jvm_tvars (list#composite owner_tvars method_tvars) lux_tvars (|> jvm_tvars list.reversed @@ -1217,12 +1257,14 @@ [owner_tvarsT mapping])) (def (lux_class it) - (-> (java/lang/Class java/lang/Object) (Type Class)) - (jvm.class (java/lang/Class::getName it) (list))) + (-> (java/lang/Class java/lang/Object) + (Type Class)) + (jvm.class (ffi.of_string (java/lang/Class::getName it)) (list))) (with_template [<name> <type> <params>] [(`` (def <name> - (-> (<type> (,, (template.spliced <params>))) (List (Type Class))) + (-> (<type> (,, (template.spliced <params>))) + (List (Type Class))) (|>> (,, (template.symbol [<type> "::getExceptionTypes"])) (array.list {.#None}) (list#each ..lux_class))))] @@ -1232,17 +1274,21 @@ ) (def (return_type it) - (-> java/lang/reflect/Method (Try (Type Return))) + (-> java/lang/reflect/Method + (Try (Type Return))) (reflection!.return (when (java/lang/reflect/Method::getGenericReturnType it) {.#Some it} it {.#None} - (java/lang/reflect/Method::getReturnType it)))) + (|> it + java/lang/reflect/Method::getReturnType + (ffi.is java/lang/reflect/Type))))) (def (method_signature method_style method) - (-> Method_Style java/lang/reflect/Method (Operation Method_Signature)) + (-> Method_Style java/lang/reflect/Method + (Operation Method_Signature)) (let [owner (java/lang/reflect/Method::getDeclaringClass method) owner_tvars (when method_style {#Static} @@ -1251,10 +1297,12 @@ _ (|> (java/lang/Class::getTypeParameters owner) (array.list {.#None}) - (list#each (|>> java/lang/reflect/TypeVariable::getName)))) + (list#each (|>> java/lang/reflect/TypeVariable::getName + ffi.of_string)))) method_tvars (|> (java/lang/reflect/Method::getTypeParameters method) (array.list {.#None}) - (list#each (|>> java/lang/reflect/TypeVariable::getName))) + (list#each (|>> java/lang/reflect/TypeVariable::getName + ffi.of_string))) [owner_tvarsT mapping] (jvm_type_var_mapping owner_tvars method_tvars)] (do [! phase.monad] [inputsT (|> (java/lang/reflect/Method::getGenericParameterTypes method) @@ -1280,7 +1328,8 @@ inputsT _ - (list.partial {.#Nominal (java/lang/Class::getName owner) owner_tvarsT} + (list.partial {.#Nominal (ffi.of_string (java/lang/Class::getName owner)) + owner_tvarsT} inputsT))) outputT)]] (in [methodT @@ -1290,14 +1339,17 @@ generic_exceptions)])))) (def (constructor_signature constructor) - (-> (java/lang/reflect/Constructor java/lang/Object) (Operation Method_Signature)) + (-> (java/lang/reflect/Constructor java/lang/Object) + (Operation Method_Signature)) (let [owner (java/lang/reflect/Constructor::getDeclaringClass constructor) owner_tvars (|> (java/lang/Class::getTypeParameters owner) (array.list {.#None}) - (list#each (|>> java/lang/reflect/TypeVariable::getName))) + (list#each (|>> java/lang/reflect/TypeVariable::getName + ffi.of_string))) method_tvars (|> (java/lang/reflect/Constructor::getTypeParameters constructor) (array.list {.#None}) - (list#each (|>> java/lang/reflect/TypeVariable::getName))) + (list#each (|>> java/lang/reflect/TypeVariable::getName + ffi.of_string))) [owner_tvarsT mapping] (jvm_type_var_mapping owner_tvars method_tvars)] (do [! phase.monad] [inputsT (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor) @@ -1312,7 +1364,8 @@ (monad.each ! (|>> reflection!.type phase.of_try)) (phase#each (monad.each ! (reflection_type mapping))) phase#conjoint) - .let [objectT {.#Nominal (java/lang/Class::getName owner) owner_tvarsT} + .let [objectT {.#Nominal (ffi.of_string (java/lang/Class::getName owner)) + owner_tvarsT} constructorT (<| (type.univ_q (dictionary.size mapping)) (type.function inputsT) objectT)]] @@ -1329,7 +1382,8 @@ (with_template [<name> <tag>] [(def <name> - (-> Evaluation (Maybe Method_Signature)) + (-> Evaluation + (Maybe Method_Signature)) (|>> (pipe.when {<tag> output} {.#Some output} @@ -1343,10 +1397,13 @@ (with_template [<name> <type> <method>] [(def <name> - (-> <type> (List (Type Var))) + (-> <type> + (List (Type Var))) (|>> <method> (array.list {.#None}) - (list#each (|>> java/lang/reflect/TypeVariable::getName jvm.var))))] + (list#each (|>> java/lang/reflect/TypeVariable::getName + ffi.of_string + jvm.var))))] [class_type_variables (java/lang/Class java/lang/Object) java/lang/Class::getTypeParameters] [constructor_type_variables (java/lang/reflect/Constructor java/lang/Object) java/lang/reflect/Constructor::getTypeParameters] @@ -1354,7 +1411,8 @@ ) (def (aliasing expected actual) - (-> (List (Type Var)) (List (Type Var)) Aliasing) + (-> (List (Type Var)) (List (Type Var)) + Aliasing) (|> (list.zipped_2 (list#each parser.name actual) (list#each parser.name expected)) (dictionary.of_list text.hash))) @@ -1380,7 +1438,7 @@ (|>> ..family_tree' ... De-duplication (list#mix (function (_ class all) - (dictionary.has (java/lang/Class::getName class) class all)) + (dictionary.has (ffi.of_string (java/lang/Class::getName class)) class all)) (dictionary.empty text.hash)) dictionary.values)) @@ -1389,18 +1447,22 @@ (List java/lang/reflect/Method)) (|> it ..family_tree - (list#each (|>> java/lang/Class::getDeclaredMethods (array.list {.#None}))) + (list#each (|>> java/lang/Class::getDeclaredMethods + (array.list {.#None}))) list#conjoint)) (def (method_candidate allow_inheritance? class_loader actual_class_tvars class_name actual_method_tvars method_name method_style inputsJT) - (-> Bit java/lang/ClassLoader (List (Type Var)) External (List (Type Var)) Text Method_Style (List (Type Value)) (Operation Method_Signature)) + (-> Bit java/lang/ClassLoader (List (Type Var)) External (List (Type Var)) Text Method_Style (List (Type Value)) + (Operation Method_Signature)) (do [! phase.monad] [class (phase.of_try (reflection!.load class_loader class_name)) .let [expected_class_tvars (class_type_variables class)] candidates (|> (if allow_inheritance? (all_declared_methods class) (array.list {.#None} (java/lang/Class::getDeclaredMethods class))) - (list.only (|>> java/lang/reflect/Method::getName (text#= method_name))) + (list.only (|>> java/lang/reflect/Method::getName + ffi.of_string + (text#= method_name))) (monad.each ! (is (-> java/lang/reflect/Method (Operation Evaluation)) (function (_ method) (do ! @@ -1417,18 +1479,19 @@ (in method) {.#End} - (/////analysis.except ..no_candidates [actual_class_tvars class_name method_name actual_method_tvars inputsJT (list.all hint candidates)]) + (analysis.except ..no_candidates [actual_class_tvars class_name method_name actual_method_tvars inputsJT (list.all hint candidates)]) {.#Item method alternatives} (if allow_inheritance? (in method) - (/////analysis.except ..too_many_candidates [actual_class_tvars class_name method_name actual_method_tvars inputsJT (list.partial method alternatives)]))))) + (analysis.except ..too_many_candidates [actual_class_tvars class_name method_name actual_method_tvars inputsJT (list.partial method alternatives)]))))) (def constructor_method "<init>") (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)) + (-> java/lang/ClassLoader (List (Type Var)) External (List (Type Var)) (List (Type Value)) + (Operation Method_Signature)) (do [! phase.monad] [class (phase.of_try (reflection!.load class_loader class_name)) .let [expected_class_tvars (class_type_variables class)] @@ -1451,10 +1514,10 @@ (in constructor) {.#End} - (/////analysis.except ..no_candidates [actual_class_tvars class_name ..constructor_method actual_method_tvars inputsJT (list.all hint candidates)]) + (analysis.except ..no_candidates [actual_class_tvars class_name ..constructor_method actual_method_tvars inputsJT (list.all hint candidates)]) candidates - (/////analysis.except ..too_many_candidates [actual_class_tvars class_name ..constructor_method actual_method_tvars inputsJT candidates])))) + (analysis.except ..too_many_candidates [actual_class_tvars class_name ..constructor_method actual_method_tvars inputsJT candidates])))) (with_template [<name> <category> <parser>] [(def .public <name> @@ -1472,17 +1535,19 @@ (<code>.tuple (<>.and ..type <code>.any))) (def (decorate_inputs @ typesT inputsA) - (-> Location (List (Type Value)) (List Analysis) (List Analysis)) + (-> Location (List (Type Value)) (List analysis.Term) + (List analysis.Term)) (|> inputsA - (list.zipped_2 (list#each (|>> ..signature (/////analysis.text @)) typesT)) + (list.zipped_2 (list#each (|>> ..signature (analysis.text @)) typesT)) (list#each (function (_ [type value]) - (/////analysis.tuple @ (list type value)))))) + (analysis.tuple @ (list type value)))))) (def type_vars (<code>.tuple (<>.some ..var))) (def (invoke::static class_loader) - (-> java/lang/ClassLoader (-> Text Handler)) + (-> java/lang/ClassLoader + (-> Text Handler)) (..custom [(all <>.and ..type_vars ..member ..type_vars (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars argsTC]) @@ -1495,14 +1560,15 @@ [outputT argsA] (inference.general archive analyse methodT (list#each product.right argsTC)) outputJT (check_return outputT) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list.partial (/////analysis.text @ (..signature (jvm.class class (list)))) - (/////analysis.text @ method) - (/////analysis.text @ (..signature outputJT)) - (decorate_inputs @ argsT argsA))}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list.partial (analysis.text @ (..signature (jvm.class class (list)))) + (analysis.text @ method) + (analysis.text @ (..signature outputJT)) + (decorate_inputs @ argsT argsA))}])))])) (def (invoke::virtual class_loader) - (-> java/lang/ClassLoader (-> Text Handler)) + (-> java/lang/ClassLoader + (-> Text Handler)) (..custom [(all <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars objectC argsTC]) @@ -1521,15 +1587,16 @@ (undefined))] outputJT (check_return outputT) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list.partial (/////analysis.text @ (..signature (jvm.class class (list)))) - (/////analysis.text @ method) - (/////analysis.text @ (..signature outputJT)) - objectA - (decorate_inputs @ argsT argsA))}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list.partial (analysis.text @ (..signature (jvm.class class (list)))) + (analysis.text @ method) + (analysis.text @ (..signature outputJT)) + objectA + (decorate_inputs @ argsT argsA))}])))])) (def (invoke::special class_loader) - (-> java/lang/ClassLoader (-> Text Handler)) + (-> java/lang/ClassLoader + (-> Text Handler)) (..custom [(all <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars objectC argsTC]) @@ -1548,15 +1615,16 @@ (undefined))] outputJT (check_return outputT) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list.partial (/////analysis.text @ (..signature (jvm.class class (list)))) - (/////analysis.text @ method) - (/////analysis.text @ (..signature outputJT)) - objectA - (decorate_inputs @ argsT argsA))}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list.partial (analysis.text @ (..signature (jvm.class class (list)))) + (analysis.text @ method) + (analysis.text @ (..signature outputJT)) + objectA + (decorate_inputs @ argsT argsA))}])))])) (def (invoke::interface class_loader) - (-> java/lang/ClassLoader (-> Text Handler)) + (-> java/lang/ClassLoader + (-> Text Handler)) (..custom [(all <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class_name method] method_tvars objectC argsTC]) @@ -1565,7 +1633,7 @@ .let [argsT (list#each product.left argsTC)] class (phase.of_try (reflection!.load class_loader class_name)) _ (phase.assertion non_interface class_name - (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class))) + (ffi.of_boolean (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class)))) [methodT deprecated? exceptionsT] (..method_candidate true class_loader class_tvars class_name method_tvars method {#Interface} argsT) _ (phase.assertion ..deprecated_method [class_name method methodT] (not deprecated?)) @@ -1578,15 +1646,16 @@ (undefined))] outputJT (check_return outputT) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list.partial (/////analysis.text @ (..signature (jvm.class class_name (list)))) - (/////analysis.text @ method) - (/////analysis.text @ (..signature outputJT)) - objectA - (decorate_inputs @ argsT argsA))}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list.partial (analysis.text @ (..signature (jvm.class class_name (list)))) + (analysis.text @ method) + (analysis.text @ (..signature outputJT)) + objectA + (decorate_inputs @ argsT argsA))}])))])) (def (invoke::constructor class_loader) - (-> java/lang/ClassLoader (-> Text Handler)) + (-> java/lang/ClassLoader + (-> Text Handler)) (..custom [(all <>.and ..type_vars <code>.text ..type_vars (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars class method_tvars argsTC]) @@ -1598,12 +1667,13 @@ (not deprecated?)) [outputT argsA] (inference.general archive analyse methodT (list#each product.right argsTC)) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list.partial (/////analysis.text @ (..signature (jvm.class class (list)))) - (decorate_inputs @ argsT argsA))}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list.partial (analysis.text @ (..signature (jvm.class class (list)))) + (decorate_inputs @ argsT argsA))}])))])) (def (with_member_extensions class_loader) - (-> java/lang/ClassLoader (-> Bundle Bundle)) + (-> java/lang/ClassLoader + (-> Bundle Bundle)) (|>> (install "jvm_member_get_static#" (get::static class_loader)) (install "jvm_member_get_virtual#" (get::virtual class_loader)) @@ -1636,21 +1706,21 @@ (<code>.tuple (<>.and <code>.text ..type))) (def (annotation_parameter_analysis @ [name value]) - (-> Location (Annotation_Parameter Analysis) - Analysis) - (/////analysis.tuple @ (list (/////analysis.text @ name) value))) + (-> Location (Annotation_Parameter analysis.Term) + analysis.Term) + (analysis.tuple @ (list (analysis.text @ name) value))) (def (annotation_analysis @ [name parameters]) - (-> Location (Annotation Analysis) - Analysis) - (/////analysis.tuple @ (list.partial (/////analysis.text @ name) - (list#each (annotation_parameter_analysis @) parameters)))) + (-> Location (Annotation analysis.Term) + analysis.Term) + (analysis.tuple @ (list.partial (analysis.text @ name) + (list#each (annotation_parameter_analysis @) parameters)))) (with_template [<name> <category>] [(def (<name> @) (-> Location (Type <category>) - Analysis) - (|>> ..signature (/////analysis.text @)))] + analysis.Term) + (|>> ..signature (analysis.text @)))] [var_analysis Var] [class_analysis Class] @@ -1659,13 +1729,15 @@ ) (def (typed_analysis @ [type term]) - (-> Location (Typed Analysis) Analysis) - (/////analysis.tuple @ (list (value_analysis @ type) term))) + (-> Location (Typed analysis.Term) + analysis.Term) + (analysis.tuple @ (list (value_analysis @ type) term))) (def (argument_analysis @ [argument argumentJT]) - (-> Location Argument Analysis) - (<| (/////analysis.tuple @) - (list (/////analysis.text @ argument) + (-> Location Argument + analysis.Term) + (<| (analysis.tuple @) + (list (analysis.text @ argument) (value_analysis @ argumentJT)))) (with_template [<name> <only> <methods>] @@ -1675,8 +1747,8 @@ (|> class <methods> (list.only (|>> java/lang/reflect/Method::getModifiers - (predicate.or (|>> java/lang/reflect/Modifier::isPublic) - (|>> java/lang/reflect/Modifier::isProtected)))) + (predicate.or (|>> java/lang/reflect/Modifier::isPublic ffi.of_boolean) + (|>> java/lang/reflect/Modifier::isProtected ffi.of_boolean)))) <only> (monad.each try.monad (function (_ method) @@ -1684,6 +1756,7 @@ [.let [type_variables (|> (java/lang/reflect/Method::getTypeParameters method) (array.list {.#None}) (list#each (|>> java/lang/reflect/TypeVariable::getName + ffi.of_string jvm.var)))] inputs (|> (java/lang/reflect/Method::getGenericParameterTypes method) (array.list {.#None}) @@ -1694,12 +1767,14 @@ (array.list {.#None}) (monad.each ! reflection!.class))] (in [type - (java/lang/reflect/Method::getName method) + (ffi.of_string (java/lang/reflect/Method::getName method)) (jvm.method [type_variables inputs return (if (list.empty? generic_exceptions) concrete_exceptions generic_exceptions)])]))))))] - [abstract_methods (list.only (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract)) + [abstract_methods (list.only (|>> java/lang/reflect/Method::getModifiers + java/lang/reflect/Modifier::isAbstract + ffi.of_boolean)) (<| (array.list {.#None}) java/lang/Class::getDeclaredMethods)] [methods (<|) ..all_declared_methods] @@ -1709,7 +1784,8 @@ (with_template [<name> <methods>] [(def (<name> class_loader) - (-> java/lang/ClassLoader (List (Type Class)) (Try (List [(Type Class) Text (Type Method)]))) + (-> java/lang/ClassLoader (List (Type Class)) + (Try (List [(Type Class) Text (Type Method)]))) (|>> (monad.each try.monad (function (_ type) (|> type ..reflection @@ -1767,18 +1843,20 @@ (<text>.then ..visibility' <code>.text)) (def .public (visibility_analysis @ visibility) - (-> Location Visibility Analysis) - (/////analysis.text @ (when visibility - {#Public} ..public_tag - {#Private} ..private_tag - {#Protected} ..protected_tag - {#Default} ..default_tag))) + (-> Location Visibility + analysis.Term) + (analysis.text @ (when visibility + {#Public} ..public_tag + {#Private} ..private_tag + {#Protected} ..protected_tag + {#Default} ..default_tag))) (.type Exception (Type Class)) (def .public parameter_types - (-> (List (Type Var)) (Check (List [(Type Var) .Type]))) + (-> (List (Type Var)) + (Check (List [(Type Var) .Type]))) (monad.each check.monad (function (_ parameterJ) (do check.monad @@ -1810,7 +1888,8 @@ (<code>.tuple (<>.some ..class))))) (def (method_mapping of_class parameters) - (-> Mapping (List (Type Var)) (Check Mapping)) + (-> Mapping (List (Type Var)) + (Check Mapping)) (|> parameters ..parameter_types (check#each (list#mix (function (_ [parameterJ parameterT] mapping) @@ -1818,11 +1897,13 @@ of_class)))) (def class_mapping - (-> (List (Type Var)) (Check Mapping)) + (-> (List (Type Var)) + (Check Mapping)) (..method_mapping luxT.fresh)) (def .public (analyse_abstract_method analyse archive method) - (-> Phase Archive (Abstract_Method Code) (Operation Analysis)) + (-> Phase Archive (Abstract_Method Code) + (Operation analysis.Term)) (let [[method_name visibility annotations vars arguments return exceptions] method] (do [! phase.monad] [mapping (typeA.check (method_mapping luxT.fresh vars)) @@ -1836,15 +1917,15 @@ (in [name parametersA]))) annotations) @ meta.location] - (in (/////analysis.tuple @ (list (/////analysis.text @ ..abstract_tag) - (/////analysis.text @ method_name) - (visibility_analysis @ visibility) - (/////analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) - (/////analysis.tuple @ (list#each (var_analysis @) vars)) - (/////analysis.tuple @ (list#each (..argument_analysis @) arguments)) - (return_analysis @ return) - (/////analysis.tuple @ (list#each (class_analysis @) exceptions)) - )))))) + (in (analysis.tuple @ (list (analysis.text @ ..abstract_tag) + (analysis.text @ method_name) + (visibility_analysis @ visibility) + (analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) + (analysis.tuple @ (list#each (var_analysis @) vars)) + (analysis.tuple @ (list#each (..argument_analysis @) arguments)) + (return_analysis @ return) + (analysis.tuple @ (list#each (class_analysis @) exceptions)) + )))))) (.type .public (Constructor a) [Visibility @@ -1875,7 +1956,8 @@ <code>.any))) (def (with_fake_parameter#pattern it) - (-> pattern.Pattern pattern.Pattern) + (-> pattern.Pattern + pattern.Pattern) (when it {pattern.#Simple _} it @@ -1893,13 +1975,14 @@ {pattern.#Bind (++ it)})) (def (with_fake_parameter [@ it]) - (-> Analysis Analysis) + (-> analysis.Term + analysis.Term) [@ (when it - {/////analysis.#Simple _} + {analysis.#Simple _} it - {/////analysis.#Structure it} - {/////analysis.#Structure + {analysis.#Structure it} + {analysis.#Structure (when it {complex.#Variant it} {complex.#Variant (revised complex.#value with_fake_parameter it)} @@ -1907,8 +1990,8 @@ {complex.#Tuple it} {complex.#Tuple (list#each with_fake_parameter it)})} - {/////analysis.#Reference it} - {/////analysis.#Reference + {analysis.#Reference it} + {analysis.#Reference (when it {reference.#Variable it} {reference.#Variable @@ -1922,67 +2005,70 @@ {reference.#Constant _} it)} - {/////analysis.#When value [head tail]} - {/////analysis.#When (with_fake_parameter value) - (let [with_fake_parameter (is (-> /////analysis.Branch /////analysis.Branch) - (|>> (revised /////analysis.#when with_fake_parameter#pattern) - (revised /////analysis.#then with_fake_parameter)))] - [(with_fake_parameter head) - (list#each with_fake_parameter tail)])} + {analysis.#When value [head tail]} + {analysis.#When (with_fake_parameter value) + (let [with_fake_parameter (is (-> analysis.Branch analysis.Branch) + (|>> (revised analysis.#when with_fake_parameter#pattern) + (revised analysis.#then with_fake_parameter)))] + [(with_fake_parameter head) + (list#each with_fake_parameter tail)])} - {/////analysis.#Function environment body} - {/////analysis.#Function (list#each with_fake_parameter environment) - body} + {analysis.#Function environment body} + {analysis.#Function (list#each with_fake_parameter environment) + body} - {/////analysis.#Apply parameter abstraction} - {/////analysis.#Apply (with_fake_parameter parameter) - (with_fake_parameter abstraction)} + {analysis.#Apply parameter abstraction} + {analysis.#Apply (with_fake_parameter parameter) + (with_fake_parameter abstraction)} - {/////analysis.#Extension name parameters} - {/////analysis.#Extension name (list#each with_fake_parameter parameters)})]) + {analysis.#Extension name parameters} + {analysis.#Extension name (list#each with_fake_parameter parameters)})]) (def .public (hidden_method_body @ arity bodyA) - (-> Location Nat Analysis Analysis) - (<| (/////analysis.tuple @) - (list (/////analysis.unit @)) + (-> Location Nat analysis.Term + analysis.Term) + (<| (analysis.tuple @) + (list (analysis.unit @)) (when arity (^.or 0 1) bodyA 2 - (let [forced_refencing (is Analysis - (/////analysis.tuple @ (is (List Analysis) - (list#each (is (-> Nat Analysis) - (|>> (/////analysis.local @))) - (list.indices (++ arity))))))] - [@ {/////analysis.#When (/////analysis.unit @) - [[/////analysis.#when - {pattern.#Bind 2} - - /////analysis.#then - (/////analysis.tuple @ (list forced_refencing bodyA))] - (list)]}]) + (let [forced_refencing (is analysis.Term + (analysis.tuple @ (is (List analysis.Term) + (list#each (is (-> Nat + analysis.Term) + (|>> (analysis.local @))) + (list.indices (++ arity))))))] + [@ {analysis.#When (analysis.unit @) + [[analysis.#when + {pattern.#Bind 2} + + analysis.#then + (analysis.tuple @ (list forced_refencing bodyA))] + (list)]}]) _ - (let [forced_refencing (is Analysis - (/////analysis.tuple @ (is (List Analysis) - (list#each (is (-> Nat Analysis) - (|>> (/////analysis.local @))) - (list.indices (++ arity))))))] - [@ {/////analysis.#When (/////analysis.unit @) - [[/////analysis.#when - {pattern.#Complex - {complex.#Tuple - (|> (-- arity) - list.indices - (list#each (|>> (n.+ 2) {pattern.#Bind})))}} - - /////analysis.#then - (/////analysis.tuple @ (list forced_refencing bodyA))] - (list)]}])))) + (let [forced_refencing (is analysis.Term + (analysis.tuple @ (is (List analysis.Term) + (list#each (is (-> Nat analysis.Term) + (|>> (analysis.local @))) + (list.indices (++ arity))))))] + [@ {analysis.#When (analysis.unit @) + [[analysis.#when + {pattern.#Complex + {complex.#Tuple + (|> (-- arity) + list.indices + (list#each (|>> (n.+ 2) {pattern.#Bind})))}} + + analysis.#then + (analysis.tuple @ (list forced_refencing bodyA))] + (list)]}])))) (def .public (analyse_constructor_method analyse archive selfT mapping method) - (-> Phase Archive .Type Mapping (Constructor Code) (Operation Analysis)) + (-> Phase Archive .Type Mapping (Constructor Code) + (Operation analysis.Term)) (let [[visibility strict_fp? annotations vars exceptions self_name arguments super_arguments body] method] @@ -2018,23 +2104,23 @@ scope.with) .let [arity (list.size arguments)] @ meta.location] - (in (/////analysis.tuple @ (list (/////analysis.text @ ..constructor_tag) - (visibility_analysis @ visibility) - (/////analysis.bit @ strict_fp?) - (/////analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) - (/////analysis.tuple @ (list#each (var_analysis @) vars)) - (/////analysis.tuple @ (list#each (class_analysis @) exceptions)) - (/////analysis.text @ self_name) - (/////analysis.tuple @ (list#each (..argument_analysis @) arguments)) - (/////analysis.tuple @ (list#each (typed_analysis @) super_arguments)) - [@ {/////analysis.#Function - (list#each (|>> (/////analysis.variable @)) - (scope.environment scope)) - (<| (..hidden_method_body @ arity) - (when arity - 0 (with_fake_parameter bodyA) - _ bodyA))}] - )))))) + (in (analysis.tuple @ (list (analysis.text @ ..constructor_tag) + (visibility_analysis @ visibility) + (analysis.bit @ strict_fp?) + (analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) + (analysis.tuple @ (list#each (var_analysis @) vars)) + (analysis.tuple @ (list#each (class_analysis @) exceptions)) + (analysis.text @ self_name) + (analysis.tuple @ (list#each (..argument_analysis @) arguments)) + (analysis.tuple @ (list#each (typed_analysis @) super_arguments)) + [@ {analysis.#Function + (list#each (|>> (analysis.variable @)) + (scope.environment scope)) + (<| (..hidden_method_body @ arity) + (when arity + 0 (with_fake_parameter bodyA) + _ bodyA))}] + )))))) (.type .public (Virtual_Method a) [Text @@ -2090,7 +2176,8 @@ ))) (def .public (analyse_virtual_method analyse archive selfT mapping method) - (-> Phase Archive .Type Mapping (Virtual_Method Code) (Operation Analysis)) + (-> Phase Archive .Type Mapping (Virtual_Method Code) + (Operation analysis.Term)) (let [[method_name visibility final? strict_fp? annotations vars self_name arguments return exceptions @@ -2121,25 +2208,25 @@ scope.with) .let [arity (list.size arguments)] @ meta.location] - (in (/////analysis.tuple @ (list (/////analysis.text @ ..virtual_tag) - (/////analysis.text @ method_name) - (visibility_analysis @ visibility) - (/////analysis.bit @ final?) - (/////analysis.bit @ strict_fp?) - (/////analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) - (/////analysis.tuple @ (list#each (var_analysis @) vars)) - (/////analysis.text @ self_name) - (/////analysis.tuple @ (list#each (..argument_analysis @) arguments)) - (return_analysis @ return) - (/////analysis.tuple @ (list#each (class_analysis @) exceptions)) - [@ {/////analysis.#Function - (list#each (|>> (/////analysis.variable @)) - (scope.environment scope)) - (<| (..hidden_method_body @ arity) - (when arity - 0 (with_fake_parameter bodyA) - _ bodyA))}] - )))))) + (in (analysis.tuple @ (list (analysis.text @ ..virtual_tag) + (analysis.text @ method_name) + (visibility_analysis @ visibility) + (analysis.bit @ final?) + (analysis.bit @ strict_fp?) + (analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) + (analysis.tuple @ (list#each (var_analysis @) vars)) + (analysis.text @ self_name) + (analysis.tuple @ (list#each (..argument_analysis @) arguments)) + (return_analysis @ return) + (analysis.tuple @ (list#each (class_analysis @) exceptions)) + [@ {analysis.#Function + (list#each (|>> (analysis.variable @)) + (scope.environment scope)) + (<| (..hidden_method_body @ arity) + (when arity + 0 (with_fake_parameter bodyA) + _ bodyA))}] + )))))) (.type .public (Static_Method a) [Text @@ -2170,7 +2257,8 @@ <code>.any))) (def .public (analyse_static_method analyse archive mapping method) - (-> Phase Archive Mapping (Static_Method Code) (Operation Analysis)) + (-> Phase Archive Mapping (Static_Method Code) + (Operation analysis.Term)) (let [[method_name visibility strict_fp? annotations vars arguments return exceptions @@ -2199,21 +2287,21 @@ (typeA.expecting :return:) scope.with) @ meta.location] - (in (/////analysis.tuple @ (list (/////analysis.text @ ..static_tag) - (/////analysis.text @ method_name) - (visibility_analysis @ visibility) - (/////analysis.bit @ strict_fp?) - (/////analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) - (/////analysis.tuple @ (list#each (var_analysis @) vars)) - (/////analysis.tuple @ (list#each (..argument_analysis @) arguments)) - (return_analysis @ return) - (/////analysis.tuple @ (list#each (class_analysis @) - exceptions)) - [@ {/////analysis.#Function - (list#each (|>> (/////analysis.variable @)) - (scope.environment scope)) - (/////analysis.tuple @ (list bodyA))}] - )))))) + (in (analysis.tuple @ (list (analysis.text @ ..static_tag) + (analysis.text @ method_name) + (visibility_analysis @ visibility) + (analysis.bit @ strict_fp?) + (analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) + (analysis.tuple @ (list#each (var_analysis @) vars)) + (analysis.tuple @ (list#each (..argument_analysis @) arguments)) + (return_analysis @ return) + (analysis.tuple @ (list#each (class_analysis @) + exceptions)) + [@ {analysis.#Function + (list#each (|>> (analysis.variable @)) + (scope.environment scope)) + (analysis.tuple @ (list bodyA))}] + )))))) (.type .public (Overriden_Method a) [(Type Class) @@ -2260,7 +2348,8 @@ ["Actual" (%.nat actual)]))) (def (override_mapping mapping supers parent_type) - (-> Mapping (List (Type Class)) (Type Class) (Operation (List [Text .Type]))) + (-> Mapping (List (Type Class)) (Type Class) + (Operation (List [Text .Type]))) (let [[parent_name parent_parameters] (parser.read_class parent_type)] (when (list.one (function (_ super) (let [[super_name super_parameters] (parser.read_class super)] @@ -2286,7 +2375,8 @@ (phase.of_try (exception.except ..unknown_super [parent_name supers]))))) (def .public (with_override_mapping supers parent_type mapping) - (-> (List (Type Class)) (Type Class) Mapping (Operation Mapping)) + (-> (List (Type Class)) (Type Class) Mapping + (Operation Mapping)) (do phase.monad [override_mapping (..override_mapping mapping supers parent_type)] (in (list#mix (function (_ [super_var bound_type] mapping) @@ -2295,7 +2385,8 @@ override_mapping)))) (def .public (analyse_overriden_method analyse archive selfT mapping supers method) - (-> Phase Archive .Type Mapping (List (Type Class)) (Overriden_Method Code) (Operation Analysis)) + (-> Phase Archive .Type Mapping (List (Type Class)) (Overriden_Method Code) + (Operation analysis.Term)) (let [[parent_type method_name strict_fp? annotations vars self_name arguments return exceptions @@ -2327,35 +2418,35 @@ scope.with) .let [arity (list.size arguments)] @ meta.location] - (in (/////analysis.tuple @ (list (/////analysis.text @ ..overriden_tag) - (class_analysis @ parent_type) - (/////analysis.text @ method_name) - (/////analysis.bit @ strict_fp?) - (/////analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) - (/////analysis.tuple @ (list#each (var_analysis @) vars)) - (/////analysis.text @ self_name) - (/////analysis.tuple @ (list#each (..argument_analysis @) arguments)) - (return_analysis @ return) - (/////analysis.tuple @ (list#each (class_analysis @) - exceptions)) - [@ {/////analysis.#Function - (list#each (|>> (/////analysis.variable @)) - (scope.environment scope)) - (<| (..hidden_method_body @ arity) - (when arity - 0 (with_fake_parameter bodyA) - _ bodyA))}] - )))))) + (in (analysis.tuple @ (list (analysis.text @ ..overriden_tag) + (class_analysis @ parent_type) + (analysis.text @ method_name) + (analysis.bit @ strict_fp?) + (analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) + (analysis.tuple @ (list#each (var_analysis @) vars)) + (analysis.text @ self_name) + (analysis.tuple @ (list#each (..argument_analysis @) arguments)) + (return_analysis @ return) + (analysis.tuple @ (list#each (class_analysis @) + exceptions)) + [@ {analysis.#Function + (list#each (|>> (analysis.variable @)) + (scope.environment scope)) + (<| (..hidden_method_body @ arity) + (when arity + 0 (with_fake_parameter bodyA) + _ bodyA))}] + )))))) (def (matched? [sub sub_method subJT] [super super_method superJT]) - (-> [(Type Class) Text (Type Method)] [(Type Class) Text (Type Method)] Bit) + (-> [(Type Class) Text (Type Method)] [(Type Class) Text (Type Method)] + Bit) (and (of descriptor.equivalence = (jvm.descriptor super) (jvm.descriptor sub)) (text#= super_method sub_method) (jvm#= superJT subJT))) (def (mismatched_methods super_set sub_set) - (-> (List [(Type Class) Text (Type Method)]) - (List [(Type Class) Text (Type Method)]) + (-> (List [(Type Class) Text (Type Method)]) (List [(Type Class) Text (Type Method)]) (List [(Type Class) Text (Type Method)])) (list.only (function (_ sub) (not (list.any? (matched? sub) super_set))) @@ -2372,13 +2463,15 @@ ["Actual (parameters)" (exception.listing ..signature actual)]))) (def (super_aliasing class_loader class) - (-> java/lang/ClassLoader (Type Class) (Operation Aliasing)) + (-> java/lang/ClassLoader (Type Class) + (Operation Aliasing)) (do phase.monad [.let [[name actual_parameters] (parser.read_class class)] jvm_class (phase.of_try (reflection!.load class_loader name)) .let [expected_parameters (|> (java/lang/Class::getTypeParameters jvm_class) (array.list {.#None}) - (list#each (|>> java/lang/reflect/TypeVariable::getName)))] + (list#each (|>> java/lang/reflect/TypeVariable::getName + ffi.of_string)))] _ (phase.assertion ..class_parameter_mismatch [name class expected_parameters actual_parameters] (n.= (list.size expected_parameters) (list.size actual_parameters)))] @@ -2393,13 +2486,15 @@ alias.fresh))))) (def (anonymous_class_name module id) - (-> Module Nat Text) + (-> Module Nat + Text) (let [global (text.replaced .module_separator ..jvm_package_separator module) local (format "anonymous-class" (%.nat id))] (format global ..jvm_package_separator local))) (def .public (require_complete_method_concretion class_loader supers methods) - (-> java/lang/ClassLoader (List (Type Class)) (List (Overriden_Method Code)) (Operation Any)) + (-> java/lang/ClassLoader (List (Type Class)) (List (Overriden_Method Code)) + (Operation Any)) (do [! phase.monad] [required_abstract_methods (phase.of_try (all_abstract_methods class_loader supers)) available_methods (phase.of_try (all_methods class_loader supers)) @@ -2479,7 +2574,8 @@ )) (def (field_definition field) - (-> Field (Resource field.Field)) + (-> Field + (Resource field.Field)) (when field ... TODO: Handle annotations. {#Constant [name annotations type value]} @@ -2491,11 +2587,11 @@ attribute (attribute.constant constant)] (field.field ..constant::modifier name true <type> (sequence.sequence attribute)))]) ([.#Bit jvm.boolean [(pipe.when #0 +0 #1 +1) .i64 i32.i32 constant.integer pool.integer]] - [.#Int jvm.byte [.i64 i32.i32 constant.integer pool.integer]] - [.#Int jvm.short [.i64 i32.i32 constant.integer pool.integer]] - [.#Int jvm.int [.i64 i32.i32 constant.integer pool.integer]] + ... [.#Int jvm.byte [.i64 i32.i32 constant.integer pool.integer]] + ... [.#Int jvm.short [.i64 i32.i32 constant.integer pool.integer]] + ... [.#Int jvm.int [.i64 i32.i32 constant.integer pool.integer]] [.#Int jvm.long [constant.long pool.long]] - [.#Frac jvm.float [ffi.double_to_float constant.float pool.float]] + ... [.#Frac jvm.float [ffi.as_double ffi.double_to_float constant.float pool.float]] [.#Frac jvm.double [constant.double pool.double]] [.#Nat jvm.char [.i64 i32.i32 constant.integer pool.integer]] [.#Text (jvm.class "java.lang.String" (list)) [pool.string]] @@ -2511,7 +2607,8 @@ name true type sequence.empty))) (def method_privacy - (-> ffi.Privacy (Modifier method.Method)) + (-> ffi.Privacy + (Modifier method.Method)) (|>> (pipe.when {ffi.#PublicP} method.public {ffi.#PrivateP} method.private @@ -2522,7 +2619,8 @@ "<init>") (def (mock_value valueT) - (-> (Type Value) (Bytecode Any)) + (-> (Type Value) + (Bytecode Any)) (when (jvm.primitive? valueT) {.#Left classT} _.aconst_null @@ -2541,7 +2639,8 @@ _.iconst_0))) (def (mock_return :return:) - (-> (Type Return) (Bytecode Any)) + (-> (Type Return) + (Bytecode Any)) (when (jvm.void? :return:) {.#Right :return:} _.return @@ -2567,7 +2666,8 @@ _.ireturn))))) (def (mock_method super method) - (-> (Type Class) (Method_Definition Code) (Resource method.Method)) + (-> (Type Class) (Method_Definition Code) + (Resource method.Method)) (when method {#Constructor [privacy strict_floating_point? annotations variables exceptions self arguments constructor_arguments @@ -2655,7 +2755,8 @@ inheritance)) (def (class::anonymous class_loader host) - (-> java/lang/ClassLoader runtime.Host (-> Text Handler)) + (-> java/lang/ClassLoader runtime.Host + (-> Text Handler)) (..custom [(all <>.and (<code>.tuple (<>.some ..var)) @@ -2704,18 +2805,20 @@ _ (..require_complete_method_concretion class_loader supers methods) methodsA (monad.each ! (analyse_overriden_method analyse archive selfT mapping supers) methods) @ meta.location] - (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|translation")] - (list (class_analysis @ super_class) - (/////analysis.tuple @ (list#each (class_analysis @) super_interfaces)) - (/////analysis.tuple @ (list#each (typed_analysis @) constructor_argsA+)) - (/////analysis.tuple @ methodsA))}])))])) + (in [@ {analysis.#Extension [.prelude (%.format extension_name "|translation")] + (list (class_analysis @ super_class) + (analysis.tuple @ (list#each (class_analysis @) super_interfaces)) + (analysis.tuple @ (list#each (typed_analysis @) constructor_argsA+)) + (analysis.tuple @ methodsA))}])))])) (def (with_class_extensions class_loader host) - (-> java/lang/ClassLoader runtime.Host (-> Bundle Bundle)) + (-> java/lang/ClassLoader runtime.Host + (-> Bundle Bundle)) (install (%.format "jvm_" "class_" "anonymous" "#") (class::anonymous class_loader host))) (def .public (bundle class_loader host) - (-> java/lang/ClassLoader runtime.Host Bundle) + (-> java/lang/ClassLoader runtime.Host + Bundle) (<| with_conversion_extensions with_int_extensions with_long_extensions diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux index d3cc72d43..b7a0df63b 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Analysis global local) + [lux (.except global local) [abstract ["[0]" monad (.only do)]] [control @@ -34,7 +34,7 @@ ["/[1]" // [// ["[0]" phase] - ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) + ["[0]" analysis (.only Operation Phase Handler Bundle) [evaluation (.only Eval)] ["[0]A" type] ["[0]" scope]] @@ -44,9 +44,9 @@ [archive (.only Archive)]]]]]]) (def .public (custom [syntax handler] extension_name) - (All (_ s) - (-> [(Parser s) - (-> Text Phase Archive s (Operation Analysis))] + (All (_ of) + (-> [(Parser of) + (-> Text Phase Archive of (Operation analysis.Term))] (-> Text Handler))) (function (_ analyse archive args) (when (<code>.result syntax args) @@ -91,19 +91,23 @@ (analysis.except ..incorrect_arity [num_expected num_actual])))))) (def .public (nullary valueT) - (-> Type (-> Text Handler)) + (-> Type + (-> Text Handler)) (simple (list) valueT)) (def .public (unary inputT outputT) - (-> Type Type (-> Text Handler)) + (-> Type Type + (-> Text Handler)) (simple (list inputT) outputT)) (def .public (binary subjectT paramT outputT) - (-> Type Type Type (-> Text Handler)) + (-> Type Type Type + (-> Text Handler)) (simple (list subjectT paramT) outputT)) (def .public (trinary subjectT param0T param1T outputT) - (-> Type Type Type Type (-> Text Handler)) + (-> Type Type Type Type + (-> Text Handler)) (simple (list subjectT param0T param1T) outputT)) (def .public (variadic input output next extension_name) @@ -201,7 +205,8 @@ (analyse archive exprC)))])) (def .public (is#_extension eval) - (-> Eval (-> Text Handler)) + (-> Eval + (-> Text Handler)) (..custom [(<>.and <code>.any <code>.any) (function (_ extension_name analyse archive [typeC valueC]) @@ -213,7 +218,8 @@ (analyse archive valueC))))])) (def .public (as#_extension eval) - (-> Eval (-> Text Handler)) + (-> Eval + (-> Text Handler)) (..custom [(<>.and <code>.any <code>.any) (function (_ extension_name analyse archive [typeC valueC]) @@ -226,7 +232,8 @@ (in valueA)))])) (def (caster input output) - (-> Type Type (-> Text Handler)) + (-> Type Type + (-> Text Handler)) (..custom [<code>.any (function (_ extension_name phase archive valueC) @@ -314,7 +321,8 @@ (analysis.except ..unknown_local [it]))))])) (def with_basic_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (install "is_type#" (..caster .Type .Type)) (install "is?#" lux::is?) (install "try#" lux::try) @@ -324,7 +332,8 @@ (install "global#" ..global))) (def with_io_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (install "log!#" (unary Text Any)) (install "error#" (unary Text Nothing)))) @@ -332,7 +341,8 @@ (type_literal (I64 Any))) (def with_i64_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (install "i64_and#" (binary I64* I64* I64)) (install "i64_or#" (binary I64* I64* I64)) (install "i64_xor#" (binary I64* I64* I64)) @@ -344,7 +354,8 @@ (install "i64_-#" (binary I64* I64* I64)))) (def with_int_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (install "int_<#" (binary Int Int Bit)) (install "int_*#" (binary Int Int Int)) (install "int_/#" (binary Int Int Int)) @@ -354,7 +365,8 @@ (install "int_char#" (unary Int Text)))) (def with_frac_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (install "f64_+#" (binary Frac Frac Frac)) (install "f64_-#" (binary Frac Frac Frac)) (install "f64_*#" (binary Frac Frac Frac)) @@ -368,7 +380,8 @@ (install "f64_decoded#" (unary Text (type_literal (Maybe Frac)))))) (def with_text_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (install "text_=#" (binary Text Text Bit)) (install "text_<#" (binary Text Text Bit)) (install "text_composite#" (variadic Text Text synthesis.synthesis)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux index c935620a8..23046cdbf 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Type Definition Analysis Synthesis Declaration) + [lux (.except Type Definition Declaration) ["[0]" ffi (.only import)] [abstract ["[0]" monad (.only do)]] @@ -70,10 +70,10 @@ [lux ["[0]" translation] ["[0]" declaration (.only Handler Bundle)] - ["[0]" analysis (.only Analysis) + ["[0]" analysis (.only) ["[0]A" type] ["[0]A" scope]] - ["[0]" synthesis (.only Synthesis) + ["[0]" synthesis (.only) ["<[1]>" \\parser]] ["[0]" phase (.only) [translation @@ -103,7 +103,8 @@ (<code>.form (<>.and <code>.text (<>.some jvm.var)))) (def method_privacy - (-> ffi.Privacy (Modifier method.Method)) + (-> ffi.Privacy + (Modifier method.Method)) (|>> (pipe.when {ffi.#PublicP} method.public {ffi.#PrivateP} method.private @@ -145,7 +146,8 @@ ["final" field.final] ["default" modifier.empty]))))) -(type Annotation Any) +(type Annotation + Any) (def annotation (Parser Annotation) @@ -227,7 +229,8 @@ field.final)) (def (field_definition field) - (-> Field (Resource field.Field)) + (-> Field + (Resource field.Field)) (when field ... TODO: Handle annotations. {#Constant [name annotations type value]} @@ -239,11 +242,11 @@ attribute (attribute.constant constant)] (field.field ..constant::modifier name true <type> (sequence.sequence attribute)))]) ([.#Bit type.boolean [(pipe.when #0 +0 #1 +1) .i64 i32.i32 constant.integer pool.integer]] - [.#Int type.byte [.i64 i32.i32 constant.integer pool.integer]] - [.#Int type.short [.i64 i32.i32 constant.integer pool.integer]] - [.#Int type.int [.i64 i32.i32 constant.integer pool.integer]] + ... [.#Int type.byte [.i64 i32.i32 constant.integer pool.integer]] + ... [.#Int type.short [.i64 i32.i32 constant.integer pool.integer]] + ... [.#Int type.int [.i64 i32.i32 constant.integer pool.integer]] [.#Int type.long [constant.long pool.long]] - [.#Frac type.float [ffi.double_to_float constant.float pool.float]] + ... [.#Frac type.float [ffi.as_double ffi.double_to_float constant.float pool.float]] [.#Frac type.double [constant.double pool.double]] [.#Nat type.char [.i64 i32.i32 constant.integer pool.integer]] [.#Text (type.class "java.lang.String" (list)) [pool.string]] @@ -264,11 +267,11 @@ name true type sequence.empty))) (def annotation_parameter_synthesis - (<synthesis>.Parser (jvm.Annotation_Parameter Synthesis)) + (<synthesis>.Parser (jvm.Annotation_Parameter synthesis.Term)) (<synthesis>.tuple (<>.and <synthesis>.text <synthesis>.any))) (def annotation_synthesis - (<synthesis>.Parser (jvm.Annotation Synthesis)) + (<synthesis>.Parser (jvm.Annotation synthesis.Term)) (<synthesis>.tuple (<>.and <synthesis>.text (<>.some ..annotation_parameter_synthesis)))) (with_template [<name> <type> <text>] @@ -287,11 +290,12 @@ (<synthesis>.tuple (<>.and <synthesis>.text ..value_type_synthesis))) (def input_synthesis - (<synthesis>.Parser (Typed Synthesis)) + (<synthesis>.Parser (Typed synthesis.Term)) (<synthesis>.tuple (<>.and ..value_type_synthesis <synthesis>.any))) (def (method_body arity) - (-> Nat (<synthesis>.Parser Synthesis)) + (-> Nat + (<synthesis>.Parser synthesis.Term)) (<| (<>#each (function (_ [env offset inits it]) it)) (<synthesis>.function 1) (<synthesis>.loop (<>.exactly 0 <synthesis>.any)) @@ -303,7 +307,7 @@ <synthesis>.any))) (def constructor_synthesis - (<synthesis>.Parser (jvm.Constructor Synthesis)) + (<synthesis>.Parser (jvm.Constructor synthesis.Term)) (<| <synthesis>.tuple (<>.after (<synthesis>.this_text jvm.constructor_tag)) (all <>.and @@ -322,7 +326,7 @@ ))) (def overriden_method_synthesis - (<synthesis>.Parser (jvm.Overriden_Method Synthesis)) + (<synthesis>.Parser (jvm.Overriden_Method synthesis.Term)) (<| <synthesis>.tuple (<>.after (<synthesis>.this_text jvm.overriden_tag)) (all <>.and @@ -342,7 +346,7 @@ ))) (def virtual_method_synthesis - (<synthesis>.Parser (jvm.Virtual_Method Synthesis)) + (<synthesis>.Parser (jvm.Virtual_Method synthesis.Term)) (<| <synthesis>.tuple (<>.after (<synthesis>.this_text jvm.virtual_tag)) (all <>.and @@ -363,7 +367,7 @@ ))) (def static_method_synthesis - (<synthesis>.Parser (jvm.Static_Method Synthesis)) + (<synthesis>.Parser (jvm.Static_Method synthesis.Term)) (<| <synthesis>.tuple (<>.after (<synthesis>.this_text jvm.static_tag)) (all <>.and @@ -382,7 +386,7 @@ ))) (def abstract_method_synthesis - (<synthesis>.Parser (jvm.Abstract_Method Synthesis)) + (<synthesis>.Parser (jvm.Abstract_Method synthesis.Term)) (<| <synthesis>.tuple (<>.after (<synthesis>.this_text jvm.abstract_tag)) (all <>.and @@ -396,7 +400,7 @@ ))) (def method_synthesis - (<synthesis>.Parser (Method_Definition Synthesis)) + (<synthesis>.Parser (Method_Definition synthesis.Term)) (all <>.or ..constructor_synthesis ..virtual_method_synthesis @@ -406,7 +410,8 @@ )) (def composite - (-> (List (Bytecode Any)) (Bytecode Any)) + (-> (List (Bytecode Any)) + (Bytecode Any)) (|>> list.reversed (list#mix _.composite (_#in [])))) @@ -414,7 +419,8 @@ "<init>") (def (method_argument lux_register argumentT jvm_register) - (-> Register (Type Value) Register [Register (Bytecode Any)]) + (-> Register (Type Value) Register + [Register (Bytecode Any)]) (when (type.primitive? argumentT) {.#Left argumentT} [(n.+ 1 jvm_register) @@ -447,7 +453,8 @@ (wrap_primitive 2 _.dload type.double)))))) (def .public (method_arguments offset types) - (-> Nat (List (Type Value)) (Bytecode Any)) + (-> Nat (List (Type Value)) + (Bytecode Any)) (|> types list.enumeration (list#mix (function (_ [lux_register type] [jvm_register before]) @@ -457,7 +464,8 @@ product.right)) (def (constructor_method_translation translate archive super_class method) - (-> (translation.Phase Anchor (Bytecode Any) Definition) Archive (Type Class) (jvm.Constructor Synthesis) (Operation (Resource Method))) + (-> (translation.Phase Anchor (Bytecode Any) Definition) Archive (Type Class) (jvm.Constructor synthesis.Term) + (Operation (Resource Method))) (<| (let [[privacy strict_floating_point? annotations method_tvars exceptions self arguments constructor_argumentsS bodyS] method @@ -493,7 +501,8 @@ )}))))) (def (method_return returnT) - (-> (Type Return) (Bytecode Any)) + (-> (Type Return) + (Bytecode Any)) (when (type.void? returnT) {.#Right returnT} _.return @@ -531,7 +540,8 @@ (unwrap_primitive _.dreturn type.double))))))) (def (overriden_method_translation translate archive method) - (-> (translation.Phase Anchor (Bytecode Any) Definition) Archive (jvm.Overriden_Method Synthesis) (Operation (Resource Method))) + (-> (translation.Phase Anchor (Bytecode Any) Definition) Archive (jvm.Overriden_Method synthesis.Term) + (Operation (Resource Method))) (<| (let [[super method_name strict_floating_point? annotations method_tvars self arguments returnJ exceptionsJ bodyS] method @@ -556,7 +566,8 @@ (method_return returnJ))}))))) (def (virtual_method_translation translate archive method) - (-> (translation.Phase Anchor (Bytecode Any) Definition) Archive (jvm.Virtual_Method Synthesis) (Operation (Resource Method))) + (-> (translation.Phase Anchor (Bytecode Any) Definition) Archive (jvm.Virtual_Method synthesis.Term) + (Operation (Resource Method))) (<| (let [[method_name privacy final? strict_floating_point? annotations method_tvars self arguments returnJ exceptionsJ bodyS] method @@ -584,7 +595,8 @@ (method_return returnJ))}))))) (def (static_method_translation translate archive method) - (-> (translation.Phase Anchor (Bytecode Any) Definition) Archive (jvm.Static_Method Synthesis) (Operation (Resource Method))) + (-> (translation.Phase Anchor (Bytecode Any) Definition) Archive (jvm.Static_Method synthesis.Term) + (Operation (Resource Method))) (<| (let [[method_name privacy strict_floating_point? annotations method_tvars arguments returnJ exceptionsJ bodyS] method]) @@ -607,7 +619,8 @@ (method_return returnJ))}))))) (def (abstract_method_translation method) - (-> (jvm.Abstract_Method Synthesis) (Resource Method)) + (-> (jvm.Abstract_Method synthesis.Term) + (Resource Method)) (let [[name privacy annotations variables arguments return exceptions] method] (method.method (all modifier#composite @@ -619,7 +632,8 @@ {.#None}))) (def (method_translation translate archive super_class method) - (-> (translation.Phase Anchor (Bytecode Any) Definition) Archive (Type Class) (Method_Definition Synthesis) (Operation (Resource Method))) + (-> (translation.Phase Anchor (Bytecode Any) Definition) Archive (Type Class) (Method_Definition synthesis.Term) + (Operation (Resource Method))) (when method {#Constructor method} (..constructor_method_translation translate archive super_class method) @@ -647,7 +661,7 @@ (-> (Method_Definition Code) (Operation [(Set unit.ID) (Resource Method)]))) (function (_ methodC) (do phase.monad - [methodA (is (Operation Analysis) + [methodA (is (Operation analysis.Term) (declaration.of_analysis (when methodC {#Constructor method} @@ -664,7 +678,7 @@ {#Abstract_Method method} (jvm.analyse_abstract_method analyse archive method)))) - methodS (is (Operation Synthesis) + methodS (is (Operation synthesis.Term) (declaration.of_synthesis (synthesize archive methodA))) dependencies (declaration.of_translation @@ -701,7 +715,8 @@ (list))))) (def (mock_value valueT) - (-> (Type Value) (Bytecode Any)) + (-> (Type Value) + (Bytecode Any)) (when (type.primitive? valueT) {.#Left classT} _.aconst_null @@ -720,7 +735,8 @@ _.iconst_0))) (def (mock_return returnT) - (-> (Type Return) (Bytecode Any)) + (-> (Type Return) + (Bytecode Any)) (when (type.void? returnT) {.#Right returnT} _.return @@ -746,7 +762,8 @@ _.ireturn))))) (def (mock_method super method) - (-> (Type Class) (Method_Definition Code) (Resource method.Method)) + (-> (Type Class) (Method_Definition Code) + (Resource method.Method)) (when method {#Constructor [privacy strict_floating_point? annotations variables exceptions self arguments constructor_arguments @@ -844,7 +861,8 @@ ) (def (save_class! name bytecode dependencies) - (-> Text Binary (Set unit.ID) (Operation Any)) + (-> Text Binary (Set unit.ID) + (Operation Any)) (declaration.of_translation (do [! phase.monad] [.let [artifact [name bytecode]] @@ -921,7 +939,8 @@ (in declaration.no_requirements)))])) (def (method_declaration (open "/[0]")) - (-> (jvm.Method_Declaration Code) (Resource Method)) + (-> (jvm.Method_Declaration Code) + (Resource Method)) (let [type (type.method [/#type_variables /#arguments /#return /#exceptions])] (method.method (all modifier#composite method.public @@ -970,7 +989,8 @@ "[1]::[0]") (def .public (bundle class_loader extender) - (-> java/lang/ClassLoader Extender (Bundle Anchor (Bytecode Any) Definition)) + (-> java/lang/ClassLoader Extender + (Bundle Anchor (Bytecode Any) Definition)) (|> extension.empty (dictionary.has (%.format "jvm_" "class" "#") jvm::class) (dictionary.has (%.format "jvm_" "class_" "interface" "#") ..jvm::class::interface) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux index 1a8b75275..a20110788 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis) + [lux (.except) [abstract ["[0]" monad (.only do)]] [control @@ -42,7 +42,7 @@ ["[0]A" type] ["[0]A" module] ["[0]" scope]] - ["[1][0]" synthesis (.only Synthesis)] + ["[0]" synthesis] ["[1][0]" translation] ["[1][0]" declaration (.only Import Requirements Phase Operation Handler Extender Bundle)] ["[0]" phase (.only) @@ -61,11 +61,9 @@ ["[1]/[0]" artifact]]]]]]]]) (def .public (custom [syntax handler]) - (All (_ anchor expression declaration s) - (-> [(Parser s) - (-> (Phase anchor expression declaration) - Archive - s + (All (_ anchor expression declaration of) + (-> [(Parser of) + (-> (Phase anchor expression declaration) Archive of (Operation anchor expression declaration Requirements))] (Handler anchor expression declaration))) (function (_ phase archive inputs) @@ -77,7 +75,8 @@ (phase.failure error)))) (def (context [@module @artifact]) - (-> unit.ID unit.ID) + (-> unit.ID + unit.ID) ... TODO: Find a better way that doesn't rely on clever tricks. [@module (n.- (++ @artifact) 0)]) @@ -87,7 +86,7 @@ (-> Archive (/////translation.Phase anchor expression declaration) Type - Synthesis + synthesis.Term (Operation anchor expression declaration [Type expression Any]))) (/////declaration.of_translation (do phase.monad @@ -100,7 +99,8 @@ (def .public (evaluate! archive type codeC) (All (_ anchor expression declaration) - (-> Archive Type Code (Operation anchor expression declaration [Type expression Any]))) + (-> Archive Type Code + (Operation anchor expression declaration [Type expression Any]))) (do phase.monad [state phase.state .let [analysis_state (the [/////declaration.#analysis /////declaration.#state] state) @@ -123,7 +123,7 @@ (/////translation.Phase anchor expression declaration) Symbol Type - Synthesis + synthesis.Term (Operation anchor expression declaration [Type expression Any]))) (/////declaration.of_translation (do phase.monad @@ -131,7 +131,7 @@ [interim_artifacts codeG] (/////translation.with_interim_artifacts archive (translation archive codeS)) .let [@abstraction (when codeS - (/////synthesis.function/abstraction @ [env arity body]) + (synthesis.function/abstraction @ [env arity body]) (|> interim_artifacts list.last (maybe#each (|>> [arity]))) @@ -274,7 +274,8 @@ ) (def (swapped original replacement) - (-> Type Type Type Type) + (-> Type Type Type + Type) (function (again type) (if (type#= original type) replacement diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux index 7cc1ceb13..73bf644d9 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis) + [lux (.except) [abstract ["[0]" monad (.only do)]] [data @@ -17,14 +17,16 @@ ["[0]" /// (.only) [/// ["[0]" phase] - ["[0]" synthesis (.only Synthesis Handler Bundle)]]]) + ["[0]" synthesis (.only Handler Bundle)]]]) (def .public synthesis - (-> Text Text) + (-> Text + Text) (|>> (text.suffix "|synthesis"))) (def translation - (-> Text Text) + (-> Text + Text) (text.replaced (synthesis "") "|translation")) (def .public (install name anonymous) @@ -33,8 +35,8 @@ (dictionary.has name (anonymous name))) (def (flat_text_composite expected) - (-> Symbol (List Synthesis) - (List Synthesis)) + (-> Symbol (List synthesis.Term) + (List synthesis.Term)) (|>> (list#each (function (_ it) (when it [@ {synthesis.#Extension actual parameters}] @@ -47,7 +49,8 @@ list#conjoint)) (def (text::composite self) - (-> Text Handler) + (-> Text + Handler) (let [translation [.prelude (translation self)]] (function (_ synthesis archive parts) (do [! phase.monad] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/common.lux index c91f78a4e..ac337f105 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/common.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Type Label Synthesis) + [lux (.except Type Label) [abstract ["[0]" monad (.only do)]] [control @@ -41,16 +41,16 @@ ["[1]" abstract]]]] [// ["[0]" phase] - ["[0]" synthesis (.only Synthesis %synthesis) + ["[0]" synthesis ["<[1]>" \\parser (.only Parser)]] [/// [meta [archive (.only Archive)]]]]]) (def .public (custom [parser handler]) - (All (_ s) - (-> [(Parser s) - (-> Phase Archive s (Operation (Bytecode Any)))] + (All (_ of) + (-> [(Parser of) + (-> Phase Archive of (Operation (Bytecode Any)))] Handler)) (function (_ phase archive input) (when (<synthesis>.result parser input) @@ -157,7 +157,8 @@ ///runtime.try)) (def with_basic_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (dictionary.has "when_char#|translation" ..lux::syntax_char_case!) (dictionary.has "is?#|translation" (binary ..lux::is)) (dictionary.has "try#|translation" (unary ..lux::try)))) @@ -227,7 +228,8 @@ ) (def (::toString class from) - (-> (Type Class) (Type Primitive) (Bytecode Any)) + (-> (Type Class) (Type Primitive) + (Bytecode Any)) (_.invokestatic class "toString" (type.method [(list) (list from) ..$String (list)]))) (with_template [<name> <prepare> <transform>] @@ -267,7 +269,8 @@ ) (def with_i64_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (dictionary.has "i64_and#|translation" (binary ..i64::and)) (dictionary.has "i64_or#|translation" (binary ..i64::or)) (dictionary.has "i64_xor#|translation" (binary ..i64::xor)) @@ -279,7 +282,8 @@ (dictionary.has "i64_-#|translation" (binary ..i64::-)))) (def with_int_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (dictionary.has "int_<#|translation" (binary ..i64::<)) (dictionary.has "int_*#|translation" (binary ..i64::*)) (dictionary.has "int_/#|translation" (binary ..i64::/)) @@ -289,7 +293,8 @@ (dictionary.has "int_char#|translation" (unary ..i64::char)))) (def with_frac_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (dictionary.has "f64_+#|translation" (binary ..f64::+)) (dictionary.has "f64_-#|translation" (binary ..f64::-)) (dictionary.has "f64_*#|translation" (binary ..f64::*)) @@ -427,7 +432,8 @@ (_.set_label @end)))) (def with_text_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (dictionary.has "text_=#|translation" (binary ..text::=)) (dictionary.has "text_<#|translation" (binary ..text::<)) (dictionary.has "text_composite#|translation" (variadic ..text::composite)) @@ -457,7 +463,8 @@ _.athrow)) (def with_io_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (dictionary.has "log!#|translation" (unary ..io::log)) (dictionary.has "error#|translation" (unary ..io::error)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux index 59ef51747..509d6dcf5 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Type Synthesis) + [lux (.except Type) [abstract ["[0]" monad (.only do)]] [control @@ -70,7 +70,7 @@ ["/[1]" // ["[0]" phase] ["[1][0]" translation] - ["[0]" synthesis (.only Synthesis Path %synthesis) + ["[0]" synthesis (.only Path %synthesis) ["<[1]>" \\parser (.only Parser)]] [analysis (.only Environment) ["[0]" complex]] @@ -139,7 +139,8 @@ ) (def with_conversion_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (dictionary.has (%.format "jvm_" "conversion_" "double_to_float" "#" "|translation") (unary conversion::double_to_float)) (dictionary.has (%.format "jvm_" "conversion_" "double_to_int" "#" "|translation") (unary conversion::double_to_int)) (dictionary.has (%.format "jvm_" "conversion_" "double_to_long" "#" "|translation") (unary conversion::double_to_long)) @@ -273,7 +274,8 @@ ) (def with_int_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (let [type (reflection.reflection reflection.int)] (|>> (dictionary.has (%.format "jvm_" type "_" "+" "#" "|translation") (binary int::+)) (dictionary.has (%.format "jvm_" type "_" "-" "#" "|translation") (binary int::-)) @@ -291,7 +293,8 @@ ))) (def with_long_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (let [type (reflection.reflection reflection.long)] (|>> (dictionary.has (%.format "jvm_" type "_" "+" "#" "|translation") (binary long::+)) (dictionary.has (%.format "jvm_" type "_" "-" "#" "|translation") (binary long::-)) @@ -309,7 +312,8 @@ ))) (def with_float_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (let [type (reflection.reflection reflection.float)] (|>> (dictionary.has (%.format "jvm_" type "_" "+" "#" "|translation") (binary float::+)) (dictionary.has (%.format "jvm_" type "_" "-" "#" "|translation") (binary float::-)) @@ -321,7 +325,8 @@ ))) (def with_double_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (let [type (reflection.reflection reflection.double)] (|>> (dictionary.has (%.format "jvm_" type "_" "+" "#" "|translation") (binary double::+)) (dictionary.has (%.format "jvm_" type "_" "-" "#" "|translation") (binary double::-)) @@ -333,7 +338,8 @@ ))) (def with_char_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (let [type (reflection.reflection reflection.char)] (|>> (dictionary.has (%.format "jvm_" type "_" "=" "#" "|translation") (binary char::=)) (dictionary.has (%.format "jvm_" type "_" "<" "#" "|translation") (binary char::<)) @@ -353,12 +359,14 @@ (def reflection (All (_ category) - (-> (Type (<| Return' Value' category)) Text)) + (-> (Type (<| Return' Value' category)) + Text)) (|>> type.reflection reflection.reflection)) (def signature (All (_ category) - (-> (Type category) Text)) + (-> (Type category) + Text)) (|>> type.signature signature.signature)) (exception.def .public (not_an_object_array arrayJT) @@ -383,7 +391,8 @@ (undefined)))) (def (primitive_array_length_handler jvm_primitive) - (-> (Type Primitive) Handler) + (-> (Type Primitive) + Handler) (..custom [<synthesis>.any (function (_ translate archive arrayS) @@ -407,7 +416,8 @@ _.arraylength))))])) (def (new_primitive_array_handler jvm_primitive) - (-> Primitive_Array_Type Handler) + (-> Primitive_Array_Type + Handler) (..custom [<synthesis>.any (function (_ translate archive [lengthS]) @@ -429,7 +439,8 @@ (_.anewarray objectJT)))))])) (def (read_primitive_array_handler jvm_primitive loadG) - (-> (Type Primitive) (Bytecode Any) Handler) + (-> (Type Primitive) (Bytecode Any) + Handler) (..custom [(all <>.and <synthesis>.any <synthesis>.any) (function (_ translate archive [idxS arrayS]) @@ -457,7 +468,8 @@ _.aaload))))])) (def (write_primitive_array_handler jvm_primitive storeG) - (-> (Type Primitive) (Bytecode Any) Handler) + (-> (Type Primitive) (Bytecode Any) + Handler) (..custom [(all <>.and <synthesis>.any <synthesis>.any <synthesis>.any) (function (_ translate archive [idxS valueS arrayS]) @@ -491,7 +503,8 @@ _.aastore))))])) (def with_array_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (dictionary.has (%.format "jvm_" "array_" "length_" (reflection.reflection reflection.boolean) "#" "|translation") (primitive_array_length_handler type.boolean)) (dictionary.has (%.format "jvm_" "array_" "length_" (reflection.reflection reflection.byte) "#" "|translation") (primitive_array_length_handler type.byte)) (dictionary.has (%.format "jvm_" "array_" "length_" (reflection.reflection reflection.short) "#" "|translation") (primitive_array_length_handler type.short)) @@ -630,7 +643,8 @@ valueG)))))])) (def with_object_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (dictionary.has (%.format "jvm_" "object_" "null" "#" "|translation") (nullary object::null)) (dictionary.has (%.format "jvm_" "object_" "null?" "#" "|translation") (unary object::null?)) (dictionary.has (%.format "jvm_" "object_" "synchronized" "#" "|translation") (binary object::synchronized)) @@ -704,14 +718,15 @@ putG))))])) (type Input - (Typed Synthesis)) + (Typed synthesis.Term)) (def input (Parser Input) (<synthesis>.tuple (<>.and ..value <synthesis>.any))) (def (translate_input translate archive [valueT valueS]) - (-> Phase Archive Input (Operation (Typed (Bytecode Any)))) + (-> Phase Archive Input + (Operation (Typed (Bytecode Any)))) (do phase.monad [valueG (translate archive valueS)] (when (type.primitive? valueT) @@ -724,7 +739,8 @@ (_.checkcast valueT))])))) (def (prepare_output outputT) - (-> (Type Return) (Bytecode Any)) + (-> (Type Return) + (Bytecode Any)) (when (type.void? outputT) {.#Right outputT} ..unitG @@ -781,7 +797,8 @@ (_.invokespecial class "<init>" (type.method [(list) (list#each product.left inputsTG) type.void (list)]))))))])) (def with_member_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (|>> (dictionary.has (%.format "jvm_" "member_" "get_" "static" "#" "|translation") get::static) (dictionary.has (%.format "jvm_" "member_" "get_" "virtual" "#" "|translation") get::virtual) @@ -796,11 +813,11 @@ )) (def annotation_parameter - (Parser (/.Annotation_Parameter Synthesis)) + (Parser (/.Annotation_Parameter synthesis.Term)) (<synthesis>.tuple (<>.and <synthesis>.text <synthesis>.any))) (def annotation - (Parser (/.Annotation Synthesis)) + (Parser (/.Annotation synthesis.Term)) (<synthesis>.tuple (<>.and <synthesis>.text (<>.some ..annotation_parameter)))) (def argument @@ -808,7 +825,8 @@ (<synthesis>.tuple (<>.and <synthesis>.text ..value))) (def .public (hidden_method_body arity body) - (-> Nat Synthesis Synthesis) + (-> Nat synthesis.Term + synthesis.Term) (with_expansions [<oops> (panic! (%.format (%.nat arity) " " (synthesis.%synthesis body)))] (when [arity body] (^.or [0 _] @@ -834,7 +852,7 @@ <oops>))) (def (without_fake_parameter#path without_fake_parameter) - (-> (-> Synthesis Synthesis) + (-> (-> synthesis.Term synthesis.Term) (-> Path Path)) (function (again it) (when it @@ -868,7 +886,8 @@ {synthesis.#Then (without_fake_parameter it)}))) (def .public (without_fake_parameter it) - (-> Synthesis Synthesis) + (-> synthesis.Term + synthesis.Term) (when it [@ {synthesis.#Simple _}] it @@ -957,7 +976,7 @@ [@ {synthesis.#Extension name (list#each without_fake_parameter parameters)}])) (def overriden_method_definition - (Parser [(Environment Synthesis) (/.Overriden_Method Synthesis)]) + (Parser [(Environment synthesis.Term) (/.Overriden_Method synthesis.Term)]) (<synthesis>.tuple (do <>.monad [_ (<synthesis>.this_text /.overriden_tag) ownerT ..class @@ -985,7 +1004,7 @@ _ body))]])))) (def (normalize_path normalize) - (-> (-> Synthesis Synthesis) + (-> (-> synthesis.Term synthesis.Term) (-> Path Path)) (function (again path) (when path @@ -1019,10 +1038,11 @@ [synthesis.#Text_Fork])))) (type Mapping - (Dictionary Synthesis Variable)) + (Dictionary synthesis.Term Variable)) (def (normalize_method_body mapping) - (-> Mapping Synthesis Synthesis) + (-> Mapping synthesis.Term + synthesis.Term) (function (again body) (when body (^.with_template [<tag>] @@ -1089,14 +1109,16 @@ (type.class "java.lang.Object" (list))) (def (anonymous_init_method env inputsTI) - (-> (Environment Synthesis) (List (Typed (Bytecode Any))) (Type category.Method)) + (-> (Environment synthesis.Term) (List (Typed (Bytecode Any))) + (Type category.Method)) (type.method [(list) (list.repeated (n.+ (list.size inputsTI) (list.size env)) ..$Object) type.void (list)])) (def (with_anonymous_init class env super_class inputsTG) - (-> (Type category.Class) (Environment Synthesis) (Type category.Class) (List (Typed (Bytecode Any))) (Resource Method)) + (-> (Type category.Class) (Environment synthesis.Term) (Type category.Class) (List (Typed (Bytecode Any))) + (Resource Method)) (let [inputs_offset (list.size inputsTG) inputs! (|> inputsTG list.enumeration @@ -1131,7 +1153,8 @@ _.return)}))) (def (anonymous_instance translate archive class env inputsTI) - (-> Phase Archive (Type category.Class) (Environment Synthesis) (List (Typed (Bytecode Any))) (Operation (Bytecode Any))) + (-> Phase Archive (Type category.Class) (Environment synthesis.Term) (List (Typed (Bytecode Any))) + (Operation (Bytecode Any))) (do [! phase.monad] [captureG+ (monad.each ! (translate archive) env)] (in (all _.composite @@ -1145,7 +1168,8 @@ (_.invokespecial class "<init>" (anonymous_init_method env inputsTI)))))) (def (returnG returnT) - (-> (Type Return) (Bytecode Any)) + (-> (Type Return) + (Bytecode Any)) (when (type.void? returnT) {.#Right returnT} _.return @@ -1183,14 +1207,15 @@ (unwrap_primitive _.dreturn type.double))))))) (def (method_dependencies archive method) - (-> Archive (/.Overriden_Method Synthesis) (Operation (Set unit.ID))) + (-> Archive (/.Overriden_Method synthesis.Term) + (Operation (Set unit.ID))) (let [[_super _name _strict_fp? _annotations _t_vars _this _arguments _return _exceptions bodyS] method] (cache/artifact.dependencies archive bodyS))) (def (anonymous_dependencies archive inputsTS overriden_methods) - (-> Archive (List Input) (List [(Environment Synthesis) (/.Overriden_Method Synthesis)]) + (-> Archive (List Input) (List [(Environment synthesis.Term) (/.Overriden_Method synthesis.Term)]) (Operation (Set unit.ID))) (do [! phase.monad] [all_input_dependencies (monad.each ! (|>> product.right (cache/artifact.dependencies archive)) inputsTS) @@ -1205,7 +1230,8 @@ all_method_dependencies))))) (def (prepare_argument lux_register argumentT jvm_register) - (-> Register (Type Value) Register [Register (Bytecode Any)]) + (-> Register (Type Value) Register + [Register (Bytecode Any)]) (when (type.primitive? argumentT) {.#Left argumentT} [(n.+ 1 jvm_register) @@ -1238,7 +1264,8 @@ (wrap_primitive 2 _.dload type.double)))))) (def .public (prepare_arguments offset types) - (-> Nat (List (Type Value)) (Bytecode Any)) + (-> Nat (List (Type Value)) + (Bytecode Any)) (|> types list.enumeration (list#mix (function (_ [lux_register type] [jvm_register before]) @@ -1253,8 +1280,8 @@ product.right)) (def (normalized_method global_mapping [environment method]) - (-> Mapping [(Environment Synthesis) (/.Overriden_Method Synthesis)] - (/.Overriden_Method Synthesis)) + (-> Mapping [(Environment synthesis.Term) (/.Overriden_Method synthesis.Term)] + (/.Overriden_Method synthesis.Term)) (let [[ownerT name strict_fp? annotations vars self_name arguments returnT exceptionsT body] method local_mapping (|> environment list.enumeration @@ -1270,8 +1297,8 @@ (normalize_method_body local_mapping body)])) (def (total_environment overriden_methods) - (-> (List [(Environment Synthesis) (/.Overriden_Method Synthesis)]) - (List Synthesis)) + (-> (List [(Environment synthesis.Term) (/.Overriden_Method synthesis.Term)]) + (List synthesis.Term)) (|> overriden_methods ... Get all the environments. (list#each product.left) @@ -1282,7 +1309,8 @@ set.list)) (def (global_mapping total_environment) - (-> (List Synthesis) Mapping) + (-> (List synthesis.Term) + Mapping) (|> total_environment ... Give them names as "foreign" variables. list.enumeration @@ -1291,7 +1319,8 @@ (dictionary.of_list synthesis.hash))) (def (method_definition phase archive artifact_id method) - (-> Phase Archive artifact.ID (/.Overriden_Method Synthesis) (Operation (Resource Method))) + (-> Phase Archive artifact.ID (/.Overriden_Method synthesis.Term) + (Operation (Resource Method))) (let [[ownerT name strict_fp? annotations vars self_name arguments returnT exceptionsT bodyS] method] (do phase.monad [bodyG (//////translation.with_context artifact_id @@ -1353,7 +1382,8 @@ (anonymous_instance translate archive class total_environment inputsTI)))])) (def with_class_extensions - (-> Bundle Bundle) + (-> Bundle + Bundle) (dictionary.has (%.format "jvm_" "class_" "anonymous" "#" "|translation") class::anonymous)) (def .public bundle diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux index d9f053aca..8c0a33cc1 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis Analysis) + [lux (.except) [abstract ["[0]" monad (.only do)]] [control @@ -27,9 +27,9 @@ ["[0]" extension] ["/[1]" // ["[0]" phase (.use "[1]#[0]" monad)] - ["/" synthesis (.only Synthesis Operation Phase Extender Handler) + ["/" synthesis (.only Operation Phase Extender Handler) ["[1][0]" simple]] - ["[1][0]" analysis (.only Analysis) + ["[0]" analysis (.only) ["[2][0]" simple] ["[2][0]" complex]] [/// @@ -39,7 +39,8 @@ [archive (.only Archive)]]]]]]) (def (simple analysis) - (-> ///simple.Simple /simple.Simple) + (-> ///simple.Simple + /simple.Simple) (when analysis {///simple.#Unit} {/simple.#Text /.unit} @@ -59,16 +60,17 @@ [///simple.#Rev /simple.#I64]))) (def (optimization extender lux) - (-> Extender Lux Phase) + (-> Extender Lux + Phase) (function (phase archive analysis) (when analysis - [@ {///analysis.#Simple analysis'}] + [@ {analysis.#Simple analysis'}] (phase#in [@ {/.#Simple (..simple analysis')}]) - [@ {///analysis.#Reference reference}] + [@ {analysis.#Reference reference}] (phase#in [@ {/.#Reference reference}]) - [@ {///analysis.#Structure structure}] + [@ {analysis.#Structure structure}] (/.with_currying? false (when structure {///complex.#Variant variant} @@ -82,21 +84,21 @@ (monad.each phase.monad (phase archive)) (phase#each (|>> (/.tuple @)))))) - [@ {///analysis.#When inputA branchesAB+}] + [@ {analysis.#When inputA branchesAB+}] (/.with_currying? false (/when.synthesize @ phase branchesAB+ archive inputA)) - (///analysis.no_op @ value) + (analysis.no_op @ value) (phase archive value) - [@ {///analysis.#Apply _}] + [@ {analysis.#Apply _}] (/.with_currying? false (/function.apply @ phase archive analysis)) - [@ {///analysis.#Function environmentA bodyA}] + [@ {analysis.#Function environmentA bodyA}] (/function.abstraction @ phase environmentA archive bodyA) - [@ {///analysis.#Extension name parameters}] + [@ {analysis.#Extension name parameters}] (extension.application extender lux phase archive .Synthesis false name parameters (|>>) (function (_ _) @@ -106,7 +108,8 @@ ))) (def .public (phase extender lux archive analysis) - (-> Extender Lux Phase) + (-> Extender Lux + Phase) (do phase.monad [synthesis (..optimization extender lux archive analysis)] (phase.of_try (/variable.optimization synthesis)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux index 15afd0042..0c9b3b3ab 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Analysis Synthesis) + [lux (.except) [abstract ["[0]" monad (.only do)] ["[0]" enum]] @@ -25,9 +25,9 @@ ["[0]" // ["[1][0]" loop (.only Transform)] ["//[1]" /// + ["/" synthesis (.only Path Abstraction Operation Phase)] ["[0]" phase (.use "[1]#[0]" monad)] - ["/" synthesis (.only Path Abstraction Synthesis Operation Phase)] - ["[1][0]" analysis (.only Environment Analysis) + ["[0]" analysis (.only Environment) ["[1]/[0]" complex]] [/// [arity (.only Arity)] @@ -35,7 +35,7 @@ ["[1]/[0]" variable (.only Register Variable)]]]]]) (exception.def .public (cannot_find_foreign_variable_in_environment [foreign environment]) - (Exception [Register (Environment Synthesis)]) + (Exception [Register (Environment /.Term)]) (exception.report (list ["Foreign" (%.nat foreign)] ["Environment" (exception.listing /.%synthesis environment)]))) @@ -45,9 +45,10 @@ [(/.variable/local @ 0)])) (def .public (apply @ phase) - (-> Location Phase Phase) + (-> Location Phase + Phase) (function (_ archive exprA) - (let [[funcA argsA] (////analysis.reification exprA)] + (let [[funcA argsA] (analysis.reification exprA)] (do [! phase.monad] [funcS (phase archive funcA) argsS (monad.each ! (phase archive) argsA)] @@ -60,7 +61,8 @@ [locals /.locals] (in (|> functionS (//loop.optimization true locals argsS) - (maybe#each (is (-> [Nat (List Synthesis) Synthesis] Synthesis) + (maybe#each (is (-> [Nat (List /.Term) /.Term] + /.Term) (function (_ [start inits iteration]) (when iteration (/.loop/scope @ [start' inits' output]) @@ -81,7 +83,8 @@ (in <apply>))))))) (def (find_foreign environment register) - (-> (Environment Synthesis) Register (Operation Synthesis)) + (-> (Environment /.Term) Register + (Operation /.Term)) (when (list.item register environment) {.#Some aliased} (phase#in aliased) @@ -90,7 +93,8 @@ (phase.except ..cannot_find_foreign_variable_in_environment [register environment]))) (def (grow_path grow path) - (-> (-> Synthesis (Operation Synthesis)) Path (Operation Path)) + (-> (-> /.Term (Operation /.Term)) Path + (Operation Path)) (when path {/.#Bind register} (phase#in {/.#Bind (++ register)}) @@ -137,16 +141,17 @@ (phase#in path))) (def (grow environment expression) - (-> (Environment Synthesis) Synthesis (Operation Synthesis)) + (-> (Environment /.Term) /.Term + (Operation /.Term)) (when expression [@ {/.#Structure structure}] (when structure - {////analysis/complex.#Variant [lefts right? subS]} + {analysis/complex.#Variant [lefts right? subS]} (|> subS (grow environment) (phase#each (|>> [lefts right?] (/.variant @)))) - {////analysis/complex.#Tuple membersS+} + {analysis/complex.#Tuple membersS+} (|> membersS+ (monad.each phase.monad (grow environment)) (phase#each (|>> (/.tuple @))))) @@ -250,7 +255,8 @@ (phase#in expression))) (def .public (abstraction @ phase environment archive bodyA) - (-> Location Phase (Environment Analysis) Phase) + (-> Location Phase (Environment analysis.Term) + Phase) (do [! phase.monad] [environment (monad.each ! (phase archive) environment) bodyS (/.with_currying? true diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux index ac62f275a..27ce06b25 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis) + [lux (.except) [abstract ["[0]" monad (.only do)]] [control @@ -18,7 +18,7 @@ [macro ["^" pattern]]]]] [//// - ["/" synthesis (.only Path Abstraction Synthesis)] + ["/" synthesis (.only Path Abstraction)] ["[0]" analysis (.only Environment) ["[1]/[0]" complex]] [/// @@ -26,15 +26,19 @@ ["[0]" reference (.only) ["[0]" variable (.only Register Variable)]]]]) -(type .public (Transform a) - (-> a (Maybe a))) +(type .public (Transform of) + (-> of + (Maybe of))) (def .public (register_optimization offset) - (-> Register (-> Register Register)) + (-> Register + (-> Register + Register)) (|>> -- (n.+ offset))) (def (path_optimization body_optimization offset) - (-> (Transform Synthesis) Register (Transform Path)) + (-> (Transform /.Term) Register + (Transform Path)) (function (again path) (when path {/.#Bind register} @@ -82,7 +86,8 @@ {.#Some path}))) (def (body_optimization true_loop? offset scope_environment arity expr) - (-> Bit Register (Environment Synthesis) Arity (Transform Synthesis)) + (-> Bit Register (Environment /.Term) Arity + (Transform /.Term)) (loop (again [return? true expr expr]) (when expr @@ -195,7 +200,8 @@ (do [! maybe.monad] [input (again false input) matches (monad.each ! - (is (-> Synthesis (Maybe Synthesis)) + (is (-> /.Term + (Maybe /.Term)) (function (_ match) (when match [@ {/.#Structure {analysis/complex.#Tuple (list when then)}}] @@ -217,7 +223,8 @@ (maybe#each (|>> [name] {/.#Extension} [@])))))) (def .public (optimization true_loop? offset inits functionS) - (-> Bit Register (List Synthesis) Abstraction (Maybe [Register (List Synthesis) Synthesis])) + (-> Bit Register (List /.Term) Abstraction + (Maybe [Register (List /.Term) /.Term])) (|> (the /.#body functionS) (body_optimization true_loop? offset (the /.#environment functionS) (the /.#arity functionS)) (maybe#each (|>> [offset inits])))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux index 2ceb5d95e..fd49b0350 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis) + [lux (.except) [abstract ["[0]" monad (.only do)]] [control @@ -27,7 +27,7 @@ [//// ["[0]" analysis (.only) ["[1]/[0]" complex]] - ["/" synthesis (.only Path Synthesis) + ["/" synthesis (.only Path) ["[1][0]" access]] [/// [arity (.only Arity)] @@ -35,16 +35,19 @@ ["[0]" variable (.only Register Variable)]]]]) (def (prune redundant register) - (-> Register Register Register) + (-> Register Register + Register) (if (n.> redundant register) (-- register) register)) (type (Remover a) - (-> Register (-> a a))) + (-> Register + (-> a a))) (def (remove_local_from_path remove_local redundant) - (-> (Remover Synthesis) (Remover Path)) + (-> (Remover /.Term) + (Remover Path)) (function (again path) (when path {/.#Seq {/.#Bind register} @@ -112,7 +115,7 @@ variable)) (def (remove_local redundant) - (Remover Synthesis) + (Remover /.Term) (function (again synthesis) (when synthesis [@ {/.#Simple _}] @@ -190,7 +193,8 @@ (def necessary! false) (def (extended offset amount redundancy) - (-> Register Nat Redundancy [(List Register) Redundancy]) + (-> Register Nat Redundancy + [(List Register) Redundancy]) (let [extension (|> amount list.indices (list#each (n.+ offset)))] [extension (list#mix (function (_ register redundancy) @@ -199,14 +203,18 @@ extension)])) (def (default arity) - (-> Arity Redundancy) + (-> Arity + Redundancy) (product.right (..extended 0 (++ arity) ..initial))) -(type (Optimization a) - (-> [Redundancy a] (Try [Redundancy a]))) +(type (Optimization of) + (-> [Redundancy of] + (Try [Redundancy of]))) (def (list_optimization optimization) - (All (_ a) (-> (Optimization a) (Optimization (List a)))) + (All (_ of) + (-> (Optimization of) + (Optimization (List of)))) (function (again [redundancy values]) (when values {.#End} @@ -231,7 +239,8 @@ ) (def (declare register redundancy) - (-> Register Redundancy (Try Redundancy)) + (-> Register Redundancy + (Try Redundancy)) (when (dictionary.value register redundancy) {.#None} {try.#Success (dictionary.has register ..redundant! redundancy)} @@ -240,7 +249,8 @@ (exception.except ..redundant_declaration [register]))) (def (observe register redundancy) - (-> Register Redundancy (Try Redundancy)) + (-> Register Redundancy + (Try Redundancy)) (when (dictionary.value register redundancy) {.#None} (exception.except ..unknown_register [register]) @@ -257,7 +267,8 @@ (text.interposed ", "))) (def (path_optimization optimization) - (-> (Optimization Synthesis) (Optimization Path)) + (-> (Optimization /.Term) + (Optimization Path)) (function (again [redundancy path]) (when path (^.or {/.#Pop} @@ -335,7 +346,7 @@ ))) (def (optimization' [redundancy synthesis]) - (Optimization Synthesis) + (Optimization /.Term) (with_expansions [<no_op> (these {try.#Success [redundancy synthesis]})] (when synthesis @@ -455,7 +466,8 @@ [@ {/.#Extension name inputs}]]))))) (def .public optimization - (-> Synthesis (Try Synthesis)) + (-> /.Term + (Try /.Term)) (|>> [..initial] optimization' (of try.monad each product.right))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux index 03276a69a..fbe1a96b6 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Pattern Analysis Synthesis) + [lux (.except Pattern) [abstract [equivalence (.only Equivalence)] ["[0]" monad (.only do)]] @@ -27,11 +27,11 @@ ["[0]" /// [// ["[0]" phase (.use "[1]#[0]" monad)] - ["[1][0]" analysis (.only Match Analysis) + ["[0]" analysis (.only Match) ["[2][0]" simple] ["[2][0]" complex] ["[2][0]" pattern (.only Pattern)]] - ["/" synthesis (.only Path Synthesis Operation Phase) + ["/" synthesis (.only Path Operation Phase) ["[1][0]" access (.only) ["[2][0]" side] ["[2][0]" member (.only Member)]]] @@ -42,11 +42,13 @@ [archive (.only Archive)]]]]]) (def clean_up - (-> Path Path) + (-> Path + Path) (|>> {/.#Seq {/.#Pop}})) (def (path' pattern end? thenC) - (-> Pattern Bit (Operation Path) (Operation Path)) + (-> Pattern Bit (Operation Path) + (Operation Path)) (when pattern {///pattern.#Simple simple} (when simple @@ -107,13 +109,14 @@ )) (def (path archive synthesize pattern bodyA) - (-> Archive Phase Pattern Analysis (Operation Path)) + (-> Archive Phase Pattern analysis.Term + (Operation Path)) (path' pattern true (phase#each (|>> {/.#Then}) (synthesize archive bodyA)))) (def (weave_branch weave equivalence [new_test new_then] [[old_test old_then] old_tail]) - (All (_ a) - (-> (-> Path Path Path) (Equivalence a) [a Path] (/.Fork a Path) - (/.Fork a Path))) + (All (_ of) + (-> (-> Path Path Path) (Equivalence of) [of Path] (/.Fork of Path) + (/.Fork of Path))) (if (of equivalence = new_test old_test) [[old_test (weave new_then old_then)] old_tail] [[old_test old_then] @@ -125,9 +128,9 @@ {.#Item (weave_branch weave equivalence [new_test new_then] old_item)})])) (def (weave_fork weave equivalence new_fork old_fork) - (All (_ a) - (-> (-> Path Path Path) (Equivalence a) (/.Fork a Path) (/.Fork a Path) - (/.Fork a Path))) + (All (_ of) + (-> (-> Path Path Path) (Equivalence of) (/.Fork of Path) (/.Fork of Path) + (/.Fork of Path))) (list#mix (..weave_branch weave equivalence) old_fork {.#Item new_fork})) (def (weave new old) @@ -247,7 +250,8 @@ <failure>))))) (def .public (synthesize_when synthesize @ archive input [[headP headA] tailPA+]) - (-> Phase Location Archive Synthesis Match (Operation Synthesis)) + (-> Phase Location Archive /.Term Match + (Operation /.Term)) (do [! phase.monad] [headSP (path archive synthesize headP headA) tailSP+ (monad.each ! (product.uncurried (path archive synthesize)) tailPA+)] @@ -256,30 +260,34 @@ (def !masking (template (_ <@> <variable> <output>) [[[{///pattern.#Bind <variable>} - [<@> {///analysis.#Reference (///reference.local <output>)}]] + [<@> {analysis.#Reference (///reference.local <output>)}]] (list)]])) (def .public (synthesize_exec synthesize @ archive before after) - (-> Phase Location Archive Synthesis Analysis (Operation Synthesis)) + (-> Phase Location Archive /.Term analysis.Term + (Operation /.Term)) (do phase.monad [after (synthesize archive after)] (in (/.branch/exec @ [before after])))) (def .public (synthesize_let synthesize @ archive input @variable body) - (-> Phase Location Archive Synthesis Register Analysis (Operation Synthesis)) + (-> Phase Location Archive /.Term Register analysis.Term + (Operation /.Term)) (do phase.monad [body (/.with_new_local (synthesize archive body))] (in (/.branch/let @ [input @variable body])))) (def .public (synthesize_masking synthesize @ archive input @variable @output) - (-> Phase Location Archive Synthesis Register Register (Operation Synthesis)) + (-> Phase Location Archive /.Term Register Register + (Operation /.Term)) (if (n.= @variable @output) (phase#in input) - (..synthesize_let synthesize @ archive input @variable [@ {///analysis.#Reference (///reference.local @output)}]))) + (..synthesize_let synthesize @ archive input @variable [@ {analysis.#Reference (///reference.local @output)}]))) (def .public (synthesize_if synthesize @ archive test then else) - (-> Phase Location Archive Synthesis Analysis Analysis (Operation Synthesis)) + (-> Phase Location Archive /.Term analysis.Term analysis.Term + (Operation /.Term)) (do phase.monad [then (synthesize archive then) else (synthesize archive else)] @@ -288,11 +296,12 @@ (def !get (template (_ <@> <patterns> <output>) [[[(///pattern.tuple <patterns>) - [<@> {///analysis.#Reference (///reference.local <output>)}]] + [<@> {analysis.#Reference (///reference.local <output>)}]] (.list)]])) (def .public (synthesize_get synthesize @ archive input patterns @member) - (-> Phase Location Archive Synthesis (///complex.Tuple Pattern) Register (Operation Synthesis)) + (-> Phase Location Archive /.Term (///complex.Tuple Pattern) Register + (Operation /.Term)) (when (..get patterns @member) {.#End} (..synthesize_when synthesize @ archive input (!get @ patterns @member)) @@ -306,7 +315,8 @@ (/.branch/get @ [path input]))))) (def .public (synthesize @ synthesize^ [headB tailB+] archive inputA) - (-> Location Phase Match Phase) + (-> Location Phase Match + Phase) (do [! phase.monad] [inputS (synthesize^ archive inputA)] (when [headB tailB+] @@ -316,9 +326,9 @@ [[(///pattern.unit) body] {.#End}] (when inputA - (^.or [@ {///analysis.#Simple _}] - [@ {///analysis.#Structure _}] - [@ {///analysis.#Reference _}]) + (^.or [@ {analysis.#Simple _}] + [@ {analysis.#Structure _}] + [@ {analysis.#Reference _}]) (synthesize^ archive body) _ @@ -346,7 +356,8 @@ (..synthesize_when synthesize^ @ archive inputS match)))) (def .public (count_pops path) - (-> Path [Nat Path]) + (-> Path + [Nat Path]) (when path (/.path/seq {/.#Pop} path') (let [[pops post_pops] (count_pops path')] @@ -375,7 +386,8 @@ ... to be created for it. ... Apply this trick to JS, Python et al. (def .public (storage path) - (-> Path Storage) + (-> Path + Storage) (loop (for_path [path path path_storage ..empty]) (when path diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/extension.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/extension.lux index 4c4a0116e..776b930eb 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/extension.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/extension.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis) + [lux (.except) [abstract ["[0]" monad (.only do)]] [control @@ -21,7 +21,6 @@ ["[0]" /// ["[1][0]" extension] [// - [synthesis (.only Synthesis)] ["[0]" phase] ["[0]" translation]]]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux index 7c1be318b..0d2b79c43 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis Declaration i64 left right) + [lux (.except Declaration i64 left right) [abstract ["[0]" monad (.only do)]] [control @@ -33,7 +33,7 @@ ["[1][0]" reference] ["//[1]" /// ["[0]" phase] - ["[1][0]" synthesis (.only Synthesis)] + ["[0]" synthesis] ["[1][0]" translation] [/// [reference @@ -62,36 +62,43 @@ [Bundle /////translation.Bundle] ) -(type .public (Translator i) - (-> Phase Archive i (Operation Expression))) +(type .public (Translator of) + (-> Phase Archive of + (Operation Expression))) (type .public Phase! - (-> Phase Archive Synthesis (Operation Statement))) + (-> Phase Archive synthesis.Term + (Operation Statement))) -(type .public (Translator! i) - (-> Phase! Phase Archive i (Operation Statement))) +(type .public (Translator! of) + (-> Phase! Phase Archive of + (Operation Statement))) (def .public high - (-> (I64 Any) (I64 Any)) + (-> (I64 Any) + (I64 Any)) (i64.right_shifted 32)) (def .public low - (-> (I64 Any) (I64 Any)) + (-> (I64 Any) + (I64 Any)) (let [mask (-- (i64.left_shifted 32 1))] (|>> (i64.and mask)))) (def .public unit Computation - (_.string /////synthesis.unit)) + (_.string synthesis.unit)) (def .public (flag value) - (-> Bit Computation) + (-> Bit + Computation) (if value (_.string "") _.null)) (def (feature name definition) - (-> Var (-> Var Expression) Statement) + (-> Var (-> Var Expression) + Statement) (_.define name (definition name))) (def .public with_vars @@ -132,7 +139,8 @@ inputsC (list#each code.local inputs) inputs_typesC (list#each (function.constant (` _.Expression)) inputs)] (in (list (` (def .public ((, g!name) (,* inputsC)) - (-> (,* inputs_typesC) Computation) + (-> (,* inputs_typesC) + Computation) (_.apply (, runtime_name) (list (,* inputsC))))) (` (def (, (code.local (format "@" name))) @@ -144,11 +152,13 @@ (, code))))))))))))))) (def length - (-> Expression Computation) + (-> Expression + Computation) (_.the "length")) (def last_index - (-> Expression Computation) + (-> Expression + Computation) (|>> ..length (_.- (_.i32 +1)))) (def (last_element tuple) @@ -201,7 +211,8 @@ ))))) (def .public (variant tag last? value) - (-> Expression Expression Expression Computation) + (-> Expression Expression Expression + Computation) (_.new ..variant//new (list tag last? value))) (runtime @@ -234,11 +245,13 @@ mismatch!))) (def left - (-> Expression Computation) + (-> Expression + Computation) (..variant (_.i32 +0) (flag #0))) (def right - (-> Expression Computation) + (-> Expression + Computation) (..variant (_.i32 +0) (flag #1))) (def none @@ -246,7 +259,8 @@ (..left ..unit)) (def some - (-> Expression Computation) + (-> Expression + Computation) ..right) (def runtime//structure @@ -298,7 +312,8 @@ ))))) (def .public (i64 high low) - (-> Expression Expression Computation) + (-> Expression Expression + Computation) (_.new ..i64::new (list high low))) (with_template [<name> <op>] @@ -320,16 +335,20 @@ (_.bit_not (_.the ..i64_low_field value))))) (def (cap_shift! shift) - (-> Var Statement) + (-> Var + Statement) (_.statement (_.set shift (|> shift (_.bit_and (_.i32 +63)))))) (def (no_shift! shift input) - (-> Var Var (-> Expression Expression)) + (-> Var Var + (-> Expression + Expression)) (_.? (|> shift (_.= (_.i32 +0))) input)) (def small_shift? - (-> Var Expression) + (-> Var + Expression) (|>> (_.< (_.i32 +32)))) (runtime @@ -582,7 +601,8 @@ )))) (def (i64::<= param subject) - (-> Expression Expression Expression) + (-> Expression Expression + Expression) (|> (i64::< param subject) (_.or (i64::= param subject)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm.lux index 4e47ca19b..6e5928be1 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis) + [lux (.except) [abstract [monad (.only do)]] [control @@ -38,7 +38,7 @@ ["[0]" extension] [// ["[0]" phase (.use "[1]#[0]" monad)] - ["[0]" synthesis (.only Synthesis)] + ["[0]" synthesis] ["[0]" translation] [/// ["[0]" reference]]]]]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/complex.lux index a449ffa45..c1ea98730 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/complex.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/complex.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Variant Tuple Synthesis) + [lux (.except Variant Tuple) [abstract ["[0]" monad (.only do)]] [control @@ -28,7 +28,7 @@ ["[1][0]" primitive] ["///[1]" //// ["[0]" phase] - ["[1][0]" synthesis (.only Synthesis)] + ["[0]" synthesis] [analysis [complex (.only Variant Tuple)]]]]) @@ -62,7 +62,7 @@ //runtime.left_right?)) (def .public (variant phase archive [lefts right? valueS]) - (Translator (Variant Synthesis)) + (Translator (Variant synthesis.Term)) (do phase.monad [valueI (phase archive valueS)] (in (do _.monad @@ -76,7 +76,7 @@ (list)])))))) (def .public (tuple phase archive membersS) - (Translator (Tuple Synthesis)) + (Translator (Tuple synthesis.Term)) (when membersS {.#End} (of phase.monad in //runtime.unit) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux index 9abd8bd85..0c4c6944b 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Type Label Synthesis with) + [lux (.except Type Label with) [abstract ["[0]" monad (.only do)]] [control @@ -64,7 +64,7 @@ [//// [analysis (.only Environment)] ["[0]" phase] - ["[0]" synthesis (.only Synthesis Abstraction Apply)] + ["[0]" synthesis (.only Abstraction Apply)] ["[0]" translation] [/// ["[0]" arity (.only Arity)] @@ -75,7 +75,7 @@ [variable (.only Register)]]]]]]) (def .public (with translate archive @begin class environment arity body) - (-> Phase Archive Label External (Environment Synthesis) Arity (Bytecode Any) + (-> Phase Archive Label External (Environment synthesis.Term) Arity (Bytecode Any) (Operation [(List (Resource Field)) (List (Resource Method)) (Bytecode Any)])) @@ -139,7 +139,7 @@ (in instance))) (def (apply/?' translate archive [abstractionG inputsS]) - (Translator [(Bytecode Any) (List Synthesis)]) + (Translator [(Bytecode Any) (List synthesis.Term)]) (do [! phase.monad] [inputsG (monad.each ! (translate archive) inputsS)] (in (all _.composite @@ -162,7 +162,7 @@ (apply/?' translate archive [abstractionG inputsS]))) (def (apply/= translate archive [$abstraction @abstraction arity inputsS]) - (Translator [Symbol unit.ID Arity (List Synthesis)]) + (Translator [Symbol unit.ID Arity (List synthesis.Term)]) (do [! phase.monad] [.let [:abstraction: (type.class (//runtime.class_name @abstraction) (list))] abstractionG (//reference.constant archive $abstraction) @@ -174,7 +174,7 @@ )))) (def (apply/> translate archive [$abstraction @abstraction arity inputsS]) - (Translator [Symbol unit.ID Arity (List Synthesis)]) + (Translator [Symbol unit.ID Arity (List synthesis.Term)]) (do [! phase.monad] [=G (apply/= translate archive [$abstraction @abstraction arity (list.first arity inputsS)])] (apply/?' translate archive [=G (list.after arity inputsS)]))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/foreign.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/foreign.lux index 5a4102c66..ec17663b7 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/foreign.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/foreign.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Type Synthesis) + [lux (.except Type) [data [collection ["[0]" list]]] @@ -22,23 +22,27 @@ ["[1][0]" reference] [//// [analysis (.only Environment)] - [synthesis (.only Synthesis)] + ["[0]" synthesis] [/// [reference [variable (.only Register)]]]]]]) (def .public (closure environment) - (-> (Environment Synthesis) (List (Type Value))) + (-> (Environment synthesis.Term) + (List (Type Value))) (list.repeated (list.size environment) //.type)) (def .public (get class register) - (-> (Type Class) Register (Bytecode Any)) + (-> (Type Class) Register + (Bytecode Any)) (//.get class (/////reference.foreign_name register))) (def .public (put class register value) - (-> (Type Class) Register (Bytecode Any) (Bytecode Any)) + (-> (Type Class) Register (Bytecode Any) + (Bytecode Any)) (//.put /////reference.foreign_name class register value)) (def .public variables - (-> (Environment Synthesis) (List (Resource Field))) + (-> (Environment synthesis.Term) + (List (Resource Field))) (|>> list.size (//.variables /////reference.foreign_name))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/apply.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/apply.lux index 88e01522c..ceb7ee756 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/apply.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/apply.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Type Label Synthesis) + [lux (.except Type Label) [abstract ["[0]" monad (.only do)]] [control @@ -47,20 +47,22 @@ ["[1][0]" reference] [//// [analysis (.only Environment)] - [synthesis (.only Synthesis)] + ["[0]" synthesis] [/// [arity (.only Arity)] [reference [variable (.only Register)]]]]]]]) (def (increment by) - (-> Nat (Bytecode Any)) + (-> Nat + (Bytecode Any)) (all _.composite (<| _.int .i64 by) _.iadd)) (def (inputs offset amount) - (-> Register Nat (Bytecode Any)) + (-> Register Nat + (Bytecode Any)) (all _.composite (|> amount list.indices @@ -69,7 +71,8 @@ )) (def (apply offset amount) - (-> Register Nat (Bytecode Any)) + (-> Register Nat + (Bytecode Any)) (let [arity (n.min amount ///arity.maximum)] (all _.composite (_.checkcast ///abstract.class) @@ -84,7 +87,8 @@ (def this_offset 1) (def .public (method class environment function_arity @begin apply_arity) - (-> (Type Class) (Environment Synthesis) Arity Label Arity (Resource Method)) + (-> (Type Class) (Environment synthesis.Term) Arity Label Arity + (Resource Method)) (let [num_partials (-- function_arity) over_extent (i.- (.int apply_arity) (.int function_arity))] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/init.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/init.lux index 0c12de66f..6e03e095b 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/init.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/init.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Type Synthesis type) + [lux (.except Type type) [abstract ["[0]" monad]] [control @@ -41,7 +41,7 @@ ["[1][0]" reference] [//// [analysis (.only Environment)] - [synthesis (.only Synthesis)] + ["[0]" synthesis] [/// ["[0]" arity (.only Arity)] [reference @@ -50,11 +50,13 @@ (def .public name "<init>") (def (partials arity) - (-> Arity (List (Type Value))) + (-> Arity + (List (Type Value))) (list.repeated (-- arity) ////type.value)) (def .public (type environment arity) - (-> (Environment Synthesis) Arity (Type category.Method)) + (-> (Environment synthesis.Term) Arity + (Type category.Method)) (type.method [(list) (list#composite (///foreign.closure environment) (if (arity.multiary? arity) @@ -70,7 +72,8 @@ _.bipush)) (def .public (super environment_size arity) - (-> Nat Arity (Bytecode Any)) + (-> Nat Arity + (Bytecode Any)) (let [arity_register (++ environment_size)] (all _.composite (if (arity.unary? arity) @@ -90,7 +93,8 @@ (monad.all _.monad))) (def .public (method class environment arity) - (-> (Type Class) (Environment Synthesis) Arity (Resource Method)) + (-> (Type Class) (Environment synthesis.Term) Arity + (Resource Method)) (let [environment_size (list.size environment) offset_foreign (is (-> Register Register) (n.+ 1)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/new.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/new.lux index 79ead2fef..d8f6c6dc8 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/new.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/new.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Type Synthesis) + [lux (.except Type) [abstract ["[0]" monad (.only do)]] [data @@ -42,13 +42,14 @@ ["[1][0]" reference] [//// [analysis (.only Environment)] - [synthesis (.only Synthesis)] + ["[0]" synthesis] ["[0]" phase] [/// ["[0]" arity (.only Arity)]]]]]]) (def .public (instance' foreign_setup class environment arity) - (-> (List (Bytecode Any)) (Type Class) (Environment Synthesis) Arity (Bytecode Any)) + (-> (List (Bytecode Any)) (Type Class) (Environment synthesis.Term) Arity + (Bytecode Any)) (all _.composite (_.new class) _.dup @@ -57,13 +58,15 @@ (_.invokespecial class //init.name (//init.type environment arity)))) (def .public (instance translate archive class environment arity) - (-> Phase Archive (Type Class) (Environment Synthesis) Arity (Operation (Bytecode Any))) + (-> Phase Archive (Type Class) (Environment synthesis.Term) Arity + (Operation (Bytecode Any))) (do [! phase.monad] [foreign* (monad.each ! (translate archive) environment)] (in (instance' foreign* class environment arity)))) (def .public (method class environment arity) - (-> (Type Class) (Environment Synthesis) Arity (Resource Method)) + (-> (Type Class) (Environment synthesis.Term) Arity + (Resource Method)) (let [after_this (is (-> Nat Nat) (n.+ 1)) environment_size (list.size environment) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/reset.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/reset.lux index cba2ab708..0ac6a86a6 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/reset.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/reset.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Type Synthesis type) + [lux (.except Type type) [data [collection ["[0]" list (.use "[1]#[0]" functor)]]] @@ -27,24 +27,27 @@ ["[1][0]" reference] [//// [analysis (.only Environment)] - [synthesis (.only Synthesis)] + ["[0]" synthesis] [/// ["[0]" arity (.only Arity)]]]]]]) (def .public name "reset") (def .public (type class) - (-> (Type Class) (Type category.Method)) + (-> (Type Class) + (Type category.Method)) (type.method [(list) (list) class (list)])) (def (current_environment class) - (-> (Type Class) (Environment Synthesis) (List (Bytecode Any))) + (-> (Type Class) (Environment synthesis.Term) + (List (Bytecode Any))) (|>> list.size list.indices (list#each (///foreign.get class)))) (def .public (method class environment arity) - (-> (Type Class) (Environment Synthesis) Arity (Resource Method)) + (-> (Type Class) (Environment synthesis.Term) Arity + (Resource Method)) (method.method //.modifier ..name false (..type class) (list) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/loop.lux index 7ecbfabf8..329927b09 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/loop.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis) + [lux (.except) [abstract ["[0]" monad (.only do)]] [control @@ -25,14 +25,15 @@ ["[1][0]" value] [//// ["[0]" phase] - ["[0]" synthesis (.only Path Synthesis)] + ["[0]" synthesis (.only Path)] ["[0]" translation] [/// [reference [variable (.only Register)]]]]]) (def (invariant? register changeS) - (-> Register Synthesis Bit) + (-> Register synthesis.Term + Bit) (when changeS (synthesis.variable/local @ var) (n.= register var) @@ -44,7 +45,7 @@ (_#in [])) (def .public (again translate archive updatesS) - (Translator (List Synthesis)) + (Translator (List synthesis.Term)) (do [! phase.monad] [[@begin offset] translation.anchor updatesG (|> updatesS @@ -78,7 +79,7 @@ (_.goto @begin))))) (def .public (scope translate archive [offset initsS+ iterationS]) - (Translator [Nat (List Synthesis) Synthesis]) + (Translator [Nat (List synthesis.Term) synthesis.Term]) (do [! phase.monad] [@begin //runtime.forge_label initsI+ (monad.each ! (translate archive) initsS+) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux index 558353ad8..a21bfc7e3 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Type Label Synthesis if let exec when int) + [lux (.except Type Label if let exec when int) [abstract ["[0]" monad (.only do)]] [control @@ -37,7 +37,7 @@ [//// ["[0]" phase (.use "operation#[0]" monad)] ["[0]" translation] - ["[0]" synthesis (.only Path Fork Synthesis) + ["[0]" synthesis (.only Path Fork) [access ["[0]" member (.only Member)]]] [/// @@ -45,7 +45,8 @@ [variable (.only Register)]]]]]) (def (pop_alt stack_depth) - (-> Nat (Bytecode Any)) + (-> Nat + (Bytecode Any)) (.when stack_depth 0 (_#in []) 1 _.pop @@ -56,11 +57,13 @@ (pop_alt (n.- 2 stack_depth))))) (def int - (-> (I64 Any) (Bytecode Any)) + (-> (I64 Any) + (Bytecode Any)) (|>> .i64 i32.i32 _.int)) (def long - (-> (I64 Any) (Bytecode Any)) + (-> (I64 Any) + (Bytecode Any)) (|>> .int _.long)) (def peek @@ -76,7 +79,8 @@ (_.checkcast //type.stack))) (def (left_projection lefts) - (-> Nat (Bytecode Any)) + (-> Nat + (Bytecode Any)) (all _.composite (_.checkcast //type.tuple) (..int lefts) @@ -88,7 +92,8 @@ //runtime.left_projection))) (def (right_projection lefts) - (-> Nat (Bytecode Any)) + (-> Nat + (Bytecode Any)) (all _.composite (_.checkcast //type.tuple) (..int lefts) @@ -100,7 +105,8 @@ (_.invokevirtual class "equals" method))) (def (path|bind register) - (-> Register (Operation (Bytecode Any))) + (-> Register + (Operation (Bytecode Any))) (operation#in (all _.composite ..peek (_.astore register)))) @@ -163,7 +169,8 @@ ) (def (path' stack_depth @else @end phase archive) - (-> Nat Label Label (Translator Path)) + (-> Nat Label Label + (Translator Path)) (function (again path) (.when path {synthesis.#Pop} @@ -248,7 +255,8 @@ ))) (def (path @end phase archive path) - (-> Label (Translator Path)) + (-> Label + (Translator Path)) (do phase.monad [@else //runtime.forge_label path! (..path' 1 @else @end phase archive path)] @@ -263,7 +271,7 @@ )))) (def .public (if phase archive [testS thenS elseS]) - (Translator [Synthesis Synthesis Synthesis]) + (Translator [synthesis.Term synthesis.Term synthesis.Term]) (do phase.monad [test! (phase archive testS) then! (phase archive thenS) @@ -283,7 +291,7 @@ (_.set_label @end))))))) (def .public (exec phase archive [this that]) - (Translator [Synthesis Synthesis]) + (Translator [synthesis.Term synthesis.Term]) (do phase.monad [this! (phase archive this) that! (phase archive that)] @@ -293,7 +301,7 @@ that!)))) (def .public (let phase archive [inputS register bodyS]) - (Translator [Synthesis Register Synthesis]) + (Translator [synthesis.Term Register synthesis.Term]) (do phase.monad [input! (phase archive inputS) body! (phase archive bodyS)] @@ -303,7 +311,7 @@ body!)))) (def .public (get phase archive [path recordS]) - (Translator [(List Member) Synthesis]) + (Translator [(List Member) synthesis.Term]) (do phase.monad [record! (phase archive recordS)] (in (list#mix (function (_ step so_far!) @@ -317,7 +325,7 @@ path)))) (def .public (when phase archive [valueS path]) - (Translator [Synthesis Path]) + (Translator [synthesis.Term Path]) (do phase.monad [@end //runtime.forge_label value! (phase archive valueS) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux index 0363cfbbb..8d264ecab 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Label Location Synthesis Declaration left right) + [lux (.except Label Location Declaration left right) [abstract ["[0]" monad (.only do)]] [control @@ -33,7 +33,7 @@ ["[1][0]" reference] ["//[1]" /// ["[0]" phase] - ["[1][0]" synthesis (.only Synthesis)] + ["[0]" synthesis] ["[1][0]" translation] ["//[1]" /// (.only) [reference @@ -62,20 +62,24 @@ [Bundle /////translation.Bundle] ) -(type .public (Translator i) - (-> Phase Archive i (Operation Expression))) +(type .public (Translator of) + (-> Phase Archive of + (Operation Expression))) (type .public Phase! - (-> Phase Archive Synthesis (Operation Statement))) + (-> Phase Archive synthesis.Term + (Operation Statement))) -(type .public (Translator! i) - (-> Phase! Phase Archive i (Operation Statement))) +(type .public (Translator! of) + (-> Phase! Phase Archive of + (Operation Statement))) (def .public unit - (_.string /////synthesis.unit)) + (_.string synthesis.unit)) (def (flag value) - (-> Bit Literal) + (-> Bit + Literal) (if value ..unit _.nil)) @@ -85,23 +89,27 @@ (def .public variant_value_field "_lux_value") (def (variant' tag last? value) - (-> Expression Expression Expression Literal) + (-> Expression Expression Expression + Literal) (_.table (list [..variant_tag_field tag] [..variant_flag_field last?] [..variant_value_field value]))) (def .public (variant tag last? value) - (-> Nat Bit Expression Literal) + (-> Nat Bit Expression + Literal) (variant' (_.int (.int tag)) (flag last?) value)) (def .public left - (-> Expression Literal) + (-> Expression + Literal) (..variant 0 #0)) (def .public right - (-> Expression Literal) + (-> Expression + Literal) (..variant 0 #1)) (def .public none @@ -109,11 +117,13 @@ (..left ..unit)) (def .public some - (-> Expression Literal) + (-> Expression + Literal) ..right) (def (feature name definition) - (-> Var (-> Var Statement) Statement) + (-> Var (-> Var Statement) + Statement) (definition name)) (def .public with_vars @@ -163,7 +173,8 @@ inputs_typesC (list#each (function.constant (` _.Expression)) inputs)] (in (list (` (def .public ((, g!name) (,* inputsC)) - (-> (,* inputs_typesC) Computation) + (-> (,* inputs_typesC) + Computation) (_.apply (list (,* inputsC)) (, runtime_name)))) (` (def (, (code.local (format "@" name))) @@ -175,7 +186,8 @@ (, code))))))))))))))))) (def (item index table) - (-> Expression Expression Location) + (-> Expression Expression + Location) (_.item (_.+ (_.int +1) index) table)) (def last_index @@ -340,21 +352,25 @@ )) (def (find_byte_index subject param start) - (-> Expression Expression Expression Expression) + (-> Expression Expression Expression + Expression) (_.apply (list subject param start (_.boolean #1)) (_.var "string.find"))) (def (char_index subject byte_index) - (-> Expression Expression Expression) + (-> Expression Expression + Expression) (_.apply (list subject (_.int +1) byte_index) (_.var "utf8.len"))) (def (byte_index subject char_index) - (-> Expression Expression Expression) + (-> Expression Expression + Expression) (_.apply (list subject (_.+ (_.int +1) char_index)) (_.var "utf8.offset"))) (def lux_index - (-> Expression Expression) + (-> Expression + Expression) (_.- (_.int +1))) ... TODO: Remove this once the Lua compiler becomes self-hosted. diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/runtime.lux index 96258bfb7..84f87938d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/runtime.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis Declaration ++ left right) + [lux (.except Declaration ++ left right) [abstract ["[0]" monad (.only do)]] [control @@ -35,7 +35,7 @@ ["[1][0]" reference] ["//[1]" /// ["[0]" phase] - ["[1][0]" synthesis (.only Synthesis)] + ["[0]" synthesis] ["[1][0]" translation] [/// [reference @@ -65,42 +65,49 @@ ) (type .public Phase! - (-> Phase Archive Synthesis (Operation (Statement Any)))) + (-> Phase Archive synthesis.Term (Operation (Statement Any)))) -(type .public (Translator! i) - (-> Phase! Phase Archive i (Operation (Statement Any)))) +(type .public (Translator! of) + (-> Phase! Phase Archive of + (Operation (Statement Any)))) -(type .public (Translator i) - (-> Phase Archive i (Operation (Expression Any)))) +(type .public (Translator of) + (-> Phase Archive of + (Operation (Expression Any)))) (def prefix "LuxRuntime") (def .public unit - (_.unicode /////synthesis.unit)) + (_.unicode synthesis.unit)) (def (flag value) - (-> Bit Literal) + (-> Bit + Literal) (if value ..unit _.none)) (def (variant' tag last? value) - (-> (Expression Any) (Expression Any) (Expression Any) Literal) + (-> (Expression Any) (Expression Any) (Expression Any) + Literal) (_.tuple (list tag last? value))) (def .public (variant tag last? value) - (-> Nat Bit (Expression Any) Literal) + (-> Nat Bit (Expression Any) + Literal) (variant' (_.int (.int tag)) (flag last?) value)) (def .public left - (-> (Expression Any) Literal) + (-> (Expression Any) + Literal) (..variant 0 #0)) (def .public right - (-> (Expression Any) Literal) + (-> (Expression Any) + Literal) (..variant 0 #1)) (def .public none @@ -108,18 +115,21 @@ (..left ..unit)) (def .public some - (-> (Expression Any) Literal) + (-> (Expression Any) + Literal) ..right) (def (runtime_name name) - (-> Text SVar) + (-> Text + SVar) (let [symbol (format ..prefix "_" (%.nat version.latest) "_" (%.nat (text#hash name)))] (_.var symbol))) (def (feature name definition) - (-> SVar (-> SVar (Statement Any)) (Statement Any)) + (-> SVar (-> SVar (Statement Any)) + (Statement Any)) (definition name)) (def .public with_vars @@ -162,7 +172,8 @@ inputs_typesC (list#each (function.constant (` (_.Expression Any))) inputs)] (in (list (` (def .public ((, nameC) (,* inputsC)) - (-> (,* inputs_typesC) (Computation Any)) + (-> (,* inputs_typesC) + (Computation Any)) (_.apply (list (,* inputsC)) (, runtime_nameC)))) (` (def (, code_nameC) (Statement Any) @@ -445,7 +456,8 @@ (|>> (_.+ (_.int +1)))) (def (within? top value) - (-> (Expression Any) (Expression Any) (Computation Any)) + (-> (Expression Any) (Expression Any) + (Computation Any)) (_.and (|> value (_.>= (_.int +0))) (|> value (_.< top)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/runtime.lux index 82e4c20ce..4e6ff18dd 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/runtime.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis Declaration i64 left right) + [lux (.except Declaration i64 left right) [abstract ["[0]" monad (.only do)]] [control @@ -34,7 +34,7 @@ ["[1][0]" reference] ["//[1]" /// ["[0]" phase] - ["[1][0]" synthesis (.only Synthesis)] + ["[0]" synthesis] ["[1][0]" translation] [/// [reference @@ -63,20 +63,24 @@ [Bundle /////translation.Bundle] ) -(type .public (Translator i) - (-> Phase Archive i (Operation Expression))) +(type .public (Translator of) + (-> Phase Archive of + (Operation Expression))) (type .public Phase! - (-> Phase Archive Synthesis (Operation Statement))) + (-> Phase Archive synthesis.Term + (Operation Statement))) -(type .public (Translator! i) - (-> Phase! Phase Archive i (Operation Statement))) +(type .public (Translator! of) + (-> Phase! Phase Archive of + (Operation Statement))) (def .public unit - (_.string /////synthesis.unit)) + (_.string synthesis.unit)) (def (flag value) - (-> Bit Literal) + (-> Bit + Literal) (if value ..unit _.nil)) @@ -150,7 +154,8 @@ inputs_typesC (list#each (function.constant (` _.Expression)) inputs)] (in (list (` (def .public ((, g!name) (,* inputsC)) - (-> (,* inputs_typesC) Computation) + (-> (,* inputs_typesC) + Computation) (_.apply (list (,* inputsC)) {.#None} (, runtime_name)))) @@ -170,7 +175,8 @@ (_.the "length")) (def last_index - (|>> ..tuple_size (_.- (_.int +1)))) + (|>> ..tuple_size + (_.- (_.int +1)))) (with_expansions [<recur> (these (all _.then (_.set (list lefts) (_.- last_index_right lefts)) @@ -213,15 +219,18 @@ [(_.string ..variant_value_field) value])))) (def .public (variant tag last? value) - (-> Nat Bit Expression Computation) + (-> Nat Bit Expression + Computation) (sum//make (_.int (.int tag)) (..flag last?) value)) (def .public left - (-> Expression Computation) + (-> Expression + Computation) (..variant 0 #0)) (def .public right - (-> Expression Computation) + (-> Expression + Computation) (..variant 0 #1)) (def .public none @@ -229,7 +238,8 @@ (..left ..unit)) (def .public some - (-> Expression Computation) + (-> Expression + Computation) ..right) (runtime @@ -299,10 +309,8 @@ (def i64::+cap (_.manual "+0x8000000000000000")) (def i64::-cap (_.manual "-0x8000000000000001")) -(runtime - i64::+iteration (_.manual "(+1<<64)")) -(runtime - i64::-iteration (_.manual "(-1<<64)")) +(runtime i64::+iteration (_.manual "(+1<<64)")) +(runtime i64::-iteration (_.manual "(-1<<64)")) (runtime (i64::i64 input) @@ -364,16 +372,20 @@ ) (def (cap_shift! shift) - (-> LVar Statement) + (-> LVar + Statement) (_.set (list shift) (|> shift (_.bit_and (_.int +63))))) (def (handle_no_shift! shift input) - (-> LVar LVar (-> Statement Statement)) + (-> LVar LVar + (-> Statement + Statement)) (_.if (|> shift (_.= (_.int +0))) (_.return input))) (def small_shift? - (-> LVar Expression) + (-> LVar + Expression) (|>> (_.< (_.int +32)))) (runtime @@ -572,7 +584,8 @@ (_.return (..some idx)))))) (def (within? top value) - (-> Expression Expression Computation) + (-> Expression Expression + Computation) (_.and (|> value (_.>= (_.int +0))) (|> value (_.< top)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux index b70974616..2006f836f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Scope Analysis Synthesis #Function #Apply #locals i64) + [lux (.except Scope #Function #Apply #locals i64) [abstract [monad (.only do)] [equivalence (.only Equivalence)] @@ -34,7 +34,7 @@ ["[2][0]" side (.only Side)] ["[2][0]" member (.only Member)]] [// - ["[0]" analysis (.only Environment Analysis) + ["[0]" analysis (.only Environment) ["[1]/[0]" complex (.only Complex)]] ["[0]" phase (.only) ["[0]" extension (.only Extension)]] @@ -124,8 +124,8 @@ {#Loop (Loop s)} {#Function (Function s)})) -(with_expansions [@ ($ (Synthesis' $))] - (type .public (Synthesis' $) +(with_expansions [@ ($ (Term' $))] + (type .public (Term' $) (Variant {#Simple Simple} {#Structure (Complex @)} @@ -133,19 +133,19 @@ {#Control (Control @)} {#Extension (Extension @)}))) -(type .public Synthesis +(type .public Term (Ann Location - (Synthesis' (Ann Location)))) + (Term' (Ann Location)))) (type .public Operation (phase.Operation State)) (type .public Phase - (phase.Phase State Analysis Synthesis)) + (phase.Phase State analysis.Term Term)) (with_template [<special> <general>] [(type .public <special> - (<general> ..State Analysis Synthesis))] + (<general> ..State analysis.Term Term))] [Handler extension.Handler] [Bundle extension.Bundle] @@ -153,7 +153,7 @@ ) (type .public Path - (Path' Synthesis)) + (Path' Term)) (def .public path/pop Path @@ -213,10 +213,10 @@ ) (type .public Abstraction - (Abstraction' Synthesis)) + (Abstraction' Term)) (type .public Apply - (Apply' Synthesis)) + (Apply' Term)) (def .public unit Text @@ -224,7 +224,10 @@ (with_template [<with> <query> <tag> <type>] [(def .public (<with> value) - (-> <type> (All (_ a) (-> (Operation a) (Operation a)))) + (-> <type> + (All (_ of) + (-> (Operation of) + (Operation of)))) (phase.temporary (has <tag> value))) (def .public <query> @@ -236,7 +239,9 @@ ) (def .public with_new_local - (All (_ a) (-> (Operation a) (Operation a))) + (All (_ of) + (-> (Operation of) + (Operation of))) (<<| (do phase.monad [locals ..locals]) (..with_locals (++ locals)))) @@ -301,7 +306,9 @@ ) (def .public (%path' %then value) - (All (_ a) (-> (Format a) (Format (Path' a)))) + (All (_ of) + (-> (Format of) + (Format (Path' of)))) (when value {#Pop} "_" @@ -345,7 +352,7 @@ (text.enclosed ["(! " ")"])))) (def .public (%synthesis [_ value]) - (Format Synthesis) + (Format Term) (when value {#Simple it} (/simple.format it) @@ -437,7 +444,9 @@ (%path' %synthesis)) (def .public (path'_equivalence equivalence) - (All (_ a) (-> (Equivalence a) (Equivalence (Path' a)))) + (All (_ of) + (-> (Equivalence of) + (Equivalence (Path' of)))) (implementation (def (= reference sample) (when [reference sample] @@ -480,7 +489,9 @@ false)))) (def (path'_hash super) - (All (_ a) (-> (Hash a) (Hash (Path' a)))) + (All (_ of) + (-> (Hash of) + (Hash (Path' of)))) (implementation (def equivalence (..path'_equivalence (of super equivalence))) @@ -525,7 +536,9 @@ )))) (def (branch_equivalence (open "#[0]")) - (All (_ a) (-> (Equivalence a) (Equivalence (Branch a)))) + (All (_ of) + (-> (Equivalence of) + (Equivalence (Branch of)))) (implementation (def (= reference sample) (when [reference sample] @@ -555,7 +568,9 @@ false)))) (def (branch_hash super) - (All (_ a) (-> (Hash a) (Hash (Branch a)))) + (All (_ of) + (-> (Hash of) + (Hash (Branch of)))) (implementation (def equivalence (..branch_equivalence (of super equivalence))) @@ -591,7 +606,9 @@ )))) (def (loop_equivalence (open "/#[0]")) - (All (_ a) (-> (Equivalence a) (Equivalence (Loop a)))) + (All (_ of) + (-> (Equivalence of) + (Equivalence (Loop of)))) (implementation (def (= reference sample) (when [reference sample] @@ -608,7 +625,9 @@ false)))) (def (loop_hash super) - (All (_ a) (-> (Hash a) (Hash (Loop a)))) + (All (_ of) + (-> (Hash of) + (Hash (Loop of)))) (implementation (def equivalence (..loop_equivalence (of super equivalence))) @@ -627,7 +646,9 @@ )))) (def (function_equivalence (open "#[0]")) - (All (_ a) (-> (Equivalence a) (Equivalence (Function a)))) + (All (_ of) + (-> (Equivalence of) + (Equivalence (Function of)))) (implementation (def (= reference sample) (when [reference sample] @@ -646,7 +667,9 @@ false)))) (def (function_hash super) - (All (_ a) (-> (Hash a) (Hash (Function a)))) + (All (_ of) + (-> (Hash of) + (Hash (Function of)))) (implementation (def equivalence (..function_equivalence (of super equivalence))) @@ -666,7 +689,9 @@ )))) (def (control_equivalence (open "#[0]")) - (All (_ a) (-> (Equivalence a) (Equivalence (Control a)))) + (All (_ of) + (-> (Equivalence of) + (Equivalence (Control of)))) (implementation (def (= reference sample) (when [reference sample] @@ -681,7 +706,9 @@ false)))) (def (control_hash super) - (All (_ a) (-> (Hash a) (Hash (Control a)))) + (All (_ of) + (-> (Hash of) + (Hash (Control of)))) (implementation (def equivalence (..control_equivalence (of super equivalence))) @@ -697,7 +724,7 @@ )))) (def .public equivalence - (Equivalence Synthesis) + (Equivalence Term) (implementation (def (= [_ reference] [_ sample]) (when [reference sample] @@ -718,7 +745,7 @@ (path'_equivalence equivalence)) (def .public hash - (Hash Synthesis) + (Hash Term) (implementation (def equivalence ..equivalence) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux b/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux index 2cd017197..0bf955402 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis #module #counter #host #location symbol) + [lux (.except #module #counter #host #location symbol) [abstract [monad (.only do)]] [control @@ -28,7 +28,7 @@ ["^" pattern] ["[0]" template]]]]] [// - [synthesis (.only Synthesis)] + ["[0]" synthesis] ["[0]" phase (.only) ["[0]" extension]] [/// @@ -98,11 +98,11 @@ (phase.Operation (State anchor expression declaration))) (type .public (Phase anchor expression declaration) - (phase.Phase (State anchor expression declaration) Synthesis expression)) + (phase.Phase (State anchor expression declaration) synthesis.Term expression)) (with_template [<special> <general>] [(type .public (<special> anchor expression declaration) - (<general> (State anchor expression declaration) Synthesis expression))] + (<general> (State anchor expression declaration) synthesis.Term expression))] [Handler extension.Handler] [Bundle extension.Bundle] diff --git a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux index 39b6a76d4..d6b3e055e 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux @@ -4,7 +4,7 @@ ... https://en.wikipedia.org/wiki/Tree_shaking (.require [library - [lux (.except Synthesis all) + [lux (.except all) [abstract [hash (.only Hash)] ["[0]" monad (.only do)]] @@ -27,7 +27,7 @@ [language [lux ["[0]" phase] - ["[0]" synthesis (.only Synthesis Path)] + ["[0]" synthesis (.only Path)] ["[0]" translation (.only Operation)] ["[0]" analysis ["[1]/[0]" complex]]]] @@ -38,7 +38,7 @@ ["[0]" unit]]]]]]]) (def (path_references references) - (-> (-> Synthesis (List Constant)) + (-> (-> synthesis.Term (List Constant)) (-> Path (List Constant))) (function (again path) (when path @@ -78,7 +78,8 @@ (references then)))) (def (references [_ value]) - (-> Synthesis (List Constant)) + (-> synthesis.Term + (List Constant)) (when value {synthesis.#Simple value} (list) @@ -166,7 +167,8 @@ (def .public (dependencies archive value) (All (_ anchor expression declaration) - (-> Archive Synthesis (Operation anchor expression declaration (Set unit.ID)))) + (-> Archive synthesis.Term + (Operation anchor expression declaration (Set unit.ID)))) (let [! phase.monad] (|> value ..references @@ -177,7 +179,8 @@ (def .public (path_dependencies archive value) (All (_ anchor expression declaration) - (-> Archive Path (Operation anchor expression declaration (Set unit.ID)))) + (-> Archive Path + (Operation anchor expression declaration (Set unit.ID)))) (let [! phase.monad] (|> value (..path_references ..references) @@ -192,8 +195,9 @@ (list#mix set.union unit.none)) (def (immediate_dependencies archive) - (-> Archive [(List unit.ID) - (Dictionary unit.ID (Set unit.ID))]) + (-> Archive + [(List unit.ID) + (Dictionary unit.ID (Set unit.ID))]) (|> archive archive.entries (list#each (function (_ [module [module_id [_module output registry]]]) @@ -216,7 +220,8 @@ (dictionary.empty unit.hash)]))) (def .public (necessary_dependencies archive) - (-> Archive (Set unit.ID)) + (-> Archive + (Set unit.ID)) (let [[mandatory immediate] (immediate_dependencies archive)] (loop (again [pending mandatory minimum unit.none]) diff --git a/stdlib/source/library/lux/meta/compiler/target/jvm/reflection.lux b/stdlib/source/library/lux/meta/compiler/target/jvm/reflection.lux index 31b143d13..72577fa38 100644 --- a/stdlib/source/library/lux/meta/compiler/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/meta/compiler/target/jvm/reflection.lux @@ -93,7 +93,7 @@ "[1]::[0]" ("static" forName [java/lang/String boolean java/lang/ClassLoader] "try" (java/lang/Class java/lang/Object)) (getName [] java/lang/String) - (isAssignableFrom [(java/lang/Class java/lang/Object)] boolean) + (isAssignableFrom [(java/lang/Class [? < java/lang/Object])] boolean) (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/Class c))]) (getDeclaredField [java/lang/String] "try" java/lang/reflect/Field) (isArray [] boolean) @@ -108,16 +108,24 @@ [(exception.def .public (<name> jvm_type) (Exception java/lang/reflect/Type) (exception.report - (list ["Type" (java/lang/reflect/Type::getTypeName jvm_type)] - ["Class" (|> jvm_type java/lang/Object::getClass java/lang/Object::toString)])))] + (list ["Type" (|> jvm_type + java/lang/reflect/Type::getTypeName + ffi.of_string)] + ["Class" (|> jvm_type + java/lang/Object::getClass + java/lang/Object::toString + ffi.of_string)])))] [not_a_class] [cannot_convert_to_a_lux_type] ) (def .public (load class_loader name) - (-> java/lang/ClassLoader External (Try (java/lang/Class java/lang/Object))) - (when (java/lang/Class::forName name false class_loader) + (-> java/lang/ClassLoader External + (Try (java/lang/Class java/lang/Object))) + (when (java/lang/Class::forName (ffi.as_string name) + (ffi.as_boolean false) + class_loader) {try.#Failure _} (exception.except ..unknown_class [name]) @@ -125,21 +133,23 @@ success)) (def .public (sub? class_loader super sub) - (-> java/lang/ClassLoader External External (Try Bit)) + (-> java/lang/ClassLoader External External + (Try Bit)) (do try.monad [super (..load class_loader super) sub (..load class_loader sub)] - (in (java/lang/Class::isAssignableFrom sub super)))) + (in (ffi.of_boolean (java/lang/Class::isAssignableFrom sub + (as java/lang/Class super)))))) (def (class' parameter reflection) - (-> (-> java/lang/reflect/Type (Try (/.Type Parameter))) - java/lang/reflect/Type + (-> (-> java/lang/reflect/Type (Try (/.Type Parameter))) java/lang/reflect/Type (Try (/.Type Class))) (<| (when (ffi.as java/lang/Class reflection) {.#Some class} (let [class_name (|> class (as (java/lang/Class java/lang/Object)) - java/lang/Class::getName)] + java/lang/Class::getName + ffi.of_string)] (`` (if (or (,, (with_template [<reflection>] [(text#= (/reflection.reflection <reflection>) class_name)] @@ -157,18 +167,19 @@ {try.#Success (/.class class_name (list))}))) _) (when (ffi.as java/lang/reflect/ParameterizedType reflection) - {.#Some reflection} - (let [raw (java/lang/reflect/ParameterizedType::getRawType reflection)] + {.#Some reflection'} + (let [raw (java/lang/reflect/ParameterizedType::getRawType reflection')] (when (ffi.as java/lang/Class raw) {.#Some raw'} (let [! try.monad] - (|> reflection + (|> reflection' java/lang/reflect/ParameterizedType::getActualTypeArguments (array.list {.#None}) (monad.each ! parameter) (of ! each (/.class (|> raw' (as (java/lang/Class java/lang/Object)) - java/lang/Class::getName))) + java/lang/Class::getName + ffi.of_string))) (exception.with ..cannot_convert_to_a_lux_type [reflection]))) _ @@ -182,7 +193,7 @@ (-> java/lang/reflect/Type (Try (/.Type Parameter)))) (<| (when (ffi.as java/lang/reflect/TypeVariable reflection) {.#Some reflection} - {try.#Success (/.var (java/lang/reflect/TypeVariable::getName reflection))} + {try.#Success (/.var (ffi.of_string (java/lang/reflect/TypeVariable::getName reflection)))} _) (when (ffi.as java/lang/reflect/WildcardType reflection) {.#Some reflection} @@ -215,22 +226,27 @@ _) (when (ffi.as java/lang/Class reflection) {.#Some class} - (if (java/lang/Class::isArray class) - (|> class - java/lang/Class::getComponentType - type - (try#each /.array)) - (..class' (parameter type) reflection)) + (let [class (as (java/lang/Class java/lang/Object) + class)] + (if (ffi.of_boolean (java/lang/Class::isArray class)) + (|> class + java/lang/Class::getComponentType + (ffi.is java/lang/reflect/Type) + type + (try#each /.array)) + (..class' (parameter type) reflection))) _) (..class' (parameter type) reflection))) (def .public (type reflection) - (-> java/lang/reflect/Type (Try (/.Type Value))) + (-> java/lang/reflect/Type + (Try (/.Type Value))) (<| (when (ffi.as java/lang/Class reflection) {.#Some reflection} (let [class_name (|> reflection (as (java/lang/Class java/lang/Object)) - java/lang/Class::getName)] + java/lang/Class::getName + ffi.of_string)] (`` (cond (,, (with_template [<reflection> <type>] [(text#= (/reflection.reflection <reflection>) class_name) @@ -257,13 +273,15 @@ (..class' (..parameter ..type))) (def .public (return reflection) - (-> java/lang/reflect/Type (Try (/.Type Return))) + (-> java/lang/reflect/Type + (Try (/.Type Return))) (with_expansions [<else> (these (..type reflection))] (when (ffi.as java/lang/Class reflection) {.#Some class} (let [class_name (|> reflection (as (java/lang/Class java/lang/Object)) - java/lang/Class::getName)] + java/lang/Class::getName + ffi.of_string)] (if (text#= (/reflection.reflection /reflection.void) class_name) {try.#Success /.void} @@ -275,7 +293,7 @@ (exception.def .public (cannot_correspond [class type]) (Exception [(java/lang/Class java/lang/Object) Type]) (exception.report - (list ["Class" (java/lang/Object::toString class)] + (list ["Class" (ffi.of_string (java/lang/Object::toString class))] ["Type" (%.type type)]))) (exception.def .public (type_parameter_mismatch [expected actual class type]) @@ -283,7 +301,7 @@ (exception.report (list ["Expected" (%.nat expected)] ["Actual" (%.nat actual)] - ["Class" (java/lang/Object::toString class)] + ["Class" (ffi.of_string (java/lang/Object::toString class))] ["Type" (%.type type)]))) (exception.def .public (non_jvm_type type) @@ -292,23 +310,25 @@ (list ["Type" (%.type type)]))) (def .public (correspond class type) - (-> (java/lang/Class java/lang/Object) Type (Try Mapping)) + (-> (java/lang/Class java/lang/Object) Type + (Try Mapping)) (when type {.#Nominal array.nominal (list :member:)} - (if (java/lang/Class::isArray class) + (if (ffi.of_boolean (java/lang/Class::isArray class)) (correspond (java/lang/Class::getComponentType class) :member:) (exception.except ..cannot_correspond [class type])) {.#Nominal name params} - (let [class_name (java/lang/Class::getName class) + (let [class_name (ffi.of_string (java/lang/Class::getName class)) class_params (array.list {.#None} (java/lang/Class::getTypeParameters class)) num_class_params (list.size class_params) num_type_params (list.size params)] (if (text#= class_name name) (if (n.= num_class_params num_type_params) (|> params - (list.zipped_2 (list#each (|>> java/lang/reflect/TypeVariable::getName) + (list.zipped_2 (list#each (|>> java/lang/reflect/TypeVariable::getName + ffi.of_string) class_params)) (list#mix (function (_ [name paramT] mapping) (dictionary.has name paramT mapping)) @@ -334,16 +354,16 @@ (exception.def .public (mistaken_field_owner [field owner target]) (Exception [java/lang/reflect/Field (java/lang/Class java/lang/Object) (java/lang/Class java/lang/Object)]) (exception.report - (list ["Field" (java/lang/Object::toString field)] - ["Owner" (java/lang/Object::toString owner)] - ["Target" (java/lang/Object::toString target)]))) + (list ["Field" (ffi.of_string (java/lang/Object::toString field))] + ["Owner" (ffi.of_string (java/lang/Object::toString owner))] + ["Target" (ffi.of_string (java/lang/Object::toString target))]))) (with_template [<name>] [(exception.def .public (<name> [field class]) (Exception [Text (java/lang/Class java/lang/Object)]) (exception.report (list ["Field" (%.text field)] - ["Class" (java/lang/Object::toString class)])))] + ["Class" (ffi.of_string (java/lang/Object::toString class))])))] [unknown_field] [not_a_static_field] @@ -351,8 +371,9 @@ ) (def .public (field field target) - (-> Text (java/lang/Class java/lang/Object) (Try java/lang/reflect/Field)) - (when (java/lang/Class::getDeclaredField field target) + (-> Text (java/lang/Class java/lang/Object) + (Try java/lang/reflect/Field)) + (when (java/lang/Class::getDeclaredField (ffi.as_string field) target) {try.#Success field} (let [owner (java/lang/reflect/Field::getDeclaringClass field)] (if (same? owner target) @@ -363,7 +384,8 @@ (exception.except ..unknown_field [field target]))) (def .public deprecated? - (-> (array.Array java/lang/annotation/Annotation) Bit) + (-> (array.Array java/lang/annotation/Annotation) + Bit) (|>> (array.list {.#None}) (list.all (|>> (ffi.as java/lang/Deprecated))) list.empty? @@ -371,15 +393,16 @@ (with_template [<name> <exception> <then?> <else?>] [(def .public (<name> field class) - (-> Text (java/lang/Class java/lang/Object) (Try [Bit Bit (/.Type Value)])) + (-> Text (java/lang/Class java/lang/Object) + (Try [Bit Bit (/.Type Value)])) (do [! try.monad] [fieldJ (..field field class) .let [modifiers (java/lang/reflect/Field::getModifiers fieldJ)]] - (when (java/lang/reflect/Modifier::isStatic modifiers) + (when (ffi.of_boolean (java/lang/reflect/Modifier::isStatic modifiers)) <then?> (|> fieldJ java/lang/reflect/Field::getGenericType ..type - (of ! each (|>> [(java/lang/reflect/Modifier::isFinal modifiers) + (of ! each (|>> [(ffi.of_boolean (java/lang/reflect/Modifier::isFinal modifiers)) (..deprecated? (java/lang/reflect/Field::getDeclaredAnnotations fieldJ))]))) <else?> (exception.except <exception> [field class]))))] |