From 461a6ce673de9b2c3d77714c4884c2a316fe7e8f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 20 Jul 2021 16:19:43 -0400 Subject: Updated the Scriptum documentation generator. --- lux-jvm/source/luxc/lang/directive/jvm.lux | 3 +- .../luxc/lang/translation/jvm/extension/host.lux | 32 +- stdlib/source/library/lux/control/exception.lux | 42 +- .../library/lux/data/collection/dictionary.lux | 21 +- stdlib/source/library/lux/data/format/markdown.lux | 68 ++-- stdlib/source/library/lux/ffi.jvm.lux | 4 +- stdlib/source/library/lux/macro.lux | 6 +- stdlib/source/library/lux/target/jvm/loader.lux | 7 +- .../source/library/lux/target/jvm/type/alias.lux | 41 +- .../library/lux/target/jvm/type/signature.lux | 14 +- .../language/lux/phase/extension/analysis/jvm.lux | 54 ++- stdlib/source/program/scriptum.lux | 448 +++++++++++---------- stdlib/source/test/lux.lux | 22 + .../source/test/lux/data/collection/dictionary.lux | 55 ++- stdlib/source/test/lux/ffi.jvm.lux | 130 ++++-- 15 files changed, 589 insertions(+), 358 deletions(-) diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index b03cf6bbc..3ebcfe641 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -29,7 +29,8 @@ ["#." type (#+ Type) [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter Declaration)] ["." parser] - ["#/." signature]]]] + ["#/." signature] + ["#/." descriptor]]]] [tool [compiler ["." phase] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux index a9727fc9a..33552c135 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux @@ -29,6 +29,7 @@ ["." box] ["." reflection] ["." signature] + ["." descriptor] ["." parser]]]] [tool [compiler @@ -76,9 +77,17 @@ [return Return parser.return] ) +(def: signature + (All [a] (-> (Type a) Text)) + (|>> type.signature signature.signature)) + +(def: descriptor + (All [a] (-> (Type a) Text)) + (|>> type.descriptor descriptor.descriptor)) + (exception: #export (not_an_object_array {arrayJT (Type Array)}) (exception.report - ["JVM Type" (|> arrayJT type.signature signature.signature)])) + ["JVM Type" (..signature arrayJT)])) (def: #export object_array (Parser (Type Object)) @@ -558,18 +567,18 @@ (^ (list (synthesis.text from) (synthesis.text to) valueS)) (do phase.monad [valueI (generate archive valueS)] - (`` (cond (~~ (template [ ] - [(and (text@= (reflection.reflection (type.reflection )) + (`` (cond (~~ (template [ ] + [(and (text@= (reflection.reflection (type.reflection )) from) (text@= to)) - (wrap (|>> valueI (_.wrap ))) + (wrap (|>> valueI (_.wrap ))) (and (text@= from) - (text@= (reflection.reflection (type.reflection )) + (text@= (reflection.reflection (type.reflection )) to)) - (wrap (|>> valueI (_.unwrap )))] + (wrap (|>> valueI (_.unwrap )))] [box.boolean type.boolean] [box.byte type.byte] @@ -960,8 +969,13 @@ (#.Left returnT) (case (type.primitive? returnT) (#.Left returnT) - (|>> (_.CHECKCAST returnT) - _.ARETURN) + (case (type.class? returnT) + (#.Some class_name) + (|>> (_.CHECKCAST returnT) + _.ARETURN) + + #.None + _.ARETURN) (#.Right returnT) (cond (or (\ type.equivalence = type.boolean returnT) @@ -1043,7 +1057,7 @@ ($_ $.++M $.finalM $.strictM) $.finalM) name - (type.method [(list) + (type.method [vars (list@map product.right arguments) returnT exceptionsT]) 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 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) kvs)) -(template [ ] - [(def: #export ( dict) - (All [k v] (-> (Dictionary k v) (List ))) - (|> dict entries (list\map )))] +(template [ ] + [(def: #export + (All [k v] (-> (Dictionary k v) (List ))) + (|>> ..entries + (list\fold (function (_ [k v] bundle) + (#.Cons 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 [ ] [(def: #export ( content) (-> Text Markdown) - (:abstraction (format " " (..sanitize content) ..blank-line)))] + (:abstraction (format " " (..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 [ ] [(def: #export @@ -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 [ ] [(def: #export 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 (.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 (.this //signature.exception_prefix)))) -(def: #export (method aliasing type) - (-> Aliasing (Type Method) (Type Method)) - (|> type - //.signature - //signature.signature - (.run (do <>.monad - [type_variables (|> (<>.some (..var aliasing)) - (<>.after (.this //signature.parameters_start)) - (<>.before (.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 + [_ (.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 + (.run (do <>.monad + [type_variables (|> (<>.some (..bound_type_var aliasing)) + (<>.after (.this //signature.parameters_start)) + (<>.before (.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 @@ .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 diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux index 420b40a8b..cdbdb0569 100644 --- a/stdlib/source/program/scriptum.lux +++ b/stdlib/source/program/scriptum.lux @@ -1,171 +1,174 @@ (.module: - [lux #* - [abstract - ["." monad (#+ do)] - ["." enum]] - [control - [pipe (#+ when>)] - ["." try (#+ Try)] - ["ex" exception (#+ exception:)] - [security - ["!" capability]]] - [cli (#+ program:)] - [data - ["." maybe] - ["." product] - [number - ["n" nat]] - [format - ["md" markdown (#+ Markdown Span Block)]] - ["." text ("#\." equivalence) - ["%" format (#+ format)] - ["." encoding]] - [collection - ["." sequence (#+ Sequence) ("#\." functor)] - ["." list ("#\." functor fold)]]] - ["." function] - ["." type ("#\." equivalence)] - ["." macro] - ["." io (#+ IO io)] - [world - ["." file (#+ File)]]] + [library + [lux #* + [program (#+ program:)] + ["." type ("#\." equivalence)] + ["." debug] + [abstract + ["." monad (#+ do)] + ["." enum]] + [control + [pipe (#+ when> new>)] + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." io (#+ IO io)] + ["." function]] + [data + ["." maybe] + ["." product] + [format + ["md" markdown (#+ Markdown Span Block)]] + ["." text ("#\." equivalence) + ["%" format (#+ format)] + [encoding + ["." utf8]]] + [collection + ["." sequence (#+ Sequence) ("#\." functor)] + ["." list ("#\." functor fold)]]] + [math + [number + ["n" nat]]] + ["." meta + ["." annotation]] + [world + ["." file]]]] ## This was added to make sure that all tested modules are picked up ## and their documentation is generated. [test/lux (#+)]) -(def: name-options "abcdefghijklmnopqrstuvwxyz") -(def: name-options-count (text.size name-options)) +(def: name_options "abcdefghijklmnopqrstuvwxyz") +(def: name_options_count (text.size name_options)) -(def: (parameter-type-name id) +(def: (parameter_type_name id) (-> Nat Text) - (case (text.nth id ..name-options) + (case (text.nth id ..name_options) (#.Some char) - (text.from-code char) + (text.from_code char) #.None - (format (parameter-type-name (n./ name-options-count id)) - (parameter-type-name (n.% name-options-count id))))) + (format (parameter_type_name (n./ name_options_count id)) + (parameter_type_name (n.% name_options_count id))))) -(def: type-var-names +(def: type_var_names (Sequence Text) - (|> 0 (sequence.iterate inc) (sequence\map parameter-type-name))) + (|> 0 (sequence.iterate inc) (sequence\map parameter_type_name))) (template [ ] [(def: ( id) (-> Nat Bit) ( id))] - [type-func? n.even?] - [type-arg? n.odd?] + [type_func? n.even?] + [type_arg? n.odd?] ) -(def: (arg-id level id) +(def: (arg_id level id) (-> Nat Nat Nat) (n.- (n./ 2 id) level)) -(def: (parameter->name [type-func-name type-function-arguments] level id) +(def: (parameter_to_name [type_func_name type_function_arguments] level id) (-> [Text (List Text)] Nat Nat Text) - (if (type-arg? id) - (let [arg-id (..arg-id level id)] - (case (list.nth arg-id type-function-arguments) + (if (type_arg? id) + (let [arg_id (..arg_id level id)] + (case (list.nth arg_id type_function_arguments) (#.Some found) found _ - (|> type-var-names - (sequence.filter (function (_ var-name) - (not (list.member? text.equivalence type-function-arguments var-name)))) - (sequence.nth arg-id)))) - type-func-name)) + (|> type_var_names + (sequence.filter (function (_ var_name) + (not (list.member? text.equivalence type_function_arguments var_name)))) + (sequence.nth arg_id)))) + type_func_name)) -(def: (level->args offset level) +(def: (level_to_args offset level) (-> Nat Nat (List Text)) (if (n.= 0 level) (list) (|> level dec (enum.range n.enum 0) - (list\map (|>> (n.+ (inc offset)) parameter-type-name))))) + (list\map (|>> (n.+ (inc offset)) parameter_type_name))))) -(def: (prefix-lines prefix lines) +(def: (prefix_lines prefix lines) (-> Text Text Text) (|> lines - (text.split-all-with text.new-line) + (text.split_all_with text.new_line) (list\map (|>> (format prefix))) - (text.join-with text.new-line))) + (text.join_with text.new_line))) -(def: (pprint-type-definition level type-func-info tags module signature? recursive-type? type) +(def: (pprint_type_definition level type_func_info tags module signature? recursive_type? type) (-> Nat [Text (List Text)] (List Name) Text Bit Bit Type Text) (case tags - (^ (list [_ single-tag])) + (^ (list [_ single_tag])) (if signature? - (format "(: " (pprint-type-definition level type-func-info #.None module signature? recursive-type? type) text.new-line " " single-tag ")") - (format "{#" single-tag " " (pprint-type-definition level type-func-info #.None module signature? recursive-type? type) "}")) + (format "(: " (pprint_type_definition level type_func_info #.None module signature? recursive_type? type) text.new_line " " single_tag ")") + (format "{#" single_tag " " (pprint_type_definition level type_func_info #.None module signature? recursive_type? type) "}")) _ - (case [recursive-type? type] + (case [recursive_type? type] [_ (#.Primitive name params)] (case params #.Nil (format "(primitive " (%.text name) ")") _ - (format "(primitive " (%.text name) " " (|> params (list\map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")")) + (format "(primitive " (%.text name) " " (|> params (list\map (pprint_type_definition level type_func_info #.None module signature? recursive_type?)) (text.join_with " ")) ")")) [_ (#.Sum _)] - (let [members (type.flatten-variant type)] + (let [members (type.flatten_variant type)] (case tags #.Nil (format "(| " (|> members - (list\map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) - (text.join-with " ")) + (list\map (pprint_type_definition level type_func_info #.None module signature? recursive_type?)) + (text.join_with " ")) ")") _ (|> members (list.zip/2 tags) - (list\map (function (_ [[_ t-name] type]) + (list\map (function (_ [[_ t_name] type]) (case type (#.Product _) - (let [types (type.flatten-tuple type)] - (format "(#" t-name " " + (let [types (type.flatten_tuple type)] + (format "(#" t_name " " (|> types - (list\map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) - (text.join-with " ")) + (list\map (pprint_type_definition level type_func_info #.None module signature? recursive_type?)) + (text.join_with " ")) ")")) _ - (format "(#" t-name " " (pprint-type-definition level type-func-info #.None module signature? recursive-type? type) ")")))) - (text.join-with text.new-line)))) + (format "(#" t_name " " (pprint_type_definition level type_func_info #.None module signature? recursive_type? type) ")")))) + (text.join_with text.new_line)))) [_ (#.Product _)] - (let [members (type.flatten-tuple type)] + (let [members (type.flatten_tuple type)] (case tags #.Nil - (format "[" (|> members (list\map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) "]") + (format "[" (|> members (list\map (pprint_type_definition level type_func_info #.None module signature? recursive_type?)) (text.join_with " ")) "]") _ - (let [member-docs (|> members + (let [member_docs (|> members (list.zip/2 tags) - (list\map (function (_ [[_ t-name] type]) + (list\map (function (_ [[_ t_name] type]) (if signature? - (format "(: " (pprint-type-definition level type-func-info #.None module signature? recursive-type? type) text.new-line " " t-name ")") - (format "#" t-name " " (pprint-type-definition level type-func-info #.None module signature? recursive-type? type))))) - (text.join-with (format text.new-line " ")))] + (format "(: " (pprint_type_definition level type_func_info #.None module signature? recursive_type? type) text.new_line " " t_name ")") + (format "#" t_name " " (pprint_type_definition level type_func_info #.None module signature? recursive_type? type))))) + (text.join_with (format text.new_line " ")))] (if signature? - member-docs - (format "{" member-docs "}"))))) + member_docs + (format "{" member_docs "}"))))) [_ (#.Function input output)] - (let [[ins out] (type.flatten-function type)] - (format "(-> " (|> ins (list\map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) + (let [[ins out] (type.flatten_function type)] + (format "(-> " (|> ins (list\map (pprint_type_definition level type_func_info #.None module signature? recursive_type?)) (text.join_with " ")) " " - (pprint-type-definition level type-func-info #.None module signature? recursive-type? out) + (pprint_type_definition level type_func_info #.None module signature? recursive_type? out) ")")) [_ (#.Parameter idx)] - (parameter->name type-func-info level idx) + (parameter_to_name type_func_info level idx) (^template [
 ]
         [[_ ( id)]
@@ -176,25 +179,25 @@
       (^template [  ]
         [[_ ( _)]
          (let [[level' body] ( type)
-               args (level->args level level')
-               body-doc (pprint-type-definition (n.+ level level') type-func-info tags module signature? recursive-type? body)]
-           (format "("  " " "[" (text.join-with " " args) "]"
+               args (level_to_args level level')
+               body_doc (pprint_type_definition (n.+ level level') type_func_info tags module signature? recursive_type? body)]
+           (format "("  " " "[" (text.join_with " " args) "]"
                    (case tags
                      #.Nil
-                     (format " " body-doc)
+                     (format " " body_doc)
 
                      _
-                     (format text.new-line (prefix-lines "  " body-doc)))
+                     (format text.new_line (prefix_lines "  " body_doc)))
                    ")"))])
-      ([#.UnivQ "All" type.flatten-univ-q]
-       [#.ExQ   "Ex"  type.flatten-ex-q])
+      ([#.UnivQ "All" type.flatten_univ_q]
+       [#.ExQ   "Ex"  type.flatten_ex_q])
 
       [true (#.Apply (#.Parameter 1) (#.Parameter 0))]
-      (product.left type-func-info)
+      (product.left type_func_info)
 
       [_ (#.Apply param fun)]
-      (let [[type-func type-arguments] (type.flatten-application type)]
-        (format  "(" (pprint-type-definition level type-func-info tags module signature? recursive-type? type-func) " " (|> type-arguments (list\map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")"))
+      (let [[type_func type_arguments] (type.flatten_application type)]
+        (format  "(" (pprint_type_definition level type_func_info tags module signature? recursive_type? type_func) " " (|> type_arguments (list\map (pprint_type_definition level type_func_info #.None module signature? recursive_type?)) (text.join_with " ")) ")"))
 
       [_ (#.Named [_module _name] type)]
       (if (text\= module _module)
@@ -202,7 +205,7 @@
         (%.name [_module _name]))
       )))
 
-(def: (pprint-type level type-func-name module type)
+(def: (pprint_type level type_func_name module type)
   (-> Nat Text Text Type Text)
   (case type
     (#.Primitive name params)
@@ -211,26 +214,26 @@
       (format "(primitive " (%.text name) ")")
 
       _
-      (format "(primitive " (%.text name) " " (|> params (list\map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")"))
+      (format "(primitive " (%.text name) " " (|> params (list\map (pprint_type level type_func_name module)) (list.interpose " ") (text.join_with "")) ")"))
 
     (#.Sum _)
-    (let [members (type.flatten-variant type)]
-      (format "(| " (|> members (list\map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")"))
+    (let [members (type.flatten_variant type)]
+      (format "(| " (|> members (list\map (pprint_type level type_func_name module)) (list.interpose " ") (text.join_with "")) ")"))
 
     (#.Product _)
-    (let [members (type.flatten-tuple type)]
-      (format "[" (|> members (list\map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) "]"))
+    (let [members (type.flatten_tuple type)]
+      (format "[" (|> members (list\map (pprint_type level type_func_name module)) (list.interpose " ") (text.join_with "")) "]"))
 
     (#.Function input output)
-    (let [[ins out] (type.flatten-function type)]
+    (let [[ins out] (type.flatten_function type)]
       (format  "(-> "
-               (|> ins (list\map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with ""))
+               (|> ins (list\map (pprint_type level type_func_name module)) (list.interpose " ") (text.join_with ""))
                " "
-               (pprint-type level type-func-name module out)
+               (pprint_type level type_func_name module out)
                ")"))
 
     (#.Parameter idx)
-    (parameter->name [type-func-name (list)] level idx)
+    (parameter_to_name [type_func_name (list)] level idx)
 
     (^template [ 
 ]
       [( id)
@@ -241,17 +244,17 @@
     (^template [  ]
       [( _)
        (let [[level' body] ( type)
-             args (level->args level level')
-             body-doc (pprint-type (n.+ level level') type-func-name module body)]
-         (format "("  " " "[" (|> args (list.interpose " ") (text.join-with "")) "]"
-                 (format " " body-doc)
+             args (level_to_args level level')
+             body_doc (pprint_type (n.+ level level') type_func_name module body)]
+         (format "("  " " "[" (|> args (list.interpose " ") (text.join_with "")) "]"
+                 (format " " body_doc)
                  ")"))])
-    ([#.UnivQ "All" type.flatten-univ-q]
-     [#.ExQ   "Ex"  type.flatten-ex-q])
+    ([#.UnivQ "All" type.flatten_univ_q]
+     [#.ExQ   "Ex"  type.flatten_ex_q])
 
     (#.Apply param fun)
-    (let [[type-func type-arguments] (type.flatten-application type)]
-      (format  "(" (pprint-type level type-func-name module type-func) " " (|> type-arguments (list\map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")"))
+    (let [[type_func type_arguments] (type.flatten_application type)]
+      (format  "(" (pprint_type level type_func_name module type_func) " " (|> type_arguments (list\map (pprint_type level type_func_name module)) (list.interpose " ") (text.join_with "")) ")"))
 
     (#.Named [_module _name] type)
     (if (text\= module _module)
@@ -262,7 +265,8 @@
 (type: (Mutation a)
   (-> a a))
 
-(type: Value [Text Code Type])
+(type: Value
+  [Text Code Type])
 
 (type: Organization
   {#types (List Value)
@@ -270,68 +274,68 @@
    #implementations (List Value)
    #values (List Value)})
 
-(def: (lux-module? module-name)
+(def: (lux_module? module_name)
   (-> Text Bit)
   (let [prefix (format .prelude_module "/")]
-    (or (text\= .prelude_module module-name)
-        (text.starts-with? prefix module-name))))
+    (or (text\= .prelude_module module_name)
+        (text.starts_with? prefix module_name))))
 
-(def: (add-definition [name [def-type def-annotations def-value]] organization)
+(def: (add_definition [name [exported? def_type def_annotations def_value]] organization)
   (-> [Text Definition] Organization Organization)
-  (cond (type\= .Type def-type)
+  (cond (type\= .Type def_type)
         (update@ #types
                  (: (Mutation (List Value))
-                    (|>> (#.Cons [name def-annotations (:as Type def-value)])))
+                    (|>> (#.Cons [name def_annotations (:as Type def_value)])))
                  organization)
 
-        (type\= .Macro def-type)
+        (type\= .Macro def_type)
         (update@ #macros
                  (: (Mutation (List [Text Code]))
-                    (|>> (#.Cons [name def-annotations])))
+                    (|>> (#.Cons [name def_annotations])))
                  organization)
 
-        (macro.implementation? def-annotations)
+        (annotation.implementation? def_annotations)
         (update@ #implementations
                  (: (Mutation (List Value))
-                    (|>> (#.Cons [name def-annotations def-type])))
+                    (|>> (#.Cons [name def_annotations def_type])))
                  organization)
 
         ## else
         (update@ #values
                  (: (Mutation (List Value))
-                    (|>> (#.Cons [name def-annotations def-type])))
+                    (|>> (#.Cons [name def_annotations def_type])))
                  organization)))
 
-(def: name-sort
+(def: name_sort
   (All [r] (-> [Text r] [Text r] Bit))
   (let [text\< (\ text.order <)]
     (function (_ [n1 _] [n2 _])
       (text\< n1 n2))))
 
-(def: (organize-definitions defs)
+(def: (organize_definitions defs)
   (-> (List [Text Definition]) Organization)
   (let [init {#types (list)
               #macros (list)
               #implementations (list)
               #values (list)}]
-    (|> (list\fold add-definition init defs)
-        (update@ #types (list.sort name-sort))
-        (update@ #macros (list.sort name-sort))
-        (update@ #implementations (list.sort name-sort))
-        (update@ #values (list.sort name-sort)))))
+    (|> (list\fold add_definition init defs)
+        (update@ #types (list.sort name_sort))
+        (update@ #macros (list.sort name_sort))
+        (update@ #implementations (list.sort name_sort))
+        (update@ #values (list.sort name_sort)))))
 
-(def: (unravel-type-func level type)
+(def: (unravel_type_func level type)
   (-> Nat Type Type)
   (if (n.> 0 level)
     (case type
       (#.UnivQ _env _type)
-      (unravel-type-func (dec level) _type)
+      (unravel_type_func (dec level) _type)
 
       _
       type)
     type))
 
-(def: (unrecurse-type type)
+(def: (unrecurse_type type)
   (-> Type Type)
   (case type
     (#.Apply _ (#.UnivQ _env _type))
@@ -340,50 +344,51 @@
     _
     type))
 
-(exception: #export (anonymous-type-definition {type Type})
-  (ex.report ["Type" (%.type type)]))
+(exception: #export (anonymous_type_definition {type Type})
+  (exception.report
+   ["Type" (%.type type)]))
 
-(def: (document-type module type def-annotations)
+(def: (document_type module type def_annotations)
   (-> Text Type Code (Meta (Markdown Block)))
   (case type
-    (#.Named type-name type)
-    (do macro.monad
-      [tags (macro.tags-of type-name)
-       #let [[_ _name] type-name
-             recursive-type? (macro.recursive-type? def-annotations)
-             type-arguments (macro.type-arguments def-annotations)
-             signature? (macro.signature? def-annotations)
-             usage (case type-arguments
+    (#.Named type_name type)
+    (do meta.monad
+      [tags (meta.tags_of type_name)
+       #let [[_ _name] type_name
+             recursive_type? (annotation.recursive_type? def_annotations)
+             type_arguments (annotation.type_arguments def_annotations)
+             signature? (annotation.signature? def_annotations)
+             usage (case type_arguments
                      #.Nil
                      _name
 
                      _
-                     (format "(" (text.join-with " " (list& _name type-arguments)) ")"))
-             nesting (list.size type-arguments)]]
+                     (format "(" (text.join_with " " (list& _name type_arguments)) ")"))
+             nesting (list.size type_arguments)]]
       (wrap (md.code (format (if signature? "(interface: " "(type: ")
-                             (if recursive-type? "#rec " "")
-                             usage text.new-line
+                             (if recursive_type? "#rec " "")
+                             usage text.new_line
                              (|> type
-                                 (unravel-type-func nesting)
-                                 (when> recursive-type? [unrecurse-type])
-                                 (pprint-type-definition (dec nesting) [_name type-arguments] (maybe.default (list) tags) module signature? recursive-type?)
-                                 (text.split-all-with text.new-line)
+                                 (unravel_type_func nesting)
+                                 (when> [(new> recursive_type? [])] [unrecurse_type])
+                                 (pprint_type_definition (dec nesting) [_name type_arguments] (maybe.default (list) tags) module signature? recursive_type?)
+                                 (text.split_all_with text.new_line)
                                  (list\map (|>> (format "  ")))
-                                 (text.join-with text.new-line))
+                                 (text.join_with text.new_line))
                              ")"))))
 
     _
-    (macro.fail (ex.construct anonymous-type-definition type))))
+    (meta.fail (exception.construct anonymous_type_definition type))))
 
-(def: (document-types module types)
+(def: (document_types module types)
   (-> Text (List Value) (Meta (Markdown Block)))
-  (do {! macro.monad}
-    [type-docs (monad.map !
+  (do {! meta.monad}
+    [type_docs (monad.map !
                           (: (-> Value (Meta (Markdown Block)))
-                             (function (_ [name def-annotations type])
-                               (do macro.monad
-                                 [#let [?doc (macro.get-documentation def-annotations)]
-                                  type-code (document-type module type def-annotations)]
+                             (function (_ [name def_annotations type])
+                               (do meta.monad
+                                 [#let [?doc (annotation.documentation def_annotations)]
+                                  type_code (document_type module type def_annotations)]
                                  (wrap ($_ md.then
                                            (md.heading/3 name)
                                            (case ?doc
@@ -392,23 +397,23 @@
 
                                              _
                                              md.empty)
-                                           type-code)))))
+                                           type_code)))))
                           types)]
     (wrap (list\fold (function.flip md.then)
                      (md.heading/2 "Types")
-                     type-docs))))
+                     type_docs))))
 
-(def: (document-macros module-name names)
+(def: (document_macros module_name names)
   (-> Text (List [Text Code]) (Markdown Block))
   (|> names
       (list\map (: (-> [Text Code] (Markdown Block))
-                   (function (_ [name def-annotations])
+                   (function (_ [name def_annotations])
                      ($_ md.then
                          (md.heading/3 name)
                          (<| (: (Markdown Block))
                              (maybe.default md.empty)
                              (do maybe.monad
-                               [documentation (macro.get-documentation def-annotations)]
+                               [documentation (annotation.documentation def_annotations)]
                                (wrap (md.code documentation))))))))
       (list\fold (function.flip md.then)
                  (md.heading/2 "Macros"))))
@@ -416,19 +421,19 @@
 (template [  
] [(def: ( module type) (-> Text Type (Markdown Block)) - (md.code (pprint-type (dec 0) "?" module type))) + (md.code (pprint_type (dec 0) "?" module type))) (def: ( module values) (-> Text (List Value) (Markdown Block)) (|> values - (list\map (function (_ [name def-annotations value-type]) - (let [?doc (macro.get-documentation def-annotations) - usage (case (macro.function-arguments def-annotations) + (list\map (function (_ [name def_annotations value_type]) + (let [?doc (annotation.documentation def_annotations) + usage (case (annotation.function_arguments def_annotations) #.Nil name args - (format "(" (text.join-with " " (list& name args)) ")"))] + (format "(" (text.join_with " " (list& name args)) ")"))] ($_ md.then (md.heading/3 usage) (case ?doc @@ -437,83 +442,80 @@ _ md.empty) - ( module value-type))))) + ( module value_type))))) (list\fold (function.flip md.then) (md.heading/2
))))] - [document-implementation document-implementations "Implementations"] - [document-value document-values "Values"] + [document_implementation document_implementations "Implementations"] + [document_value document_values "Values"] ) -(def: (enclose-lines pre+post block) +(def: (enclose_lines pre+post block) (-> [Text Text] Text Text) (|> block - (text.split-all-with text.new-line) + (text.split_all_with text.new_line) (list\map (text.enclose pre+post)) - (text.join-with text.new-line))) + (text.join_with text.new_line))) -(def: (document-module [[module-name module] organization]) +(def: (document_module [[module_name module] organization]) (-> [[Text Module] Organization] (Meta [Text (Markdown Block)])) - (do macro.monad + (do meta.monad [#let [(^slots [#types #macros #implementations #values]) organization annotations (|> module - (get@ #.module-annotations) + (get@ #.module_annotations) (maybe.default (' {})) - macro.get-documentation) + annotation.documentation) description (case annotations - (#.Some doc-text) - (md.quote (md.paragraph (md.text doc-text))) + (#.Some doc_text) + (md.quote (md.paragraph (md.text doc_text))) #.None md.empty) - empty-block (: (Markdown Block) md.empty)] - types-documentation (if (list.empty? types) - (wrap empty-block) - (document-types module-name types)) + empty_block (: (Markdown Block) md.empty)] + types_documentation (if (list.empty? types) + (wrap empty_block) + (document_types module_name types)) #let [documentation ($_ md.then - types-documentation - (if (list.empty? macros) empty-block (document-macros module-name macros)) - (if (list.empty? implementations) empty-block (document-implementations module-name implementations)) - (if (list.empty? values) empty-block (document-values module-name values)))]] - (wrap [module-name + types_documentation + (if (list.empty? macros) empty_block (document_macros module_name macros)) + (if (list.empty? implementations) empty_block (document_implementations module_name implementations)) + (if (list.empty? values) empty_block (document_values module_name values)))]] + (wrap [module_name ($_ md.then - (md.heading/1 module-name) + (md.heading/1 module_name) description documentation)]))) -(exception: #export (io-error {error Text}) +(exception: #export (io_error {error Text}) error) -(def: (save-documentation! [module-name documentation]) +(def: (save_documentation! [module_name documentation]) (-> [Text (Markdown Block)] (IO Any)) - (let [path (format (text.replace-all "/" "_" module-name) ".md")] + (let [path (format (text.replace_all "/" "_" module_name) ".md")] (do io.monad - [outcome (do (try.with io.monad) - [target (: (IO (Try (File IO))) - (file.get-file io.monad file.default path))] - (!.use (\ target over-write) (\ encoding.utf8 encode (md.markdown documentation))))] - (case outcome - (#try.Failure error) - (wrap (log! (ex.construct io-error error))) - - (#try.Success _) - (wrap []))))) - -(macro: (gen-documentation! _) - (do {! macro.monad} - [all-modules macro.modules - #let [lux-modules (|> all-modules - (list.filter (function.compose lux-module? product.left)) - (list.sort name-sort))] - lux-exports (monad.map ! (function.compose macro.exports product.left) - lux-modules) - module-documentation (|> (list\map organize-definitions lux-exports) - (list.zip/2 lux-modules) - (monad.map ! document-module)) - #let [_ (io.run (monad.map io.monad save-documentation! module-documentation))]] + [outcome (\ file.default write (\ utf8.codec encode (md.markdown documentation)) path)] + (wrap (case outcome + (#try.Failure error) + (debug.log! (exception.construct io_error error)) + + (#try.Success _) + []))))) + +(macro: (gen_documentation! _) + (do {! meta.monad} + [all_modules meta.modules + #let [lux_modules (|> all_modules + (list.filter (function.compose lux_module? product.left)) + (list.sort name_sort))] + lux_exports (monad.map ! (function.compose meta.exports product.left) + lux_modules) + module_documentation (|> (list\map organize_definitions lux_exports) + (list.zip/2 lux_modules) + (monad.map ! document_module)) + #let [_ (io.run (monad.map io.monad save_documentation! module_documentation))]] (wrap (list)))) -(gen-documentation!) +(gen_documentation!) (program: args - (io (log! "Done!"))) + (io (debug.log! "Done!"))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index e7ad9d03c..cbc63d90d 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -711,6 +711,27 @@ (n.= expected/s))))) ))) +(def: for_associative + Test + (do random.monad + [left (random.ascii/lower 1) + mid (random.ascii/lower 1) + right (random.ascii/lower 1) + #let [expected (text.join_with "" (list left mid right))]] + (_.cover [/.$_ /._$] + (with_expansions [ (/._$ format + left + mid + right) + (/.$_ format + left + mid + right)] + (and (text\= + ) + (not (code\= (' ) + (' )))))))) + (def: test Test (<| (_.covering /._) @@ -738,6 +759,7 @@ ..for_template ..for_static ..for_slot + ..for_associative ..sub_tests ))) diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index c38df7030..541092b4e 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -13,9 +13,10 @@ ["." exception]] [data ["." product] - ["." maybe] + ["." maybe ("#\." functor)] [collection - ["." list ("#\." functor)]]] + ["." list ("#\." functor)] + ["." set]]] [math ["." random] [number @@ -61,11 +62,51 @@ (_.cover [/.key_hash] (is? hash (/.key_hash (/.new hash))))) - (_.cover [/.entries /.keys /.values] - (\ (list.equivalence (product.equivalence n.equivalence n.equivalence)) = - (/.entries dict) - (list.zip/2 (/.keys dict) - (/.values dict)))) + (_.cover [/.entries] + (let [entries (/.entries dict) + + correct_size! + (n.= (/.size dict) + (list.size entries)) + + unique_keys! + (|> entries + (list\map product.left) + (set.from_list n.hash) + set.size + (n.= (/.size dict))) + + correct_pairing! + (list.every? (function (_ [key value]) + (|> dict + (/.get key) + (maybe\map (n.= value)) + (maybe.default false))) + entries)] + (and correct_size! + unique_keys! + correct_pairing!))) + (_.cover [/.keys] + (let [keys (/.keys dict) + + correct_size! + (n.= (/.size dict) + (list.size keys)) + + unique_keys! + (|> keys + (set.from_list n.hash) + set.size + (n.= (/.size dict))) + + recognized! + (list.every? (/.key? dict) keys)] + (and correct_size! + unique_keys! + recognized!))) + (_.cover [/.values] + (n.= (/.size dict) + (list.size (/.values dict)))) (_.cover [/.merge] (let [merging_with_oneself (let [(^open ".") (/.equivalence n.equivalence)] diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux index ba02b1fc9..e8e07e7e1 100644 --- a/stdlib/source/test/lux/ffi.jvm.lux +++ b/stdlib/source/test/lux/ffi.jvm.lux @@ -27,30 +27,17 @@ [\\library ["." /]]) -(/.import: (java/util/concurrent/Callable a)) - +(/.import: java/lang/Boolean) (/.import: java/lang/Long) (/.import: java/lang/String) -(/.import: java/lang/Exception - ["#::." - (new [java/lang/String])]) - (/.import: java/lang/Object) (/.import: (java/lang/Class a) ["#::." (getName [] java/lang/String)]) -(/.import: java/lang/Runnable) - -(/.import: java/lang/System - ["#::." - (#static out java/io/PrintStream) - (#static currentTimeMillis [] #io long) - (#static getenv [java/lang/String] #io #? java/lang/String)]) - ## TODO: Handle "/.class:" ASAP. ## (/.class: #final (TestClass A) [java/lang/Runnable] ## ## Fields @@ -70,23 +57,6 @@ ## (java/lang/Runnable [] (run self) void ## [])) -(def: test_runnable - (/.object [] [java/lang/Runnable] - [] - (java/lang/Runnable - [] (run self) void - []))) - -(def: test_callable - (/.object [a] [(java/util/concurrent/Callable a)] - [] - ((java/util/concurrent/Callable a) - [] (call self) a #throws [java/lang/Exception] - (undefined)))) - -## (/.interface: TestInterface -## ([] foo [boolean java/lang/String] void #throws [java/lang/Exception])) - (template [ <=>] [(def: ( left right) (-> Bit) @@ -262,9 +232,105 @@ (type\= /.Character (/.type char))))) )))) +(/.interface: test/TestInterface0 + ([] actual0 [] java/lang/Long)) + +(/.import: test/TestInterface0 + ["#::." + (actual0 [] java/lang/Long)]) + +(/.interface: test/TestInterface1 + ([] actual1 [java/lang/Boolean] java/lang/Long #throws [java/lang/Throwable])) + +(/.import: test/TestInterface1 + ["#::." + (actual1 [java/lang/Boolean] #try java/lang/Long)]) + +(/.interface: test/TestInterface2 + ([a] actual2 [a] a)) + +(/.import: test/TestInterface2 + ["#::." + ([a] actual2 [a] a)]) + +(/.interface: (test/TestInterface3 a) + ([] actual3 [] a)) + +(/.import: (test/TestInterface3 a) + ["#::." + (actual3 [] a)]) + +(def: interface + (do random.monad + [expected random.nat + #let [object/0 (/.object [] [test/TestInterface0] + [] + (test/TestInterface0 + [] (actual0 self) + java/lang/Long + (:as java/lang/Long + expected))) + object/1 (/.object [] [test/TestInterface1] + [] + (test/TestInterface1 + [] (actual1 self {throw? java/lang/Boolean}) + java/lang/Long + #throws [java/lang/Throwable] + (if (:as Bit throw?) + (error! "YOLO") + (:as java/lang/Long + expected)))) + object/2 (/.object [] [test/TestInterface2] + [] + (test/TestInterface2 + [a] (actual2 self {input a}) + a + input)) + object/3 (/.object [] [(test/TestInterface3 java/lang/Long)] + [] + ((test/TestInterface3 a) + [] (actual3 self) + a + (:as java/lang/Long + expected))) + + example/0! + (is? (: Any expected) + (: Any (test/TestInterface0::actual0 object/0))) + + example/1! + (and (case (test/TestInterface1::actual1 false object/1) + (#try.Success actual) + (is? (: Any expected) + (: Any actual)) + + (#try.Failure error) + false) + (case (test/TestInterface1::actual1 true object/1) + (#try.Success actual) + false + + (#try.Failure error) + true)) + + example/2! + (is? (: Any expected) + (: Any (test/TestInterface2::actual2 (:as /.Long expected) object/2))) + + example/3! + (is? (: Any expected) + (: Any (test/TestInterface3::actual3 object/3)))]] + (_.cover [/.interface:] + (and example/0! + example/1! + example/2! + example/3!)))) + (def: #export test (<| (_.covering /._) ($_ _.and ..conversions ..arrays - ..miscellaneous))) + ..miscellaneous + ..interface + ))) -- cgit v1.2.3