From 374ccf07246484eb7beb2cd87f3fc88396373ee1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 20 Aug 2021 03:12:49 -0400 Subject: More fixes. --- stdlib/source/library/lux.lux | 30 ++-- stdlib/source/library/lux/control/parser/text.lux | 2 +- stdlib/source/library/lux/data/format/binary.lux | 8 -- stdlib/source/library/lux/data/format/json.lux | 26 +--- stdlib/source/library/lux/data/format/tar.lux | 8 +- stdlib/source/library/lux/data/format/xml.lux | 3 - stdlib/source/library/lux/data/identity.lux | 1 - stdlib/source/library/lux/data/name.lux | 12 +- stdlib/source/library/lux/data/product.lux | 23 ++-- stdlib/source/library/lux/data/sum.lux | 36 ++--- stdlib/source/library/lux/data/text.lux | 18 +-- stdlib/source/library/lux/data/text/buffer.lux | 2 +- stdlib/source/library/lux/data/text/encoding.lux | 2 +- stdlib/source/library/lux/data/text/escape.lux | 4 - stdlib/source/library/lux/data/text/format.lux | 3 - stdlib/source/library/lux/data/text/regex.lux | 69 ---------- .../source/library/lux/data/text/unicode/block.lux | 31 ++--- stdlib/source/library/lux/debug.lux | 38 ------ stdlib/source/library/lux/ffi.jvm.lux | 151 +-------------------- stdlib/source/library/lux/ffi.py.lux | 10 +- stdlib/source/library/lux/program.lux | 12 -- .../compiler/language/lux/phase/synthesis/loop.lux | 21 ++- stdlib/source/library/lux/world/file.lux | 2 +- 23 files changed, 113 insertions(+), 399 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 6c1335fe9..50fe70f4e 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -195,25 +195,35 @@ ({Type_Pair (9 #0 Nothing (7 #0 #End - (1 #0 ... "lux.Primitive" + (1 #0 + ... "lux.Primitive" (2 #0 Text Type_List) - (1 #0 ... "lux.Sum" + (1 #0 + ... "lux.Sum" Type_Pair - (1 #0 ... "lux.Product" + (1 #0 + ... "lux.Product" Type_Pair - (1 #0 ... "lux.Function" + (1 #0 + ... "lux.Function" Type_Pair - (1 #0 ... "lux.Parameter" + (1 #0 + ... "lux.Parameter" Nat - (1 #0 ... "lux.Var" + (1 #0 + ... "lux.Var" Nat - (1 #0 ... "lux.Ex" + (1 #0 + ... "lux.Ex" Nat - (1 #0 ... "lux.UnivQ" + (1 #0 + ... "lux.UnivQ" (2 #0 Type_List Type) - (1 #0 ... "lux.ExQ" + (1 #0 + ... "lux.ExQ" (2 #0 Type_List Type) - (1 #0 ... "lux.Apply" + (1 #0 + ... "lux.Apply" Type_Pair ... "lux.Named" (2 #0 Name Type)))))))))))))} diff --git a/stdlib/source/library/lux/control/parser/text.lux b/stdlib/source/library/lux/control/parser/text.lux index b95df4bfd..a9f69d81e 100644 --- a/stdlib/source/library/lux/control/parser/text.lux +++ b/stdlib/source/library/lux/control/parser/text.lux @@ -124,7 +124,7 @@ (def: .public (this reference) (-> Text (Parser Any)) (function (_ [offset tape]) - (case (/.index_of' offset reference tape) + (case (/.index' offset reference tape) (#.Some where) (if (n.= offset where) (#try.Success [[("lux i64 +" (/.size reference) offset) tape] diff --git a/stdlib/source/library/lux/data/format/binary.lux b/stdlib/source/library/lux/data/format/binary.lux index 7a6ccadba..bb0510528 100644 --- a/stdlib/source/library/lux/data/format/binary.lux +++ b/stdlib/source/library/lux/data/format/binary.lux @@ -33,20 +33,16 @@ (|>> (n.* i64.bits_per_byte) i64.mask)) (type: .public Mutation - {#.doc (example "A mutation of binary data, tracking where in the data to transform.")} (-> [Offset Binary] [Offset Binary])) (type: .public Specification - {#.doc (example "A description of how to transform binary data.")} [Size Mutation]) (def: .public no_op - {#.doc (example "A specification for empty binary data.")} Specification [0 function.identity]) (def: .public (instance [size mutation]) - {#.doc (example "Given a specification of how to construct binary data, yields a binary blob that matches it.")} (-> Specification Binary) (|> size binary.empty [0] mutation product.right)) @@ -61,11 +57,9 @@ (|>> mutL mutR)])) (type: .public (Writer a) - {#.doc (example "An operation that knows how to write information into a binary blob.")} (-> a Specification)) (def: .public (result writer value) - {#.doc (example "Yields a binary blob with all the information written to it.")} (All [a] (-> (Writer a) a Binary)) (..instance (writer value))) @@ -110,7 +104,6 @@ (\ ..monoid compose (pre preV) (post postV)))) (def: .public (rec body) - {#.doc (example "A combinator for recursive writers.")} (All [a] (-> (-> (Writer a) (Writer a)) (Writer a))) (function (recur value) (body recur value))) @@ -136,7 +129,6 @@ (|>> frac.bits ..bits/64)) (def: .public (segment size) - {#.doc (example "Writes at most 'size' bytes of an input binary blob.")} (-> Nat (Writer Binary)) (function (_ value) [size diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index c6a7ebef0..ed2643efa 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -1,6 +1,4 @@ (.module: - {#.doc (.example "Functionality for reading and writing values in the JSON format." - "For more information, please see: http://www.json.org/")} [library [lux #* ["." meta (#+ monad)] @@ -68,14 +66,6 @@ (|>> (dictionary.of_list text.hash) #..Object)) (syntax: .public (json [token .any]) - {#.doc (example "A simple way to produce JSON literals." - (json #null) - (json #1) - (json +123.456) - (json "this is a string") - (json ["this" "is" "an" "array"]) - (json {"this" "is" - "an" "object"}))} (let [(^open ".") ..monad wrapper (function (_ x) (` (..json (~ x))))] (case token @@ -111,7 +101,6 @@ (in (list token))))) (def: .public (fields json) - {#.doc "Get all the fields in a JSON object."} (-> JSON (Try (List String))) (case json (#Object obj) @@ -121,7 +110,6 @@ (#try.Failure ($_ text\compose "Cannot get the fields of a non-object.")))) (def: .public (field key json) - {#.doc "A JSON object field getter."} (-> String JSON (Try JSON)) (case json (#Object obj) @@ -136,7 +124,6 @@ (#try.Failure ($_ text\compose "Cannot get field '" key "' on a non-object.")))) (def: .public (has key value json) - {#.doc "A JSON object field setter."} (-> String JSON JSON (Try JSON)) (case json (#Object obj) @@ -145,9 +132,8 @@ _ (#try.Failure ($_ text\compose "Cannot set field '" key "' on a non-object.")))) -(template [ ] +(template [ ] [(def: .public ( key json) - {#.doc (code.text ($_ text\compose "A JSON object field getter for " "."))} (-> Text JSON (Try )) (case (field key json) (#try.Success ( value)) @@ -159,11 +145,11 @@ (#try.Failure error) (#try.Failure error)))] - [boolean_field #Boolean Boolean "booleans"] - [number_field #Number Number "numbers"] - [string_field #String String "strings"] - [array_field #Array Array "arrays"] - [object_field #Object Object "objects"] + [boolean_field #Boolean Boolean] + [number_field #Number Number] + [string_field #String String] + [array_field #Array Array] + [object_field #Object Object] ) (implementation: .public equivalence diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index c26a7a751..59a24a875 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -36,7 +36,9 @@ (type: Size Nat) -(def: octal_size Size 8) +(def: octal_size + Size + 8) (def: (octal_padding max_size number) (-> Size Text Text) @@ -729,7 +731,9 @@ (#Directory value) (..directory_writer value) (#Contiguous value) (..contiguous_file_writer value)))) -(def: end_of_archive_size Size (n.* 2 ..block_size)) +(def: end_of_archive_size + Size + (n.* 2 ..block_size)) (def: .public writer (Writer Tar) diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux index b596734ea..4e358f91d 100644 --- a/stdlib/source/library/lux/data/format/xml.lux +++ b/stdlib/source/library/lux/data/format/xml.lux @@ -31,7 +31,6 @@ (Dictionary Attribute Text)) (def: .public attributes - {#.doc (example "An empty set of XML attributes.")} Attrs (dictionary.empty name.hash)) @@ -207,14 +206,12 @@ (text.replaced text.double_quote """))) (def: .public (tag [namespace name]) - {#.doc (example "The text format of a XML tag.")} (-> Tag Text) (case namespace "" name _ ($_ text\compose namespace ..namespace_separator name))) (def: .public attribute - {#.doc (example "The text format of a XML attribute.")} (-> Attribute Text) ..tag) diff --git a/stdlib/source/library/lux/data/identity.lux b/stdlib/source/library/lux/data/identity.lux index 1a7f1ec76..72ae09d38 100644 --- a/stdlib/source/library/lux/data/identity.lux +++ b/stdlib/source/library/lux/data/identity.lux @@ -10,7 +10,6 @@ ["." function]]]]) (type: .public (Identity a) - {#.doc (example "A value, as is, without any extra structure super-imposed on it.")} a) (implementation: .public functor diff --git a/stdlib/source/library/lux/data/name.lux b/stdlib/source/library/lux/data/name.lux index 8373951c4..3dfa6dcce 100644 --- a/stdlib/source/library/lux/data/name.lux +++ b/stdlib/source/library/lux/data/name.lux @@ -13,15 +13,13 @@ ... (type: Name ... [Text Text]) -(template [ ] - [(def: .public ( name) - {#.doc (example )} +(template [] + [(def: .public ( [module short]) (-> Name Text) - (let [[module short] name] - ))] + )] - [module "The module part of a name."] - [short "The short part of a name."] + [module] + [short] ) (def: .public hash diff --git a/stdlib/source/library/lux/data/product.lux b/stdlib/source/library/lux/data/product.lux index aba9488bc..9a3bf40dc 100644 --- a/stdlib/source/library/lux/data/product.lux +++ b/stdlib/source/library/lux/data/product.lux @@ -6,21 +6,18 @@ [equivalence (#+ Equivalence)] [hash (#+ Hash)]]]]) -(template [ ] - [(def: .public ( pair) - {#.doc (example )} +(template [] + [(def: .public ( [left right]) (All [left right] (-> [left right] )) - (let [[left right] pair] - ))] + )] - [left "The left side of a pair."] - [right "The right side of a pair."] + [left] + [right] ) ... https://en.wikipedia.org/wiki/Currying (def: .public (curried f) - {#.doc (example "Converts a 2-argument function into nested single-argument functions.")} (All [a b c] (-> (-> [a b] c) (-> a b c))) @@ -28,7 +25,6 @@ (f [x y]))) (def: .public (uncurried f) - {#.doc (example "Converts nested single-argument functions into a 2-argument function.")} (All [a b c] (-> (-> a b c) (-> [a b] c))) @@ -36,13 +32,11 @@ (let [[x y] xy] (f x y)))) -(def: .public (swapped xy) - (All [a b] (-> [a b] [b a])) - (let [[x y] xy] - [y x])) +(def: .public (swapped [left right]) + (All [left right] (-> [left right] [right left])) + [right left]) (def: .public (then f g) - {#.doc (example "Apply functions to both sides of a pair.")} (All [a b c d] (-> (-> a c) (-> b d) (-> [a b] [c d]))) @@ -50,7 +44,6 @@ [(f x) (g y)])) (def: .public (forked f g) - {#.doc (example "Yields a pair by applying both functions to a single value.")} (All [a l r] (-> (-> a l) (-> a r) (-> a [l r]))) diff --git a/stdlib/source/library/lux/data/sum.lux b/stdlib/source/library/lux/data/sum.lux index f14efa463..193f25a05 100644 --- a/stdlib/source/library/lux/data/sum.lux +++ b/stdlib/source/library/lux/data/sum.lux @@ -1,55 +1,49 @@ (.module: - {#.doc "Functionality for working with variants (particularly 2-variants)."} [library [lux #* [abstract [equivalence (#+ Equivalence)] [hash (#+ Hash)]]]]) -(template [ ] +(template [ ] [(def: .public ( value) - {#.doc (example )} (All [left right] (-> (Or left right))) (0 value))] - [#0 left - "Lifts value to the left side of a 2-variant."] - [#1 right - "Lifts value to the right side of a 2-variant."]) + [#0 left] + [#1 right]) -(def: .public (either fl fr) - {#.doc (example "Applies a function to either side of a 2-variant.")} +(def: .public (either on_left on_right) (All [a b c] (-> (-> a c) (-> b c) (-> (Or a b) c))) (function (_ input) (case input - (0 #0 l) (fl l) - (0 #1 r) (fr r)))) + (0 #0 l) (on_left l) + (0 #1 r) (on_right r)))) -(def: .public (then fl fr) - {#.doc (example "Applies functions to both sides of a 2-variant.")} +(def: .public (then on_left on_right) (All [l l' r r'] (-> (-> l l') (-> r r') (-> (Or l r) (Or l' r')))) (function (_ input) (case input - (0 #0 l) (0 #0 (fl l)) - (0 #1 r) (0 #1 (fr r))))) + (0 #0 l) (0 #0 (on_left l)) + (0 #1 r) (0 #1 (on_right r))))) (template [ ] - [(def: .public ( es) + [(def: .public ( items) (All [a b] (-> (List (Or a b)) (List ))) - (case es + (case items #.End #.End - (#.Item (0 x) es') - (#.Item [x ( es')]) + (#.Item (0 x) items') + (#.Item [x ( items')]) - (#.Item _ es') - ( es')))] + (#.Item _ items') + ( items')))] [lefts a #0] [rights b #1] diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index baeade224..096c25a9a 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -59,15 +59,15 @@ (#.Some ("lux text char" index input)) #.None)) -(def: .public (index_of' from pattern input) +(def: .public (index' from pattern input) (-> Nat Text Text (Maybe Nat)) ("lux text index" from pattern input)) -(def: .public (index_of pattern input) +(def: .public (index pattern input) (-> Text Text (Maybe Nat)) - (index_of' 0 pattern input)) + (index' 0 pattern input)) -(def: (last_index_of' from part text) +(def: (last_index' from part text) (-> Nat Text Text (Maybe Nat)) (loop [from from output (: (Maybe Nat) @@ -80,13 +80,13 @@ (#.Some from') (recur (++ from') output'))))) -(def: .public (last_index_of part text) +(def: .public (last_index part text) (-> Text Text (Maybe Nat)) - (last_index_of' 0 part text)) + (last_index' 0 part text)) (def: .public (starts_with? prefix x) (-> Text Text Bit) - (case (index_of prefix x) + (case (index prefix x) (#.Some 0) true @@ -95,7 +95,7 @@ (def: .public (ends_with? postfix x) (-> Text Text Bit) - (case (last_index_of postfix x) + (case (last_index postfix x) (#.Some n) (n.= (size x) (n.+ (size postfix) n)) @@ -166,7 +166,7 @@ (def: .public (split_by token sample) (-> Text Text (Maybe [Text Text])) (do maybe.monad - [index (index_of token sample) + [index (index token sample) [pre post'] (split_at index sample) [_ post] (split_at (size token) post')] (in [pre post]))) diff --git a/stdlib/source/library/lux/data/text/buffer.lux b/stdlib/source/library/lux/data/text/buffer.lux index 196227220..08f640648 100644 --- a/stdlib/source/library/lux/data/text/buffer.lux +++ b/stdlib/source/library/lux/data/text/buffer.lux @@ -48,7 +48,7 @@ (as_is)))) (`` (abstract: .public Buffer - {#.doc "Immutable text buffer for efficient text concatenation."} + {} (for {@.old [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)] @.jvm [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)] diff --git a/stdlib/source/library/lux/data/text/encoding.lux b/stdlib/source/library/lux/data/text/encoding.lux index 83474b909..fbe70b92d 100644 --- a/stdlib/source/library/lux/data/text/encoding.lux +++ b/stdlib/source/library/lux/data/text/encoding.lux @@ -8,7 +8,7 @@ ... https://en.wikipedia.org/wiki/Character_encoding#Common_character_encodings (abstract: .public Encoding - {#.doc (example "Encoding formats for text.")} + {} Text diff --git a/stdlib/source/library/lux/data/text/escape.lux b/stdlib/source/library/lux/data/text/escape.lux index 89205cbff..dc847995a 100644 --- a/stdlib/source/library/lux/data/text/escape.lux +++ b/stdlib/source/library/lux/data/text/escape.lux @@ -110,7 +110,6 @@ post_limit])) (def: .public (escaped text) - {#.doc (example "Yields a escaped version of the text.")} (-> Text Text) (loop [offset 0 previous "" @@ -192,8 +191,6 @@ (exception.except ..invalid_unicode_escape [current offset]))) (def: .public (un_escaped text) - {#.doc (example "Yields an un-escaped text." - "Fails if it was improperly escaped.")} (-> Text (Try Text)) (loop [offset 0 previous "" @@ -239,7 +236,6 @@ _ (format previous current)))))) (syntax: .public (literal [literal .text]) - {#.doc (example "If given a escaped text literal, expands to an un-escaped version.")} (case (..un_escaped literal) (#try.Success un_escaped) (in (list (code.text un_escaped))) diff --git a/stdlib/source/library/lux/data/text/format.lux b/stdlib/source/library/lux/data/text/format.lux index 894dd8321..de6482910 100644 --- a/stdlib/source/library/lux/data/text/format.lux +++ b/stdlib/source/library/lux/data/text/format.lux @@ -40,7 +40,6 @@ ["." type]]]) (type: .public (Format a) - {#.doc "A way to produce readable text from values."} (-> a Text)) (implementation: .public functor @@ -50,8 +49,6 @@ (|>> f fb))) (syntax: .public (format [fragments (<>.many .any)]) - {#.doc (example "Text interpolation." - (format "Static part " (text static) " does not match URI: " uri))} (in (.list (` ($_ "lux text concat" (~+ fragments)))))) (template [ ] diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux index 3b26dac8e..8c626ed6e 100644 --- a/stdlib/source/library/lux/data/text/regex.lux +++ b/stdlib/source/library/lux/data/text/regex.lux @@ -410,64 +410,6 @@ (\ <>.monad map product.right (re_alternative^ #1 re_scoped^ current_module))) (syntax: .public (regex [pattern .text]) - {#.doc (example "Create lexers using regular-expression syntax." - "For example:" - - "Literals" - (regex "a") - - "Wildcards" - (regex ".") - - "Escaping" - (regex "\.") - - "Character classes" - (regex "\d") - (regex "\p{Lower}") - (regex "[abc]") - (regex "[a-z]") - (regex "[a-zA-Z]") - (regex "[a-z&&[def]]") - - "Negation" - (regex "[^abc]") - (regex "[^a-z]") - (regex "[^a-zA-Z]") - (regex "[a-z&&[^bc]]") - (regex "[a-z&&[^m-p]]") - - "Combinations" - (regex "aa") - (regex "a?") - (regex "a*") - (regex "a+") - - "Specific amounts" - (regex "a{2}") - - "At least" - (regex "a{1,}") - - "At most" - (regex "a{,1}") - - "Between" - (regex "a{1,2}") - - "Groups" - (regex "a(.)c") - (regex "a(b+)c") - (regex "(\d{3})-(\d{3})-(\d{4})") - (regex "(\d{3})-(?:\d{3})-(\d{4})") - (regex "(?\d{3})-\k-(\d{4})") - (regex "(?\d{3})-\k-(\d{4})-\0") - (regex "(\d{3})-((\d{3})-(\d{4}))") - - "Alternation" - (regex "a|b") - (regex "a(.)(.)|b(.)(.)") - )} (do meta.monad [current_module meta.current_module_name] (case (.result (regex^ current_module) @@ -483,17 +425,6 @@ (syntax: .public (^regex [[pattern bindings] (.form (<>.and .text (<>.maybe .any))) body .any branches (<>.many .any)]) - {#.doc (example "Allows you to test text against regular expressions." - (case some_text - (^regex "(\d{3})-(\d{3})-(\d{4})" - [_ country_code area_code place_code]) - do_some_thing_when_number - - (^regex "\w+") - do_some_thing_when_word - - _ - do_something_else))} (with_identifiers [g!temp] (in (list& (` (^multi (~ g!temp) {((~! .result) (..regex (~ (code.text pattern))) (~ g!temp)) diff --git a/stdlib/source/library/lux/data/text/unicode/block.lux b/stdlib/source/library/lux/data/text/unicode/block.lux index 95931ff4a..70087d56a 100644 --- a/stdlib/source/library/lux/data/text/unicode/block.lux +++ b/stdlib/source/library/lux/data/text/unicode/block.lux @@ -6,23 +6,16 @@ [hash (#+ Hash)] [monoid (#+ Monoid)] ["." interval (#+ Interval)]] - [control - [parser - ["<.>" code]]] - [macro - [syntax (#+ syntax:)] - ["." template] - ["." code]] [math [number (#+ hex) ["n" nat ("#\." interval)] ["." i64]]] [type abstract]]] - ["." /// (#+ Char)]) + [/// (#+ Char)]) (abstract: .public Block - {#.doc (example "A block of valid unicode characters.")} + {} (Interval Char) @@ -30,7 +23,9 @@ (Monoid Block) (def: identity - (:abstraction (interval.between n.enum n\top n\bottom))) + (:abstraction + (interval.between n.enum n\top n\bottom))) + (def: (compose left right) (let [left (:representation left) right (:representation right)] @@ -80,18 +75,12 @@ (i64.or (i64.left_shifted 32 (..start value)) (..end value)))) -(syntax: (block_name [name .local_identifier]) - (in (list (code.text (///.replaced "_" " " name))))) - (template [ ] - [(with_expansions [ (..block_name ) - (template.text [ "-" " | " ])] - (def: .public - {#.doc (example )} - Block - (let [start (hex ) - end (hex )] - (..block start (n.- start end)))))] + [(def: .public + Block + (let [start (hex ) + end (hex )] + (..block start (n.- start end))))] ... Normal blocks [basic_latin "0000" "007F"] diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 7a5a9a153..d033bd3f0 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -141,7 +141,6 @@ (text.enclosed ["[" "]"]))))) (def: .public (inspection value) - {#.doc (example "A best-effort attempt to generate a textual representation of a value, without knowing its type.")} Inspector (with_expansions [ (let [object (:as java/lang/Object value)] (`` (<| (~~ (template [ ] @@ -513,7 +512,6 @@ )))) (def: .public (representation type value) - {#.doc (example "A best-effort attempt to generate a textual representation of a value, while knowing its type.")} (-> Type Any (Try Text)) (case (.result ..representation_parser type) (#try.Success representation) @@ -523,20 +521,12 @@ (exception.except ..cannot_represent_value type))) (syntax: .public (private [definition .identifier]) - {#.doc (example "Allows access to un-exported definitions in other modules." - "Module A" - (def: .private (secret_definition input) - (-> ??? ???) - (foo (bar (baz input)))) - "Module B" - ((..private secret_definition) my_input))} (let [[module _] definition] (in (list (` ("lux in-module" (~ (code.text module)) (~ (code.identifier definition)))))))) (def: .public (log! message) - {#.doc "Prints/writes a message to standard output."} (-> Text Any) ("lux io log" message)) @@ -546,11 +536,6 @@ ["Type" (%.type type)])) (syntax: .public (:hole []) - {#.doc (example "A typed 'hole'." - "Reveals the type expected of the expression that should go in the hole." - (: (-> Nat Text) - (function (_ number) - (:hole))))} (do meta.monad [location meta.location expectedT meta.expected_type] @@ -574,29 +559,6 @@ (|> ..target <>.some (<>.else (list))))]) - {#.doc (example "Shows the names and values of local bindings available around the call to 'here'." - (let [foo 123 - bar +456 - baz +789.0] - (: Any - (here))) - "=>" - "foo: +123" - "bar: +456" - "baz: +789.0" - [] - - "Can optionally be given a list of definitions to focus on." - "These definitions to focus on can include custom format to represent the values." - (let [foo 123 - bar +456 - baz +789.0] - (: Any - (here {foo %.nat} baz))) - "=>" - "foo: 123" - "baz: +789.0" - [])} (do {! meta.monad} [location meta.location locals meta.locals diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index bc91e8880..a025b8108 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -56,7 +56,6 @@ (template [ ] [(`` (def: .public - {#.doc (example (~~ (template.text ["The type of a (boxed) " " object."])))} .Type (#.Primitive #.End)))] @@ -1211,37 +1210,6 @@ annotations ..annotations^ fields (<>.some (..field_decl^ class_vars)) methods (<>.some (..method_def^ class_vars))]) - {#.doc (example "Allows defining JVM classes in Lux code." - "For example:" - (class: #final (TestClass A) [Runnable] - ... Fields - (#private foo boolean) - (#private bar A) - (#private baz java/lang/Object) - ... Methods - (#public [] (new [value A]) [] - (exec - (:= ::foo #1) - (:= ::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 #1) for modifying it." - "(::new! []) for calling the class's constructor." - "(::resolve! container [value]) for calling the 'resolve' method." - )} (do meta.monad [.let [fully_qualified_class_name full_class_name method_parser (: (Parser Code) @@ -1263,9 +1231,6 @@ (.tuple (<>.some (class^ class_vars)))) annotations ..annotations^ members (<>.some (..method_decl^ class_vars))]) - {#.doc (example "Allows defining JVM interfaces." - (interface: TestInterface - ([] foo [boolean String] void #throws [Exception])))} (in (list (` ("jvm class interface" (~ (declaration$ (type.declaration full_class_name class_vars))) [(~+ (list\map class$ supers))] @@ -1279,18 +1244,6 @@ (.tuple (<>.some (class^ class_vars)))) constructor_args (..constructor_args^ class_vars) methods (<>.some ..overriden_method_def^)]) - {#.doc (example "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) - []))) - )} (in (list (` ("jvm class anonymous" [(~+ (list\map var$ class_vars))] (~ (class$ super)) @@ -1299,25 +1252,13 @@ [(~+ (list\map (method_def$ "" (<>.failure "") super (list)) methods))]))))) (syntax: .public (null []) - {#.doc (example "The null pointer." - (null))} (in (list (` ("jvm object null"))))) (def: .public (null? obj) - {#.doc (example "Test for the null pointer." - (= (null? (null)) - true) - (= (null? "YOLO") - false))} (-> (primitive "java.lang.Object") Bit) ("jvm object null?" obj)) (syntax: .public (??? [expr .any]) - {#.doc (example "Takes a (potentially null) ObjectType reference and creates a (Maybe ObjectType) for it." - (= (??? (: java/lang/String (null))) - #.None) - (= (??? "YOLO") - (#.Some "YOLO")))} (with_identifiers [g!temp] (in (list (` (let [(~ g!temp) (~ expr)] (if ("jvm object null?" (~ g!temp)) @@ -1325,12 +1266,6 @@ (#.Some (~ g!temp))))))))) (syntax: .public (!!! [expr .any]) - {#.doc (example "Takes a (Maybe ObjectType) and returns a ObjectType." - "A #.None would get translated into a (null)." - (= (null) - (!!! (??? (: java/lang/Thread (null))))) - (= "foo" - (!!! (??? "foo"))))} (with_identifiers [g!value] (in (list (` ({(#.Some (~ g!value)) (~ g!value) @@ -1341,11 +1276,6 @@ (syntax: .public (check [class (..type^ (list)) unchecked (<>.maybe .any)]) - {#.doc (example "Checks whether an object is an instance of a particular class." - "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes." - (case (check String "YOLO") - (#.Some value_as_string) - #.None))} (with_identifiers [g!_ g!unchecked] (let [class_name (..reflection class) class_type (` (.primitive (~ (code.text class_name)))) @@ -1368,20 +1298,10 @@ (syntax: .public (synchronized [lock .any body .any]) - {#.doc (example "Evaluates body, while holding a lock on a given object." - (synchronized object_to_be_locked - (exec - (do something) - (dosomething else) - (finish the computation))))} (in (list (` ("jvm object synchronized" (~ lock) (~ body)))))) (syntax: .public (do_to [obj .any methods (<>.some partial_call^)]) - {#.doc (example "Call a variety of methods on an object. Then, return the object." - (do_to object - (ClassName::method1 arg0 arg1 arg2) - (ClassName::method2 arg3 arg4 arg5)))} (with_identifiers [g!obj] (in (list (` (let [(~ g!obj) (~ obj)] (exec (~+ (list\map (complete_call$ g!obj) methods)) @@ -1753,57 +1673,6 @@ (syntax: .public (import: [declaration ..declaration^ .let [[class_name class_type_vars] (parser.declaration declaration)] bundles (<>.some (..bundle class_type_vars))]) - {#.doc (example "Allows importing JVM classes, and using them as types." - "Their methods, fields and enum options can also be imported." - (import: java/lang/Object - ["#::." - (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 - ["#::." - (new [[byte]]) - (#static valueOf [char] java/lang/String) - (#static valueOf #as int_valueOf [int] java/lang/String)]) - - (import: (java/util/List e) - ["#::." - (size [] int) - (get [int] e)]) - - (import: (java/util/ArrayList a) - ["#::." - ([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 - ["#::." - (#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-vars." - "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)." - (import: (lux/concurrency/async/JvmAsync A) - ["#::." - (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 - )} (do {! meta.monad} [kind (class_kind declaration) =members (|> bundles @@ -1815,13 +1684,11 @@ (syntax: .public (array [type (..type^ (list)) size .any]) - {#.doc (example "Create an array of the given type, with the given size." - (array java/lang/Object 10))} - (let [g!size (` (|> (~ size) - (.: .Nat) - (.:as (.primitive (~ (code.text box.long)))) - "jvm object cast" - "jvm conversion long-to-int"))] + (let [g!size (` (|> (~ size) + (.: .Nat) + (.:as (.primitive (~ (code.text box.long)))) + "jvm object cast" + "jvm conversion long-to-int"))] (`` (cond (~~ (template [ ] [(\ type.equivalence = type) (in (list (` ( (~ g!size)))))] @@ -1934,8 +1801,6 @@ )))) (syntax: .public (length [array .any]) - {#.doc (example "Gives the length of an array." - (length my_array))} (case array [_ (#.Identifier array_name)] (do meta.monad @@ -1971,8 +1836,6 @@ (syntax: .public (read! [idx .any array .any]) - {#.doc (example "Loads an element from an array." - (read! 10 my_array))} (case array [_ (#.Identifier array_name)] (do meta.monad @@ -2011,8 +1874,6 @@ (syntax: .public (write! [idx .any value .any array .any]) - {#.doc (example "Stores an element into an array." - (write! 10 my_object my_array))} (case array [_ (#.Identifier array_name)] (do meta.monad @@ -2050,8 +1911,6 @@ (..write! (~ idx) (~ value) (~ g!array))))))))) (syntax: .public (class_for [type (..type^ (list))]) - {#.doc (example "Loads the class as a java.lang.Class object." - (class_for java/lang/String))} (in (list (` ("jvm object class" (~ (code.text (..reflection type)))))))) (syntax: .public (type [type (..type^ (list))]) diff --git a/stdlib/source/library/lux/ffi.py.lux b/stdlib/source/library/lux/ffi.py.lux index 0bb32e7f8..c4d8e1298 100644 --- a/stdlib/source/library/lux/ffi.py.lux +++ b/stdlib/source/library/lux/ffi.py.lux @@ -337,8 +337,8 @@ (: ..Function (lambda [left right] (do_something (:as Foo left) (:as Bar right)))))} - (.:as ..Function - (`` ("python function" - (~~ (template.amount )) - (.function (_ []) - ))))) + [(.:as ..Function + (`` ("python function" + (~~ (template.amount )) + (.function (_ []) + ))))]) diff --git a/stdlib/source/library/lux/program.lux b/stdlib/source/library/lux/program.lux index 3bb42e75f..87e80b27b 100644 --- a/stdlib/source/library/lux/program.lux +++ b/stdlib/source/library/lux/program.lux @@ -30,18 +30,6 @@ (syntax: .public (program: [args ..arguments^ body .any]) - {#.doc (example "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)." - "Can take a list of all the input parameters to the program." - "Or, can destructure them using CLI-option combinators from the library/lux/control/parser/cli module." - (program: all_arguments - (do io.monad - [foo (initialize program)] - (do_something_with all_arguments))) - - (program: [config configuration_parser] - (do io.monad - [data (initialize program with config)] - (do_something_with data))))} (with_identifiers [g!program g!args g!_ g!output g!message] (let [initialization+event_loop (` ((~! do) (~! io.monad) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index a615c00ef..39082e826 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -160,7 +160,7 @@ (^ (/.function/apply [abstraction arguments])) (do {! maybe.monad} - [arguments' (monad.map maybe.monad (recur false) arguments)] + [arguments' (monad.map ! (recur false) arguments)] (with_expansions [ (as_is (do ! [abstraction' (recur false abstraction)] (in (/.function/apply [abstraction' arguments']))))] @@ -176,6 +176,25 @@ _ ))) + ... TODO: Stop relying on this custom code. + (^ (#/.Extension ["lux syntax char case!" (list& input else matches)])) + (do {! maybe.monad} + [input (recur false input) + matches (monad.map ! + (function (_ match) + (case match + (^ (#/.Structure (#analysis.Tuple (list when then)))) + (do ! + [when (recur false when) + then (recur return? then)] + (in (#/.Structure (#analysis.Tuple (list when then))))) + + _ + (recur false match))) + matches) + else (recur return? else)] + (in (#/.Extension ["lux syntax char case!" (list& input else matches)]))) + (#/.Extension [name args]) (|> args (monad.map maybe.monad (recur false)) diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index 05925b4e8..2a8dd0951 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -82,7 +82,7 @@ (def: (un_rooted fs path) (All [!] (-> (System !) Path (Maybe [Path Text]))) (let [/ (\ fs separator)] - (case (text.last_index_of / path) + (case (text.last_index / path) #.None #.None -- cgit v1.2.3