diff options
Diffstat (limited to '')
9 files changed, 171 insertions, 86 deletions
diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux index 405c858a5..6d8b4e5e7 100644 --- a/stdlib/source/library/lux/control/exception.lux +++ b/stdlib/source/library/lux/control/exception.lux @@ -128,17 +128,25 @@ (list.repeat (n.+ (text.size header_separator) largest_header_size)) (text.join_with "") - (text\compose text.new_line))] - (|> entries - (list\map (function (_ [header message]) - (let [padding (|> " " - (list.repeat (n.- (text.size header) - largest_header_size)) - (text.join_with ""))] - (|> message - (text.replace_all text.new_line on_new_line) - ($_ text\compose padding header header_separator))))) - (text.join_with text.new_line)))) + (text\compose text.new_line)) + on_entry (: (-> [Text Text] Text) + (function (_ [header message]) + (let [padding (|> " " + (list.repeat (n.- (text.size header) + largest_header_size)) + (text.join_with ""))] + (|> message + (text.replace_all text.new_line on_new_line) + ($_ text\compose padding header header_separator)))))] + (case entries + #.Nil + "" + + (#.Cons head tail) + (list\fold (function (_ post pre) + ($_ text\compose pre text.new_line (on_entry post))) + (on_entry head) + tail)))) (syntax: #export (report {entries (p.many (s.tuple (p.and s.any s.any)))}) (wrap (list (` ((~! report') (list (~+ (|> entries @@ -149,10 +157,14 @@ (All [a] (-> (-> a Text) (List a) Text)) (|> entries - list.enumeration - (list\map (function (_ [index entry]) - [(n\encode index) (format entry)])) - report')) + (list\fold (function (_ entry [index next]) + [(inc index) + (#.Cons [(n\encode index) (format entry)] + next)]) + [0 #.Nil]) + product.right + list.reverse + ..report')) (def: separator (let [gap ($_ "lux text concat" text.new_line text.new_line) diff --git a/stdlib/source/library/lux/data/collection/dictionary.lux b/stdlib/source/library/lux/data/collection/dictionary.lux index 02d733d80..6768d2155 100644 --- a/stdlib/source/library/lux/data/collection/dictionary.lux +++ b/stdlib/source/library/lux/data/collection/dictionary.lux @@ -623,24 +623,27 @@ (All [k v] (-> (Dictionary k v) Bit)) (|>> size (n.= 0))) -(def: #export (entries dict) +(def: #export entries (All [k v] (-> (Dictionary k v) (List [k v]))) - (entries' (product.right dict))) + (|>> product.right ..entries')) (def: #export (from_list Hash<k> kvs) (All [k v] (-> (Hash k) (List [k v]) (Dictionary k v))) (list\fold (function (_ [k v] dict) - (put k v dict)) + (..put k v dict)) (new Hash<k>) kvs)) -(template [<name> <elem_type> <side>] - [(def: #export (<name> dict) - (All [k v] (-> (Dictionary k v) (List <elem_type>))) - (|> dict entries (list\map <side>)))] +(template [<name> <side>] + [(def: #export <name> + (All [k v] (-> (Dictionary k v) (List <side>))) + (|>> ..entries + (list\fold (function (_ [k v] bundle) + (#.Cons <side> bundle)) + #.Nil)))] - [keys k product.left] - [values v product.right] + [keys k] + [values v] ) (def: #export (merge dict2 dict1) diff --git a/stdlib/source/library/lux/data/format/markdown.lux b/stdlib/source/library/lux/data/format/markdown.lux index 05a8ed94a..5dba35fed 100644 --- a/stdlib/source/library/lux/data/format/markdown.lux +++ b/stdlib/source/library/lux/data/format/markdown.lux @@ -15,21 +15,21 @@ (def: sanitize (-> Text Text) - (|>> (text.replace-all "\" "\\") - (text.replace-all "`" "\`") - (text.replace-all "*" "\*") - (text.replace-all "_" "\_") - (text.replace-all "{" "\{") - (text.replace-all "}" "\}") - (text.replace-all "[" "\[") - (text.replace-all "]" "\]") - (text.replace-all "(" "\(") - (text.replace-all ")" "\)") - (text.replace-all "#" "\#") - (text.replace-all "+" "\+") - (text.replace-all "-" "\-") - (text.replace-all "." "\.") - (text.replace-all "!" "\!"))) + (|>> (text.replace_all "\" "\\") + (text.replace_all "`" "\`") + (text.replace_all "*" "\*") + (text.replace_all "_" "\_") + (text.replace_all "{" "\{") + (text.replace_all "}" "\}") + (text.replace_all "[" "\[") + (text.replace_all "]" "\]") + (text.replace_all "(" "\(") + (text.replace_all ")" "\)") + (text.replace_all "#" "\#") + (text.replace_all "+" "\+") + (text.replace_all "-" "\-") + (text.replace_all "." "\.") + (text.replace_all "!" "\!"))) (abstract: #export Span Any) (abstract: #export Block Any) @@ -45,12 +45,13 @@ (-> Text (Markdown Span)) (|>> ..sanitize :abstraction)) - (def: blank-line (format text.new-line text.new-line)) + (def: blank_line + (format text.new_line text.new_line)) (template [<name> <prefix>] [(def: #export (<name> content) (-> Text Markdown) - (:abstraction (format <prefix> " " (..sanitize content) ..blank-line)))] + (:abstraction (format <prefix> " " (..sanitize content) ..blank_line)))] [heading/1 "#"] [heading/2 "##"] @@ -62,7 +63,7 @@ (def: (block content) (-> Text (Markdown Block)) - (:abstraction (format content ..blank-line))) + (:abstraction (format content ..blank_line))) (def: #export paragraph (-> (Markdown Span) (Markdown Block)) @@ -70,7 +71,7 @@ (def: #export break (Markdown Span) - (:abstraction (format " " text.new-line))) + (:abstraction (format " " text.new_line))) (template [<name> <wrapper>] [(def: #export <name> @@ -85,12 +86,12 @@ (def: (prefix with) (-> Text (-> Text Text)) - (|>> (text.split-all-with text.new-line) + (|>> (text.split_all_with text.new_line) (list\map (function (_ line) (if (text.empty? line) line (format with line)))) - (text.join-with text.new-line))) + (text.join_with text.new_line))) (def: indent (-> Text Text) @@ -102,33 +103,33 @@ (..prefix "> ") :abstraction)) - (def: #export numbered-list + (def: #export numbered_list (-> (List [(Markdown Span) (Maybe (Markdown Block))]) (Markdown Block)) (|>> list.enumeration (list\map (function (_ [idx [summary detail]]) - (format (%.nat (inc idx)) ". " (:representation summary) text.new-line + (format (%.nat (inc idx)) ". " (:representation summary) text.new_line (case detail (#.Some detail) - (|> detail :representation ..indent (text.enclose [text.new-line text.new-line])) + (|> detail :representation ..indent (text.enclose [text.new_line text.new_line])) #.None "")))) - (text.join-with text.new-line) + (text.join_with text.new_line) ..block)) - (def: #export bullet-list + (def: #export bullet_list (-> (List [(Markdown Span) (Maybe (Markdown Block))]) (Markdown Block)) (|>> (list\map (function (_ [summary detail]) - (format "*. " (:representation summary) text.new-line + (format "*. " (:representation summary) text.new_line (case detail (#.Some detail) - (|> detail :representation ..indent (text.enclose [text.new-line text.new-line])) + (|> detail :representation ..indent (text.enclose [text.new_line text.new_line])) #.None "")))) - (text.join-with text.new-line) + (text.join_with text.new_line) ..block)) (def: #export snippet @@ -139,15 +140,15 @@ (def: #export code {#.doc "A block of code."} (-> Text (Markdown Block)) - (let [open (format "```" text.new-line) - close (format text.new-line "```")] + (let [open (format "```" text.new_line) + close (format text.new_line "```")] (|>> (text.enclose [open close]) ..block))) (def: #export (image description url) (-> Text URL (Markdown Span)) (:abstraction (format "![" (..sanitize description) "](" url ")"))) - (def: #export horizontal-rule + (def: #export horizontal_rule (Markdown Block) (..block "___")) @@ -155,7 +156,8 @@ (-> (Markdown Span) URL (Markdown Span)) (:abstraction (format "[" (:representation description) "](" url ")"))) - (type: #export Email Text) + (type: #export Email + Text) (template [<name> <type>] [(def: #export <name> diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index b265e3e42..fbcd39119 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -725,11 +725,11 @@ anns ..annotations^ inputs (<code>.tuple (<>.some (..type^ total_vars))) output (..return^ total_vars) - exs (throws_decl^ total_vars)] + exs (..throws_decl^ total_vars)] (wrap [[name #PublicP anns] {#method_tvars tvars #method_inputs inputs #method_output output - #method_exs exs}])))) + #method_exs exs}])))) (def: state_modifier^ (Parser StateModifier) diff --git a/stdlib/source/library/lux/macro.lux b/stdlib/source/library/lux/macro.lux index c446dfa70..0c72af316 100644 --- a/stdlib/source/library/lux/macro.lux +++ b/stdlib/source/library/lux/macro.lux @@ -204,7 +204,7 @@ #.None (//.fail (..wrong_syntax_error macro_name)))))] - [log_expand_once! expand_once] - [log_expand! expand] - [log_expand_all! expand_all] + [log_expand_once! ..expand_once] + [log_expand! ..expand] + [log_expand_all! ..expand_all] ) diff --git a/stdlib/source/library/lux/target/jvm/loader.lux b/stdlib/source/library/lux/target/jvm/loader.lux index c76ff1310..49beb0a66 100644 --- a/stdlib/source/library/lux/target/jvm/loader.lux +++ b/stdlib/source/library/lux/target/jvm/loader.lux @@ -26,10 +26,9 @@ (exception.report ["Class" class])) -(exception: #export (unknown {class Text} {known_classes (List Text)}) +(exception: #export (unknown {class Text}) (exception.report - ["Class" class] - ["Known classes" (exception.enumerate (|>>) known_classes)])) + ["Class" class])) (exception: #export (cannot_define {class Text} {error Text}) (exception.report @@ -125,7 +124,7 @@ (error! (exception.construct ..cannot_define [class_name error]))) #.None - (error! (exception.construct ..unknown [class_name (dictionary.keys classes)]))))))))) + (error! (exception.construct ..unknown [class_name]))))))))) (def: #export (store name bytecode library) (-> Text Binary Library (IO (Try Any))) diff --git a/stdlib/source/library/lux/target/jvm/type/alias.lux b/stdlib/source/library/lux/target/jvm/type/alias.lux index d52051f04..594a75562 100644 --- a/stdlib/source/library/lux/target/jvm/type/alias.lux +++ b/stdlib/source/library/lux/target/jvm/type/alias.lux @@ -103,18 +103,29 @@ (|> (..class (..parameter aliasing)) (<>.after (<text>.this //signature.exception_prefix)))) -(def: #export (method aliasing type) - (-> Aliasing (Type Method) (Type Method)) - (|> type - //.signature - //signature.signature - (<text>.run (do <>.monad - [type_variables (|> (<>.some (..var aliasing)) - (<>.after (<text>.this //signature.parameters_start)) - (<>.before (<text>.this //signature.parameters_end)) - (<>.default (list))) - inputs (..inputs aliasing) - return (..return aliasing) - exceptions (<>.some (..exception aliasing))] - (wrap (//.method [type_variables inputs return exceptions])))) - try.assume)) +(def: (bound aliasing) + (-> Aliasing (Parser (Type Class))) + (do <>.monad + [_ (<text>.this ":")] + (..class (..parameter aliasing)))) + +(def: (bound_type_var aliasing) + (-> Aliasing (Parser (Type Var))) + (|> //parser.var_name + (\ <>.monad map //.var) + (<>.before (<>.many (..bound aliasing))))) + +(def: #export (method aliasing) + (-> Aliasing (-> (Type Method) (Type Method))) + (|>> //.signature + //signature.signature + (<text>.run (do <>.monad + [type_variables (|> (<>.some (..bound_type_var aliasing)) + (<>.after (<text>.this //signature.parameters_start)) + (<>.before (<text>.this //signature.parameters_end)) + (<>.default (list))) + inputs (..inputs aliasing) + return (..return aliasing) + exceptions (<>.some (..exception aliasing))] + (wrap (//.method [type_variables inputs return exceptions])))) + try.assume)) diff --git a/stdlib/source/library/lux/target/jvm/type/signature.lux b/stdlib/source/library/lux/target/jvm/type/signature.lux index 89cce34e0..570ec8e73 100644 --- a/stdlib/source/library/lux/target/jvm/type/signature.lux +++ b/stdlib/source/library/lux/target/jvm/type/signature.lux @@ -58,6 +58,12 @@ (|>> (text.enclose [..var_prefix //descriptor.class_suffix]) :abstraction)) + (def: #export var_name + (-> (Signature Var) Text) + (|>> :representation + (text.replace_all ..var_prefix "") + (text.replace_all //descriptor.class_suffix ""))) + (def: #export lower_prefix "-") (def: #export upper_prefix "+") @@ -103,6 +109,11 @@ (def: #export exception_prefix "^") + (def: class_bound + (|> (..class "java.lang.Object" (list)) + ..signature + (format ":"))) + (def: #export (method [type_variables inputs output exceptions]) (-> [(List (Signature Var)) (List (Signature Value)) @@ -115,7 +126,8 @@ "" _ (|> type_variables - (list\map ..signature) + (list\map (|>> ..var_name + (text.suffix ..class_bound))) (text.join_with "") (text.enclose [..parameters_start ..parameters_end]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 0dcb22927..3c458c041 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -1882,14 +1882,60 @@ <code>.any ))) -(def: #export (analyse_overriden_method analyse archive selfT mapping method) - (-> Phase Archive .Type Mapping (Overriden_Method Code) (Operation Analysis)) +(exception: #export (unknown_super {name Text} {supers (List (Type Class))}) + (exception.report + ["Name" (%.text name)] + ["Available" (exception.enumerate (|>> jvm_parser.read_class product.left) supers)])) + +(exception: #export (mismatched_super_parameters {name Text} {expected Nat} {actual Nat}) + (exception.report + ["Name" (%.text name)] + ["Expected" (%.nat expected)] + ["Actual" (%.nat actual)])) + +(def: (override_mapping mapping supers parent_type) + (-> Mapping (List (Type Class)) (Type Class) (Operation (List [Text .Type]))) + (let [[parent_name parent_parameters] (jvm_parser.read_class parent_type)] + (case (list.one (function (_ super) + (let [[super_name super_parameters] (jvm_parser.read_class super)] + (if (text\= parent_name super_name) + (#.Some super_parameters) + #.None))) + supers) + (#.Some super_parameters) + (let [expected_count (list.size parent_parameters) + actual_count (list.size super_parameters)] + (if (n.= expected_count actual_count) + (do {! phase.monad} + [parent_parameters (|> parent_parameters + (monad.map maybe.monad jvm_parser.var?) + try.from_maybe + phase.lift)] + (|> super_parameters + (monad.map ! (..reflection_type mapping)) + (\ ! map (|>> (list.zip/2 parent_parameters))))) + (phase.lift (exception.throw ..mismatched_super_parameters [parent_name expected_count actual_count])))) + + #.None + (phase.lift (exception.throw ..unknown_super [parent_name supers]))))) + +(def: #export (analyse_overriden_method analyse archive selfT mapping supers method) + (-> Phase Archive .Type Mapping (List (Type Class)) (Overriden_Method Code) (Operation Analysis)) (let [[parent_type method_name strict_fp? annotations vars self_name arguments return exceptions body] method] (do {! phase.monad} - [annotationsA (monad.map ! (function (_ [name parameters]) + [override_mapping (..override_mapping mapping supers parent_type) + #let [mapping (list\fold (function (_ [super_var bound_type] mapping) + (dictionary.put super_var bound_type mapping)) + mapping + override_mapping) + mapping (list\fold (function (_ varJ mapping) + (dictionary.put (jvm_parser.name varJ) java/lang/Object mapping)) + mapping + vars)] + annotationsA (monad.map ! (function (_ [name parameters]) (do ! [parametersA (monad.map ! (function (_ [name value]) (do ! @@ -2033,7 +2079,7 @@ (analyse archive term))] (wrap [type termA]))) constructor_args) - methodsA (monad.map ! (analyse_overriden_method analyse archive selfT mapping) methods) + methodsA (monad.map ! (analyse_overriden_method analyse archive selfT mapping (#.Cons super_class super_interfaces)) methods) required_abstract_methods (phase.lift (all_abstract_methods class_loader (list& super_class super_interfaces))) available_methods (phase.lift (all_methods class_loader (list& super_class super_interfaces))) overriden_methods (monad.map ! (function (_ [parent_type method_name |