From 7976268575e7c6910dfba2d2733e8cc1883678e7 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 8 Jul 2022 17:47:23 -0400 Subject: Re-named the "documentation" macro to "definition". --- stdlib/source/documentation/lux.lux | 212 ++++++++++++++++++------------------ 1 file changed, 105 insertions(+), 107 deletions(-) (limited to 'stdlib/source/documentation/lux.lux') diff --git a/stdlib/source/documentation/lux.lux b/stdlib/source/documentation/lux.lux index c76736c72..c8d8fff45 100644 --- a/stdlib/source/documentation/lux.lux +++ b/stdlib/source/documentation/lux.lux @@ -25,7 +25,6 @@ ["[1][0]" math] ["[1][0]" meta] ["[1][0]" program] - ["[1][0]" static] ["[1][0]" test] ["[1][0]" world]]) @@ -33,106 +32,106 @@ (.List $.Module) ($.module /._ "" - [($.documentation /.prelude + [($.definition /.prelude (format "The name of the prelude module" \n "Value: " (%.text /.prelude))) - ($.documentation /.Any + ($.definition /.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 + ($.definition /.Nothing (format "The type of things whose type is undefined." \n "Useful for expressions that cause errors or other 'extraordinary' conditions.")) - ($.documentation (/.List item) + ($.definition (/.List item) "A potentially empty list of values.") - ($.documentation /.Bit + ($.definition /.Bit "Your standard, run-of-the-mill boolean values (as #0 or #1 bits).") - ($.documentation (/.I64 kind) + ($.definition (/.I64 kind) "64-bit integers without any semantics.") - ($.documentation /.Nat + ($.definition /.Nat (format "Natural numbers (unsigned integers)." \n "They start at zero (0) and extend in the positive direction.")) - ($.documentation /.Int + ($.definition /.Int "Your standard, run-of-the-mill integer numbers.") - ($.documentation /.Rev + ($.definition /.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 + ($.definition /.Frac "Your standard, run-of-the-mill floating-point (fractional) numbers.") - ($.documentation /.Text + ($.definition /.Text "Your standard, run-of-the-mill string values.") - ($.documentation /.Symbol + ($.definition /.Symbol (format "A name for a Lux definition." \n "It includes the module of provenance.")) - ($.documentation (/.Maybe value) + ($.definition (/.Maybe value) "A potentially missing value.") - ($.documentation /.Type + ($.definition /.Type "This type represents the data-structures that are used to specify types themselves.") - ($.documentation /.Location + ($.definition /.Location "Locations are for specifying the location of Code nodes in Lux files during compilation.") - ($.documentation (/.Ann meta_data datum) + ($.definition (/.Ann meta_data datum) "The type of things that can be annotated with meta-data of arbitrary types.") - ($.documentation /.Code + ($.definition /.Code "The type of Code nodes for Lux syntax.") - ($.documentation /.private + ($.definition /.private "The export policy for private/local definitions.") - ($.documentation /.local + ($.definition /.local "The export policy for private/local definitions.") - ($.documentation /.public + ($.definition /.public "The export policy for public/global definitions.") - ($.documentation /.global + ($.definition /.global "The export policy for public/global definitions.") - ($.documentation /.Definition + ($.definition /.Definition "Represents all the data associated with a definition: its type, its annotations, and its value.") - ($.documentation /.Global + ($.definition /.Global "Represents all the data associated with a global constant.") - ($.documentation (/.Either left right) + ($.definition (/.Either left right) "A choice between two values of different types.") - ($.documentation /.Module + ($.definition /.Module "All the information contained within a Lux module.") - ($.documentation /.Mode + ($.definition /.Mode "A sign that shows the conditions under which the compiler is running.") - ($.documentation /.Info + ($.definition /.Info "Information about the current version and type of compiler that is running.") - ($.documentation /.Lux + ($.definition /.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 it) + ($.definition (/.Meta it) (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 + ($.definition /.Macro "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.") - ($.documentation /.comment + ($.definition /.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 @@ -140,7 +139,7 @@ (Be Defined) (because it will be (commented out))))]) - ($.documentation /.All + ($.definition /.All "Universal quantification." [(All (_ a) (-> a a))] @@ -149,7 +148,7 @@ (Or Any [a (List a)]))]) - ($.documentation /.Ex + ($.definition /.Ex "Existential quantification." [(Ex (_ a) [(Codec Text a) a])] @@ -159,55 +158,55 @@ a (List (Self a))])]) - ($.documentation /.-> + ($.definition /.-> "Function types." ["This is the type of a function that takes 2 Ints and returns an Int." (-> Int Int Int)]) - ($.documentation /.list + ($.definition /.list "List literals." [(is (List Nat) (list 0 1 2 3))]) - ($.documentation /.Union + ($.definition /.Union "Union types." [(Union Bit Nat Text)] [(= Nothing (Union))]) - ($.documentation /.Tuple + ($.definition /.Tuple "Tuple types." [(Tuple Bit Nat Text)] [(= Any (Tuple))]) - ($.documentation /.Or + ($.definition /.Or "An alias for the Union type constructor." [(= (Union Bit Nat Text) (Or Bit Nat Text))] [(= (Union) (Or))]) - ($.documentation /.And + ($.definition /.And "An alias for the Tuple type constructor." [(= (Tuple Bit Nat Text) (And Bit Nat Text))] [(= (Tuple) (And))]) - ($.documentation /.left + ($.definition /.left "Left-association for the application of binary functions over variadic arguments." [(left text#composite "Hello, " name ". How are you?") "=>" (text#composite (text#composite "Hello, " name) ". How are you?")]) - ($.documentation /.all + ($.definition /.all "Right-association for the application of binary functions over variadic arguments." [(all text#composite "Hello, " name ". How are you?") "=>" (text#composite "Hello, " (text#composite name ". How are you?"))]) - ($.documentation /.if + ($.definition /.if "Picks which expression to evaluate based on a bit test value." [(if #1 "Oh, yeah!" @@ -220,12 +219,12 @@ "=>" "Aw hell naw!"]) - ($.documentation /.Primitive + ($.definition /.Primitive "Macro to treat define new primitive types." [(Primitive "java.lang.Object")] [(Primitive "java.util.List" [(Primitive "java.lang.Long")])]) - ($.documentation /.` + ($.definition /.` (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.") @@ -233,18 +232,18 @@ (function ((,' _) (,* args)) (, body))))]) - ($.documentation /.`' + ($.definition /.`' (format "Unhygienic quasi-quotation as a macro." \n "Unquote (,) and unquote-splice (,*) must also be used as forms.") [(`' (def (, name) (function (_ (,* args)) (, body))))]) - ($.documentation /.' + ($.definition /.' "Quotation as a macro." [(' YOLO)]) - ($.documentation /.|> + ($.definition /.|> "Piping macro." [(|> elems (list#each int#encoded) @@ -256,7 +255,7 @@ (list#each int#encoded elems)))]) - ($.documentation /.<| + ($.definition /.<| "Reverse piping macro." [(<| (mix text#composite "") (interposed " ") @@ -268,7 +267,7 @@ (list#each int#encoded elems)))]) - ($.documentation /.template + ($.definition /.template "" ["By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary." (with_template [ ] @@ -280,7 +279,7 @@ [-- -1] )]) - ($.documentation /.not + ($.definition /.not "Bit negation." [(not #1) "=>" @@ -289,22 +288,22 @@ "=>" #1]) - ($.documentation /.type + ($.definition /.type "Takes a type expression and returns its representation as data-structure." [(type_literal (All (_ a) (Maybe (List a))))]) - ($.documentation /.is + ($.definition /.is "The type-annotation macro." [(is (List Int) (list +1 +2 +3))]) - ($.documentation /.as + ($.definition /.as "The type-coercion macro." [(as Dinosaur (list +1 +2 +3))]) - ($.documentation /.Rec + ($.definition /.Rec "Parameter-less recursive types." ["A name has to be given to the whole type, to use it within its body." (Rec Int_List @@ -326,7 +325,7 @@ {#Apply @ @} {#Named Symbol @})))]) - ($.documentation /.exec + ($.definition /.exec "Sequential execution of expressions (great for side-effects)." [(exec (log! "#1") @@ -334,7 +333,7 @@ (log! "#3") "YOLO")]) - ($.documentation /.case + ($.definition /.case (format "The pattern-matching macro." \n "Allows the usage of macros within the patterns to provide custom syntax.") [(case (is (List Int) @@ -345,7 +344,7 @@ _ {#None})]) - ($.documentation /.pattern + ($.definition /.pattern (format "Macro-expanding patterns." \n "It's a special macro meant to be used with 'case'.") [(case (is (List Int) @@ -356,7 +355,7 @@ _ {#None})]) - ... ($.documentation /.^or + ... ($.definition /.^or ... (format "Or-patterns." ... \n "It's a special macro meant to be used with 'case'.") ... [(type Weekday @@ -378,14 +377,14 @@ ... _ ... #0))]) - ($.documentation /.let + ($.definition /.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 + ($.definition /.function "Syntax for creating functions." [(is (All (_ a b) (-> a b a)) @@ -398,7 +397,7 @@ 0 1 _ (* n (factorial (-- n))))))]) - ($.documentation /.def + ($.definition /.def "Defines global constants/functions." [(def branching_exponent Int @@ -415,7 +414,7 @@ (-> [Code Code] (List Code)) (list left right))]) - ($.documentation /.macro + ($.definition /.macro "Macro-definition macro." [(def .public symbol (macro (_ tokens) @@ -428,7 +427,7 @@ _ (failure "Wrong syntax for symbol"))))]) - ($.documentation /.and + ($.definition /.and "Short-circuiting 'and'." [(and #1 #0) "=>" @@ -437,7 +436,7 @@ "=>" #1]) - ($.documentation /.or + ($.definition /.or "Short-circuiting 'or'." [(or #1 #0) "=>" @@ -446,11 +445,11 @@ "=>" #0]) - ($.documentation /.panic! + ($.definition /.panic! "Causes an error, with the given error message." [(panic! "OH NO!")]) - ($.documentation /.implementation + ($.definition /.implementation "Express a value that implements an interface." [(is (Order Int) (implementation @@ -460,7 +459,7 @@ (< reference subject)) ))]) - ($.documentation /.Variant + ($.definition /.Variant (format "Syntax for defining labelled/tagged sum/union types." \n "WARNING: Only use it within the type macro.") [(type Referrals @@ -471,7 +470,7 @@ {#Ignore} {#Nothing}))]) - ($.documentation /.Record + ($.definition /.Record (format "Syntax for defining labelled/slotted product/tuple types." \n "WARNING: Only use it within the type macro.") [(type Refer @@ -479,13 +478,13 @@ [#refer_defs Referrals #refer_open (List Openings)]))]) - ($.documentation /.type + ($.definition /.type "The type-definition macro." [(type (List a) {#End} {#Item a (List a)})]) - ($.documentation /.Interface + ($.definition /.Interface "Interface definition." [(type .public (Order a) (Interface @@ -495,7 +494,7 @@ <)))]) (.,, (.with_template [] - [($.documentation + [($.definition "Safe type-casting for I64 values.")] [/.i64] @@ -504,11 +503,11 @@ [/.rev] )) - ($.documentation /.module_separator + ($.definition /.module_separator (format "Character used to separate the parts of module names." \n "Value: " (%.text /.module_separator))) - ($.documentation /.open + ($.definition /.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) @@ -525,13 +524,13 @@ ... (= end from) {.#Item end output}))))]) - ($.documentation /.cond + ($.definition /.cond "Conditional branching with multiple test conditions." [(cond (even? num) "WHEN even" (odd? num) "WHEN odd" "ELSE")]) - ($.documentation /.the + ($.definition /.the "Accesses the value of a record at a given tag." [(the #field my_record)] ["Can also work with multiple levels of nesting." @@ -540,14 +539,14 @@ (let [getter (the [#foo #bar #baz])] (getter my_record))]) - ($.documentation /.use + ($.definition /.use "Opens a implementation and generates a definition for each of its members (including nested members)." [(use "i:[0]" order) "=>" (def i:= (at order =)) (def i:< (at order <))]) - ($.documentation /.|>> + ($.definition /.|>> "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 " ") @@ -558,7 +557,7 @@ (interposed " " (list#each int#encoded ))))]) - ($.documentation /.<<| + ($.definition /.<<| "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 " ") @@ -570,7 +569,7 @@ (list#each int#encoded ))))]) - ($.documentation /.require + ($.definition /.require "Module-definition macro." [(.require [lux (.except) @@ -584,13 +583,13 @@ [// [type (.use "[0]" equivalence)]])]) - ($.documentation /.at + ($.definition /.at "Allows accessing the value of a implementation's member." [(at codec encoded)] ["Also allows using that value as a function." (at codec encoded +123)]) - ($.documentation /.has + ($.definition /.has "Sets the value of a record at a given tag." [(has #name "Lux" lang)] ["Can also work with multiple levels of nesting." @@ -601,7 +600,7 @@ (let [setter (has [#foo #bar #baz])] (setter value my_record))]) - ($.documentation /.revised + ($.definition /.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." @@ -612,7 +611,7 @@ (let [updater (revised [#foo #bar #baz])] (updater func my_record))]) - ... ($.documentation /.^template + ... ($.definition /.^template ... "It's similar to template, but meant to be used during pattern-matching." ... [(def (reduced env type) ... (-> (List Type) Type Type) @@ -648,14 +647,14 @@ ... ))]) (.,, (.with_template [ ] - [($.documentation + [($.definition )] [/.++ "Increment function."] [/.-- "Decrement function."] )) - ($.documentation /.loop + ($.definition /.loop (format "Allows arbitrary looping, using the 'again' form to re-start the loop." \n "Can be used in monadic code to create monadic loops.") [(loop (again [count +0 @@ -670,7 +669,7 @@ (my_loop (++ count) (f x)) x))]) - ($.documentation /.with_expansions + ($.definition /.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.") @@ -694,7 +693,7 @@ )))]) - ($.documentation /.static + ($.definition /.static (format "Resolves the names of definitions to their values at compile-time, assuming their values are either:" \n "* Bit" \n "* Nat" @@ -717,7 +716,7 @@ _ false))]) - ... ($.documentation /.^multi + ... ($.definition /.^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) @@ -737,13 +736,13 @@ ... _ ... {#Left (format "Static part " (%t static) " does not match URI: " uri)})]) - ($.documentation /.symbol + ($.definition /.symbol "Gives back a 2 tuple with the module and name parts, both as Text." [(symbol ..#doc) "=>" ["documentation/lux" "#doc"]]) - ($.documentation /.parameter + ($.definition /.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." @@ -754,7 +753,7 @@ empty) list))]) - ($.documentation /.same? + ($.definition /.same? "Tests whether the 2 values are identical (not just 'equal')." ["This one should succeed:" (let [value +5] @@ -764,7 +763,7 @@ (same? +5 (+ +2 +3))]) - ... ($.documentation /.^let + ... ($.definition /.^let ... "Allows you to simultaneously bind and de-structure a value." ... [(def (hash (^let set [member_hash _])) ... (list#mix (function (_ elem acc) @@ -773,19 +772,19 @@ ... 0 ... (set.list set)))]) - ... ($.documentation /.^|> + ... ($.definition /.^|> ... "Pipes the value being pattern-matched against prior to binding it to a variable." ... [(case input ... (^|> value [++ (% 10) (max 1)]) ... (foo value))]) - ($.documentation /.as_expected + ($.definition /.as_expected "Coerces the given expression to the type of whatever is expected." [(is Dinosaur (as_expected (is (List Nat) (list 1 2 3))))]) - ($.documentation /.undefined + ($.definition /.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.") @@ -793,7 +792,7 @@ (-> Int Int) (undefined))]) - ($.documentation /.type_of + ($.definition /.type_of "Generates the type corresponding to a given expression." [(let [my_num +123] (type_of my_num)) @@ -803,14 +802,14 @@ "==" Int]) - ($.documentation /.template + ($.definition /.template (format "Define macros in the style of with_template." \n "For simple macros that do not need any fancy features.") [(def square (template (square x) (* x x)))]) - ($.documentation /.these + ($.definition /.these (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 [ (these 1 @@ -819,14 +818,14 @@ 4)] (all + ))]) - ($.documentation /.char + ($.definition /.char "If given a 1-character text literal, yields the char-code of the sole character." [(is Nat (char "A")) "=>" 65]) - ($.documentation /.for + ($.definition /.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 @@ -836,13 +835,13 @@ js (do js stuff) (do default stuff))]) - ($.documentation /.`` + ($.definition /.`` (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 + ... ($.definition /.^code ... "Generates pattern-matching code for Code values in a way that looks like code-templating." ... [(is (Maybe Nat) ... (case (` (#0 123 +456.789)) @@ -852,13 +851,13 @@ ... _ ... {.#None}))]) - ($.documentation /.false + ($.definition /.false "The boolean FALSE value.") - ($.documentation /.true + ($.definition /.true "The boolean TRUE value.") - ($.documentation /.try + ($.definition /.try "" [(is Foo (case (is (Either Text Bar) @@ -893,7 +892,6 @@ /math.documentation /meta.documentation /program.documentation - /static.documentation /test.documentation /world.documentation]))) -- cgit v1.2.3