From cb572295c9a73330531e07f3f6a92b3bb2434514 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 7 Nov 2022 18:52:46 -0400 Subject: Can now mark definitions as deprecated in their documentation. --- stdlib/source/documentation/lux.lux | 957 ++++++++++++++++++------------------ 1 file changed, 490 insertions(+), 467 deletions(-) (limited to 'stdlib/source/documentation/lux.lux') diff --git a/stdlib/source/documentation/lux.lux b/stdlib/source/documentation/lux.lux index c9225a539..84fb5c9d7 100644 --- a/stdlib/source/documentation/lux.lux +++ b/stdlib/source/documentation/lux.lux @@ -131,370 +131,383 @@ ($.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 - (def (this will not) - (Be Defined) - (because it will be (commented out))))]) + ($.example (comment + (def (this will not) + (Be Defined) + (because it will be (commented out)))))) ($.definition /.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)]))]) + + ($.example (All (_ a) + (-> a a))) + + ($.comment "A name can be provided, to specify a recursive type.") + ($.example (All (List a) + (Or Any + [a (List a)])))) ($.definition /.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))])]) + + ($.example (Ex (_ a) + [(Codec Text a) a])) + + ($.comment "A name can be provided, to specify a recursive type.") + ($.example (Ex (Self a) + [(Codec Text a) + a + (List (Self a))]))) )) (def all_2/4 (List $.Documentation) (list ($.definition /.-> "Function types." - ["This is the type of a function that takes 2 Ints and returns an Int." - (-> Int Int Int)]) + ($.comment "This is the type of a function that takes 2 Ints and returns an Int.") + ($.example (-> Int Int Int))) ($.definition /.list "List literals." - [(is (List Nat) - (list 0 1 2 3))]) + ($.example (is (List Nat) + (list 0 1 2 3)))) ($.definition /.Union "Union types." - [(Union Bit Nat Text)] - [(= Nothing - (Union))]) + ($.example (Union Bit Nat Text)) + ($.example (= Nothing + (Union)))) ($.definition /.Tuple "Tuple types." - [(Tuple Bit Nat Text)] - [(= Any - (Tuple))]) + ($.example (Tuple Bit Nat Text)) + ($.example (= Any + (Tuple)))) ($.definition /.Or "An alias for the Union type constructor." - [(= (Union Bit Nat Text) - (Or Bit Nat Text))] - [(= (Union) - (Or))]) + ($.example (= (Union Bit Nat Text) + (Or Bit Nat Text))) + ($.example (= (Union) + (Or)))) ($.definition /.And "An alias for the Tuple type constructor." - [(= (Tuple Bit Nat Text) - (And Bit Nat Text))] - [(= (Tuple) - (And))]) + ($.example (= (Tuple Bit Nat Text) + (And Bit Nat Text))) + ($.example (= (Tuple) + (And)))) ($.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?")]) + + ($.example (left text#composite "Hello, " name ". How are you?")) + ($.comment "=>") + ($.example (text#composite (text#composite "Hello, " name) ". How are you?"))) ($.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?"))]) + ($.example (all text#composite "Hello, " name ". How are you?")) + ($.comment "=>") + ($.example (text#composite "Hello, " (text#composite name ". How are you?")))) ($.definition /.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!"]) + ($.example (if #1 + "Oh, yeah!" + "Aw hell naw!")) + ($.comment "=>") + ($.example "Oh, yeah!") + + ($.example (if #0 + "Oh, yeah!" + "Aw hell naw!")) + ($.comment "=>") + ($.example "Aw hell naw!")) ($.definition /.Primitive "Macro to treat define new primitive types." - [(Primitive "java.lang.Object")] - [(Primitive "java.util.List" [(Primitive "java.lang.Long")])]) + ($.example (Primitive "java.lang.Object")) + ($.example (Primitive "java.util.List" [(Primitive "java.lang.Long")]))) ($.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.") - [(` (def (, name) - (function ((,' _) (,* args)) - (, body))))]) + ($.example (` (def (, name) + (function ((,' _) (,* args)) + (, body)))))) ($.definition /.`' (format "Unhygienic quasi-quotation as a macro." \n "Unquote (,) and unquote-splice (,*) must also be used as forms.") - [(`' (def (, name) - (function (_ (,* args)) - (, body))))]) + ($.example (`' (def (, name) + (function (_ (,* args)) + (, body)))))) ($.definition /.' "Quotation as a macro." - [(' YOLO)]) + ($.example (' YOLO))) ($.definition /.|> "Piping macro." - [(|> elems - (list#each int#encoded) - (interposed " ") - (mix text#composite "")) - "=>" - (mix text#composite "" - (interposed " " - (list#each int#encoded - elems)))]) + ($.example (|> elems + (list#each int#encoded) + (interposed " ") + (mix text#composite ""))) + ($.comment "=>") + ($.example (mix text#composite "" + (interposed " " + (list#each int#encoded + elems))))) ($.definition /.<| "Reverse piping macro." - [(<| (mix text#composite "") - (interposed " ") - (list#each int#encoded) - elems) - "=>" - (mix text#composite "" - (interposed " " - (list#each int#encoded - elems)))]) + ($.example (<| (mix text#composite "") + (interposed " ") + (list#each int#encoded) + elems)) + ($.comment "=>") + ($.example (mix text#composite "" + (interposed " " + (list#each int#encoded + elems))))) ($.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 [ ] - [(def .public - (-> Int Int) - (+ ))] - - [++ +1] - [-- -1] - )]) + ($.comment "By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary.") + ($.example (with_template [ ] + [(def .public + (-> Int Int) + (+ ))] + + [++ +1] + [-- -1] + ))) )) (`` (def all_3/4 (List $.Documentation) (list ($.definition /.not "Bit negation." - [(not #1) - "=>" - #0] - [(not #0) - "=>" - #1]) + ($.example (not #1)) + ($.comment "=>") + ($.example #0) + + ($.example (not #0)) + ($.comment "=>") + ($.example #1)) ($.definition /.type "Takes a type expression and returns its representation as data-structure." - [(type_literal (All (_ a) - (Maybe (List a))))]) + ($.example (type_literal (All (_ a) + (Maybe (List a)))))) ($.definition /.is "The type-annotation macro." - [(is (List Int) - (list +1 +2 +3))]) + ($.example (is (List Int) + (list +1 +2 +3)))) ($.definition /.as "The type-coercion macro." - [(as Dinosaur - (list +1 +2 +3))]) + ($.example (as Dinosaur + (list +1 +2 +3)))) ($.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 - (Or Any - [Int Int_List]))] - ["Can also be used with type and labelled-type definitions." - (type Type - (Rec @ - (Variant - {#Primitive Text (List @)} - {#Sum @ @} - {#Product @ @} - {#Function @ @} - {#Parameter Nat} - {#Var Nat} - {#Ex Nat} - {#UnivQ (List @) @} - {#ExQ (List @) @} - {#Apply @ @} - {#Named Symbol @})))]) + ($.comment "A name has to be given to the whole type, to use it within its body.") + ($.example (Rec Int_List + (Or Any + [Int Int_List]))) + + ($.comment "Can also be used with type and labelled-type definitions.") + ($.example (type Type + (Rec @ + (Variant + {#Primitive Text (List @)} + {#Sum @ @} + {#Product @ @} + {#Function @ @} + {#Parameter Nat} + {#Var Nat} + {#Ex Nat} + {#UnivQ (List @) @} + {#ExQ (List @) @} + {#Apply @ @} + {#Named Symbol @}))))) ($.definition /.exec "Sequential execution of expressions (great for side-effects)." - [(exec - (log! "#1") - (log! "#2") - (log! "#3") - "YOLO")]) + ($.example (exec + (log! "#1") + (log! "#2") + (log! "#3") + "YOLO"))) ($.definition /.when (format "The pattern-matching macro." \n "Allows the usage of macros within the patterns to provide custom syntax.") - [(when (is (List Int) - (list +1 +2 +3)) - {#Item x {#Item y {#Item z {#End}}}} - {#Some (all * x y z)} + ($.example (when (is (List Int) + (list +1 +2 +3)) + {#Item x {#Item y {#Item z {#End}}}} + {#Some (all * x y z)} - _ - {#None})]) + _ + {#None}))) ($.definition /.pattern (format "Macro-expanding patterns." \n "It's a special macro meant to be used with 'when'.") - [(when (is (List Int) - (list +1 +2 +3)) - (list x y z) - {#Some (all * x y z)} + ($.example (when (is (List Int) + (list +1 +2 +3)) + (list x y z) + {#Some (all * x y z)} - _ - {#None})]) + _ + {#None}))) ... ($.definition /.^or ... (format "Or-patterns." ... \n "It's a special macro meant to be used with 'when'.") - ... [(type Weekday - ... (Variant - ... {#Monday} - ... {#Tuesday} - ... {#Wednesday} - ... {#Thursday} - ... {#Friday} - ... {#Saturday} - ... {#Sunday})) - - ... (def (weekend? day) - ... (-> Weekday Bit) - ... (when day - ... (^or {#Saturday} {#Sunday}) - ... true - - ... _ - ... false))]) + ... ($.example (type Weekday + ... (Variant + ... {#Monday} + ... {#Tuesday} + ... {#Wednesday} + ... {#Thursday} + ... {#Friday} + ... {#Saturday} + ... {#Sunday}))) + ... ($.example (def (weekend? day) + ... (-> Weekday Bit) + ... (when day + ... (^or {#Saturday} {#Sunday}) + ... true + + ... _ + ... false)))) ($.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))]) + ($.example (let [x (foo bar) + y (baz quux)] + (op x y)))) ($.definition /.function "Syntax for creating functions." - [(is (All (_ a b) - (-> a b a)) - (function (_ x y) - x))] - ["Allows for giving the function itself a name, for the sake of recursion." - (is (-> Nat Nat) - (function (factorial n) - (when n - 0 1 - _ (* n (factorial (-- n))))))]) + ($.example (is (All (_ a b) + (-> a b a)) + (function (_ x y) + x))) + + ($.comment "Allows for giving the function itself a name, for the sake of recursion.") + ($.example (is (-> Nat Nat) + (function (factorial n) + (when n + 0 1 + _ (* n (factorial (-- n)))))))) ($.definition /.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))]) + ($.example (def branching_exponent + Int + +5)) + + ($.comment "The type is optional.") + ($.example (def branching_exponent + +5)) + + ($.example (def (pair_list pair) + (-> [Code Code] (List Code)) + (let [[left right] pair] + (list left right)))) + + ($.comment "Can pattern-match on the inputs to functions.") + ($.example (def (pair_list [left right]) + (-> [Code Code] (List Code)) + (list left right)))) ($.definition /.macro "Macro-definition macro." - [(def .public symbol - (macro (_ tokens) - (when tokens - (^with_template [] - [(list [_ { [module name]}]) - (in (list (` [(, (text$ module)) (, (text$ name))])))]) - ([#Symbol]) - - _ - (failure "Wrong syntax for symbol"))))]) + ($.example (def .public symbol + (macro (_ tokens) + (when tokens + (^with_template [] + [(list [_ { [module name]}]) + (in (list (` [(, (text$ module)) (, (text$ name))])))]) + ([#Symbol]) + + _ + (failure "Wrong syntax for symbol")))))) ($.definition /.and "Short-circuiting 'and'." - [(and #1 #0) - "=>" - #0] - [(and #1 #1) - "=>" - #1]) + ($.example (and #1 #0)) + ($.comment "=>") + ($.example #0) + + ($.example (and #1 #1)) + ($.comment "=>") + ($.example #1)) ($.definition /.or "Short-circuiting 'or'." - [(or #1 #0) - "=>" - #1] - [(or #0 #0) - "=>" - #0]) + ($.example (or #1 #0)) + ($.comment "=>") + ($.example #1) + + ($.example (or #0 #0)) + ($.comment "=>") + ($.example #0)) ($.definition /.panic! "Causes an error, with the given error message." - [(panic! "OH NO!")]) + ($.example (panic! "OH NO!"))) ($.definition /.implementation "Express a value that implements an interface." - [(is (Order Int) - (implementation - (def equivalence - equivalence) - (def (< reference subject) - (< reference subject)) - ))]) + ($.example (is (Order Int) + (implementation + (def equivalence + equivalence) + (def (< reference subject) + (< reference subject)) + )))) ($.definition /.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}))]) + ($.example (type Referrals + (Variant + {#All} + {#Only (List Text)} + {#Exclude (List Text)} + {#Ignore} + {#Nothing})))) ($.definition /.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)]))]) + ($.example (type Refer + (Record + [#refer_defs Referrals + #refer_open (List Openings)])))) ($.definition /.type "The type-definition macro." - [(type (List a) - {#End} - {#Item a (List a)})]) + ($.example (type (List a) + {#End} + {#Item a (List a)}))) ($.definition /.Interface "Interface definition." - [(type .public (Order a) - (Interface - (is (Equivalence a) - equivalence) - (is (-> a a Bit) - <)))]) + ($.example (type .public (Order a) + (Interface + (is (Equivalence a) + equivalence) + (is (-> a a Bit) + <))))) (,, (with_template [] [($.definition @@ -513,144 +526,151 @@ ($.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) - (All (_ a) (-> (Enum a) a a (List a))) - (let [(open "[0]") enum] - (loop (again [end to - output {.#End}]) - (cond (< end from) - (again (pred end) {.#Item end output}) + ($.example (def .public (range enum from to) + (All (_ a) (-> (Enum a) a a (List a))) + (let [(open "[0]") enum] + (loop (again [end to + output {.#End}]) + (cond (< end from) + (again (pred end) {.#Item end output}) - (< from end) - (again (succ end) {.#Item end output}) + (< from end) + (again (succ end) {.#Item end output}) - ... (= end from) - {.#Item end output}))))]) + ... (= end from) + {.#Item end output})))))) ($.definition /.cond "Conditional branching with multiple test conditions." - [(cond (even? num) "WHEN even" - (odd? num) "WHEN odd" - "ELSE")]) + ($.example (cond (even? num) "WHEN even" + (odd? num) "WHEN odd" + "ELSE"))) ($.definition /.the "Accesses the value of a record at a given tag." - [(the #field my_record)] - ["Can also work with multiple levels of nesting." - (the [#foo #bar #baz] my_record)] - ["And, if only the slot/path is given, generates an accessor function." - (let [getter (the [#foo #bar #baz])] - (getter my_record))]) + ($.example (the #field my_record)) + + ($.comment "Can also work with multiple levels of nesting.") + ($.example (the [#foo #bar #baz] my_record)) + + ($.comment "And, if only the slot/path is given, generates an accessor function.") + ($.example (let [getter (the [#foo #bar #baz])] + (getter my_record)))) ($.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 <))]) + ($.example (use "i:[0]" order)) + ($.comment "=>") + ($.example (def i:= (at order =))) + ($.example (def i:< (at order <)))) ($.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 " ") - (mix text#composite "")) - "=>" - (function (_ ) - (mix text#composite "" - (interposed " " - (list#each int#encoded ))))]) + ($.example (|>> (list#each int#encoded) + (interposed " ") + (mix text#composite ""))) + ($.comment "=>") + ($.example (function (_ ) + (mix text#composite "" + (interposed " " + (list#each int#encoded )))))) ($.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 " ") - (list#each int#encoded)) - "=>" - (function (_ ) - (mix text#composite "" - (interposed " " - (list#each int#encoded - ))))]) + ($.example (<<| (mix text#composite "") + (interposed " ") + (list#each int#encoded))) + ($.comment "=>") + ($.example (function (_ ) + (mix text#composite "" + (interposed " " + (list#each int#encoded + )))))) ($.definition /.require "Module-definition macro." - [(.require - [lux (.except) - [control - ["M" monad (.except)]] - [data - maybe - ["[0]" name (.use "[1]#[0]" codec)]] - [macro - code]] - [// - [type (.use "[0]" equivalence)]])]) + ($.example (.require + [lux (.except) + [control + ["M" monad (.except)]] + [data + maybe + ["[0]" name (.use "[1]#[0]" codec)]] + [macro + code]] + [// + [type (.use "[0]" equivalence)]]))) ($.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)]) + ($.example (at codec encoded)) + + ($.comment "Also allows using that value as a function.") + ($.example (at codec encoded +123))) ($.definition /.has "Sets the value of a record at a given tag." - [(has #name "Lux" lang)] - ["Can also work with multiple levels of nesting." - (has [#foo #bar #baz] value my_record)] - ["And, if only the slot/path and (optionally) the value are given, generates a mutator function." - (let [setter (has [#foo #bar #baz] value)] - (setter my_record)) - (let [setter (has [#foo #bar #baz])] - (setter value my_record))]) + ($.example (has #name "Lux" lang)) + + ($.comment "Can also work with multiple levels of nesting.") + ($.example (has [#foo #bar #baz] value my_record)) + + ($.comment "And, if only the slot/path and (optionally) the value are given, generates a mutator function.") + ($.example (let [setter (has [#foo #bar #baz] value)] + (setter my_record))) + ($.example (let [setter (has [#foo #bar #baz])] + (setter value my_record)))) ))) (`` (def all_4/4 (List $.Documentation) (list ($.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." - (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))]) + ($.example (revised #age ++ person)) + + ($.comment "Can also work with multiple levels of nesting.") + ($.example (revised [#foo #bar #baz] func my_record)) + + ($.comment "And, if only the slot/path and (optionally) the value are given, generates a mutator function.") + ($.example (let [updater (revised [#foo #bar #baz] func)] + (updater my_record))) + ($.example (let [updater (revised [#foo #bar #baz])] + (updater func my_record)))) ... ($.definition /.^template ... "It's similar to template, but meant to be used during pattern-matching." - ... [(def (reduced env type) - ... (-> (List Type) Type Type) - ... (when type - ... {.#Primitive name params} - ... {.#Primitive name (list#each (reduced env) params)} - - ... (^with_template [] - ... [{ left right} - ... { (reduced env left) (reduced env right)}]) - ... ([.#Sum] [.#Product]) - - ... (^with_template [] - ... [{ left right} - ... { (reduced env left) (reduced env right)}]) - ... ([.#Function] [.#Apply]) - - ... (^with_template [] - ... [{ old_env def} - ... (when old_env - ... {.#End} - ... { env def} - - ... _ - ... type)]) - ... ([.#UnivQ] [.#ExQ]) - - ... {.#Parameter idx} - ... (else type (list.item idx env)) - - ... _ - ... type - ... ))]) + ... ($.example (def (reduced env type) + ... (-> (List Type) Type Type) + ... (when type + ... {.#Primitive name params} + ... {.#Primitive name (list#each (reduced env) params)} + + ... (^with_template [] + ... [{ left right} + ... { (reduced env left) (reduced env right)}]) + ... ([.#Sum] [.#Product]) + + ... (^with_template [] + ... [{ left right} + ... { (reduced env left) (reduced env right)}]) + ... ([.#Function] [.#Apply]) + + ... (^with_template [] + ... [{ old_env def} + ... (when old_env + ... {.#End} + ... { env def} + + ... _ + ... type)]) + ... ([.#UnivQ] [.#ExQ]) + + ... {.#Parameter idx} + ... (else type (list.item idx env)) + + ... _ + ... type + ... )))) (,, (with_template [ ] [($.definition @@ -663,41 +683,42 @@ ($.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 - x init]) - (if (< +10 count) - (again (++ 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))]) + ($.example (loop (again [count +0 + x init]) + (if (< +10 count) + (again (++ count) (f x)) + x))) + + ($.comment "Loops can also be given custom names.") + ($.example (loop (my_loop [count +0 + x init]) + (if (< +10 count) + (my_loop (++ count) (f x)) + x)))) ($.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.") - [(def test - Test - (with_expansions - [ (with_template [ ] - [(cover [] - (compare - (at codec encoded )))] - - [bit #1 "#1"] - [int +123 "+123"] - [frac +123.0 "+123.0"] - [text "123" "'123'"] - [symbol ["yolo" "lol"] "yolo.lol"] - [form (list (bit #1)) "(#1)"] - [tuple (list (bit #1)) "[#1]"] - )] - (all and - - )))]) + ($.example (def test + Test + (with_expansions + [ (with_template [ ] + [(cover [] + (compare + (at codec encoded )))] + + [bit #1 "#1"] + [int +123 "+123"] + [frac +123.0 "+123.0"] + [text "123" "'123'"] + [symbol ["yolo" "lol"] "yolo.lol"] + [form (list (bit #1)) "(#1)"] + [tuple (list (bit #1)) "[#1]"] + )] + (all and + + ))))) ($.definition /.static (format "Resolves the names of definitions to their values at compile-time, assuming their values are either:" @@ -707,155 +728,157 @@ \n "* Rev" \n "* Frac" \n "* Text") - [(def my_nat 123) - (def my_text "456") - (and (when [my_nat my_text] - (static [..my_nat ..my_text]) - true + ($.example (def my_nat 123)) + ($.example (def my_text "456")) + ($.example (and (when [my_nat my_text] + (static [..my_nat ..my_text]) + true - _ - false) - (when [my_nat my_text] - [(static ..my_nat) (static ..my_text)] - true + _ + false) + (when [my_nat my_text] + [(static ..my_nat) (static ..my_text)] + true - _ - false))]) + _ + false)))) ... ($.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.") - ... [(when (split (size static) uri) - ... (^multi {#Some [chunk uri']} - ... [(text#= static chunk) .true]) - ... (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..." - ... (when (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)})]) + ... ($.example (when (split (size static) uri) + ... (^multi {#Some [chunk uri']} + ... [(text#= static chunk) .true]) + ... (match_uri endpoint? parts' uri') + + ... _ + ... {#Left (format "Static part " (%t static) " does not match URI: " uri)})) + + ... ($.comment "Short-cuts can be taken when using bit tests.") + ... ($.comment "The example above can be rewritten as...") + ... ($.example (when (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)}))) ($.definition /.symbol "Gives back a 2 tuple with the module and name parts, both as Text." - [(symbol ..#doc) - "=>" - ["documentation/lux" "#doc"]]) + ($.example (symbol ..#doc)) + ($.comment "=>") + ($.example ["documentation/lux" "#doc"])) ($.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." - (def .public (of_list list) - (All (_ a) (-> (List a) (Sequence a))) - (list#mix add - (is (Sequence (parameter 0)) - empty) - list))]) + ($.comment "In the example below, 0 corresponds to the 'a' variable.") + ($.example (def .public (of_list list) + (All (_ a) (-> (List a) (Sequence a))) + (list#mix add + (is (Sequence (parameter 0)) + empty) + list)))) ($.definition /.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))]) + ($.comment "This one should succeed:") + ($.example (let [value +5] + (same? value + value))) + + ($.comment "This one should fail:") + ($.example (same? +5 + (+ +2 +3)))) ... ($.definition /.^let ... "Allows you to simultaneously bind and de-structure a value." - ... [(def (hash (^let set [member_hash _])) - ... (list#mix (function (_ elem acc) - ... (+ acc - ... (at member_hash hash elem))) - ... 0 - ... (set.list set)))]) + ... ($.example (def (hash (^let set [member_hash _])) + ... (list#mix (function (_ elem acc) + ... (+ acc + ... (at member_hash hash elem))) + ... 0 + ... (set.list set))))) ... ($.definition /.^|> ... "Pipes the value being pattern-matched against prior to binding it to a variable." - ... [(when input - ... (^|> value [++ (% 10) (max 1)]) - ... (foo value))]) + ... ($.example (when input + ... (^|> value [++ (% 10) (max 1)]) + ... (foo value)))) ($.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))))]) + ($.example (is Dinosaur + (as_expected (is (List Nat) + (list 1 2 3)))))) ($.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.") - [(def (square x) - (-> Int Int) - (undefined))]) + ($.example (def (square x) + (-> Int Int) + (undefined)))) ($.definition /.type_of "Generates the type corresponding to a given expression." - [(let [my_num +123] - (type_of my_num)) - "==" - Int] - [(type_of +123) - "==" - Int]) + ($.example (let [my_num +123] + (type_of my_num))) + ($.comment "==") + ($.example Int) + + ($.example (type_of +123)) + ($.comment "==") + ($.example Int)) ($.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)))]) + ($.example (def square + (template (square x) + (* x x))))) ($.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 - 2 - 3 - 4)] - (all + ))]) + ($.example (with_expansions [ (these 1 + 2 + 3 + 4)] + (all + )))) ($.definition /.char "If given a 1-character text literal, yields the char-code of the sole character." - [(is Nat - (char "A")) - "=>" - 65]) + ($.example (is Nat + (char "A"))) + ($.comment "=>") + ($.example 65)) ($.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 - "JavaScript") - - (for "JVM" (do jvm stuff) - js (do js stuff) - (do default stuff))]) + ($.example (def js + "JavaScript")) + ($.example (for "JVM" (do jvm stuff) + js (do js stuff) + (do default stuff)))) ($.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))))]) + ($.example (`` (some expression + (,, (some macro which may yield 0 or more results)))))) ... ($.definition /.^code ... "Generates pattern-matching code for Code values in a way that looks like code-templating." - ... [(is (Maybe Nat) - ... (when (` (#0 123 +456.789)) - ... (^code (#0 (, [_ {.#Nat number}]) +456.789)) - ... {.#Some number} + ... ($.example (is (Maybe Nat) + ... (when (` (#0 123 +456.789)) + ... (^code (#0 (, [_ {.#Nat number}]) +456.789)) + ... {.#Some number} - ... _ - ... {.#None}))]) + ... _ + ... {.#None})))) ($.definition /.false "The boolean FALSE value.") @@ -865,17 +888,17 @@ ($.definition /.try "" - [(is Foo - (when (is (Either Text Bar) - (try (is Bar - (risky computation which may panic)))) - {.#Right success} - (is Foo - (do something after success)) - - {.#Left error} - (is Foo - (recover from error))))]) + ($.example (is Foo + (when (is (Either Text Bar) + (try (is Bar + (risky computation which may panic)))) + {.#Right success} + (is Foo + (do something after success)) + + {.#Left error} + (is Foo + (recover from error)))))) ($.definition (/.Code' w)) ($.definition /.Alias) -- cgit v1.2.3