diff options
Diffstat (limited to 'stdlib/source/library')
-rw-r--r-- | stdlib/source/library/lux/data/format/markdown.lux | 13 | ||||
-rw-r--r-- | stdlib/source/library/lux/documentation.lux | 224 | ||||
-rw-r--r-- | stdlib/source/library/lux/type/abstract.lux | 5 | ||||
-rw-r--r-- | stdlib/source/library/lux/type/variance.lux | 12 |
4 files changed, 218 insertions, 36 deletions
diff --git a/stdlib/source/library/lux/data/format/markdown.lux b/stdlib/source/library/lux/data/format/markdown.lux index a2df019bb..88746a059 100644 --- a/stdlib/source/library/lux/data/format/markdown.lux +++ b/stdlib/source/library/lux/data/format/markdown.lux @@ -147,13 +147,22 @@ (-> Text (Markdown Span)) (|>> (text.enclosed ["`` " " ``"]) :abstraction)) - (def: .public code - {#.doc "A block of code."} + (def: .public generic_code + {#.doc "A (generic) block of code."} (-> Text (Markdown Block)) (let [open (format "```" text.new_line) close (format text.new_line "```")] (|>> (text.enclosed [open close]) ..block))) + (def: .public (code language block) + {#.doc "A block of code of a specific language."} + (-> Text Text (Markdown Block)) + (let [open (format "```" language text.new_line) + close (format text.new_line "```")] + (|> block + (text.enclosed [open close]) + ..block))) + (def: .public (image description url) (-> Text URL (Markdown Span)) (:abstraction (format "![" (..safe description) "](" url ")"))) diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux index c73a71cd2..5de44d483 100644 --- a/stdlib/source/library/lux/documentation.lux +++ b/stdlib/source/library/lux/documentation.lux @@ -9,7 +9,7 @@ [control ["." maybe ("#\." functor)] ["." exception (#+ exception:)] - ["<>" parser + ["<>" parser ("#\." monad) ["<.>" code (#+ Parser)]]] [data ["." product] @@ -273,15 +273,168 @@ (format "(" (%type' level type_function_name module type_func) " " (|> type_arguments (list\each (%type' level type_function_name module)) (text.interposed " ")) ")")) (#.Named [_module _name] type) - (if (text\= module _module) - _name - (%.name [_module _name])) + (cond (text\= module _module) + _name + + (text\= .prelude_module _module) + (format "." _name) + + ... else + (%.name [_module _name])) )) (def: type (-> Text Type Text) (%type' (-- 0) "?")) +(def: (parameterized_type arity type) + (-> Nat Type (Maybe Type)) + (case arity + 0 (#.Some type) + _ (case type + (#.UnivQ _env _type) + (parameterized_type (-- arity) _type) + + _ + #.None))) + +(def: (prefixed_lines prefix lines) + (-> Text Text Text) + (|> lines + (text.all_split_by text.new_line) + (list\each (|>> (format prefix))) + (text.interposed text.new_line))) + +(def: (type_definition' level type_function_info tags module type) + (-> Nat [Text (List Text)] (List Text) Text Type Text) + (case tags + (^ (list single_tag)) + (format "{#" single_tag " " (type_definition' level type_function_info #.None module type) "}") + + _ + (case type + (#.Primitive name params) + (case params + #.End + (format "(primitive " (%.text name) ")") + + _ + (format "(primitive " (%.text name) " " (|> params (list\each (type_definition' level type_function_info #.None module)) (text.interposed " ")) ")")) + + (#.Sum _) + (let [members (type.flat_variant type)] + (case tags + #.End + (format "(Or " + (|> members + (list\each (type_definition' level type_function_info #.None module)) + (text.interposed " ")) + ")") + + _ + (|> members + (list.zipped/2 tags) + (list\each (function (_ [t_name type]) + (case type + (#.Product _) + (let [types (type.flat_tuple type)] + (format "(#" t_name " " + (|> types + (list\each (type_definition' level type_function_info #.None module)) + (text.interposed " ")) + ")")) + + _ + (format "(#" t_name " " (type_definition' level type_function_info #.None module type) ")")))) + (text.interposed text.new_line)))) + + (#.Product _) + (let [members (type.flat_tuple type)] + (case tags + #.End + (format "[" (|> members (list\each (type_definition' level type_function_info #.None module)) (text.interposed " ")) "]") + + _ + (let [member_docs (|> members + (list.zipped/2 tags) + (list\each (function (_ [t_name type]) + (format "#" t_name " " (type_definition' level type_function_info #.None module type)))) + (text.interposed (format text.new_line " ")))] + (format "{" member_docs "}")))) + + (#.Function input output) + (let [[ins out] (type.flat_function type)] + (format "(-> " (|> ins (list\each (type_definition' level type_function_info #.None module)) (text.interposed " ")) + " " + (type_definition' level type_function_info #.None module out) + ")")) + + (#.Parameter idx) + (parameter_name type_function_info level idx) + + (^template [<tag> <pre>] + [(<tag> id) + (format <pre> (%.nat id))]) + ([#.Var "-"] + [#.Ex "+"]) + + (^template [<tag> <name> <flat>] + [(<tag> _) + (let [[level' body] (<flat> type) + args (level_parameters level level') + body_doc (type_definition' (n.+ level level') type_function_info tags module body) + fn_name (case type_function_info + [fn_name #.End] fn_name + _ "_")] + (format "(" <name> " " "(" fn_name " " (text.interposed " " args) ")" + (case tags + #.End + (format " " body_doc) + + _ + (format text.new_line (prefixed_lines " " body_doc))) + ")"))]) + ([#.UnivQ "All" type.flat_univ_q] + [#.ExQ "Ex" type.flat_ex_q]) + + ... Recursive call + (#.Apply (#.Parameter param_id) (#.Parameter fn_id)) + (if (n.= fn_id param_id) + (product.left type_function_info) + (let [[type_func type_arguments] (type.flat_application type)] + (format "(" (type_definition' level type_function_info tags module (#.Parameter fn_id)) + " " (type_definition' level type_function_info tags module (#.Parameter param_id)) + ")"))) + + (#.Apply param fun) + (let [[type_func type_arguments] (type.flat_application type)] + (format "(" (type_definition' level type_function_info tags module type_func) + " " (|> type_arguments + (list\each (type_definition' level type_function_info #.None module)) + (text.interposed " ")) + ")")) + + (#.Named [_module _name] type) + (cond (text\= module _module) + _name + + (text\= .prelude_module _module) + (format "." _name) + + ... else + (%.name [_module _name])) + ))) + +(def: (type_definition module [name parameters] tags type) + (-> Text [Text (List Text)] (List Text) Type Text) + (let [arity (list.size parameters)] + (case (parameterized_type arity type) + (#.Some type) + (type_definition' (-- arity) [name parameters] tags module type) + + #.None + (..type module type)))) + (def: description (Parser (Maybe Code)) (<>.or (<code>.text! "") @@ -326,39 +479,60 @@ (text.interposed "") code.text)) +(type: Declaration + [Name (List Text)]) + +(def: declaration + (Parser Declaration) + (<>.either (<>.and ..qualified_identifier (<>\in (list))) + (<code>.form (<>.and ..qualified_identifier + (<>.some (<code>.local_identifier)))))) + (syntax: (minimal_definition_documentation - [name ..qualified_identifier]) - (let [g!module (code.text (product.left name))] + [[name parameters] ..declaration]) + (do meta.monad + [.let [g!module (code.text (product.left name))] + [[_ def_type def_annotations def_value]] (meta.export name)] (with_expansions [<\n> (~! text.\n)] (macro.with_identifiers [g!type] (in (list (` ($_ ((~! md.then)) ... Name (<| ((~! md.heading/3)) - (~ (code.text (|> name product.right [""] %.name)))) + (~ (code.text (%.code (let [g!name (|> name product.right code.local_identifier)] + (case parameters + #.End + g!name + + _ + (` ((~ g!name) (~+ (list\each code.local_identifier parameters)))))))))) ... Type (let [(~ g!type) ("lux in-module" (~ g!module) (.:of (~ (code.identifier name))))] - ((~! md.code) - (if ((~! type\=) .Type (~ g!type)) - (|> (~ (code.identifier name)) - (:as .Type) - ((~! type.anonymous)) - ((~! ..type) (~ g!module)) - ((~! %.format) - ((~! ..single_line_comment) ((~! ..type) (~ g!module) (~ g!type))) - <\n>)) - ((~! ..type) (~ g!module) (~ g!type)))))) + ((~! md.code) "clojure" + (~ (if (type\= .Type def_type) + (` (|> (~ (code.identifier name)) + (:as .Type) + ((~! type.anonymous)) + ((~! ..type_definition) + (~ g!module) + [(~ (code.text (product.right name))) (list (~+ (list\each code.text parameters)))] + (list)) + ((~! %.format) + ((~! ..single_line_comment) ((~! ..type) (~ g!module) (~ g!type))) + <\n>))) + (` ((~! ..type) (~ g!module) (~ g!type)))))))) ))))))) (syntax: (definition_documentation - [name ..qualified_identifier + [[name parameters] ..declaration description ..description examples (<>.some ..example)]) (with_expansions [<\n> (~! text.\n)] (in (list (` ($_ ((~! md.then)) ((~! ..minimal_definition_documentation) - (~ (code.identifier name))) + ((~ (code.identifier name)) + (~+ (list\each code.local_identifier parameters)))) ... Description (~+ (case description (#.Some description) @@ -374,7 +548,7 @@ (list) _ - (list (` (<| ((~! md.code)) + (list (` (<| ((~! md.code) "clojure") ((~! %.format) (~+ (|> examples (list\each (..example_documentation (product.left name))) @@ -393,21 +567,23 @@ #expected (Set Text) #definitions (List Definition)})) -(syntax: .public (default [name ..qualified_identifier]) +(syntax: .public (default [[name parameters] ..declaration]) (let [[_ short] name] (in (list (` (: (.List ..Definition) (list {#..definition (~ (code.text short)) #..documentation ((~! ..minimal_definition_documentation) - (~ (code.identifier name)))}))))))) + ((~ (code.identifier name)) + (~+ (list\each code.local_identifier parameters))))}))))))) -(syntax: .public (documentation: [name ..qualified_identifier +(syntax: .public (documentation: [[name parameters] ..declaration extra (<>.some <code>.any)]) (let [[_ short] name] (in (list (` (.def: .public (~ (code.local_identifier short)) (.List ..Definition) (.list {#..definition (~ (code.text short)) #..documentation ((~! ..definition_documentation) - (~ (code.identifier name)) + ((~ (code.identifier name)) + (~+ (list\each code.local_identifier parameters))) (~+ extra))}))))))) (def: definitions_documentation diff --git a/stdlib/source/library/lux/type/abstract.lux b/stdlib/source/library/lux/type/abstract.lux index 9a0edab98..23e7b4378 100644 --- a/stdlib/source/library/lux/type/abstract.lux +++ b/stdlib/source/library/lux/type/abstract.lux @@ -197,10 +197,7 @@ (def: abstraction_type_name (-> Name Text) - (|>> name\encoded - ($_ text\composite - (name\encoded (name_of #..Abstraction)) - " "))) + name\encoded) (def: representation_definition_name (-> Text Text) diff --git a/stdlib/source/library/lux/type/variance.lux b/stdlib/source/library/lux/type/variance.lux index 2a7d65267..ae2c889ca 100644 --- a/stdlib/source/library/lux/type/variance.lux +++ b/stdlib/source/library/lux/type/variance.lux @@ -2,11 +2,11 @@ [library [lux #*]]) -(type: .public (Co t) - (-> Any t)) +(type: .public (Co it) + (-> Any it)) -(type: .public (Contra t) - (-> t Any)) +(type: .public (Contra it) + (-> it Any)) -(type: .public (In t) - (-> t t)) +(type: .public (In it) + (-> it it)) |