aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2021-07-20 16:19:43 -0400
committerEduardo Julian2021-07-20 16:19:43 -0400
commit461a6ce673de9b2c3d77714c4884c2a316fe7e8f (patch)
tree9522fbf422dea7935ca167f425c8bacce0f76b63 /stdlib
parenta1c192d175f13cdb3e69b3ca5985d0d5ecf0fe93 (diff)
Updated the Scriptum documentation generator.
Diffstat (limited to '')
-rw-r--r--stdlib/source/library/lux/control/exception.lux42
-rw-r--r--stdlib/source/library/lux/data/collection/dictionary.lux21
-rw-r--r--stdlib/source/library/lux/data/format/markdown.lux68
-rw-r--r--stdlib/source/library/lux/ffi.jvm.lux4
-rw-r--r--stdlib/source/library/lux/macro.lux6
-rw-r--r--stdlib/source/library/lux/target/jvm/loader.lux7
-rw-r--r--stdlib/source/library/lux/target/jvm/type/alias.lux41
-rw-r--r--stdlib/source/library/lux/target/jvm/type/signature.lux14
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux54
-rw-r--r--stdlib/source/program/scriptum.lux448
-rw-r--r--stdlib/source/test/lux.lux22
-rw-r--r--stdlib/source/test/lux/data/collection/dictionary.lux55
-rw-r--r--stdlib/source/test/lux/ffi.jvm.lux130
13 files changed, 564 insertions, 348 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
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 [<name> <partition>]
[(def: (<name> id)
(-> Nat Bit)
(<partition> 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 [<tag> <pre> <post>]
[[_ (<tag> id)]
@@ -176,25 +179,25 @@
(^template [<tag> <name> <flatten>]
[[_ (<tag> _)]
(let [[level' body] (<flatten> type)
- args (level->args level level')
- body-doc (pprint-type-definition (n.+ level level') type-func-info tags module signature? recursive-type? body)]
- (format "(" <name> " " "[" (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 "(" <name> " " "[" (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 [<tag> <pre> <post>]
[(<tag> id)
@@ -241,17 +244,17 @@
(^template [<tag> <name> <flatten>]
[(<tag> _)
(let [[level' body] (<flatten> type)
- args (level->args level level')
- body-doc (pprint-type (n.+ level level') type-func-name module body)]
- (format "(" <name> " " "[" (|> 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 "(" <name> " " "[" (|> 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 [<singular> <plural> <header>]
[(def: (<singular> module type)
(-> Text Type (Markdown Block))
- (md.code (pprint-type (dec 0) "?" module type)))
+ (md.code (pprint_type (dec 0) "?" module type)))
(def: (<plural> 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)
- (<singular> module value-type)))))
+ (<singular> module value_type)))))
(list\fold (function.flip md.then)
(md.heading/2 <header>))))]
- [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 [<left_association> (/._$ format
+ left
+ mid
+ right)
+ <right_association> (/.$_ format
+ left
+ mid
+ right)]
+ (and (text\= <left_association>
+ <right_association>)
+ (not (code\= (' <left_association>)
+ (' <right_association>))))))))
+
(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 [<name> <type> <conversion> <lux> <=>]
[(def: (<name> left right)
(-> <type> <type> 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
+ )))