From b216900093c905b3b20dd45c69e577b192e2f7a3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 25 Aug 2021 16:47:50 -0400 Subject: Updates to the Lua compiler. --- stdlib/source/documentation/lux.lux | 988 ++++++++++++++++++++- .../documentation/lux/control/function/mixin.lux | 12 +- .../documentation/lux/data/collection/array.lux | 11 +- stdlib/source/documentation/lux/data/text.lux | 12 +- stdlib/source/documentation/lux/extension.lux | 62 ++ stdlib/source/documentation/lux/math.lux | 6 +- stdlib/source/documentation/lux/type.lux | 189 +++- stdlib/source/documentation/lux/type/check.lux | 2 +- stdlib/source/documentation/lux/type/poly.lux | 72 ++ stdlib/source/documentation/lux/type/quotient.lux | 52 ++ .../source/documentation/lux/type/refinement.lux | 64 ++ stdlib/source/documentation/lux/type/resource.lux | 118 +++ stdlib/source/documentation/lux/type/unit.lux | 117 +++ stdlib/source/documentation/lux/type/variance.lux | 32 + stdlib/source/documentation/lux/world.lux | 33 + stdlib/source/documentation/lux/world/console.lux | 43 + stdlib/source/documentation/lux/world/file.lux | 76 ++ .../source/documentation/lux/world/file/watch.lux | 58 ++ .../documentation/lux/world/input/keyboard.lux | 112 +++ stdlib/source/documentation/lux/world/net.lux | 36 + .../documentation/lux/world/net/http/client.lux | 54 ++ .../documentation/lux/world/net/http/status.lux | 171 ++++ stdlib/source/documentation/lux/world/net/uri.lux | 24 + .../lux/world/output/video/resolution.lux | 69 ++ stdlib/source/documentation/lux/world/program.lux | 37 + stdlib/source/documentation/lux/world/shell.lux | 54 ++ 26 files changed, 2458 insertions(+), 46 deletions(-) create mode 100644 stdlib/source/documentation/lux/extension.lux create mode 100644 stdlib/source/documentation/lux/type/poly.lux create mode 100644 stdlib/source/documentation/lux/type/quotient.lux create mode 100644 stdlib/source/documentation/lux/type/refinement.lux create mode 100644 stdlib/source/documentation/lux/type/resource.lux create mode 100644 stdlib/source/documentation/lux/type/unit.lux create mode 100644 stdlib/source/documentation/lux/type/variance.lux create mode 100644 stdlib/source/documentation/lux/world.lux create mode 100644 stdlib/source/documentation/lux/world/console.lux create mode 100644 stdlib/source/documentation/lux/world/file.lux create mode 100644 stdlib/source/documentation/lux/world/file/watch.lux create mode 100644 stdlib/source/documentation/lux/world/input/keyboard.lux create mode 100644 stdlib/source/documentation/lux/world/net.lux create mode 100644 stdlib/source/documentation/lux/world/net/http/client.lux create mode 100644 stdlib/source/documentation/lux/world/net/http/status.lux create mode 100644 stdlib/source/documentation/lux/world/net/uri.lux create mode 100644 stdlib/source/documentation/lux/world/output/video/resolution.lux create mode 100644 stdlib/source/documentation/lux/world/program.lux create mode 100644 stdlib/source/documentation/lux/world/shell.lux (limited to 'stdlib/source/documentation') diff --git a/stdlib/source/documentation/lux.lux b/stdlib/source/documentation/lux.lux index 4365ea0eb..a046d1fdc 100644 --- a/stdlib/source/documentation/lux.lux +++ b/stdlib/source/documentation/lux.lux @@ -5,7 +5,17 @@ ["$" documentation (#+ documentation:)] ["." debug] [control - ["." io]]]] + ["." io] + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]] + [collection + ["." list] + ["." set]]] + [macro + ["." template]]]] [\\library ["." /]] ["." / #_ @@ -14,6 +24,7 @@ ["#." data] ["#." debug] ["#." documentation] + ["#." extension] ["#." ffi] ["#." locale] ["#." macro] @@ -26,22 +37,988 @@ ["#." time] ... ["#." tool] ... TODO: Documentation for this ["#." type] - ... ["#." world] - ... ["#." extension] + ["#." world] ... ["#." target #_ ... ] ]) +(documentation: /.prelude_module + (format "The name of the prelude module" + \n "Value: " (%.text /.prelude_module))) + +(documentation: /.Any + (format "The type of things whose type is irrelevant." + \n "It can be used to write functions or data-structures that can take, or return, anything.")) + +(documentation: /.Nothing + (format "The type of things whose type is undefined." + \n "Useful for expressions that cause errors or other 'extraordinary' conditions.")) + +(documentation: /.List + "A potentially empty list of values.") + +(documentation: /.Bit + "Your standard, run-of-the-mill boolean values (as #0 or #1 bits).") + +(documentation: /.I64 + "64-bit integers without any semantics.") + +(documentation: /.Nat + (format "Natural numbers (unsigned integers)." + \n "They start at zero (0) and extend in the positive direction.")) + +(documentation: /.Int + "Your standard, run-of-the-mill integer numbers.") + +(documentation: /.Rev + (format "Fractional numbers that live in the interval [0,1)." + \n "Useful for probability, and other domains that work within that interval.")) + +(documentation: /.Frac + "Your standard, run-of-the-mill floating-point (fractional) numbers.") + +(documentation: /.Text + "Your standard, run-of-the-mill string values.") + +(documentation: /.Name + "A name. It is used as part of Lux syntax to represent identifiers and tags.") + +(documentation: /.Maybe + "A potentially missing value.") + +(documentation: /.Type + "This type represents the data-structures that are used to specify types themselves.") + +(documentation: /.Location + "Locations are for specifying the location of Code nodes in Lux files during compilation.") + +(documentation: /.Ann + "The type of things that can be annotated with meta-data of arbitrary types.") + +(documentation: /.Code + "The type of Code nodes for Lux syntax.") + +(documentation: /.private + "The export policy for private/local definitions.") + +(documentation: /.local + "The export policy for private/local definitions.") + +(documentation: /.public + "The export policy for public/global definitions.") + +(documentation: /.global + "The export policy for public/global definitions.") + +(documentation: /.Definition + "Represents all the data associated with a definition: its type, its annotations, and its value.") + +(documentation: /.Global + "Represents all the data associated with a global constant.") + +(documentation: /.Either + "A choice between two values of different types.") + +(documentation: /.Module + "All the information contained within a Lux module.") + +(documentation: /.Mode + "A sign that shows the conditions under which the compiler is running.") + +(documentation: /.Info + "Information about the current version and type of compiler that is running.") + +(documentation: /.Lux + (format "Represents the state of the Lux compiler during a run." + \n "It is provided to macros during their invocation, so they can access compiler data." + \n "Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")) + +(documentation: /.Meta + (format "Computations that can have access to the state of the compiler." + \n "These computations may fail, or modify the state of the compiler.")) + +(documentation: /.Macro + "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.") + +(documentation: /.comment + (format "Throws away any code given to it." + \n "Great for commenting-out code, while retaining syntax high-lighting and formatting in your text editor.") + [(comment + (def: (this will not) + (Be Defined) + (because it will be (commented out))))]) + +(documentation: /.All + "Universal quantification." + [(All [a] + (-> a a))] + ["A name can be provided, to specify a recursive type." + (All List [a] + (Or Any + [a (List a)]))]) + +(documentation: /.Ex + "Existential quantification." + [(Ex [a] + [(Codec Text a) a])] + ["A name can be provided, to specify a recursive type." + (Ex Self [a] + [(Codec Text a) + a + (List (Self a))])]) + +(documentation: /.-> + "Function types." + ["This is the type of a function that takes 2 Ints and returns an Int." + (-> Int Int Int)]) + +(documentation: /.list + "List literals." + [(: (List Nat) + (list 0 1 2 3))]) + +(documentation: /.list& + "List literals, with the last element being a tail-list." + [(: (List Nat) + (list& 0 1 2 3 + (: (List Nat) + (list 4 5 6))))]) + +(documentation: /.Union + "Union types." + [(Union Bit Nat Text)] + [(= Nothing + (Union))]) + +(documentation: /.Tuple + "Tuple types." + [(Tuple Bit Nat Text)] + [(= Any + (Tuple))]) + +(documentation: /.Or + "An alias for the Union type constructor." + [(= (Union Bit Nat Text) + (Or Bit Nat Text))] + [(= (Union) + (Or))]) + +(documentation: /.And + "An alias for the Tuple type constructor." + [(= (Tuple Bit Nat Text) + (And Bit Nat Text))] + [(= (Tuple) + (And))]) + +(documentation: /._$ + "Left-association for the application of binary functions over variadic arguments." + [(_$ text\composite "Hello, " name ". How are you?") + "=>" + (text\composite (text\composite "Hello, " name) ". How are you?")]) + +(documentation: /.$_ + "Right-association for the application of binary functions over variadic arguments." + [($_ text\composite "Hello, " name ". How are you?") + "=>" + (text\composite "Hello, " (text\composite name ". How are you?"))]) + +(documentation: /.if + "Picks which expression to evaluate based on a bit test value." + [(if #1 + "Oh, yeah!" + "Aw hell naw!") + "=>" + "Oh, yeah!"] + [(if #0 + "Oh, yeah!" + "Aw hell naw!") + "=>" + "Aw hell naw!"]) + +(documentation: /.primitive + "Macro to treat define new primitive types." + [(primitive "java.lang.Object")] + [(primitive "java.util.List" [(primitive "java.lang.Long")])]) + +(documentation: /.` + (format "Hygienic quasi-quotation as a macro." + \n "Unquote (~) and unquote-splice (~+) must also be used as forms." + \n "All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used.") + [(` (def: (~ name) + (function ((~' _) (~+ args)) + (~ body))))]) + +(documentation: /.`' + (format "Unhygienic quasi-quotation as a macro." + \n "Unquote (~) and unquote-splice (~+) must also be used as forms.") + [(`' (def: (~ name) + (function (_ (~+ args)) + (~ body))))]) + +(documentation: /.' + "Quotation as a macro." + [(' YOLO)]) + +(documentation: /.|> + "Piping macro." + [(|> elems + (list\each int\encoded) + (interposed " ") + (mix text\composite "")) + "=>" + (mix text\composite "" + (interposed " " + (list\each int\encoded + elems)))]) + +(documentation: /.<| + "Reverse piping macro." + [(<| (mix text\composite "") + (interposed " ") + (list\each int\encoded) + elems) + "=>" + (mix text\composite "" + (interposed " " + (list\each int\encoded + elems)))]) + +(documentation: /.template + "" + ["By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary." + (template [ ] + [(def: .public + (-> Int Int) + (+ ))] + [++ +1] + [-- -1])]) + +(documentation: /.not + "Bit negation." + [(not #1) + "=>" + #0] + [(not #0) + "=>" + #1]) + +(documentation: /.type + "Takes a type expression and returns its representation as data-structure." + [(type (All [a] + (Maybe (List a))))]) + +(documentation: /.: + "The type-annotation macro." + [(: (List Int) + (list +1 +2 +3))]) + +(documentation: /.:as + "The type-coercion macro." + [(:as Dinosaur + (list +1 +2 +3))]) + +(documentation: /.Rec + "Parameter-less recursive types." + ["A name has to be given to the whole type, to use it within its body." + (Rec Int_List + (Or Any + [Int Int_List]))]) + +(documentation: /.exec + "Sequential execution of expressions (great for side-effects)." + [(exec + (log! "#1") + (log! "#2") + (log! "#3") + "YOLO")]) + +(documentation: /.case + (format "The pattern-matching macro." + \n "Allows the usage of macros within the patterns to provide custom syntax.") + [(case (: (List Int) + (list +1 +2 +3)) + (#Item x (#Item y (#Item z #End))) + (#Some ($_ * x y z)) + + _ + #None)]) + +(documentation: /.^ + (format "Macro-expanding patterns." + \n "It's a special macro meant to be used with 'case'.") + [(case (: (List Int) + (list +1 +2 +3)) + (^ (list x y z)) + (#Some ($_ * x y z)) + + _ + #None)]) + +(documentation: /.^or + (format "Or-patterns." + \n "It's a special macro meant to be used with 'case'.") + [(type: Weekday + (Variant + #Monday + #Tuesday + #Wednesday + #Thursday + #Friday + #Saturday + #Sunday)) + + (def: (weekend? day) + (-> Weekday Bit) + (case day + (^or #Saturday #Sunday) + #1 + + _ + #0))]) + +(documentation: /.let + (format "Creates local bindings." + \n "Can (optionally) use pattern-matching macros when binding.") + [(let [x (foo bar) + y (baz quux)] + (op x y))]) + +(documentation: /.function + "Syntax for creating functions." + [(: (All [a b] + (-> a b a)) + (function (_ x y) + x))] + ["Allows for giving the function itself a name, for the sake of recursion." + (: (-> Nat Nat) + (function (factorial n) + (case n + 0 1 + _ (* n (factorial (-- n))))))]) + +(documentation: /.def: + "Defines global constants/functions." + [(def: branching_exponent + Int + +5)] + ["The type is optional." + (def: branching_exponent + +5)] + [(def: (pair_list pair) + (-> [Code Code] (List Code)) + (let [[left right] pair] + (list left right)))] + ["Can pattern-match on the inputs to functions." + (def: (pair_list [left right]) + (-> [Code Code] (List Code)) + (list left right))]) + +(documentation: /.macro: + "Macro-definition macro." + [(macro: .public (name_of tokens) + (case tokens + (^template [] + [(^ (list [_ ( [module name])])) + (in (list (` [(~ (text$ module)) (~ (text$ name))])))]) + ([#Identifier] [#Tag]) + + _ + (failure "Wrong syntax for name_of")))]) + +(documentation: /.and + "Short-circuiting 'and'." + [(and #1 #0) + "=>" + #0] + [(and #1 #1) + "=>" + #1]) + +(documentation: /.or + "Short-circuiting 'or'." + [(or #1 #0) + "=>" + #1] + [(or #0 #0) + "=>" + #0]) + +(documentation: /.panic! + "Causes an error, with the given error message." + [(panic! "OH NO!")]) + +(documentation: /.implementation + "Express a value that implements an interface." + [(: (Order Int) + (implementation + (def: &equivalence + equivalence) + (def: (< reference subject) + (< reference subject)) + ))]) + +(documentation: /.implementation: + "Interface implementation." + [(implementation: .public order + (Order Int) + (def: &equivalence + equivalence) + (def: (< test subject) + (< test subject)))]) + +(documentation: /.Variant + (format "Syntax for defining labelled/tagged sum/union types." + \n "WARNING: Only use it within the type: macro.") + [(type: Referrals + (Variant + #All + (#Only (List Text)) + (#Exclude (List Text)) + #Ignore + #Nothing))]) + +(documentation: /.Record + (format "Syntax for defining labelled/slotted product/tuple types." + \n "WARNING: Only use it within the type: macro.") + [(type: Refer + (Record + {#refer_defs Referrals + #refer_open (List Openings)}))]) + +(documentation: /.type: + "The type-definition macro." + [(type: (List a) + #End + (#Item a (List a)))]) + +(documentation: /.interface: + "Interface definition." + [(interface: .public (Order a) + (: (Equivalence a) + &equivalence) + (: (-> a a Bit) + <))]) + +(.template [] + [(documentation: + "Safe type-casting for I64 values.")] + + [/.i64] + [/.nat] + [/.int] + [/.rev] + ) + +(documentation: /.module_separator + (format "Character used to separate the parts of module names." + \n "Value: " (%.text /.module_separator))) + +(documentation: /.^open + (format "Same as the 'open' macro, but meant to be used as a pattern-matching macro for generating local bindings." + \n "Takes an 'alias' text for the generated local bindings.") + [(def: .public (range enum from to) + (All [a] (-> (Enum a) a a (List a))) + (let [(^open ".") enum] + (loop [end to + output #.End] + (cond (< end from) + (recur (pred end) (#.Item end output)) + + (< from end) + (recur (succ end) (#.Item end output)) + + ... (= end from) + (#.Item end output)))))]) + +(documentation: /.cond + "Conditional branching with multiple test conditions." + [(cond (even? num) "WHEN even" + (odd? num) "WHEN odd" + "ELSE")]) + +(documentation: /.value@ + "Accesses the value of a record at a given tag." + [(value@ #field my_record)] + ["Can also work with multiple levels of nesting." + (value@ [#foo #bar #baz] my_record)] + ["And, if only the slot/path is given, generates an accessor function." + (let [getter (value@ [#foo #bar #baz])] + (getter my_record))]) + +(documentation: /.open: + "Opens a implementation and generates a definition for each of its members (including nested members)." + [(open: "i:." order) + "=>" + (def: i:= (\ order =)) + (def: i:< (\ order <))]) + +(documentation: /.|>> + "Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." + [(|>> (list\each int\encoded) + (interposed " ") + (mix text\composite "")) + "=>" + (function (_ ) + (mix text\composite "" + (interposed " " + (list\each int\encoded ))))]) + +(documentation: /.<<| + "Similar to the reverse piping macro, but rather than taking an initial object to work on, creates a function for taking it." + [(<<| (mix text\composite "") + (interposed " ") + (list\each int\encoded)) + "=>" + (function (_ ) + (mix text\composite "" + (interposed " " + (list\each int\encoded + ))))]) + +(documentation: /.module: + "Module-definition macro." + [(.module: + [lux #* + [control + ["M" monad #*]] + [data + maybe + ["." name ("#/." codec)]] + [macro + code]] + [// + [type ("." equivalence)]])]) + +(documentation: /.\ + "Allows accessing the value of a implementation's member." + [(\ codec encoded)] + ["Also allows using that value as a function." + (\ codec encoded +123)]) + +(documentation: /.with@ + "Sets the value of a record at a given tag." + [(with@ #name "Lux" lang)] + ["Can also work with multiple levels of nesting." + (with@ [#foo #bar #baz] value my_record)] + ["And, if only the slot/path and (optionally) the value are given, generates a mutator function." + (let [setter (with@ [#foo #bar #baz] value)] + (setter my_record)) + (let [setter (with@ [#foo #bar #baz])] + (setter value my_record))]) + +(documentation: /.revised@ + "Modifies the value of a record at a given tag, based on some function." + [(revised@ #age ++ person)] + ["Can also work with multiple levels of nesting." + (revised@ [#foo #bar #baz] func my_record)] + ["And, if only the slot/path and (optionally) the value are given, generates a mutator function." + (let [updater (revised@ [#foo #bar #baz] func)] + (updater my_record)) + (let [updater (revised@ [#foo #bar #baz])] + (updater func my_record))]) + +(documentation: /.^template + "It's similar to template, but meant to be used during pattern-matching." + [(def: (reduced env type) + (-> (List Type) Type Type) + (case type + (#.Primitive name params) + (#.Primitive name (list\each (reduced env) params)) + + (^template [] + [( left right) + ( (reduced env left) (reduced env right))]) + ([#.Sum] [#.Product]) + + (^template [] + [( left right) + ( (reduced env left) (reduced env right))]) + ([#.Function] [#.Apply]) + + (^template [] + [( old_env def) + (case old_env + #.End + ( env def) + + _ + type)]) + ([#.UnivQ] [#.ExQ]) + + (#.Parameter idx) + (else type (list.item idx env)) + + _ + type + ))]) + +(.template [ ] + [(documentation: + )] + + [/.++ "Increment function."] + [/.-- "Decrement function."] + ) + +(documentation: /.loop + (format "Allows arbitrary looping, using the 'recur' form to re-start the loop." + \n "Can be used in monadic code to create monadic loops.") + [(loop [count +0 + x init] + (if (< +10 count) + (recur (++ count) (f x)) + x))] + ["Loops can also be given custom names." + (loop my_loop + [count +0 + x init] + (if (< +10 count) + (my_loop (++ count) (f x)) + x))]) + +(documentation: /.^slots + "Allows you to extract record members as local variables with the same names." + [(let [(^slots [#foo #bar #baz]) quux] + (f foo bar baz))]) + +(documentation: /.with_expansions + (format "Controlled macro-expansion." + \n "Bind an arbitraty number of Code nodes resulting from macro-expansion to local bindings." + \n "Wherever a binding appears, the bound Code nodes will be spliced in there.") + [(def: test + Test + (with_expansions + [ (template [ ] + [(cover [] + (compare + (\ codec encoded )))] + + [bit #1 "#1"] + [int +123 "+123"] + [frac +123.0 "+123.0"] + [text "123" "'123'"] + [tag ["yolo" "lol"] "#yolo.lol"] + [identifier ["yolo" "lol"] "yolo.lol"] + [form (list (bit #1)) "(#1)"] + [tuple (list (bit #1)) "[#1]"] + [record (list [(bit #1) (int +123)]) "{#1 +123}"] + )] + ($_ and + + )))]) + +(documentation: /.static + (format "Resolves the names of definitions to their values at compile-time, assuming their values are either:" + \n "* Bit" + \n "* Nat" + \n "* Int" + \n "* Rev" + \n "* Frac" + \n "* Text") + [(def: my_nat 123) + (def: my_text "456") + (and (case [my_nat my_text] + (^ (static [..my_nat ..my_text])) + true + + _ + false) + (case [my_nat my_text] + (^ [(static ..my_nat) (static ..my_text)]) + true + + _ + false))]) + +(documentation: /.^multi + (format "Multi-level pattern matching." + \n "Useful in situations where the result of a branch depends on further refinements on the values being matched.") + [(case (split (size static) uri) + (^multi (#Some [chunk uri']) + {(text\= static chunk) #1}) + (match_uri endpoint? parts' uri') + + _ + (#Left (format "Static part " (%t static) " does not match URI: " uri)))] + ["Short-cuts can be taken when using bit tests." + "The example above can be rewritten as..." + (case (split (size static) uri) + (^multi (#Some [chunk uri']) + (text\= static chunk)) + (match_uri endpoint? parts' uri') + + _ + (#Left (format "Static part " (%t static) " does not match URI: " uri)))]) + +(documentation: /.name_of + "Given an identifier or a tag, gives back a 2 tuple with the module and name parts, both as Text." + [(name_of #.doc) + "=>" + ["library/lux" "doc"]]) + +(documentation: /.:parameter + (format "WARNING: Please stay away from this macro; it's very likely to be removed in a future version of Lux." + "Allows you to refer to the type-variables in a polymorphic function's type, by their index.") + ["In the example below, 0 corresponds to the 'a' variable." + (def: .public (of_list list) + (All [a] (-> (List a) (Row a))) + (list\mix add + (: (Row (:parameter 0)) + empty) + list))]) + +(documentation: /.same? + "Tests whether the 2 values are identical (not just 'equal')." + ["This one should succeed:" + (let [value +5] + (same? value + value))] + ["This one should fail:" + (same? +5 + (+ +2 +3))]) + +(documentation: /.^@ + "Allows you to simultaneously bind and de-structure a value." + [(def: (hash (^@ set [member_hash _])) + (list\mix (function (_ elem acc) + (+ acc + (\ member_hash hash elem))) + 0 + (set.list set)))]) + +(documentation: /.^|> + "Pipes the value being pattern-matched against prior to binding it to a variable." + [(case input + (^|> value [++ (% 10) (max 1)]) + (foo value))]) + +(documentation: /.:expected + "Coerces the given expression to the type of whatever is expected." + [(: Dinosaur + (:expected (: (List Nat) + (list 1 2 3))))]) + +(documentation: /.undefined + (format "Meant to be used as a stand-in for functions with undefined implementations." + \n "Undefined expressions will type-check against everything, so they make good dummy implementations." + \n "However, if an undefined expression is ever evaluated, it will raise a runtime error.") + [(def: (square x) + (-> Int Int) + (undefined))]) + +(documentation: /.:of + "Generates the type corresponding to a given expression." + [(let [my_num +123] + (:of my_num)) + "==" + Int] + [(:of +123) + "==" + Int]) + +(documentation: /.template: + (format "Define macros in the style of template and ^template." + \n "For simple macros that do not need any fancy features.") + [(template: (square x) + (* x x))]) + +(documentation: /.as_is + (format "Given a (potentially empty) list of codes, just returns them immediately, without any work done." + \n "This may seen useless, but it has its utility when dealing with controlled-macro-expansion macros.") + [(with_expansions [ (as_is 1 + 2 + 3 + 4)] + ($_ + ))]) + +(documentation: /.char + "If given a 1-character text literal, yields the char-code of the sole character." + [(: Nat + (char "A")) + "=>" + 65]) + +(documentation: /.for + (format "Selects the appropriate code for a given target-platform when compiling Lux to it." + \n "Look-up the available targets in library/lux/target.") + [(def: js "JavaScript") + (for {"JVM" (do jvm stuff) + ..js (do js stuff)} + (do default stuff))]) + +(documentation: /.`` + (format "Delimits a controlled (spliced) macro-expansion." + \n "Uses a (~~) special form to specify where to expand.") + [(`` (some expression + (~~ (some macro which may yield 0 or more results))))]) + +(documentation: /.^code + "Generates pattern-matching code for Code values in a way that looks like code-templating." + [(: (Maybe Nat) + (case (` (#0 123 +456.789)) + (^code (#0 (~ [_ (#.Nat number)]) +456.789)) + (#.Some number) + + _ + #.None))]) + +(documentation: /.false + "The boolean FALSE value.") + +(documentation: /.true + "The boolean TRUE value.") + +(documentation: /.:let + "Local bindings for types." + [(:let [side (Either Int Frac)] + (List [side side]))]) + +(documentation: /.try + "" + [(: Foo + (case (: (Either Text Bar) + (try (: Bar + (risky computation which may panic)))) + (#.Right success) + (: Foo + (do something after success)) + + (#.Left error) + (: Foo + (recover from error))))]) + (.def: .public documentation (.List $.Module) ($.module /._ "" - [] + [..prelude_module + ..Any + ..Nothing + ..List + ..Bit + ..I64 + ..Nat + ..Int + ..Rev + ..Frac + ..Text + ..Name + ..Maybe + ..Type + ..Location + ..Ann + ..Code + ..private + ..local + ..public + ..global + ..Definition + ..Global + ..Either + ..Module + ..Mode + ..Info + ..Lux + ..Meta + ..Macro + ..comment + ..All + ..Ex + ..-> + ..list + ..list& + ..Union + ..Tuple + ..Or + ..And + .._$ + ..$_ + ..if + ..primitive + ..` + ..`' + ..' + ..|> + ..<| + ..template + ..not + ..type + ..: + ..:as + ..Rec + ..exec + ..case + ..^ + ..^or + ..let + ..function + ..def: + ..macro: + ..and + ..or + ..panic! + ..implementation + ..implementation: + ..Variant + ..Record + ..type: + ..interface: + ..i64 + ..nat + ..int + ..rev + ..module_separator + ..^open + ..cond + ..value@ + ..open: + ..|>> + ..<<| + ..module: + ..\ + ..with@ + ..revised@ + ..^template + ..++ + ..-- + ..loop + ..^slots + ..with_expansions + ..static + ..^multi + ..name_of + ..:parameter + ..same? + ..^@ + ..^|> + ..:expected + ..undefined + ..:of + ..template: + ..as_is + ..char + ..for + ..`` + ..^code + ..false + ..true + ..:let + ..try + ($.default /.Code') + ($.default /.Alias) + ($.default /.Bindings) + ($.default /.Ref) + ($.default /.Scope) + ($.default /.Source) + ($.default /.Module_State) + ($.default /.Type_Context) + ($.default /.Macro')] [/abstract.documentation /control.documentation /data.documentation /debug.documentation /documentation.documentation + /extension.documentation /ffi.documentation /locale.documentation /macro.documentation @@ -52,7 +1029,8 @@ /target.documentation /test.documentation /time.documentation - /type.documentation])) + /type.documentation + /world.documentation])) (program: inputs (io.io (debug.log! ($.documentation ..documentation)))) diff --git a/stdlib/source/documentation/lux/control/function/mixin.lux b/stdlib/source/documentation/lux/control/function/mixin.lux index f23f065b0..d0a8c9667 100644 --- a/stdlib/source/documentation/lux/control/function/mixin.lux +++ b/stdlib/source/documentation/lux/control/function/mixin.lux @@ -13,16 +13,16 @@ (documentation: /.Mixin "A partially-defined function which can be mixed with others to inherit their behavior.") -(documentation: /.mixin +(documentation: /.fixed "Given a mixin, produces a normal function." - [(mixin f)]) + [(fixed f)]) (documentation: /.nothing "A mixin that does nothing and just delegates work to the next mixin.") -(documentation: /.with +(documentation: /.mixed "Produces a new mixin, where the behavior of the child can make use of the behavior of the parent." - [(with parent child)]) + [(mixed parent child)]) (documentation: /.advice "Only apply then mixin when the input meets some criterion." @@ -48,9 +48,9 @@ ($.module /._ "" [..Mixin - ..mixin + ..fixed ..nothing - ..with + ..mixed ..advice ..before ..after diff --git a/stdlib/source/documentation/lux/data/collection/array.lux b/stdlib/source/documentation/lux/data/collection/array.lux index e36cba1a8..ce1d461c5 100644 --- a/stdlib/source/documentation/lux/data/collection/array.lux +++ b/stdlib/source/documentation/lux/data/collection/array.lux @@ -84,12 +84,10 @@ [(of_list xs)]) (documentation: /.list - "Yields a list with every non-empty item in the array." - [(list array)]) - -(documentation: /.list' - "Like 'list', but uses the 'default' value when encountering an empty cell in the array." - [(list' default array)]) + (format "Yields a list with every non-empty item in the array." + \n "Can use the optional default value when encountering an empty cell in the array.") + [(list #.None array) + (list (#.Some default) array)]) (.def: .public documentation (.List $.Module) @@ -113,7 +111,6 @@ ..clone ..of_list ..list - ..list' ($.default /.type_name) ($.default /.equivalence) ($.default /.monoid) diff --git a/stdlib/source/documentation/lux/data/text.lux b/stdlib/source/documentation/lux/data/text.lux index 7887d97f6..690eacd4b 100644 --- a/stdlib/source/documentation/lux/data/text.lux +++ b/stdlib/source/documentation/lux/data/text.lux @@ -27,9 +27,9 @@ "Yields the character at the specified index." [(char index input)]) -(documentation: /.index' +(documentation: /.index_since "" - [(index' from pattern input)]) + [(index_since from pattern input)]) (documentation: /.index "" @@ -75,9 +75,9 @@ "Clips a chunk of text from the input at the specified offset and of the specified size." [(clip offset size input)]) -(documentation: /.clip' +(documentation: /.clip_since "Clips the remaining text from the input at the specified offset." - [(clip' offset input)]) + [(clip_since offset input)]) (documentation: /.split_at "" @@ -114,7 +114,7 @@ [..Char ..line_feed ..char - ..index' + ..index_since ..index ..last_index ..starts_with? @@ -126,7 +126,7 @@ ..enclosed ..enclosed' ..clip - ..clip' + ..clip_since ..split_at ..split_by ..all_split_by diff --git a/stdlib/source/documentation/lux/extension.lux b/stdlib/source/documentation/lux/extension.lux new file mode 100644 index 000000000..d5b9836e7 --- /dev/null +++ b/stdlib/source/documentation/lux/extension.lux @@ -0,0 +1,62 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + ["." debug] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]] + [collection + ["." row]]] + [macro + ["." template]] + ["@" target + ["." jvm]] + [tool + [compiler + ["." phase] + [language + [lux + [phase + ["." directive]]]]]]]] + [\\library + ["." /]]) + +(documentation: /.analysis: + "Mechanism for defining extensions to Lux's analysis/type-checking infrastructure." + [(analysis: ("my analysis" self phase archive [pass_through .any]) + (phase archive pass_through))]) + +(documentation: /.synthesis: + "Mechanism for defining extensions to Lux's synthesis/optimization infrastructure." + [(synthesis: ("my synthesis" self phase archive [pass_through .any]) + (phase archive pass_through))]) + +(documentation: /.generation: + "" + [(generation: ("my generation" self phase archive [pass_through .any]) + (for {@.jvm + (\ phase.monad each (|>> #jvm.Embedded + row.row) + (phase archive pass_through))} + (phase archive pass_through)))]) + +(documentation: /.directive: + "" + [(directive: ("my directive" self phase archive [parameters (<>.some .any)]) + (do phase.monad + [.let [_ (debug.log! (format "Successfully installed directive " (%.text self) "!"))]] + (in directive.no_requirements)))]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..analysis: + ..synthesis: + ..generation: + ..directive:] + [])) diff --git a/stdlib/source/documentation/lux/math.lux b/stdlib/source/documentation/lux/math.lux index f41afe130..57b56dec2 100644 --- a/stdlib/source/documentation/lux/math.lux +++ b/stdlib/source/documentation/lux/math.lux @@ -34,9 +34,9 @@ "" [(atan/2 x y)]) -(documentation: /.log' +(documentation: /.log_by "" - [(log' base it)]) + [(log_by base it)]) (.def: .public documentation (.List $.Module) @@ -47,7 +47,7 @@ ..tau ..pow ..atan/2 - ..log' + ..log_by ($.default /.cos) ($.default /.sin) ($.default /.tan) diff --git a/stdlib/source/documentation/lux/type.lux b/stdlib/source/documentation/lux/type.lux index 0ad9a5f51..25d216dca 100644 --- a/stdlib/source/documentation/lux/type.lux +++ b/stdlib/source/documentation/lux/type.lux @@ -1,13 +1,13 @@ (.module: [library - [lux (#- and) + [lux (#- function :as) ["$" documentation (#+ documentation:)] [control ["<>" parser ["<.>" code]]] [data ["." text (#+ \n) - ["%" format (#+ format)]]] + ["%" format]]] [macro ["." template]]]] [\\library @@ -17,27 +17,180 @@ ["#." check] ["#." dynamic] ["#." implicit] - ... ["#." poly] - ... ["#." quotient] - ... ["#." refinement] - ... ["#." resource] - ... ["#." unit] - ... ["#." variance] - ]) + ["#." poly] + ["#." quotient] + ["#." refinement] + ["#." resource] + ["#." unit] + ["#." variance]]) + +(template [] + [(documentation: + "The number of parameters, and the body, of a quantified type." + [( type)])] + + [/.flat_univ_q] + [/.flat_ex_q] + ) + +(documentation: /.flat_function + "The input, and the output of a function type." + [(flat_function type)]) + +(documentation: /.flat_application + "The quantified type, and its parameters, for a type-application." + [(flat_application type)]) + +(template [] + [(documentation: + "The members of a composite type." + [( type)])] + + [/.flat_variant] + [/.flat_tuple] + ) + +(documentation: /.format + "A (readable) textual representable of a type." + [(format type)]) + +(documentation: /.applied + "To the extend possible, applies a quantified type to the given parameters." + [(applied params func)]) + +(documentation: /.code + (%.format "A representation of a type as code." + \n "The code is such that evaluating it would yield the type value.") + [(code type)]) + +(documentation: /.de_aliased + "A (potentially named) type that does not have its name shadowed by other names." + [(de_aliased type)]) + +(documentation: /.anonymous + "A type without any names covering it." + [(anonymous type)]) + +(template [] + [(documentation: + "A composite type, constituted by the given member types." + [( types)])] + + [/.variant] + [/.tuple] + ) + +(documentation: /.function + "A function type, with the given inputs and output." + [(function inputs output)]) + +(documentation: /.application + "An un-evaluated type application, with the given quantified type, and parameters." + [(application params quant)]) + +(template [] + [(documentation: + "A quantified type, with the given number of parameters, and body." + [( size body)])] + + [/.univ_q] + [/.ex_q] + ) + +(documentation: /.quantified? + "Only yields #1 for universally or existentially quantified types." + [(quantified? type)]) + +(documentation: /.array + "An array type, with the given level of nesting/depth, and the given element type." + [(array depth element_type)]) + +(documentation: /.flat_array + "The level of nesting/depth and element type for an array type." + [(flat_array type)]) + +(documentation: /.array? + "Is a type an array type?") + +(documentation: /.:log! + "Logs to the console/terminal the type of an expression." + [(:log! (: Foo (foo expression))) + "=>" + "Expression: (foo expression)" + " Type: Foo" + (foo expression)]) + +(documentation: /.:as + (%.format "Casts a value to a specific type." + \n "The specified type can depend on type variables of the original type of the value." + \n "NOTE: Careless use of type-casts is an easy way to introduce bugs. USE WITH CAUTION.") + [(: (Bar Bit Nat Text) + (:as [a b c] + (Foo a [b c]) + (Bar a b c) + (: (Foo Bit [Nat Text]) + (foo expression))))]) + +(documentation: /.:sharing + "Allows specifing the type of an expression as sharing type-variables with the type of another expression." + [(: (Bar Bit Nat Text) + (:sharing [a b c] + (Foo a [b c]) + (: (Foo Bit [Nat Text]) + (foo expression)) + + (Bar a b c) + (bar expression)))]) + +(documentation: /.:by_example + "Constructs a type that shares type-variables with an expression of some other type." + [(: Type + (:by_example [a b c] + (Foo a [b c]) + (: (Foo Bit [Nat Text]) + (foo expression)) + + (Bar a b c))) + "=>" + (.type (Bar Bit Nat Text))]) (.def: .public documentation (.List $.Module) ($.module /._ - "" - [] + "Basic functionality for working with types." + [..flat_univ_q + ..flat_ex_q + ..flat_function + ..flat_application + ..flat_variant + ..flat_tuple + ..format + ..applied + ..code + ..de_aliased + ..anonymous + ..variant + ..tuple + ..function + ..application + ..univ_q + ..ex_q + ..quantified? + ..array + ..flat_array + ..array? + ..:log! + ..:as + ..:sharing + ..:by_example + ($.default /.equivalence)] [/abstract.documentation /check.documentation /dynamic.documentation /implicit.documentation - ... /poly.documentation - ... /quotient.documentation - ... /refinement.documentation - ... /resource.documentation - ... /unit.documentation - ... /variance.documentation - ])) + /poly.documentation + /quotient.documentation + /refinement.documentation + /resource.documentation + /unit.documentation + /variance.documentation])) diff --git a/stdlib/source/documentation/lux/type/check.lux b/stdlib/source/documentation/lux/type/check.lux index 3264a87a3..f6f8db6f0 100644 --- a/stdlib/source/documentation/lux/type/check.lux +++ b/stdlib/source/documentation/lux/type/check.lux @@ -91,6 +91,6 @@ ($.default /.apply) ($.default /.monad) ($.default /.bound?) - ($.default /.read') + ($.default /.peek) ($.default /.read)] [])) diff --git a/stdlib/source/documentation/lux/type/poly.lux b/stdlib/source/documentation/lux/type/poly.lux new file mode 100644 index 000000000..47ea08837 --- /dev/null +++ b/stdlib/source/documentation/lux/type/poly.lux @@ -0,0 +1,72 @@ +(.module: + [library + [lux (#- and) + ["$" documentation (#+ documentation:)] + [abstract + [\\specification + ["$." equivalence] + ["$." codec]]] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.derived: + "" + [(type: Variant + (.Variant + (#Bit Bit) + (#Text Text) + (#Frac Frac))) + + (type: #rec Recursive + (.Variant + (#Number Frac) + (#Addition Frac Recursive))) + + (type: Record + (.Record + {#bit Bit + #frac Frac + #text Text + #maybe (Maybe Frac) + #list (List Frac) + #dictionary (Dictionary Text Frac) + #variant Variant + #tuple [Bit Text Frac] + #recursive Recursive + #date Date + #grams (Qty Gram)})) + + (derived: equivalence + ($equivalence.equivalence + Record)) + + (: (Equivalence Record) + equivalence) + + (derived: codec + ($codec.codec + Record)) + + (: (Codec Json Record) + codec)]) + +(documentation: /.code + "" + [(code env type)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..derived: + ..code + ($.default /.poly:)] + [])) diff --git a/stdlib/source/documentation/lux/type/quotient.lux b/stdlib/source/documentation/lux/type/quotient.lux new file mode 100644 index 000000000..51b9db079 --- /dev/null +++ b/stdlib/source/documentation/lux/type/quotient.lux @@ -0,0 +1,52 @@ +(.module: + [library + [lux (#- type) + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Class + "The class knows how to classify/label values that are meant to be equivalent to one another.") + +(documentation: /.Quotient + (format "A quotient value has been labeled with a class." + \n "All equivalent values will belong to the same class." + \n "This means all equivalent values possess the same label.")) + +(documentation: /.quotient + "" + [(quotient class value)]) + +(documentation: /.type + "The Quotient type associated with a Class type." + [(def: even + (class even?)) + + (def: Even + Type + (type even)) + + (: Even + (quotient even 123))]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Class + ..Quotient + ..quotient + ..type + ($.default /.class) + ($.default /.value) + ($.default /.label) + ($.default /.equivalence)] + [])) diff --git a/stdlib/source/documentation/lux/type/refinement.lux b/stdlib/source/documentation/lux/type/refinement.lux new file mode 100644 index 000000000..eb7c4b902 --- /dev/null +++ b/stdlib/source/documentation/lux/type/refinement.lux @@ -0,0 +1,64 @@ +(.module: + [library + [lux (#- type) + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Refined + "A refined version of another type, using a predicate to select valid instances.") + +(documentation: /.Refiner + "A selection mechanism for refined instances of a type.") + +(documentation: /.refiner + "" + [(refiner predicate)]) + +(documentation: /.lifted + (format "Yields a function that can work on refined values." + \n "Respects the constraints of the refinement.") + [(lifted transform)]) + +(documentation: /.only + "" + [(only refiner values)]) + +(documentation: /.partition + "Separates refined values from the un-refined ones." + [(partition refiner values)]) + +(documentation: /.type + "The Refined type associated with a Refiner type." + [(def: even + (refiner even?)) + + (def: Even + Type + (type even)) + + (: (Maybe Even) + (even 123))]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Refined + ..Refiner + ..refiner + ..lifted + ..only + ..partition + ..type + ($.default /.value) + ($.default /.predicate)] + [])) diff --git a/stdlib/source/documentation/lux/type/resource.lux b/stdlib/source/documentation/lux/type/resource.lux new file mode 100644 index 000000000..653cac853 --- /dev/null +++ b/stdlib/source/documentation/lux/type/resource.lux @@ -0,0 +1,118 @@ +(.module: + [library + [lux (#- and) + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Procedure + (format "A computation that takes a sequence of resource access rights as inputs and yields a different sequence as outputs." + \n "A procedure yields a result value." + \n "A procedure can make use of monadic effects.")) + +(documentation: /.Linear + (format "A procedure that is constant with regards to resource access rights." + \n "This means no additional resources will be available after the computation is over." + \n "This also means no previously available resources will have been consumed.")) + +(documentation: /.Affine + "A procedure which expands the number of available resources.") + +(documentation: /.Relevant + "A procedure which reduces the number of available resources.") + +(documentation: /.run! + "" + [(run! monad procedure)]) + +(documentation: /.lifted + "" + [(lifted monad procedure)]) + +(documentation: /.Ordered + "The mode of keys which CANNOT be swapped, and for whom order of release/consumption matters.") + +(documentation: /.Commutative + "The mode of keys which CAN be swapped, and for whom order of release/consumption DOES NOT matters.") + +(documentation: /.Key + (format "The access right for a resource." + \n "Without the key for a resource existing somewhere among the available ambient rights, one cannot use a resource.")) + +(documentation: /.Res + (format "A resource locked by a key." + \n "The 'key' represents the right to access/consume a resource.")) + +(template [] + [(documentation: + "Makes a value into a resource and adds the key/access-right to it to the ambient keyring for future use." + [( monad value)])] + + [/.ordered] + [/.commutative] + ) + +(documentation: /.read + "Access the value of a resource, so long as its key is available." + [(read monad resource)]) + +(documentation: /.exchange + (format "A function that can exchange the keys for resource, so long as they are commutative." + \n "This keys will be placed at the front of the keyring in the order they are specified." + \n "The specific keys must be specified based of their index into the current keyring.") + [(do (monad !) + [res|left (commutative ! pre) + res|right (commutative ! post) + _ ((exchange [1 0]) !) + left (read ! res|left) + right (read ! res|right)] + (in (format left right)))]) + +(template [] + [(documentation: + "Group/un-group keys in the keyring into/out-of tuples." + [(do (monad !) + [res|left (commutative ! pre) + res|right (commutative ! post) + _ ((group 2) !) + _ ((un_group 2) !) + right (read ! res|right) + left (read ! res|left)] + (in (format left right)))])] + + [/.group] + [/.un_group] + ) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Procedure + ..Linear + ..Affine + ..Relevant + ..run! + ..lifted + ..Ordered + ..Commutative + ..Key + ..Res + ..ordered + ..commutative + ..read + ..exchange + ..group + ..un_group + ($.default /.monad) + ($.default /.index_cannot_be_repeated) + ($.default /.amount_cannot_be_zero)] + [])) diff --git a/stdlib/source/documentation/lux/type/unit.lux b/stdlib/source/documentation/lux/type/unit.lux new file mode 100644 index 000000000..b33a797c6 --- /dev/null +++ b/stdlib/source/documentation/lux/type/unit.lux @@ -0,0 +1,117 @@ +(.module: + [library + [lux (#- and) + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]] + [math + [number + ["." ratio]]]]] + [\\library + ["." /]]) + +(documentation: /.Qty + "A quantity with an associated unit of measurement.") + +(template [] + [(documentation: + "" + [( param subject)])] + + [/.+] + [/.-] + [/.*] + [/./] + ) + +(documentation: /.Unit + "A unit of measurement, to qualify numbers with.") + +(documentation: /.Scale + "A scale of magnitude.") + +(documentation: /.Pure + "A pure, unit-less quantity.") + +(documentation: /.unit: + (format "Define a unit of measurement." + \n "Both the name of the type, and the name of the Unit implementation must be specified.") + [(unit: .public Feet feet)]) + +(documentation: /.scale: + "Define a scale of magnitude." + [(scale: .public Bajillion bajillion + [1 1,234,567,890])]) + +(documentation: /.re_scaled + "" + [(re_scaled from to quantity)]) + +(template [ ] + [(`` (documentation: + (let [numerator (value@ [#/.ratio #ratio.numerator] ) + denominator (value@ [#/.ratio #ratio.denominator] )] + (format "'" (~~ (template.text [])) "' scale from " (%.nat numerator) " to " (%.nat denominator) "."))))] + + [/.Kilo /.kilo] + [/.Mega /.mega] + [/.Giga /.giga] + + [/.Milli /.milli] + [/.Micro /.micro] + [/.Nano /.nano] + ) + +(template [] + [(`` (documentation: + (format "'" (~~ (template.text [])) "' unit of meaurement.")))] + + [/.Gram] + [/.Meter] + [/.Litre] + [/.Second] + ) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Qty + ..+ + ..- + ..* + ../ + ..Unit + ..Scale + ..Pure + ..unit: + ..scale: + ..re_scaled + ..kilo + ..mega + ..giga + ..milli + ..micro + ..nano + ..Gram + ..Meter + ..Litre + ..Second + ($.default /.pure) + ($.default /.number) + ($.default /.equivalence) + ($.default /.order) + ($.default /.enum) + ($.default /.Kilo) + ($.default /.Mega) + ($.default /.Giga) + ($.default /.Milli) + ($.default /.Micro) + ($.default /.Nano)] + [])) diff --git a/stdlib/source/documentation/lux/type/variance.lux b/stdlib/source/documentation/lux/type/variance.lux new file mode 100644 index 000000000..7503f9197 --- /dev/null +++ b/stdlib/source/documentation/lux/type/variance.lux @@ -0,0 +1,32 @@ +(.module: + [library + [lux (#- and) + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Co + "A constraint for covariant types.") + +(documentation: /.Contra + "A constraint for contravariant types.") + +(documentation: /.In + "A constraint for invariant types.") + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Co + ..Contra + ..In] + [])) diff --git a/stdlib/source/documentation/lux/world.lux b/stdlib/source/documentation/lux/world.lux new file mode 100644 index 000000000..834c8cdd5 --- /dev/null +++ b/stdlib/source/documentation/lux/world.lux @@ -0,0 +1,33 @@ +(.module: + [library + [lux #* + [program (#+ program:)] + ["$" documentation (#+ documentation:)] + ["." debug] + [control + ["." io]] + [data + [collection + ["." list ("#\." monoid)]]]]] + ["." / #_ + ["#." console] + ["#." file] + ["#." input #_ + ["#/." keyboard]] + ["#." net] + ["#." output #_ + ["#/." video #_ + ["#/." resolution]]] + ["#." program] + ["#." shell]]) + +(.def: .public documentation + (.List $.Module) + ($_ list\composite + /console.documentation + /file.documentation + /input/keyboard.documentation + /net.documentation + /output/video/resolution.documentation + /program.documentation + /shell.documentation)) diff --git a/stdlib/source/documentation/lux/world/console.lux b/stdlib/source/documentation/lux/world/console.lux new file mode 100644 index 000000000..80841123d --- /dev/null +++ b/stdlib/source/documentation/lux/world/console.lux @@ -0,0 +1,43 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Console + "An interface to console/terminal I/O.") + +(documentation: /.write_line + "Writes the message on the console and appends a new-line/line-feed at the end." + [(write_line message console)]) + +(documentation: /.Mock + (format "A mock/simulation of a console." + \n "Useful for testing.")) + +(documentation: /.mock + "" + [(mock mock init)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Console + ..write_line + ..Mock + ..mock + ($.default /.async) + ($.default /.cannot_open) + ($.default /.cannot_close) + ($.default /.default)] + [])) diff --git a/stdlib/source/documentation/lux/world/file.lux b/stdlib/source/documentation/lux/world/file.lux new file mode 100644 index 000000000..06596ef56 --- /dev/null +++ b/stdlib/source/documentation/lux/world/file.lux @@ -0,0 +1,76 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]] + ["." / #_ + ["#." watch]]) + +(documentation: /.Path + "A path to a file or a directory in a file-system.") + +(documentation: /.System + "An interface to a file-system.") + +(documentation: /.parent + "If a path represents a nested file/directory, extracts its parent directory." + [(parent fs path)]) + +(documentation: /.name + "The un-nested name of a file/directory." + [(name fs path)]) + +(documentation: /.rooted + "A nested path for a file/directory, given a root/parent path and a file/directory name within it." + [(rooted fs parent child)]) + +(documentation: /.exists? + "Checks if either a file or a directory exists at the given path." + [(exists? monad fs path)]) + +(documentation: /.mock + (format "A purely in-memory simulation of a file-system." + \n "Useful for testing.") + [(mock separator)]) + +(documentation: /.make_directories + (format "Creates the directory specified by the given path." + \n "Also, creates every super-directory necessary to make the given path valid.") + [(make_directories monad fs path)]) + +(documentation: /.make_file + "Creates a new file with the given content if-and-only-if the file does not already exist." + [(make_file monad fs content path)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Path + ..System + ..parent + ..name + ..rooted + ..exists? + ..mock + ..make_directories + ..make_file + ($.default /.async) + ($.default /.cannot_make_file) + ($.default /.cannot_find_file) + ($.default /.cannot_delete) + ($.default /.cannot_make_directory) + ($.default /.cannot_find_directory) + ($.default /.cannot_read_all_data) + ($.default /.cannot_modify_file) + ($.default /.default)] + [/watch.documentation])) diff --git a/stdlib/source/documentation/lux/world/file/watch.lux b/stdlib/source/documentation/lux/world/file/watch.lux new file mode 100644 index 000000000..e310d8d2d --- /dev/null +++ b/stdlib/source/documentation/lux/world/file/watch.lux @@ -0,0 +1,58 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Concern + "A particular concern to watch-out for.") + +(documentation: /.also + "" + [(also left right)]) + +(documentation: /.Watcher + "Machinery for watching a file-system for changes to files and directories.") + +(documentation: /.polling + (format "A simple watcher that works for any file-system." + "Polls files and directories to detect changes.") + [(polling fs)]) + +(documentation: /.mock + (format "A fake/emulated watcher." + \n "Must be given a path separator for the file-system.") + [(mock separator)]) + +(documentation: /.default + "The default watcher for the default file-system.") + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Concern + ..also + ..Watcher + ..polling + ..mock + ..default + ($.default /.creation) + ($.default /.creation?) + ($.default /.modification) + ($.default /.modification?) + ($.default /.deletion) + ($.default /.deletion?) + ($.default /.all) + ($.default /.not_being_watched) + ($.default /.cannot_poll_a_non_existent_directory)] + [])) diff --git a/stdlib/source/documentation/lux/world/input/keyboard.lux b/stdlib/source/documentation/lux/world/input/keyboard.lux new file mode 100644 index 000000000..8c63ade98 --- /dev/null +++ b/stdlib/source/documentation/lux/world/input/keyboard.lux @@ -0,0 +1,112 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Key + "A key from a keyboard, identify by a numeric ID.") + +(documentation: /.Press + "A key-press for a key.") + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Key + ..Press + ($.default /.back_space) + ($.default /.enter) + ($.default /.shift) + ($.default /.control) + ($.default /.alt) + ($.default /.caps_lock) + ($.default /.escape) + ($.default /.space) + ($.default /.page_up) + ($.default /.page_down) + ($.default /.end) + ($.default /.home) + ($.default /.left) + ($.default /.up) + ($.default /.right) + ($.default /.down) + ($.default /.a) + ($.default /.b) + ($.default /.c) + ($.default /.d) + ($.default /.e) + ($.default /.f) + ($.default /.g) + ($.default /.h) + ($.default /.i) + ($.default /.j) + ($.default /.k) + ($.default /.l) + ($.default /.m) + ($.default /.n) + ($.default /.o) + ($.default /.p) + ($.default /.q) + ($.default /.r) + ($.default /.s) + ($.default /.t) + ($.default /.u) + ($.default /.v) + ($.default /.w) + ($.default /.x) + ($.default /.y) + ($.default /.z) + ($.default /.num_pad_0) + ($.default /.num_pad_1) + ($.default /.num_pad_2) + ($.default /.num_pad_3) + ($.default /.num_pad_4) + ($.default /.num_pad_5) + ($.default /.num_pad_6) + ($.default /.num_pad_7) + ($.default /.num_pad_8) + ($.default /.num_pad_9) + ($.default /.delete) + ($.default /.num_lock) + ($.default /.scroll_lock) + ($.default /.print_screen) + ($.default /.insert) + ($.default /.windows) + ($.default /.f1) + ($.default /.f2) + ($.default /.f3) + ($.default /.f4) + ($.default /.f5) + ($.default /.f6) + ($.default /.f7) + ($.default /.f8) + ($.default /.f9) + ($.default /.f10) + ($.default /.f11) + ($.default /.f12) + ($.default /.f13) + ($.default /.f14) + ($.default /.f15) + ($.default /.f16) + ($.default /.f17) + ($.default /.f18) + ($.default /.f19) + ($.default /.f20) + ($.default /.f21) + ($.default /.f22) + ($.default /.f23) + ($.default /.f24) + ($.default /.release) + ($.default /.press)] + [])) diff --git a/stdlib/source/documentation/lux/world/net.lux b/stdlib/source/documentation/lux/world/net.lux new file mode 100644 index 000000000..f6247b2e2 --- /dev/null +++ b/stdlib/source/documentation/lux/world/net.lux @@ -0,0 +1,36 @@ +(.module: + [library + [lux #* + [program (#+ program:)] + ["$" documentation (#+ documentation:)] + ["." debug] + [control + ["." io]]]] + [\\library + ["." /]] + ["." / #_ + ["#." uri] + ["#." http #_ + ["#/." client] + ["#/." status]]]) + +(documentation: /.Address + "A TCP/IP address.") + +(documentation: /.Port + "A TCP/IP port.") + +(documentation: /.URL + "A Uniform Resource Locator.") + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Address + ..Port + ..URL + ($.default /.Location)] + [/uri.documentation + /http/client.documentation + /http/status.documentation])) diff --git a/stdlib/source/documentation/lux/world/net/http/client.lux b/stdlib/source/documentation/lux/world/net/http/client.lux new file mode 100644 index 000000000..3534ebc6a --- /dev/null +++ b/stdlib/source/documentation/lux/world/net/http/client.lux @@ -0,0 +1,54 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Client + "A HTTP client capable of issuing requests to a HTTP server.") + +(template [] + [(documentation: + (format "A " (text.upper_cased (template.text [])) " request."))] + + [/.post] + [/.get] + [/.put] + [/.patch] + [/.delete] + [/.head] + [/.connect] + [/.options] + [/.trace] + [/.default] + [/.async] + [/.headers] + ) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Client + ..post + ..get + ..put + ..patch + ..delete + ..head + ..connect + ..options + ..trace + ..default + ..async + ..headers] + [])) diff --git a/stdlib/source/documentation/lux/world/net/http/status.lux b/stdlib/source/documentation/lux/world/net/http/status.lux new file mode 100644 index 000000000..f0623b88d --- /dev/null +++ b/stdlib/source/documentation/lux/world/net/http/status.lux @@ -0,0 +1,171 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(template [] + [(documentation: + (|> (template.text []) + (text.replaced "_" " ") + text.upper_cased + (format (%.nat ) ": ")))] + + ... 1xx Informational response + [/.continue] + [/.switching_protocols] + [/.processing] + [/.early_hints] + + ... 2xx Success + [/.ok] + [/.created] + [/.accepted] + [/.non_authoritative_information] + [/.no_content] + [/.reset_content] + [/.partial_content] + [/.multi_status] + [/.already_reported] + [/.im_used] + + ... 3xx Redirection + [/.multiple_choices] + [/.moved_permanently] + [/.found] + [/.see_other] + [/.not_modified] + [/.use_proxy] + [/.switch_proxy] + [/.temporary_redirect] + [/.permanent_redirect] + + ... 4xx Client errors + [/.bad_request] + [/.unauthorized] + [/.payment_required] + [/.forbidden] + [/.not_found] + [/.method_not_allowed] + [/.not_acceptable] + [/.proxy_authentication_required] + [/.request_timeout] + [/.conflict] + [/.gone] + [/.length_required] + [/.precondition_failed] + [/.payload_too_large] + [/.uri_too_long] + [/.unsupported_media_type] + [/.range_not_satisfiable] + [/.expectation_failed] + [/.im_a_teapot] + [/.misdirected_request] + [/.unprocessable_entity] + [/.locked] + [/.failed_dependency] + [/.upgrade_required] + [/.precondition_required] + [/.too_many_requests] + [/.request_header_fields_too_large] + [/.unavailable_for_legal_reasons] + + ... 5xx Server errors + [/.internal_server_error] + [/.not_implemented] + [/.bad_gateway] + [/.service_unavailable] + [/.gateway_timeout] + [/.http_version_not_supported] + [/.variant_also_negotiates] + [/.insufficient_storage] + [/.loop_detected] + [/.not_extended] + [/.network_authentication_required] + ) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [ ... 1xx Informational response + ..continue + ..switching_protocols + ..processing + ..early_hints + + ... 2xx Success + ..ok + ..created + ..accepted + ..non_authoritative_information + ..no_content + ..reset_content + ..partial_content + ..multi_status + ..already_reported + ..im_used + + ... 3xx Redirection + ..multiple_choices + ..moved_permanently + ..found + ..see_other + ..not_modified + ..use_proxy + ..switch_proxy + ..temporary_redirect + ..permanent_redirect + + ... 4xx Client errors + ..bad_request + ..unauthorized + ..payment_required + ..forbidden + ..not_found + ..method_not_allowed + ..not_acceptable + ..proxy_authentication_required + ..request_timeout + ..conflict + ..gone + ..length_required + ..precondition_failed + ..payload_too_large + ..uri_too_long + ..unsupported_media_type + ..range_not_satisfiable + ..expectation_failed + ..im_a_teapot + ..misdirected_request + ..unprocessable_entity + ..locked + ..failed_dependency + ..upgrade_required + ..precondition_required + ..too_many_requests + ..request_header_fields_too_large + ..unavailable_for_legal_reasons + + ... 5xx Server errors + ..internal_server_error + ..not_implemented + ..bad_gateway + ..service_unavailable + ..gateway_timeout + ..http_version_not_supported + ..variant_also_negotiates + ..insufficient_storage + ..loop_detected + ..not_extended + ..network_authentication_required] + [])) diff --git a/stdlib/source/documentation/lux/world/net/uri.lux b/stdlib/source/documentation/lux/world/net/uri.lux new file mode 100644 index 000000000..710bf4b7c --- /dev/null +++ b/stdlib/source/documentation/lux/world/net/uri.lux @@ -0,0 +1,24 @@ +(.module: + [library + [lux #* + [program (#+ program:)] + ["$" documentation (#+ documentation:)] + ["." debug] + [control + ["." io]]]] + [\\library + ["." /]]) + +(documentation: /.URI + "A Uniform Resource Identifier.") + +(documentation: /.separator + "A separator for the pieces of a URI.") + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..URI + ..separator] + [])) diff --git a/stdlib/source/documentation/lux/world/output/video/resolution.lux b/stdlib/source/documentation/lux/world/output/video/resolution.lux new file mode 100644 index 000000000..6425902c8 --- /dev/null +++ b/stdlib/source/documentation/lux/world/output/video/resolution.lux @@ -0,0 +1,69 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Resolution + "A screen resolution.") + +(template [] + [(documentation: + (let [name (|> (template.text []) + (text.replaced "/" " ") + (text.replaced "_" " ") + text.upper_cased)] + (format name " resolution: " + (%.nat (value@ #/.width )) + "x" (%.nat (value@ #/.height )) + ".")))] + + [/.svga] + [/.wsvga] + [/.xga] + [/.xga+] + [/.wxga/16:9] + [/.wxga/5:3] + [/.wxga/16:10] + [/.sxga] + [/.wxga+] + [/.hd+] + [/.wsxga+] + [/.fhd] + [/.wuxga] + [/.wqhd] + [/.uhd_4k] + ) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Resolution + ..svga + ..wsvga + ..xga + ..xga+ + ..wxga/16:9 + ..wxga/5:3 + ..wxga/16:10 + ..sxga + ..wxga+ + ..hd+ + ..wsxga+ + ..fhd + ..wuxga + ..wqhd + ..uhd_4k + ($.default /.hash) + ($.default /.equivalence)] + [])) diff --git a/stdlib/source/documentation/lux/world/program.lux b/stdlib/source/documentation/lux/world/program.lux new file mode 100644 index 000000000..d61db573b --- /dev/null +++ b/stdlib/source/documentation/lux/world/program.lux @@ -0,0 +1,37 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Program + "Access to ambient program data and the capacity to exit the program.") + +(documentation: /.environment + "Assembles the environment variables available to the program." + [(environment monad program)]) + +(documentation: /.mock + "" + [(mock environment home directory)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Program + ..environment + ..mock + ($.default /.unknown_environment_variable) + ($.default /.async) + ($.default /.default)] + [])) diff --git a/stdlib/source/documentation/lux/world/shell.lux b/stdlib/source/documentation/lux/world/shell.lux new file mode 100644 index 000000000..43264c503 --- /dev/null +++ b/stdlib/source/documentation/lux/world/shell.lux @@ -0,0 +1,54 @@ +(.module: + [library + [lux #* + ["$" documentation (#+ documentation:)] + [control + ["<>" parser + ["<.>" code]]] + [data + ["." text (#+ \n) + ["%" format (#+ format)]]] + [macro + ["." template]]]] + [\\library + ["." /]]) + +(documentation: /.Exit + "A program exit code.") + +(documentation: /.Process + "The means for communicating with a program/process being executed by the operating system.") + +(documentation: /.Command + "A command that can be executed by the operating system.") + +(documentation: /.Argument + "A parameter for a command.") + +(documentation: /.Shell + "The means for issuing commands to the operating system.") + +(documentation: /.Mock + "A simulated process.") + +(documentation: /.mock + "" + [(mock mock init)]) + +(.def: .public documentation + (.List $.Module) + ($.module /._ + "" + [..Exit + ..Process + ..Command + ..Argument + ..Shell + ..Mock + ..mock + ($.default /.normal) + ($.default /.error) + ($.default /.async) + ($.default /.no_more_output) + ($.default /.default)] + [])) -- cgit v1.2.3