aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/documentation
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/documentation')
-rw-r--r--stdlib/source/documentation/lux.lux1751
-rw-r--r--stdlib/source/documentation/lux/control/concatenative.lux3
-rw-r--r--stdlib/source/documentation/lux/control/function/mutual.lux8
-rw-r--r--stdlib/source/documentation/lux/control/pipe.lux13
-rw-r--r--stdlib/source/documentation/lux/data/color/named.lux142
-rw-r--r--stdlib/source/documentation/lux/data/text/encoding.lux322
-rw-r--r--stdlib/source/documentation/lux/data/text/regex.lux2
-rw-r--r--stdlib/source/documentation/lux/data/text/unicode/block.lux99
-rw-r--r--stdlib/source/documentation/lux/ffi.js.lux103
-rw-r--r--stdlib/source/documentation/lux/ffi.jvm.lux2
-rw-r--r--stdlib/source/documentation/lux/ffi.lua.lux47
-rw-r--r--stdlib/source/documentation/lux/ffi.old.lux423
-rw-r--r--stdlib/source/documentation/lux/ffi.py.lux85
-rw-r--r--stdlib/source/documentation/lux/ffi.rb.lux61
-rw-r--r--stdlib/source/documentation/lux/meta/compiler/language/lux/analysis.lux2
-rw-r--r--stdlib/source/documentation/lux/meta/compiler/language/lux/synthesis.lux2
-rw-r--r--stdlib/source/documentation/lux/meta/target/python.lux39
-rw-r--r--stdlib/source/documentation/lux/world/input/keyboard.lux38
18 files changed, 1668 insertions, 1474 deletions
diff --git a/stdlib/source/documentation/lux.lux b/stdlib/source/documentation/lux.lux
index 68491c807..21b90e2a6 100644
--- a/stdlib/source/documentation/lux.lux
+++ b/stdlib/source/documentation/lux.lux
@@ -27,876 +27,895 @@
["[1][0]" test]
["[1][0]" world]])
-(`` (def .public documentation
- (List $.Documentation)
- (list.partial ($.module /._
- "")
-
- ($.definition /.prelude
- (format "The name of the prelude module"
- \n "Value: " (%.text /.prelude)))
-
- ($.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."))
-
- ($.definition /.Nothing
- (format "The type of things whose type is undefined."
- \n "Useful for expressions that cause errors or other 'extraordinary' conditions."))
-
- ($.definition (/.List item)
- "A potentially empty list of values.")
-
- ($.definition /.Bit
- "Your standard, run-of-the-mill boolean values (as #0 or #1 bits).")
-
- ($.definition (/.I64 kind)
- "64-bit integers without any semantics.")
-
- ($.definition /.Nat
- (format "Natural numbers (unsigned integers)."
- \n "They start at zero (0) and extend in the positive direction."))
+(def sub_modules
+ (List $.Documentation)
+ (all list#composite
+ /abstract.documentation
+ /control.documentation
+ /data.documentation
+ /debug.documentation
+ /documentation.documentation
+ /ffi.documentation
+ /math.documentation
+ /meta.documentation
+ /program.documentation
+ /test.documentation
+ /world.documentation
+ ))
- ($.definition /.Int
- "Your standard, run-of-the-mill integer numbers.")
+(def all/1-4
+ (List $.Documentation)
+ (list ($.definition /.prelude
+ (format "The name of the prelude module"
+ \n "Value: " (%.text /.prelude)))
- ($.definition /.Rev
- (format "Fractional numbers that live in the interval [0,1)."
- \n "Useful for probability, and other domains that work within that interval."))
+ ($.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."))
- ($.definition /.Frac
- "Your standard, run-of-the-mill floating-point (fractional) numbers.")
+ ($.definition /.Nothing
+ (format "The type of things whose type is undefined."
+ \n "Useful for expressions that cause errors or other 'extraordinary' conditions."))
- ($.definition /.Text
- "Your standard, run-of-the-mill string values.")
-
- ($.definition /.Symbol
- (format "A name for a Lux definition."
- \n "It includes the module of provenance."))
-
- ($.definition (/.Maybe value)
- "A potentially missing value.")
-
- ($.definition /.Type
- "This type represents the data-structures that are used to specify types themselves.")
-
- ($.definition /.Location
- "Locations are for specifying the location of Code nodes in Lux files during compilation.")
-
- ($.definition (/.Ann meta_data datum)
- "The type of things that can be annotated with meta-data of arbitrary types.")
-
- ($.definition /.Code
- "The type of Code nodes for Lux syntax.")
-
- ($.definition /.private
- "The export policy for private/local definitions.")
-
- ($.definition /.local
- "The export policy for private/local definitions.")
-
- ($.definition /.public
- "The export policy for public/global definitions.")
-
- ($.definition /.global
- "The export policy for public/global definitions.")
-
- ($.definition /.Definition
- "Represents all the data associated with a definition: its type, its annotations, and its value.")
-
- ($.definition /.Global
- "Represents all the data associated with a global constant.")
-
- ($.definition (/.Either left right)
- "A choice between two values of different types.")
-
- ($.definition /.Module
- "All the information contained within a Lux module.")
-
- ($.definition /.Mode
- "A sign that shows the conditions under which the compiler is running.")
-
- ($.definition /.Info
- "Information about the current version and type of compiler that is running.")
-
- ($.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."))
-
- ($.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."))
-
- ($.definition /.Macro
- "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")
-
- ($.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))))])
-
- ($.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)]))])
-
- ($.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))])])
-
- ($.definition /.->
- "Function types."
- ["This is the type of a function that takes 2 Ints and returns an Int."
- (-> Int Int Int)])
-
- ($.definition /.list
- "List literals."
- [(is (List Nat)
- (list 0 1 2 3))])
-
- ($.definition /.Union
- "Union types."
- [(Union Bit Nat Text)]
- [(= Nothing
- (Union))])
-
- ($.definition /.Tuple
- "Tuple types."
- [(Tuple Bit Nat Text)]
- [(= Any
- (Tuple))])
-
- ($.definition /.Or
- "An alias for the Union type constructor."
- [(= (Union Bit Nat Text)
- (Or Bit Nat Text))]
- [(= (Union)
- (Or))])
-
- ($.definition /.And
- "An alias for the Tuple type constructor."
- [(= (Tuple Bit Nat Text)
- (And Bit Nat Text))]
- [(= (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?")])
-
- ($.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?"))])
-
- ($.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!"])
-
- ($.definition /.Primitive
- "Macro to treat define new primitive types."
- [(Primitive "java.lang.Object")]
- [(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))))])
-
- ($.definition /.`'
- (format "Unhygienic quasi-quotation as a macro."
- \n "Unquote (,) and unquote-splice (,*) must also be used as forms.")
- [(`' (def (, name)
- (function (_ (,* args))
- (, body))))])
-
- ($.definition /.'
- "Quotation as a macro."
- [(' YOLO)])
-
- ($.definition /.|>
- "Piping macro."
- [(|> elems
- (list#each int#encoded)
- (interposed " ")
- (mix text#composite ""))
- "=>"
- (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)))])
-
- ($.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 [<name> <diff>]
- [(def .public <name>
- (-> Int Int)
- (+ <diff>))]
-
- [++ +1]
- [-- -1]
- )])
-
- ($.definition /.not
- "Bit negation."
- [(not #1)
- "=>"
- #0]
- [(not #0)
- "=>"
- #1])
-
- ($.definition /.type
- "Takes a type expression and returns its representation as data-structure."
- [(type_literal (All (_ a)
- (Maybe (List a))))])
-
- ($.definition /.is
- "The type-annotation macro."
- [(is (List Int)
- (list +1 +2 +3))])
-
- ($.definition /.as
- "The type-coercion macro."
- [(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 @})))])
-
- ($.definition /.exec
- "Sequential execution of expressions (great for side-effects)."
- [(exec
- (log! "#1")
- (log! "#2")
- (log! "#3")
- "YOLO")])
-
- ($.definition /.case
- (format "The pattern-matching macro."
- \n "Allows the usage of macros within the patterns to provide custom syntax.")
- [(case (is (List Int)
- (list +1 +2 +3))
- {#Item x {#Item y {#Item z {#End}}}}
- {#Some (all * x y z)}
-
- _
- {#None})])
-
- ($.definition /.pattern
- (format "Macro-expanding patterns."
- \n "It's a special macro meant to be used with 'case'.")
- [(case (is (List Int)
- (list +1 +2 +3))
- (list x y z)
- {#Some (all * x y z)}
-
- _
- {#None})])
-
- ... ($.definition /.^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})
- ... 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))])
-
- ($.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)
- (case 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))])
-
- ($.definition /.macro
- "Macro-definition macro."
- [(def .public symbol
- (macro (_ tokens)
- (case tokens
- (^with_template [<tag>]
- [(list [_ {<tag> [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])
-
- ($.definition /.or
- "Short-circuiting 'or'."
- [(or #1 #0)
- "=>"
- #1]
- [(or #0 #0)
- "=>"
- #0])
-
- ($.definition /.panic!
- "Causes an error, with the given error message."
- [(panic! "OH NO!")])
-
- ($.definition /.implementation
- "Express a value that implements an interface."
- [(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}))])
-
- ($.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)]))])
-
- ($.definition /.type
- "The type-definition macro."
- [(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)
- <)))])
-
- (,, (with_template [<name>]
- [($.definition <name>
- "Safe type-casting for I64 values.")]
-
- [/.i64]
- [/.nat]
- [/.int]
- [/.rev]
- ))
-
- ($.definition /.module_separator
- (format "Character used to separate the parts of module names."
- \n "Value: " (%.text /.module_separator)))
-
- ($.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})
-
- (< from end)
- (again (succ end) {.#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")])
-
- ($.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))])
-
- ($.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 <))])
-
- ($.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 (_ <it>)
- (mix text#composite ""
- (interposed " "
- (list#each int#encoded <it>))))])
-
- ($.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 (_ <it>)
- (mix text#composite ""
- (interposed " "
- (list#each int#encoded
- <it>))))])
-
- ($.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)]])])
-
- ($.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)])
-
- ($.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))])
-
- ($.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))])
-
- ... ($.definition /.^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)}
-
- ... (^with_template [<tag>]
- ... [{<tag> left right}
- ... {<tag> (reduced env left) (reduced env right)}])
- ... ([.#Sum] [.#Product])
-
- ... (^with_template [<tag>]
- ... [{<tag> left right}
- ... {<tag> (reduced env left) (reduced env right)}])
- ... ([.#Function] [.#Apply])
-
- ... (^with_template [<tag>]
- ... [{<tag> old_env def}
- ... (case old_env
- ... {.#End}
- ... {<tag> env def}
-
- ... _
- ... type)])
- ... ([.#UnivQ] [.#ExQ])
-
- ... {.#Parameter idx}
- ... (else type (list.item idx env))
-
- ... _
- ... type
- ... ))])
-
- (,, (with_template [<name> <doc>]
- [($.definition <name>
- <doc>)]
-
- [/.++ "Increment function."]
- [/.-- "Decrement function."]
- ))
-
- ($.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))])
-
- ($.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
- [<tests> (with_template [<function> <parameter> <expected>]
- [(cover [<function>]
- (compare <text>
- (at codec encoded <function> <parameter>)))]
-
- [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
- <tests>
- )))])
-
- ($.definition /.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))])
-
- ... ($.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)
- ... (^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..."
- ... (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)})])
-
- ($.definition /.symbol
- "Gives back a 2 tuple with the module and name parts, both as Text."
- [(symbol ..#doc)
- "=>"
- ["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))])
-
- ($.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))])
-
- ... ($.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)))])
-
- ... ($.definition /.^|>
- ... "Pipes the value being pattern-matched against prior to binding it to a variable."
- ... [(case 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))))])
-
- ($.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))])
-
- ($.definition /.type_of
- "Generates the type corresponding to a given expression."
- [(let [my_num +123]
- (type_of my_num))
- "=="
- Int]
- [(type_of +123)
- "=="
- 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)))])
-
- ($.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 [<operands> (these 1
- 2
- 3
- 4)]
- (all + <operands>))])
-
- ($.definition /.char
- "If given a 1-character text literal, yields the char-code of the sole character."
- [(is Nat
- (char "A"))
- "=>"
- 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))])
-
- ($.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))))])
-
- ... ($.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))
- ... (^code (#0 (, [_ {.#Nat number}]) +456.789))
- ... {.#Some number}
-
- ... _
- ... {.#None}))])
-
- ($.definition /.false
- "The boolean FALSE value.")
-
- ($.definition /.true
- "The boolean TRUE value.")
-
- ($.definition /.try
- ""
- [(is Foo
- (case (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)
- ($.definition (/.Bindings key value))
- ($.definition /.Ref)
- ($.definition /.Scope)
- ($.definition /.Source)
- ($.definition /.Module_State)
- ($.definition /.Type_Context)
- ($.definition /.Macro')
- ($.definition /.Label)
- ($.definition /.macro)
-
- (all list#composite
- /abstract.documentation
- /control.documentation
- /data.documentation
- /debug.documentation
- /documentation.documentation
- /ffi.documentation
- /math.documentation
- /meta.documentation
- /program.documentation
- /test.documentation
- /world.documentation
- )
- )))
+ ($.definition (/.List item)
+ "A potentially empty list of values.")
+
+ ($.definition /.Bit
+ "Your standard, run-of-the-mill boolean values (as #0 or #1 bits).")
+
+ ($.definition (/.I64 kind)
+ "64-bit integers without any semantics.")
+
+ ($.definition /.Nat
+ (format "Natural numbers (unsigned integers)."
+ \n "They start at zero (0) and extend in the positive direction."))
+
+ ($.definition /.Int
+ "Your standard, run-of-the-mill integer numbers.")
+
+ ($.definition /.Rev
+ (format "Fractional numbers that live in the interval [0,1)."
+ \n "Useful for probability, and other domains that work within that interval."))
+
+ ($.definition /.Frac
+ "Your standard, run-of-the-mill floating-point (fractional) numbers.")
+
+ ($.definition /.Text
+ "Your standard, run-of-the-mill string values.")
+
+ ($.definition /.Symbol
+ (format "A name for a Lux definition."
+ \n "It includes the module of provenance."))
+
+ ($.definition (/.Maybe value)
+ "A potentially missing value.")
+
+ ($.definition /.Type
+ "This type represents the data-structures that are used to specify types themselves.")
+
+ ($.definition /.Location
+ "Locations are for specifying the location of Code nodes in Lux files during compilation.")
+
+ ($.definition (/.Ann meta_data datum)
+ "The type of things that can be annotated with meta-data of arbitrary types.")
+
+ ($.definition /.Code
+ "The type of Code nodes for Lux syntax.")
+
+ ($.definition /.private
+ "The export policy for private/local definitions.")
+
+ ($.definition /.local
+ "The export policy for private/local definitions.")
+
+ ($.definition /.public
+ "The export policy for public/global definitions.")
+
+ ($.definition /.global
+ "The export policy for public/global definitions.")
+
+ ($.definition /.Definition
+ "Represents all the data associated with a definition: its type, its annotations, and its value.")
+
+ ($.definition /.Global
+ "Represents all the data associated with a global constant.")
+
+ ($.definition (/.Either left right)
+ "A choice between two values of different types.")
+
+ ($.definition /.Module
+ "All the information contained within a Lux module.")
+
+ ($.definition /.Mode
+ "A sign that shows the conditions under which the compiler is running.")
+
+ ($.definition /.Info
+ "Information about the current version and type of compiler that is running.")
+
+ ($.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."))
+
+ ($.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."))
+
+ ($.definition /.Macro
+ "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")
+
+ ($.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))))])
+
+ ($.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)]))])
+
+ ($.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))])])
+ ))
+
+(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)])
+
+ ($.definition /.list
+ "List literals."
+ [(is (List Nat)
+ (list 0 1 2 3))])
+
+ ($.definition /.Union
+ "Union types."
+ [(Union Bit Nat Text)]
+ [(= Nothing
+ (Union))])
+
+ ($.definition /.Tuple
+ "Tuple types."
+ [(Tuple Bit Nat Text)]
+ [(= Any
+ (Tuple))])
+
+ ($.definition /.Or
+ "An alias for the Union type constructor."
+ [(= (Union Bit Nat Text)
+ (Or Bit Nat Text))]
+ [(= (Union)
+ (Or))])
+
+ ($.definition /.And
+ "An alias for the Tuple type constructor."
+ [(= (Tuple Bit Nat Text)
+ (And Bit Nat Text))]
+ [(= (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?")])
+
+ ($.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?"))])
+
+ ($.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!"])
+
+ ($.definition /.Primitive
+ "Macro to treat define new primitive types."
+ [(Primitive "java.lang.Object")]
+ [(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))))])
+
+ ($.definition /.`'
+ (format "Unhygienic quasi-quotation as a macro."
+ \n "Unquote (,) and unquote-splice (,*) must also be used as forms.")
+ [(`' (def (, name)
+ (function (_ (,* args))
+ (, body))))])
+
+ ($.definition /.'
+ "Quotation as a macro."
+ [(' YOLO)])
+
+ ($.definition /.|>
+ "Piping macro."
+ [(|> elems
+ (list#each int#encoded)
+ (interposed " ")
+ (mix text#composite ""))
+ "=>"
+ (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)))])
+
+ ($.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 [<name> <diff>]
+ [(def .public <name>
+ (-> Int Int)
+ (+ <diff>))]
+
+ [++ +1]
+ [-- -1]
+ )])
+ ))
+
+(`` (def all/3-4
+ (List $.Documentation)
+ (list ($.definition /.not
+ "Bit negation."
+ [(not #1)
+ "=>"
+ #0]
+ [(not #0)
+ "=>"
+ #1])
+
+ ($.definition /.type
+ "Takes a type expression and returns its representation as data-structure."
+ [(type_literal (All (_ a)
+ (Maybe (List a))))])
+
+ ($.definition /.is
+ "The type-annotation macro."
+ [(is (List Int)
+ (list +1 +2 +3))])
+
+ ($.definition /.as
+ "The type-coercion macro."
+ [(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 @})))])
+
+ ($.definition /.exec
+ "Sequential execution of expressions (great for side-effects)."
+ [(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)}
+
+ _
+ {#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)}
+
+ _
+ {#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))])
+
+ ($.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))])
+
+ ($.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))))))])
+
+ ($.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))])
+
+ ($.definition /.macro
+ "Macro-definition macro."
+ [(def .public symbol
+ (macro (_ tokens)
+ (when tokens
+ (^with_template [<tag>]
+ [(list [_ {<tag> [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])
+
+ ($.definition /.or
+ "Short-circuiting 'or'."
+ [(or #1 #0)
+ "=>"
+ #1]
+ [(or #0 #0)
+ "=>"
+ #0])
+
+ ($.definition /.panic!
+ "Causes an error, with the given error message."
+ [(panic! "OH NO!")])
+
+ ($.definition /.implementation
+ "Express a value that implements an interface."
+ [(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}))])
+
+ ($.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)]))])
+
+ ($.definition /.type
+ "The type-definition macro."
+ [(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)
+ <)))])
+
+ (,, (with_template [<name>]
+ [($.definition <name>
+ "Safe type-casting for I64 values.")]
+
+ [/.i64]
+ [/.nat]
+ [/.int]
+ [/.rev]
+ ))
+
+ ($.definition /.module_separator
+ (format "Character used to separate the parts of module names."
+ \n "Value: " (%.text /.module_separator)))
+
+ ($.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})
+
+ (< from end)
+ (again (succ end) {.#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")])
+
+ ($.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))])
+
+ ($.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 <))])
+
+ ($.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 (_ <it>)
+ (mix text#composite ""
+ (interposed " "
+ (list#each int#encoded <it>))))])
+
+ ($.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 (_ <it>)
+ (mix text#composite ""
+ (interposed " "
+ (list#each int#encoded
+ <it>))))])
+
+ ($.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)]])])
+
+ ($.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)])
+
+ ($.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))])
+ )))
+
+(`` (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))])
+
+ ... ($.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 [<tag>]
+ ... [{<tag> left right}
+ ... {<tag> (reduced env left) (reduced env right)}])
+ ... ([.#Sum] [.#Product])
+
+ ... (^with_template [<tag>]
+ ... [{<tag> left right}
+ ... {<tag> (reduced env left) (reduced env right)}])
+ ... ([.#Function] [.#Apply])
+
+ ... (^with_template [<tag>]
+ ... [{<tag> old_env def}
+ ... (when old_env
+ ... {.#End}
+ ... {<tag> env def}
+
+ ... _
+ ... type)])
+ ... ([.#UnivQ] [.#ExQ])
+
+ ... {.#Parameter idx}
+ ... (else type (list.item idx env))
+
+ ... _
+ ... type
+ ... ))])
+
+ (,, (with_template [<name> <doc>]
+ [($.definition <name>
+ <doc>)]
+
+ [/.++ "Increment function."]
+ [/.-- "Decrement function."]
+ ))
+
+ ($.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))])
+
+ ($.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
+ [<tests> (with_template [<function> <parameter> <expected>]
+ [(cover [<function>]
+ (compare <text>
+ (at codec encoded <function> <parameter>)))]
+
+ [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
+ <tests>
+ )))])
+
+ ($.definition /.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 (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))])
+
+ ... ($.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)})])
+
+ ($.definition /.symbol
+ "Gives back a 2 tuple with the module and name parts, both as Text."
+ [(symbol ..#doc)
+ "=>"
+ ["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))])
+
+ ($.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))])
+
+ ... ($.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)))])
+
+ ... ($.definition /.^|>
+ ... "Pipes the value being pattern-matched against prior to binding it to a variable."
+ ... [(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))))])
+
+ ($.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))])
+
+ ($.definition /.type_of
+ "Generates the type corresponding to a given expression."
+ [(let [my_num +123]
+ (type_of my_num))
+ "=="
+ Int]
+ [(type_of +123)
+ "=="
+ 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)))])
+
+ ($.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 [<operands> (these 1
+ 2
+ 3
+ 4)]
+ (all + <operands>))])
+
+ ($.definition /.char
+ "If given a 1-character text literal, yields the char-code of the sole character."
+ [(is Nat
+ (char "A"))
+ "=>"
+ 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))])
+
+ ($.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))))])
+
+ ... ($.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}
+
+ ... _
+ ... {.#None}))])
+
+ ($.definition /.false
+ "The boolean FALSE value.")
+
+ ($.definition /.true
+ "The boolean TRUE value.")
+
+ ($.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))))])
+
+ ($.definition (/.Code' w))
+ ($.definition /.Alias)
+ ($.definition (/.Bindings key value))
+ ($.definition /.Ref)
+ ($.definition /.Scope)
+ ($.definition /.Source)
+ ($.definition /.Module_State)
+ ($.definition /.Type_Context)
+ ($.definition /.Macro')
+ ($.definition /.Label)
+ ($.definition /.macro)
+ )))
+
+(def .public documentation
+ (List $.Documentation)
+ (all list#composite
+ all/1-4
+ all/2-4
+ all/3-4
+ all/4-4
+
+ ..sub_modules
+ ))
(def _
(program inputs
diff --git a/stdlib/source/documentation/lux/control/concatenative.lux b/stdlib/source/documentation/lux/control/concatenative.lux
index 1a1f06dfa..6c8b17adf 100644
--- a/stdlib/source/documentation/lux/control/concatenative.lux
+++ b/stdlib/source/documentation/lux/control/concatenative.lux
@@ -189,9 +189,6 @@
partial
call)))])
- ($.definition /.when
- "Only execute the block when #1.")
-
($.definition /.?
"Choose the top value when #0 and the second-to-top when #1.")
)))
diff --git a/stdlib/source/documentation/lux/control/function/mutual.lux b/stdlib/source/documentation/lux/control/function/mutual.lux
index 9a6930379..58fb34b97 100644
--- a/stdlib/source/documentation/lux/control/function/mutual.lux
+++ b/stdlib/source/documentation/lux/control/function/mutual.lux
@@ -17,13 +17,13 @@
"Locally-defined mutually-recursive functions."
[(let [(even? number)
(-> Nat Bit)
- (case number
+ (when number
0 true
_ (odd? (-- number)))
(odd? number)
(-> Nat Bit)
- (case number
+ (when number
0 false
_ (even? (-- number)))]
(and (even? 4)
@@ -34,13 +34,13 @@
[(def
[.public (even? number)
(-> Nat Bit)
- (case number
+ (when number
0 true
_ (odd? (-- number)))]
[.public (odd? number)
(-> Nat Bit)
- (case number
+ (when number
0 false
_ (even? (-- number)))])])
))
diff --git a/stdlib/source/documentation/lux/control/pipe.lux b/stdlib/source/documentation/lux/control/pipe.lux
index 50d232154..ff4d7a4fb 100644
--- a/stdlib/source/documentation/lux/control/pipe.lux
+++ b/stdlib/source/documentation/lux/control/pipe.lux
@@ -45,15 +45,6 @@
[(new "even" [])]
[(new "odd" [])])))])
- ($.definition /.when
- "Only execute the body when the test passes."
- [(same? (if (n.even? sample)
- (n.* 2 sample)
- sample)
- (|> sample
- (when [n.even?]
- [(n.* 2)])))])
-
($.definition /.while
(format "While loops for pipes."
\n "Both the testing and calculating steps are pipes and must be given inside tuples.")
@@ -87,11 +78,11 @@
"=>"
[+50 +2 "+5"]])
- ($.definition /.case
+ ($.definition /.when
(format "Pattern-matching for pipes."
\n "The bodies of each branch are NOT pipes; just regular values.")
[(|> +5
- (case
+ (when
+0 "zero"
+1 "one"
+2 "two"
diff --git a/stdlib/source/documentation/lux/data/color/named.lux b/stdlib/source/documentation/lux/data/color/named.lux
index 4ed4c3324..5e884b82c 100644
--- a/stdlib/source/documentation/lux/data/color/named.lux
+++ b/stdlib/source/documentation/lux/data/color/named.lux
@@ -4,7 +4,9 @@
["$" documentation]
[data
["[0]" text (.only)
- ["%" \\format (.only format)]]]
+ ["%" \\format (.only format)]]
+ [collection
+ ["[0]" list (.use "[1]#[0]" monoid)]]]
[math
[number
["[0]" nat (.use "hex#[0]" hex)]]]]]
@@ -12,41 +14,21 @@
["[0]" / (.only)
["/[1]" //]]])
-(`` (def .public documentation
- (List $.Documentation)
- (list ($.module /._
- "")
+(def description
+ (template (_ <name>)
+ [($.definition <name>
+ (let [[red green blue] (//.rgb <name>)
+ [_ name] (symbol <name>)]
+ (format "R:" (hex#encoded red)
+ " G:" (hex#encoded green)
+ " B:" (hex#encoded blue)
+ " | " (text.replaced "_" " " name))))]))
- (,, (with_template [<name>]
- [($.definition <name>
- (let [[red green blue] (//.rgb <name>)
- [_ name] (symbol <name>)]
- (format "R:" (hex#encoded red)
- " G:" (hex#encoded green)
- " B:" (hex#encoded blue)
- " | " (text.replaced "_" " " name))))]
+(`` (def colors/d-k
+ (List $.Documentation)
+ (list (,, (with_template [<name>]
+ [(description <name>)]
- [/.alice_blue]
- [/.antique_white]
- [/.aqua]
- [/.aquamarine]
- [/.azure]
- [/.beige]
- [/.bisque]
- [/.black]
- [/.blanched_almond]
- [/.blue]
- [/.blue_violet]
- [/.brown]
- [/.burly_wood]
- [/.cadet_blue]
- [/.chartreuse]
- [/.chocolate]
- [/.coral]
- [/.cornflower_blue]
- [/.cornsilk]
- [/.crimson]
- [/.cyan]
[/.dark_blue]
[/.dark_cyan]
[/.dark_goldenrod]
@@ -85,6 +67,14 @@
[/.indigo]
[/.ivory]
[/.khaki]
+ ))
+ )))
+
+(`` (def colors/l-o
+ (List $.Documentation)
+ (list (,, (with_template [<name>]
+ [(description <name>)]
+
[/.lavender]
[/.lavender_blush]
[/.lawn_green]
@@ -128,6 +118,14 @@
[/.orange]
[/.orange_red]
[/.orchid]
+ ))
+ )))
+
+(`` (def colors/p-y
+ (List $.Documentation)
+ (list (,, (with_template [<name>]
+ [(description <name>)]
+
[/.pale_goldenrod]
[/.pale_green]
[/.pale_turquoise]
@@ -169,3 +167,79 @@
[/.yellow_green]
))
)))
+
+(`` (def .public documentation
+ (List $.Documentation)
+ (list.partial ($.module /._
+ "")
+
+ (,, (with_template [<name>]
+ [(description <name>)]
+
+ [/.alice_blue]
+ [/.antique_white]
+ [/.aqua]
+ [/.aquamarine]
+ [/.azure]
+ [/.beige]
+ [/.bisque]
+ [/.black]
+ [/.blanched_almond]
+ [/.blue]
+ [/.blue_violet]
+ [/.brown]
+ [/.burly_wood]
+ [/.cadet_blue]
+ [/.chartreuse]
+ [/.chocolate]
+ [/.coral]
+ [/.cornflower_blue]
+ [/.cornsilk]
+ [/.crimson]
+ [/.cyan]
+ [/.dark_blue]
+ [/.dark_cyan]
+ [/.dark_goldenrod]
+ [/.dark_gray]
+ [/.dark_green]
+ [/.dark_khaki]
+ [/.dark_magenta]
+ [/.dark_olive_green]
+ [/.dark_orange]
+ [/.dark_orchid]
+ [/.dark_red]
+ [/.dark_salmon]
+ [/.dark_sea_green]
+ [/.dark_slate_blue]
+ [/.dark_slate_gray]
+ [/.dark_turquoise]
+ [/.dark_violet]
+ [/.deep_pink]
+ [/.deep_sky_blue]
+ [/.dim_gray]
+ [/.dodger_blue]
+ [/.fire_brick]
+ [/.floral_white]
+ [/.forest_green]
+ [/.fuchsia]
+ [/.gainsboro]
+ [/.ghost_white]
+ [/.gold]
+ [/.goldenrod]
+ [/.gray]
+ [/.green]
+ [/.green_yellow]
+ [/.honey_dew]
+ [/.hot_pink]
+ [/.indian_red]
+ [/.indigo]
+ [/.ivory]
+ [/.khaki]
+ ))
+
+ (all list#composite
+ colors/d-k
+ colors/l-o
+ colors/p-y
+ )
+ )))
diff --git a/stdlib/source/documentation/lux/data/text/encoding.lux b/stdlib/source/documentation/lux/data/text/encoding.lux
index e5e324f22..f370ef501 100644
--- a/stdlib/source/documentation/lux/data/text/encoding.lux
+++ b/stdlib/source/documentation/lux/data/text/encoding.lux
@@ -6,12 +6,180 @@
[text (.only \n)
["%" \\format (.only format)]]
[collection
- ["[0]" list]]]]]
+ ["[0]" list (.use "[1]#[0]" monoid)]]]]]
[\\library
["[0]" /]]
["[0]" /
["[1][0]" utf8]])
+(def description
+ (template (_ <name>)
+ [($.definition <name>
+ (format "'" (/.name <name>) "' text encoding. "))]))
+
+(`` (def all/ibm
+ (List $.Documentation)
+ (list (,, (with_template [<name>]
+ [(description <name>)]
+
+ [/.ibm_037]
+ [/.ibm_273]
+ [/.ibm_277]
+ [/.ibm_278]
+ [/.ibm_280]
+ [/.ibm_284]
+ [/.ibm_285]
+ [/.ibm_290]
+ [/.ibm_297]
+ [/.ibm_300]
+ [/.ibm_420]
+ [/.ibm_424]
+ [/.ibm_437]
+ [/.ibm_500]
+ [/.ibm_737]
+ [/.ibm_775]
+ [/.ibm_833]
+ [/.ibm_834]
+ [/.ibm_838]
+ [/.ibm_850]
+ [/.ibm_852]
+ [/.ibm_855]
+ [/.ibm_856]
+ [/.ibm_857]
+ [/.ibm_858]
+ [/.ibm_860]
+ [/.ibm_861]
+ [/.ibm_862]
+ [/.ibm_863]
+ [/.ibm_864]
+ [/.ibm_865]
+ [/.ibm_866]
+ [/.ibm_868]
+ [/.ibm_869]
+ [/.ibm_870]
+ [/.ibm_871]
+ [/.ibm_874]
+ [/.ibm_875]
+ [/.ibm_918]
+ [/.ibm_921]
+ [/.ibm_922]
+ [/.ibm_930]
+ [/.ibm_933]
+ [/.ibm_935]
+ [/.ibm_937]
+ [/.ibm_939]
+ [/.ibm_942]
+ [/.ibm_942c]
+ [/.ibm_943]
+ [/.ibm_943c]
+ [/.ibm_948]
+ [/.ibm_949]
+ [/.ibm_949c]
+ [/.ibm_950]
+ [/.ibm_964]
+ [/.ibm_970]
+ [/.ibm_1006]
+ [/.ibm_1025]
+ [/.ibm_1026]
+ [/.ibm_1046]
+ [/.ibm_1047]
+ [/.ibm_1097]
+ [/.ibm_1098]
+ [/.ibm_1112]
+ [/.ibm_1122]
+ [/.ibm_1123]
+ [/.ibm_1124]
+ [/.ibm_1140]
+ [/.ibm_1141]
+ [/.ibm_1142]
+ [/.ibm_1143]
+ [/.ibm_1144]
+ [/.ibm_1145]
+ [/.ibm_1146]
+ [/.ibm_1147]
+ [/.ibm_1148]
+ [/.ibm_1149]
+ [/.ibm_1166]
+ [/.ibm_1364]
+ [/.ibm_1381]
+ [/.ibm_1383]
+ [/.ibm_33722]
+ ))
+ )))
+
+(`` (def all/iso-mac
+ (List $.Documentation)
+ (list (,, (with_template [<name>]
+ [(description <name>)]
+
+ [/.iso_2022_cn]
+ [/.iso2022_cn_cns]
+ [/.iso2022_cn_gb]
+ [/.iso_2022_jp]
+ [/.iso_2022_jp_2]
+ [/.iso_2022_kr]
+ [/.iso_8859_1]
+ [/.iso_8859_2]
+ [/.iso_8859_3]
+ [/.iso_8859_4]
+ [/.iso_8859_5]
+ [/.iso_8859_6]
+ [/.iso_8859_7]
+ [/.iso_8859_8]
+ [/.iso_8859_9]
+ [/.iso_8859_11]
+ [/.iso_8859_13]
+ [/.iso_8859_15]
+
+ [/.mac_arabic]
+ [/.mac_central_europe]
+ [/.mac_croatian]
+ [/.mac_cyrillic]
+ [/.mac_dingbat]
+ [/.mac_greek]
+ [/.mac_hebrew]
+ [/.mac_iceland]
+ [/.mac_roman]
+ [/.mac_romania]
+ [/.mac_symbol]
+ [/.mac_thai]
+ [/.mac_turkish]
+ [/.mac_ukraine]
+ ))
+ )))
+
+(`` (def all/utf-koi8
+ (List $.Documentation)
+ (list (,, (with_template [<name>]
+ [(description <name>)]
+
+ [/.utf_8]
+ [/.utf_16]
+ [/.utf_32]
+
+ [/.windows_31j]
+ [/.windows_874]
+ [/.windows_949]
+ [/.windows_950]
+ [/.windows_1250]
+ [/.windows_1252]
+ [/.windows_1251]
+ [/.windows_1253]
+ [/.windows_1254]
+ [/.windows_1255]
+ [/.windows_1256]
+ [/.windows_1257]
+ [/.windows_1258]
+ [/.windows_iso2022jp]
+ [/.windows_50220]
+ [/.windows_50221]
+
+ [/.cesu_8]
+ [/.koi8_r]
+ [/.koi8_u]
+ ))
+ )))
+
(`` (def .public documentation
(List $.Documentation)
(list.partial ($.module /._
@@ -23,153 +191,15 @@
"Encoding formats for text.")
(,, (with_template [<name>]
- [($.definition <name>
- (format "'" (/.name <name>) "' text encoding. "))]
+ [(description <name>)]
[/.ascii]
-
- [/.ibm_037]
- [/.ibm_273]
- [/.ibm_277]
- [/.ibm_278]
- [/.ibm_280]
- [/.ibm_284]
- [/.ibm_285]
- [/.ibm_290]
- [/.ibm_297]
- [/.ibm_300]
- [/.ibm_420]
- [/.ibm_424]
- [/.ibm_437]
- [/.ibm_500]
- [/.ibm_737]
- [/.ibm_775]
- [/.ibm_833]
- [/.ibm_834]
- [/.ibm_838]
- [/.ibm_850]
- [/.ibm_852]
- [/.ibm_855]
- [/.ibm_856]
- [/.ibm_857]
- [/.ibm_858]
- [/.ibm_860]
- [/.ibm_861]
- [/.ibm_862]
- [/.ibm_863]
- [/.ibm_864]
- [/.ibm_865]
- [/.ibm_866]
- [/.ibm_868]
- [/.ibm_869]
- [/.ibm_870]
- [/.ibm_871]
- [/.ibm_874]
- [/.ibm_875]
- [/.ibm_918]
- [/.ibm_921]
- [/.ibm_922]
- [/.ibm_930]
- [/.ibm_933]
- [/.ibm_935]
- [/.ibm_937]
- [/.ibm_939]
- [/.ibm_942]
- [/.ibm_942c]
- [/.ibm_943]
- [/.ibm_943c]
- [/.ibm_948]
- [/.ibm_949]
- [/.ibm_949c]
- [/.ibm_950]
- [/.ibm_964]
- [/.ibm_970]
- [/.ibm_1006]
- [/.ibm_1025]
- [/.ibm_1026]
- [/.ibm_1046]
- [/.ibm_1047]
- [/.ibm_1097]
- [/.ibm_1098]
- [/.ibm_1112]
- [/.ibm_1122]
- [/.ibm_1123]
- [/.ibm_1124]
- [/.ibm_1140]
- [/.ibm_1141]
- [/.ibm_1142]
- [/.ibm_1143]
- [/.ibm_1144]
- [/.ibm_1145]
- [/.ibm_1146]
- [/.ibm_1147]
- [/.ibm_1148]
- [/.ibm_1149]
- [/.ibm_1166]
- [/.ibm_1364]
- [/.ibm_1381]
- [/.ibm_1383]
- [/.ibm_33722]
-
- [/.iso_2022_cn]
- [/.iso2022_cn_cns]
- [/.iso2022_cn_gb]
- [/.iso_2022_jp]
- [/.iso_2022_jp_2]
- [/.iso_2022_kr]
- [/.iso_8859_1]
- [/.iso_8859_2]
- [/.iso_8859_3]
- [/.iso_8859_4]
- [/.iso_8859_5]
- [/.iso_8859_6]
- [/.iso_8859_7]
- [/.iso_8859_8]
- [/.iso_8859_9]
- [/.iso_8859_11]
- [/.iso_8859_13]
- [/.iso_8859_15]
-
- [/.mac_arabic]
- [/.mac_central_europe]
- [/.mac_croatian]
- [/.mac_cyrillic]
- [/.mac_dingbat]
- [/.mac_greek]
- [/.mac_hebrew]
- [/.mac_iceland]
- [/.mac_roman]
- [/.mac_romania]
- [/.mac_symbol]
- [/.mac_thai]
- [/.mac_turkish]
- [/.mac_ukraine]
-
- [/.utf_8]
- [/.utf_16]
- [/.utf_32]
-
- [/.windows_31j]
- [/.windows_874]
- [/.windows_949]
- [/.windows_950]
- [/.windows_1250]
- [/.windows_1252]
- [/.windows_1251]
- [/.windows_1253]
- [/.windows_1254]
- [/.windows_1255]
- [/.windows_1256]
- [/.windows_1257]
- [/.windows_1258]
- [/.windows_iso2022jp]
- [/.windows_50220]
- [/.windows_50221]
-
- [/.cesu_8]
- [/.koi8_r]
- [/.koi8_u]
))
- /utf8.documentation
+ (all list#composite
+ all/ibm
+ all/iso-mac
+ all/utf-koi8
+ /utf8.documentation
+ )
)))
diff --git a/stdlib/source/documentation/lux/data/text/regex.lux b/stdlib/source/documentation/lux/data/text/regex.lux
index 090b88c41..8de3d70e7 100644
--- a/stdlib/source/documentation/lux/data/text/regex.lux
+++ b/stdlib/source/documentation/lux/data/text/regex.lux
@@ -63,7 +63,7 @@
($.definition /.pattern
"Allows you to test text against regular expressions."
- [(case some_text
+ [(when some_text
(pattern "(\d{3})-(\d{3})-(\d{4})"
[_ country_code area_code place_code])
do_some_thing_when_number
diff --git a/stdlib/source/documentation/lux/data/text/unicode/block.lux b/stdlib/source/documentation/lux/data/text/unicode/block.lux
index 7aa0355ab..78002e97c 100644
--- a/stdlib/source/documentation/lux/data/text/unicode/block.lux
+++ b/stdlib/source/documentation/lux/data/text/unicode/block.lux
@@ -4,42 +4,27 @@
["$" documentation]
[data
["[0]" text (.only)
- ["%" \\format (.only format)]]]
+ ["%" \\format (.only format)]]
+ [collection
+ ["[0]" list (.use "[1]#[0]" monoid)]]]
[math
[number
["[0]" nat (.use "hex#[0]" hex)]]]]]
[\\library
["[0]" /]])
-(`` (def .public documentation
- (List $.Documentation)
- (list ($.module /._
- "")
-
- ($.definition /.monoid)
- ($.definition /.start)
- ($.definition /.end)
- ($.definition /.size)
- ($.definition /.equivalence)
- ($.definition /.hash)
-
- ($.definition /.Block
- "A block of valid unicode characters.")
-
- ($.definition /.block
- ""
- [(block start additional)])
+(def description
+ (template (_ <name>)
+ [($.definition <name>
+ (let [[_ name] (symbol <name>)]
+ (format (hex#encoded (/.start <name>))
+ "-" (hex#encoded (/.end <name>))
+ " | " (text.replaced "_" " " name))))]))
- ($.definition /.within?
- ""
- [(within? block char)])
-
- (,, (with_template [<name>]
- [($.definition <name>
- (let [[_ name] (symbol <name>)]
- (format (hex#encoded (/.start <name>))
- "-" (hex#encoded (/.end <name>))
- " | " (text.replaced "_" " " name))))]
+(`` (def all_1/4
+ (List $.Documentation)
+ (list (,, (with_template [<name>]
+ [(description <name>)]
[/.basic_latin]
[/.latin_1_supplement]
@@ -74,6 +59,14 @@
[/.hangul_jamo]
[/.ethiopic]
[/.cherokee]
+ ))
+ )))
+
+(`` (def all_2/4
+ (List $.Documentation)
+ (list (,, (with_template [<name>]
+ [(description <name>)]
+
[/.unified_canadian_aboriginal_syllabics]
[/.ogham]
[/.runic]
@@ -93,6 +86,15 @@
[/.superscripts_and_subscripts]
[/.currency_symbols]
[/.combining_diacritical_marks_for_symbols]
+ ))
+ )))
+
+(`` (def all_3/4
+ (List $.Documentation)
+ (list (,, (with_template [<name>]
+ [(description <name>)]
+
+ [/.combining_diacritical_marks_for_symbols]
[/.letterlike_symbols]
[/.number_forms]
[/.arrows]
@@ -120,6 +122,14 @@
[/.hiragana]
[/.katakana]
[/.bopomofo]
+ ))
+ )))
+
+(`` (def all_4/4
+ (List $.Documentation)
+ (list (,, (with_template [<name>]
+ [(description <name>)]
+
[/.hangul_compatibility_jamo]
[/.kanbun]
[/.bopomofo_extended]
@@ -151,3 +161,34 @@
[/.lower_case]
))
)))
+
+(def .public documentation
+ (List $.Documentation)
+ (list.partial ($.module /._
+ "")
+
+ ($.definition /.monoid)
+ ($.definition /.start)
+ ($.definition /.end)
+ ($.definition /.size)
+ ($.definition /.equivalence)
+ ($.definition /.hash)
+
+ ($.definition /.Block
+ "A block of valid unicode characters.")
+
+ ($.definition /.block
+ ""
+ [(block start additional)])
+
+ ($.definition /.within?
+ ""
+ [(within? block char)])
+
+ (all list#composite
+ all_1/4
+ all_2/4
+ all_3/4
+ all_4/4
+ )
+ ))
diff --git a/stdlib/source/documentation/lux/ffi.js.lux b/stdlib/source/documentation/lux/ffi.js.lux
index 3048cea36..980ad9a6e 100644
--- a/stdlib/source/documentation/lux/ffi.js.lux
+++ b/stdlib/source/documentation/lux/ffi.js.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except int char)
+ [lux (.except)
["$" documentation]
[data
["[0]" text (.only \n)
@@ -8,60 +8,61 @@
[\\library
["[0]" /]])
-(.def .public documentation
- (.List $.Module)
- ($.module /._
- ""
- [($.definition (/.Object brand))
- ($.definition /.Function)
- ($.definition /.Symbol)
- ($.definition /.Null)
- ($.definition /.Undefined)
- ($.definition /.Boolean)
- ($.definition /.Number)
- ($.definition /.String)
- ($.definition /.null?)
- ($.definition /.on_browser?)
- ($.definition /.on_nashorn?)
- ($.definition /.on_node_js?)
+(def .public documentation
+ (List $.Documentation)
+ (list ($.module /._
+ "")
- ($.definition /.null
- "The null pointer.")
+ ($.definition (/.Object brand))
+ ($.definition /.Function)
+ ($.definition /.Symbol)
+ ($.definition /.Null)
+ ($.definition /.Undefined)
+ ($.definition /.Boolean)
+ ($.definition /.Number)
+ ($.definition /.String)
+ ($.definition /.null?)
+ ($.definition /.on_browser?)
+ ($.definition /.on_nashorn?)
+ ($.definition /.on_node_js?)
- ($.definition /.import
- "Easily import types, methods, functions and constants."
- [(import Uint8Array
- "[1]::[0]")
+ ($.definition /.null
+ "The null pointer.")
- (import TextEncoder
- "[1]::[0]"
- (new [/.String])
- (encode [/.String] Uint8Array))
+ ($.definition /.import
+ "Easily import types, methods, functions and constants."
+ [(import Uint8Array
+ "[1]::[0]")
- (import TextDecoder
- "[1]::[0]"
- (new [/.String])
- (decode [/.String] String))])
+ (import TextEncoder
+ "[1]::[0]"
+ (new [/.String])
+ (encode [/.String] Uint8Array))
- ($.definition /.type_of
- "The type of an object, as text."
- [(= "boolean"
- (type_of true))]
- [(= "number"
- (type_of +123.456))]
- [(= "string"
- (type_of "789"))]
- [(= "function"
- (type_of (function (_ value) value)))])
+ (import TextDecoder
+ "[1]::[0]"
+ (new [/.String])
+ (decode [/.String] String))])
- ($.definition /.global
- "Allows using definitions from the JavaScript host platform."
- [(global .Frac [Math PI])])
+ ($.definition /.type_of
+ "The type of an object, as text."
+ [(= "boolean"
+ (type_of true))]
+ [(= "number"
+ (type_of +123.456))]
+ [(= "string"
+ (type_of "789"))]
+ [(= "function"
+ (type_of (function (_ value) value)))])
- ($.definition /.function
- (format "Allows defining closures/anonymous-functions in the form that JavaScript expects."
- \n "This is useful for adapting Lux functions for usage by JavaScript code.")
- [(is /.Function
- (function [left right]
- (do_something (as Foo left) (as Bar right))))])]
- []))
+ ($.definition /.global
+ "Allows using definitions from the JavaScript host platform."
+ [(global .Frac [Math PI])])
+
+ ($.definition /.function
+ (format "Allows defining closures/anonymous-functions in the form that JavaScript expects."
+ \n "This is useful for adapting Lux functions for usage by JavaScript code.")
+ [(is /.Function
+ (function [left right]
+ (do_something (as Foo left) (as Bar right))))])
+ ))
diff --git a/stdlib/source/documentation/lux/ffi.jvm.lux b/stdlib/source/documentation/lux/ffi.jvm.lux
index 52b551378..ca1841a0b 100644
--- a/stdlib/source/documentation/lux/ffi.jvm.lux
+++ b/stdlib/source/documentation/lux/ffi.jvm.lux
@@ -171,7 +171,7 @@
($.definition /.as
(format "Checks whether an object is an instance of a particular class."
\n "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes.")
- [(case (as String "YOLO")
+ [(when (as String "YOLO")
{.#Some value_as_string}
{.#None})])
diff --git a/stdlib/source/documentation/lux/ffi.lua.lux b/stdlib/source/documentation/lux/ffi.lua.lux
index 0763955d6..b4713841f 100644
--- a/stdlib/source/documentation/lux/ffi.lua.lux
+++ b/stdlib/source/documentation/lux/ffi.lua.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except int char)
+ [lux (.except)
["$" documentation]
[data
["[0]" text (.only \n)
@@ -8,27 +8,28 @@
[\\library
["[0]" /]])
-(.def .public documentation
- (.List $.Module)
- ($.module /._
- ""
- [($.definition (/.Object brand))
- ($.definition /.Nil)
- ($.definition /.Function)
- ($.definition /.Table)
- ($.definition /.Boolean)
- ($.definition /.Integer)
- ($.definition /.Float)
- ($.definition /.String)
+(def .public documentation
+ (List $.Documentation)
+ (list ($.module /._
+ "")
- ($.definition /.import
- "Easily import types, methods, functions and constants."
- [(import (os/getenv [..String] "io" "?" ..String))])
+ ($.definition (/.Object brand))
+ ($.definition /.Nil)
+ ($.definition /.Function)
+ ($.definition /.Table)
+ ($.definition /.Boolean)
+ ($.definition /.Integer)
+ ($.definition /.Float)
+ ($.definition /.String)
- ($.definition /.closure
- (format "Allows defining closures/anonymous-functions in the form that Lua expects."
- \n "This is useful for adapting Lux functions for usage by Lua code.")
- [(is ..Function
- (closure [left right]
- (do_something (as Foo left) (as Bar right))))])]
- []))
+ ($.definition /.import
+ "Easily import types, methods, functions and constants."
+ [(import (os/getenv [..String] "io" "?" ..String))])
+
+ ($.definition /.function
+ (format "Allows defining closures/anonymous-functions in the form that Lua expects."
+ \n "This is useful for adapting Lux functions for usage by Lua code.")
+ [(is ..Function
+ (function [left right]
+ (do_something (as Foo left) (as Bar right))))])
+ ))
diff --git a/stdlib/source/documentation/lux/ffi.old.lux b/stdlib/source/documentation/lux/ffi.old.lux
index a862963d8..2400b4f37 100644
--- a/stdlib/source/documentation/lux/ffi.old.lux
+++ b/stdlib/source/documentation/lux/ffi.old.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except int char)
+ [lux (.except)
["$" documentation]
[data
["[0]" text (.only \n)
@@ -8,213 +8,214 @@
[\\library
["[0]" /]])
-(`` (.def .public documentation
- (.List $.Module)
- ($.module /._
- ""
- [($.definition /.Privacy)
- ($.definition /.State)
- ($.definition /.Inheritance)
-
- (,, (with_template [<name> <from> <to>]
- [($.definition <name>
- "Type converter.")]
-
- [/.byte_to_long "java.lang.Byte" "java.lang.Long"]
-
- [/.short_to_long "java.lang.Short" "java.lang.Long"]
-
- [/.double_to_int "java.lang.Double" "java.lang.Integer"]
- [/.double_to_long "java.lang.Double" "java.lang.Long"]
- [/.double_to_float "java.lang.Double" "java.lang.Float"]
-
- [/.float_to_int "java.lang.Float" "java.lang.Integer"]
- [/.float_to_long "java.lang.Float" "java.lang.Long"]
- [/.float_to_double "java.lang.Float" "java.lang.Double"]
-
- [/.int_to_byte "java.lang.Integer" "java.lang.Byte"]
- [/.int_to_short "java.lang.Integer" "java.lang.Short"]
- [/.int_to_long "java.lang.Integer" "java.lang.Long"]
- [/.int_to_float "java.lang.Integer" "java.lang.Float"]
- [/.int_to_double "java.lang.Integer" "java.lang.Double"]
- [/.int_to_char "java.lang.Integer" "java.lang.Character"]
-
- [/.long_to_byte "java.lang.Long" "java.lang.Byte"]
- [/.long_to_short "java.lang.Long" "java.lang.Short"]
- [/.long_to_int "java.lang.Long" "java.lang.Integer"]
- [/.long_to_float "java.lang.Long" "java.lang.Float"]
- [/.long_to_double "java.lang.Long" "java.lang.Double"]
-
- [/.char_to_byte "java.lang.Character" "java.lang.Byte"]
- [/.char_to_short "java.lang.Character" "java.lang.Short"]
- [/.char_to_int "java.lang.Character" "java.lang.Integer"]
- [/.char_to_long "java.lang.Character" "java.lang.Long"]
- ))
-
- ($.definition /.class
- "Allows defining JVM classes in Lux code."
- [(class "final" (TestClass A) [Runnable]
- ... Fields
- ("private" foo boolean)
- ("private" bar A)
- ("private" baz java/lang/Object)
- ... Methods
- ("public" [] (new [value A]) []
- (exec
- (:= ::foo true)
- (:= ::bar value)
- (:= ::baz "")
- []))
- ("public" (virtual) java/lang/Object
- "")
- ("public" "static" (static) java/lang/Object
- "")
- (Runnable [] (run) void
- []))
- "The tuple corresponds to parent interfaces."
- "An optional super-class can be specified before the tuple. If not specified, java.lang.Object will be assumed."
- "Fields and methods defined in the class can be used with special syntax."
- "For example:"
- "::resolved, for accessing the 'resolved' field."
- "(:= ::resolved true) for modifying it."
- "(::new! []) for calling the class's constructor."
- "(::resolve! container [value]) for calling the 'resolve' method."])
-
- ($.definition /.interface
- "Allows defining JVM interfaces."
- [(interface TestInterface
- ([] foo [boolean String] void "throws" [Exception]))])
-
- ($.definition /.object
- "Allows defining anonymous classes."
- ["The 1st tuple corresponds to class-level type-variables."
- "The 2nd tuple corresponds to parent interfaces."
- "The 3rd tuple corresponds to arguments to the super class constructor."
- "An optional super-class can be specified before the 1st tuple. If not specified, java.lang.Object will be assumed."
- (object [] [Runnable]
- []
- (Runnable [] (run self) void
- (exec (do_something some_value)
- [])))])
-
- ($.definition /.null
- "Null object reference."
- (null))
-
- ($.definition /.null?
- "Test for null object reference."
- [(= (null? (null))
- true)]
- [(= (null? "YOLO")
- false)])
-
- ($.definition /.???
- "Takes a (potentially null) ObjectType reference and creates a (Maybe ObjectType) for it."
- [(= (??? (is java/lang/String (null)))
- {.#None})]
- [(= (??? "YOLO")
- {.#Some "YOLO"})])
-
- ($.definition /.!!!
- "Takes a (Maybe ObjectType) and returns a ObjectType."
- [(= "foo"
- (!!! (??? "foo")))]
- ["A .#None would get translated into a (null)."
- (= (null)
- (!!! (??? (is java/lang/Thread (null)))))])
-
- ($.definition /.check
- (format "Checks whether an object is an instance of a particular class."
- \n "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes.")
- [(case (check java/lang/String "YOLO")
- {.#Some value_as_string}
- {.#None})])
-
- ($.definition /.synchronized
- "Evaluates body, while holding a lock on a given object."
- [(synchronized object_to_be_locked
- (exec
- (do something)
- (do_something else)
- (finish the computation)))])
-
- ($.definition /.to
- "Call a variety of methods on an object. Then, return the object."
- [(to object
- (ClassName::method0 arg0 arg1 arg2)
- (ClassName::method1 arg3 arg4 arg5))])
-
- ($.definition /.import
- (format "Allows importing JVM classes, and using them as types."
- \n "Their methods, fields and enum options can also be imported.")
- [(import java/lang/Object
- "[1]::[0]"
- (new [])
- (equals [java/lang/Object] boolean)
- (wait [int] "io" "try" void))]
- ["Special options can also be given for the return values."
- "'?' means that the values will be returned inside a Maybe type. That way, null becomes .#None."
- "'try' means that the computation might throw an exception, and the return value will be wrapped by the Try type."
- "'io' means the computation has side effects, and will be wrapped by the IO type."
- "These options must show up in the following order ['io' 'try' '?'] (although, each option can be used independently)."
- (import java/lang/String
- "[1]::[0]"
- (new [[byte]])
- ("static" valueOf [char] java/lang/String)
- ("static" valueOf "as" int_valueOf [int] java/lang/String))
-
- (import (java/util/List e)
- "[1]::[0]"
- (size [] int)
- (get [int] e))
-
- (import (java/util/ArrayList a)
- "[1]::[0]"
- ([T] toArray [[T]] [T]))]
- ["The class-type that is generated is of the fully-qualified name."
- "This avoids a clash between the java.util.List type, and Lux's own List type."
- "All enum options to be imported must be specified."
- (import java/lang/Character$UnicodeScript
- "[1]::[0]"
- ("enum" ARABIC CYRILLIC LATIN))]
- ["It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-parameters."
- "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)."
- (import (lux/concurrency/async/JvmAsync A)
- "[1]::[0]"
- (resolve [A] boolean)
- (poll [] A)
- (wasResolved [] boolean)
- (waitOn [lux/Function] void)
- ("static" [A] make [A] (lux/concurrency/async/JvmAsync A)))]
- ["Also, the names of the imported members will look like Class::member"
- (java/lang/Object::new [])
- (java/lang/Object::equals [other_object] my_object)
- (java/util/List::size [] my_list)
- java/lang/Character$UnicodeScript::LATIN])
-
- ($.definition /.array
- "Create an array of the given type, with the given size."
- [(array java/lang/Object 10)])
-
- ($.definition /.length
- "Gives the length of an array."
- [(length my_array)])
-
- ($.definition /.read!
- "Loads an element from an array."
- [(read! 10 my_array)])
-
- ($.definition /.write!
- "Stores an element into an array."
- [(write! 10 my_object my_array)])
-
- ($.definition /.class_for
- "Loads the class as a java.lang.Class object."
- [(is (Primitive "java.lang.Class" ["java.lang.Object"])
- (class_for java/lang/String))])
-
- ($.definition /.type
- ""
- [(is .Type
- (type java/lang/String))])]
- [])))
+(`` (def .public documentation
+ (List $.Documentation)
+ (list ($.module /._
+ "")
+
+ ($.definition /.Privacy)
+ ($.definition /.State)
+ ($.definition /.Inheritance)
+
+ (,, (with_template [<name> <from> <to>]
+ [($.definition <name>
+ "Type converter.")]
+
+ [/.byte_to_long "java.lang.Byte" "java.lang.Long"]
+
+ [/.short_to_long "java.lang.Short" "java.lang.Long"]
+
+ [/.double_to_int "java.lang.Double" "java.lang.Integer"]
+ [/.double_to_long "java.lang.Double" "java.lang.Long"]
+ [/.double_to_float "java.lang.Double" "java.lang.Float"]
+
+ [/.float_to_int "java.lang.Float" "java.lang.Integer"]
+ [/.float_to_long "java.lang.Float" "java.lang.Long"]
+ [/.float_to_double "java.lang.Float" "java.lang.Double"]
+
+ [/.int_to_byte "java.lang.Integer" "java.lang.Byte"]
+ [/.int_to_short "java.lang.Integer" "java.lang.Short"]
+ [/.int_to_long "java.lang.Integer" "java.lang.Long"]
+ [/.int_to_float "java.lang.Integer" "java.lang.Float"]
+ [/.int_to_double "java.lang.Integer" "java.lang.Double"]
+ [/.int_to_char "java.lang.Integer" "java.lang.Character"]
+
+ [/.long_to_byte "java.lang.Long" "java.lang.Byte"]
+ [/.long_to_short "java.lang.Long" "java.lang.Short"]
+ [/.long_to_int "java.lang.Long" "java.lang.Integer"]
+ [/.long_to_float "java.lang.Long" "java.lang.Float"]
+ [/.long_to_double "java.lang.Long" "java.lang.Double"]
+
+ [/.char_to_byte "java.lang.Character" "java.lang.Byte"]
+ [/.char_to_short "java.lang.Character" "java.lang.Short"]
+ [/.char_to_int "java.lang.Character" "java.lang.Integer"]
+ [/.char_to_long "java.lang.Character" "java.lang.Long"]
+ ))
+
+ ($.definition /.class
+ "Allows defining JVM classes in Lux code."
+ [(class "final" (TestClass A) [Runnable]
+ ... Fields
+ ("private" foo boolean)
+ ("private" bar A)
+ ("private" baz java/lang/Object)
+ ... Methods
+ ("public" [] (new [value A]) []
+ (exec
+ (:= ::foo true)
+ (:= ::bar value)
+ (:= ::baz "")
+ []))
+ ("public" (virtual) java/lang/Object
+ "")
+ ("public" "static" (static) java/lang/Object
+ "")
+ (Runnable [] (run) void
+ []))
+ "The tuple corresponds to parent interfaces."
+ "An optional super-class can be specified before the tuple. If not specified, java.lang.Object will be assumed."
+ "Fields and methods defined in the class can be used with special syntax."
+ "For example:"
+ "::resolved, for accessing the 'resolved' field."
+ "(:= ::resolved true) for modifying it."
+ "(::new! []) for calling the class's constructor."
+ "(::resolve! container [value]) for calling the 'resolve' method."])
+
+ ($.definition /.interface
+ "Allows defining JVM interfaces."
+ [(interface TestInterface
+ ([] foo [boolean String] void "throws" [Exception]))])
+
+ ($.definition /.object
+ "Allows defining anonymous classes."
+ ["The 1st tuple corresponds to class-level type-variables."
+ "The 2nd tuple corresponds to parent interfaces."
+ "The 3rd tuple corresponds to arguments to the super class constructor."
+ "An optional super-class can be specified before the 1st tuple. If not specified, java.lang.Object will be assumed."
+ (object [] [Runnable]
+ []
+ (Runnable [] (run self) void
+ (exec (do_something some_value)
+ [])))])
+
+ ($.definition /.null
+ "Null object reference."
+ (null))
+
+ ($.definition /.null?
+ "Test for null object reference."
+ [(= (null? (null))
+ true)]
+ [(= (null? "YOLO")
+ false)])
+
+ ($.definition /.???
+ "Takes a (potentially null) ObjectType reference and creates a (Maybe ObjectType) for it."
+ [(= (??? (is java/lang/String (null)))
+ {.#None})]
+ [(= (??? "YOLO")
+ {.#Some "YOLO"})])
+
+ ($.definition /.!!!
+ "Takes a (Maybe ObjectType) and returns a ObjectType."
+ [(= "foo"
+ (!!! (??? "foo")))]
+ ["A .#None would get translated into a (null)."
+ (= (null)
+ (!!! (??? (is java/lang/Thread (null)))))])
+
+ ($.definition /.check
+ (format "Checks whether an object is an instance of a particular class."
+ \n "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes.")
+ [(when (check java/lang/String "YOLO")
+ {.#Some value_as_string}
+ {.#None})])
+
+ ($.definition /.synchronized
+ "Evaluates body, while holding a lock on a given object."
+ [(synchronized object_to_be_locked
+ (exec
+ (do something)
+ (do_something else)
+ (finish the computation)))])
+
+ ($.definition /.to
+ "Call a variety of methods on an object. Then, return the object."
+ [(to object
+ (ClassName::method0 arg0 arg1 arg2)
+ (ClassName::method1 arg3 arg4 arg5))])
+
+ ($.definition /.import
+ (format "Allows importing JVM classes, and using them as types."
+ \n "Their methods, fields and enum options can also be imported.")
+ [(import java/lang/Object
+ "[1]::[0]"
+ (new [])
+ (equals [java/lang/Object] boolean)
+ (wait [int] "io" "try" void))]
+ ["Special options can also be given for the return values."
+ "'?' means that the values will be returned inside a Maybe type. That way, null becomes .#None."
+ "'try' means that the computation might throw an exception, and the return value will be wrapped by the Try type."
+ "'io' means the computation has side effects, and will be wrapped by the IO type."
+ "These options must show up in the following order ['io' 'try' '?'] (although, each option can be used independently)."
+ (import java/lang/String
+ "[1]::[0]"
+ (new [[byte]])
+ ("static" valueOf [char] java/lang/String)
+ ("static" valueOf "as" int_valueOf [int] java/lang/String))
+
+ (import (java/util/List e)
+ "[1]::[0]"
+ (size [] int)
+ (get [int] e))
+
+ (import (java/util/ArrayList a)
+ "[1]::[0]"
+ ([T] toArray [[T]] [T]))]
+ ["The class-type that is generated is of the fully-qualified name."
+ "This avoids a clash between the java.util.List type, and Lux's own List type."
+ "All enum options to be imported must be specified."
+ (import java/lang/Character$UnicodeScript
+ "[1]::[0]"
+ ("enum" ARABIC CYRILLIC LATIN))]
+ ["It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-parameters."
+ "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)."
+ (import (lux/concurrency/async/JvmAsync A)
+ "[1]::[0]"
+ (resolve [A] boolean)
+ (poll [] A)
+ (wasResolved [] boolean)
+ (waitOn [lux/Function] void)
+ ("static" [A] make [A] (lux/concurrency/async/JvmAsync A)))]
+ ["Also, the names of the imported members will look like Class::member"
+ (java/lang/Object::new [])
+ (java/lang/Object::equals [other_object] my_object)
+ (java/util/List::size [] my_list)
+ java/lang/Character$UnicodeScript::LATIN])
+
+ ($.definition /.array
+ "Create an array of the given type, with the given size."
+ [(array java/lang/Object 10)])
+
+ ($.definition /.length
+ "Gives the length of an array."
+ [(length my_array)])
+
+ ($.definition /.read!
+ "Loads an element from an array."
+ [(read! 10 my_array)])
+
+ ($.definition /.write!
+ "Stores an element into an array."
+ [(write! 10 my_object my_array)])
+
+ ($.definition /.class_for
+ "Loads the class as a java.lang.Class object."
+ [(is (Primitive "java.lang.Class" ["java.lang.Object"])
+ (class_for java/lang/String))])
+
+ ($.definition /.type
+ ""
+ [(is .Type
+ (type java/lang/String))])
+ )))
diff --git a/stdlib/source/documentation/lux/ffi.py.lux b/stdlib/source/documentation/lux/ffi.py.lux
index d2da39eff..f73c5eb83 100644
--- a/stdlib/source/documentation/lux/ffi.py.lux
+++ b/stdlib/source/documentation/lux/ffi.py.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except int char)
+ [lux (.except)
["$" documentation]
[data
["[0]" text (.only \n)
@@ -8,48 +8,49 @@
[\\library
["[0]" /]])
-(.def .public documentation
- (.List $.Module)
- ($.module /._
- ""
- [($.definition (/.Object brand))
- ($.definition /.None)
- ($.definition /.Dict)
- ($.definition /.Function)
- ($.definition /.Boolean)
- ($.definition /.Integer)
- ($.definition /.Float)
- ($.definition /.String)
+(def .public documentation
+ (List $.Documentation)
+ (list ($.module /._
+ "")
- ($.definition /.import
- "Easily import types, methods, functions and constants."
- [(import os
- "[1]::[0]"
- ("static" F_OK Integer)
- ("static" R_OK Integer)
- ("static" W_OK Integer)
- ("static" X_OK Integer)
+ ($.definition (/.Object brand))
+ ($.definition /.None)
+ ($.definition /.Dict)
+ ($.definition /.Function)
+ ($.definition /.Boolean)
+ ($.definition /.Integer)
+ ($.definition /.Float)
+ ($.definition /.String)
- ("static" mkdir [String] "io" "try" "?" Any)
- ("static" access [String Integer] "io" "try" Boolean)
- ("static" remove [String] "io" "try" "?" Any)
- ("static" rmdir [String] "io" "try" "?" Any)
- ("static" rename [String String] "io" "try" "?" Any)
- ("static" listdir [String] "io" "try" (Array String)))
+ ($.definition /.import
+ "Easily import types, methods, functions and constants."
+ [(import os
+ "[1]::[0]"
+ ("static" F_OK Integer)
+ ("static" R_OK Integer)
+ ("static" W_OK Integer)
+ ("static" X_OK Integer)
- (import os/path
- "[1]::[0]"
- ("static" isfile [String] "io" "try" Boolean)
- ("static" isdir [String] "io" "try" Boolean)
- ("static" sep String)
- ("static" getsize [String] "io" "try" Integer)
- ("static" getmtime [String] "io" "try" Float))])
+ ("static" mkdir [String] "io" "try" "?" Any)
+ ("static" access [String Integer] "io" "try" Boolean)
+ ("static" remove [String] "io" "try" "?" Any)
+ ("static" rmdir [String] "io" "try" "?" Any)
+ ("static" rename [String String] "io" "try" "?" Any)
+ ("static" listdir [String] "io" "try" (Array String)))
- ($.definition /.function
- (format "Allows defining closures/anonymous-functions in the form that Python expects."
- \n "This is useful for adapting Lux functions for usage by Python code.")
- [(is ..Function
- (function [left right]
- (do_something (as Foo left)
- (as Bar right))))])]
- []))
+ (import os/path
+ "[1]::[0]"
+ ("static" isfile [String] "io" "try" Boolean)
+ ("static" isdir [String] "io" "try" Boolean)
+ ("static" sep String)
+ ("static" getsize [String] "io" "try" Integer)
+ ("static" getmtime [String] "io" "try" Float))])
+
+ ($.definition /.function
+ (format "Allows defining closures/anonymous-functions in the form that Python expects."
+ \n "This is useful for adapting Lux functions for usage by Python code.")
+ [(is ..Function
+ (function [left right]
+ (do_something (as Foo left)
+ (as Bar right))))])
+ ))
diff --git a/stdlib/source/documentation/lux/ffi.rb.lux b/stdlib/source/documentation/lux/ffi.rb.lux
index 24696edc5..bc3f482c1 100644
--- a/stdlib/source/documentation/lux/ffi.rb.lux
+++ b/stdlib/source/documentation/lux/ffi.rb.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except int char)
+ [lux (.except)
["$" documentation]
[data
["[0]" text (.only \n)
@@ -8,35 +8,36 @@
[\\library
["[0]" /]])
-(.def .public documentation
- (.List $.Module)
- ($.module /._
- ""
- [($.definition (/.Object brand))
- ($.definition /.Nil)
- ($.definition /.Function)
- ($.definition /.Integer)
- ($.definition /.Float)
- ($.definition /.String)
+(def .public documentation
+ (List $.Documentation)
+ (list ($.module /._
+ "")
- ($.definition /.import
- "Easily import types, methods, functions and constants."
- [(import Stat
- "[1]::[0]"
- (executable? [] Bit)
- (size Int))
+ ($.definition (/.Object brand))
+ ($.definition /.Nil)
+ ($.definition /.Function)
+ ($.definition /.Integer)
+ ($.definition /.Float)
+ ($.definition /.String)
- (import File "as" RubyFile
- "[1]::[0]"
- ("static" SEPARATOR ..String)
- ("static" open [Path ..String] "io" "try" RubyFile)
- ("static" stat [Path] "io" "try" Stat)
- ("static" delete [Path] "io" "try" Int)
- ("static" file? [Path] "io" "try" Bit)
- ("static" directory? [Path] "io" "try" Bit)
+ ($.definition /.import
+ "Easily import types, methods, functions and constants."
+ [(import Stat
+ "[1]::[0]"
+ (executable? [] Bit)
+ (size Int))
- (read [] "io" "try" Binary)
- (write [Binary] "io" "try" Int)
- (flush [] "io" "try" "?" Any)
- (close [] "io" "try" "?" Any))])]
- []))
+ (import File "as" RubyFile
+ "[1]::[0]"
+ ("static" SEPARATOR ..String)
+ ("static" open [Path ..String] "io" "try" RubyFile)
+ ("static" stat [Path] "io" "try" Stat)
+ ("static" delete [Path] "io" "try" Int)
+ ("static" file? [Path] "io" "try" Bit)
+ ("static" directory? [Path] "io" "try" Bit)
+
+ (read [] "io" "try" Binary)
+ (write [Binary] "io" "try" Int)
+ (flush [] "io" "try" "?" Any)
+ (close [] "io" "try" "?" Any))])
+ ))
diff --git a/stdlib/source/documentation/lux/meta/compiler/language/lux/analysis.lux b/stdlib/source/documentation/lux/meta/compiler/language/lux/analysis.lux
index 45d71946e..766e1740f 100644
--- a/stdlib/source/documentation/lux/meta/compiler/language/lux/analysis.lux
+++ b/stdlib/source/documentation/lux/meta/compiler/language/lux/analysis.lux
@@ -72,7 +72,7 @@
($.definition /.Branch)
($.definition /.Match)
($.definition /.equivalence)
- ($.definition /.case)
+ ($.definition /.when)
($.definition /.unit)
($.definition /.bit)
($.definition /.nat)
diff --git a/stdlib/source/documentation/lux/meta/compiler/language/lux/synthesis.lux b/stdlib/source/documentation/lux/meta/compiler/language/lux/synthesis.lux
index b74515da2..af6cc479e 100644
--- a/stdlib/source/documentation/lux/meta/compiler/language/lux/synthesis.lux
+++ b/stdlib/source/documentation/lux/meta/compiler/language/lux/synthesis.lux
@@ -124,7 +124,7 @@
($.definition /.constant)
($.definition /.variable/local)
($.definition /.variable/foreign)
- ($.definition /.branch/case)
+ ($.definition /.branch/when)
($.definition /.branch/let)
($.definition /.branch/if)
($.definition /.branch/get)
diff --git a/stdlib/source/documentation/lux/meta/target/python.lux b/stdlib/source/documentation/lux/meta/target/python.lux
index 50263c3b9..656f3373f 100644
--- a/stdlib/source/documentation/lux/meta/target/python.lux
+++ b/stdlib/source/documentation/lux/meta/target/python.lux
@@ -6,16 +6,13 @@
[text (.only \n)
["%" \\format (.only format)]]
[collection
- ["[0]" list]]]]]
+ ["[0]" list (.use "[1]#[0]" monoid)]]]]]
[\\library
["[0]" /]])
-(def .public documentation
+(def all_1/4
(List $.Documentation)
- (list ($.module /._
- "")
-
- ($.definition /.Code)
+ (list ($.definition /.Code)
($.definition /.equivalence)
($.definition /.hash)
($.definition /.manual)
@@ -37,7 +34,11 @@
($.definition /.var)
($.definition /.poly)
($.definition /.keyword)
- ($.definition /.none)
+ ))
+
+(def all_2/4
+ (List $.Documentation)
+ (list ($.definition /.none)
($.definition /.bool)
($.definition /.int)
($.definition /.long)
@@ -69,7 +70,11 @@
($.definition /.//)
($.definition /.%)
($.definition /.**)
- ($.definition /.bit_or)
+ ))
+
+(def all_3/4
+ (List $.Documentation)
+ (list ($.definition /.bit_or)
($.definition /.bit_and)
($.definition /.bit_xor)
($.definition /.bit_shl)
@@ -89,6 +94,11 @@
($.definition /.while)
($.definition /.for_in)
($.definition /.statement)
+ ))
+
+(def all_4/4
+ (List $.Documentation)
+ (list ($.definition /.statement)
($.definition /.pass)
($.definition /.Except)
($.definition /.try)
@@ -111,3 +121,16 @@
($.definition /.__import__/1)
($.definition /.Exception/1)
))
+
+(def .public documentation
+ (List $.Documentation)
+ (list.partial ($.module /._
+ "")
+
+ (all list#composite
+ ..all_1/4
+ ..all_2/4
+ ..all_3/4
+ ..all_4/4
+ )
+ ))
diff --git a/stdlib/source/documentation/lux/world/input/keyboard.lux b/stdlib/source/documentation/lux/world/input/keyboard.lux
index b6fa9b392..3d8d246e8 100644
--- a/stdlib/source/documentation/lux/world/input/keyboard.lux
+++ b/stdlib/source/documentation/lux/world/input/keyboard.lux
@@ -4,16 +4,15 @@
["$" documentation]
[data
["[0]" text (.only \n)
- ["%" \\format (.only format)]]]]]
+ ["%" \\format (.only format)]]
+ [collection
+ ["[0]" list (.use "[1]#[0]" monoid)]]]]]
[\\library
["[0]" /]])
-(def .public documentation
+(def all/characters
(List $.Documentation)
- (list ($.module /._
- "")
-
- ($.definition /.back_space)
+ (list ($.definition /.back_space)
($.definition /.enter)
($.definition /.shift)
($.definition /.control)
@@ -55,7 +54,11 @@
($.definition /.x)
($.definition /.y)
($.definition /.z)
- ($.definition /.num_pad_0)
+ ))
+
+(def all/special
+ (List $.Documentation)
+ (list ($.definition /.num_pad_0)
($.definition /.num_pad_1)
($.definition /.num_pad_2)
($.definition /.num_pad_3)
@@ -97,10 +100,21 @@
($.definition /.f24)
($.definition /.release)
($.definition /.press)
+ ))
- ($.definition /.Key
- "A key from a keyboard, identify by a numeric ID.")
+(def .public documentation
+ (List $.Documentation)
+ (list.partial ($.module /._
+ "")
- ($.definition /.Press
- "A key-press for a key.")
- ))
+ ($.definition /.Key
+ "A key from a keyboard, identify by a numeric ID.")
+
+ ($.definition /.Press
+ "A key-press for a key.")
+
+ (all list#composite
+ ..all/characters
+ ..all/special
+ )
+ ))