diff options
Diffstat (limited to '')
20 files changed, 464 insertions, 311 deletions
diff --git a/stdlib/source/lux/control/thread.lux b/stdlib/source/lux/control/thread.lux index 7147c2517..8e707e6d2 100644 --- a/stdlib/source/lux/control/thread.lux +++ b/stdlib/source/lux/control/thread.lux @@ -43,7 +43,8 @@ (:representation box)) @.js ("js array read" 0 (:representation box)) - @.python ("python array read" 0 (:representation box))}))) + @.python ("python array read" 0 (:representation box)) + @.lua ("lua array read" 0 (:representation box))}))) (def: #export (write value box) (All [a] (-> a (All [!] (-> (Box ! a) (Thread ! Any))))) diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux index 5d29532a5..fe648023d 100644 --- a/stdlib/source/lux/data/text/buffer.lux +++ b/stdlib/source/lux/data/text/buffer.lux @@ -35,11 +35,11 @@ (toString [] java/lang/String)]))] (`` (for {@.old (as_is <jvm>) @.jvm (as_is <jvm>) - @.lua (as_is (import: table - ##v https://www.lua.org/manual/5.3/manual.html#pdf-table.concat - (#static concat [(Array Text) Text] Text) - ## https://www.lua.org/manual/5.3/manual.html#pdf-table.insert - (#static insert [(Array Text) Text] Nothing)))} + @.lua (as_is (import: (table/concat [(array.Array Text) Text] Text)) + ##https://www.lua.org/manual/5.3/manual.html#pdf-table.concat + (import: (table/insert [(array.Array Text) Text] #? Nothing)) + ## https://www.lua.org/manual/5.3/manual.html#pdf-table.insert + )} (as_is)))) (`` (abstract: #export Buffer @@ -56,7 +56,7 @@ (:abstraction (with_expansions [<jvm> [0 function.identity]] (for {@.old <jvm> @.jvm <jvm> - @.lua function.identity} + @.lua [0 function.identity]} ## default row.empty)))) @@ -65,8 +65,9 @@ (with_expansions [<jvm> (let [[capacity transform] (:representation buffer) append! (: (-> Text java/lang/StringBuilder java/lang/StringBuilder) (function (_ chunk builder) - (exec (java/lang/Appendable::append (:coerce java/lang/CharSequence chunk) - builder) + (exec + (java/lang/Appendable::append (:coerce java/lang/CharSequence chunk) + builder) builder)))] (:abstraction [(n.+ (//.size chunk) capacity) (|>> transform (append! chunk))]))] @@ -76,7 +77,7 @@ append! (: (-> Text (array.Array Text) (array.Array Text)) (function (_ chunk array) (exec - (table::insert [array chunk]) + (table/insert [array chunk]) array)))] (:abstraction [(n.+ (//.size chunk) capacity) (|>> transform (append! chunk))]))} @@ -104,7 +105,7 @@ (for {@.old <jvm> @.jvm <jvm> @.lua (let [[capacity transform] (:representation buffer)] - (table::concat [(transform (array.new 0)) ""]))} + (table/concat [(transform (array.new 0)) ""]))} ## default (row\fold (function (_ chunk total) (format total chunk)) diff --git a/stdlib/source/lux/data/text/unicode/set.lux b/stdlib/source/lux/data/text/unicode/set.lux index d773ba8e4..1ac443d1a 100644 --- a/stdlib/source/lux/data/text/unicode/set.lux +++ b/stdlib/source/lux/data/text/unicode/set.lux @@ -41,7 +41,11 @@ (def: #export (set [head tail]) (-> [Block (List Block)] Set) - (list\fold ..compose (..singleton head) (list\map ..singleton tail))) + (list\fold (: (-> Block Set Set) + (function (_ block set) + (..compose (..singleton block) set))) + (..singleton head) + tail)) (def: character/0 Set diff --git a/stdlib/source/lux/host.lua.lux b/stdlib/source/lux/host.lua.lux index ed81d97b1..785ca82d6 100644 --- a/stdlib/source/lux/host.lua.lux +++ b/stdlib/source/lux/host.lua.lux @@ -6,7 +6,7 @@ [monad (#+ do)]] [control ["." io] - ["<>" parser + ["<>" parser ("#\." monad) ["<c>" code (#+ Parser)]]] [data ["." product] @@ -69,6 +69,13 @@ <c>.local_identifier ..nilable))) +(def: constant + (Parser Field) + (<c>.form ($_ <>.and + (<>\wrap true) + <c>.local_identifier + ..nilable))) + (type: Common_Method {#name Text #alias (Maybe Text) @@ -150,7 +157,8 @@ (type: Import (#Class [Text (List Member)]) - (#Function Static_Method)) + (#Function Static_Method) + (#Constant Field)) (def: import ($_ <>.or @@ -158,6 +166,7 @@ <c>.local_identifier (<>.some member)) (<c>.form ..common_method) + ..constant )) (syntax: #export (try expression) @@ -283,11 +292,17 @@ (#Function [name alias inputsT io? try? outputT]) (wrap (list (..make_function (code.local_identifier (maybe.default name alias)) g!temp - (` ("lua constant" (~ (code.text name)))) + (` ("lua constant" (~ (code.text (text.replace_all "/" "." name))))) inputsT io? try? outputT))) + + (#Constant [_ name fieldT]) + (wrap (list (` ((~! syntax:) ((~ (code.local_identifier name))) + (\ (~! meta.monad) (~' wrap) + (list (` (.:coerce (~ (nilable_type fieldT)) + ("lua constant" (~ (code.text (text.replace_all "/" "." name)))))))))))) ))) (template: #export (closure <inputs> <output>) diff --git a/stdlib/source/lux/math/logic/fuzzy.lux b/stdlib/source/lux/math/logic/fuzzy.lux index 8b1b68e97..cbe54fae5 100644 --- a/stdlib/source/lux/math/logic/fuzzy.lux +++ b/stdlib/source/lux/math/logic/fuzzy.lux @@ -82,8 +82,9 @@ (/.< to elem) ## in the middle... - (/./ measure - (/.- from elem)) + (|> elem + (/.- from) + (/./ measure)) ## above //.true)))) diff --git a/stdlib/source/lux/math/number/nat.lux b/stdlib/source/lux/math/number/nat.lux index a9583ea8a..e3d8d8628 100644 --- a/stdlib/source/lux/math/number/nat.lux +++ b/stdlib/source/lux/math/number/nat.lux @@ -194,11 +194,11 @@ ) (def: (binary-character value) - (-> Nat (Maybe Text)) + (-> Nat Text) (case value - 0 (#.Some "0") - 1 (#.Some "1") - _ #.None)) + 0 "0" + 1 "1" + _ (undefined))) (def: (binary-value digit) (-> Nat (Maybe Nat)) @@ -208,17 +208,17 @@ _ #.None)) (def: (octal-character value) - (-> Nat (Maybe Text)) + (-> Nat Text) (case value - 0 (#.Some "0") - 1 (#.Some "1") - 2 (#.Some "2") - 3 (#.Some "3") - 4 (#.Some "4") - 5 (#.Some "5") - 6 (#.Some "6") - 7 (#.Some "7") - _ #.None)) + 0 "0" + 1 "1" + 2 "2" + 3 "3" + 4 "4" + 5 "5" + 6 "6" + 7 "7" + _ (undefined))) (def: (octal-value digit) (-> Nat (Maybe Nat)) @@ -234,19 +234,19 @@ _ #.None)) (def: (decimal-character value) - (-> Nat (Maybe Text)) + (-> Nat Text) (case value - 0 (#.Some "0") - 1 (#.Some "1") - 2 (#.Some "2") - 3 (#.Some "3") - 4 (#.Some "4") - 5 (#.Some "5") - 6 (#.Some "6") - 7 (#.Some "7") - 8 (#.Some "8") - 9 (#.Some "9") - _ #.None)) + 0 "0" + 1 "1" + 2 "2" + 3 "3" + 4 "4" + 5 "5" + 6 "6" + 7 "7" + 8 "8" + 9 "9" + _ (undefined))) (def: (decimal-value digit) (-> Nat (Maybe Nat)) @@ -264,25 +264,25 @@ _ #.None)) (def: (hexadecimal-character value) - (-> Nat (Maybe Text)) + (-> Nat Text) (case value - 0 (#.Some "0") - 1 (#.Some "1") - 2 (#.Some "2") - 3 (#.Some "3") - 4 (#.Some "4") - 5 (#.Some "5") - 6 (#.Some "6") - 7 (#.Some "7") - 8 (#.Some "8") - 9 (#.Some "9") - 10 (#.Some "A") - 11 (#.Some "B") - 12 (#.Some "C") - 13 (#.Some "D") - 14 (#.Some "E") - 15 (#.Some "F") - _ #.None)) + 0 "0" + 1 "1" + 2 "2" + 3 "3" + 4 "4" + 5 "5" + 6 "6" + 7 "7" + 8 "8" + 9 "9" + 10 "A" + 11 "B" + 12 "C" + 13 "D" + 14 "E" + 15 "F" + _ (undefined))) (def: (hexadecimal-value digit) (-> Nat (Maybe Nat)) @@ -305,21 +305,56 @@ (^or (^ (char "f")) (^ (char "F"))) (#.Some 15) _ #.None)) -(template [<base> <struct> <to-character> <to-value> <error>] +(structure: #export decimal + (Codec Text Nat) + + (def: (encode value) + (loop [input value + output ""] + (let [digit (decimal-character (..% 10 input)) + output' ("lux text concat" digit output)] + (case (../ 10 input) + 0 + output' + + input' + (recur input' output'))))) + + (def: (decode repr) + (let [input-size ("lux text size" repr)] + (with_expansions [<failure> (#try.Failure ("lux text concat" "Invalid decimal syntax for Nat: " repr))] + (if (..> 0 input-size) + (loop [idx 0 + output 0] + (if (..< input-size idx) + (case (decimal-value ("lux text char" idx repr)) + #.None + <failure> + + (#.Some digit-value) + (recur (inc idx) + (|> output (..* 10) (..+ digit-value)))) + (#try.Success output))) + <failure>))))) + +(template [<shift> <struct> <to-character> <to-value> <error>] [(structure: #export <struct> (Codec Text Nat) - (def: (encode value) - (loop [input value - output ""] - (let [digit (maybe.assume (<to-character> (..% <base> input))) - output' ("lux text concat" digit output)] - (case (../ <base> input) - 0 - output' - - input' - (recur input' output'))))) + (def: encode + (let [mask (|> 1 ("lux i64 left-shift" <shift>) dec)] + (function (_ value) + (loop [input value + output ""] + (let [output' ("lux text concat" + (<to-character> ("lux i64 and" mask input)) + output)] + (case (: Nat ("lux i64 right-shift" <shift> input)) + 0 + output' + + input' + (recur input' output'))))))) (def: (decode repr) (let [input-size ("lux text size" repr)] @@ -328,19 +363,20 @@ output 0] (if (..< input-size idx) (case (<to-value> ("lux text char" idx repr)) - #.None - (#try.Failure ("lux text concat" <error> repr)) - (#.Some digit-value) (recur (inc idx) - (|> output (..* <base>) (..+ digit-value)))) + (|> output + ("lux i64 left-shift" <shift>) + ("lux i64 or" digit-value))) + + _ + (#try.Failure ("lux text concat" <error> repr))) (#try.Success output))) (#try.Failure ("lux text concat" <error> repr))))))] - [02 binary binary-character binary-value "Invalid binary syntax for Nat: "] - [08 octal octal-character octal-value "Invalid octal syntax for Nat: "] - [10 decimal decimal-character decimal-value "Invalid decimal syntax for Nat: "] - [16 hex hexadecimal-character hexadecimal-value "Invalid hexadecimal syntax for Nat: "] + [1 binary binary-character binary-value "Invalid binary syntax for Nat: "] + [3 octal octal-character octal-value "Invalid octal syntax for Nat: "] + [4 hex hexadecimal-character hexadecimal-value "Invalid hexadecimal syntax for Nat: "] ) (structure: #export hash diff --git a/stdlib/source/lux/target/lua.lux b/stdlib/source/lux/target/lua.lux index 586b060a2..c557c7feb 100644 --- a/stdlib/source/lux/target/lua.lux +++ b/stdlib/source/lux/target/lua.lux @@ -100,11 +100,15 @@ #1 "true") :abstraction)) - (def: #export (int value) + (def: #export int (-> Int Literal) - (:abstraction (.if (i.< +0 value) - (%.int value) - (%.nat (.nat value))))) + ## Integers must be turned into hexadecimal to avoid quirks in how Lua parses integers. + ## In particular, the number -9223372036854775808 will be incorrectly parsed as a float by Lua. + (.let [to_hex (\ n.hex encode)] + (|>> .nat + to_hex + (format "0x") + :abstraction))) (def: #export float (-> Frac Literal) @@ -391,11 +395,18 @@ [1 [["error"] ["print"] - ["require"]]] + ["require"] + ["type"]]] [2 - []] + [["print"]]] [3 + [["print"]]] + + [4 + []] + + [5 []] ) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 2d1b56740..6b0e59d0e 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -276,6 +276,29 @@ [_ (meta.find_export name)] (wrap (list (name_code name))))) +(def: coverage_separator + Text + (text.from_code 31)) + +(def: encode_coverage + (-> (List Text) Text) + (list\fold (function (_ short aggregate) + (case aggregate + "" short + _ (format short ..coverage_separator aggregate))) + "")) + +(def: (decode_coverage module encoding) + (-> Text Text (Set Name)) + (loop [remaining encoding + output (set.from_list name.hash (list))] + (case (text.split_with ..coverage_separator remaining) + (#.Some [head tail]) + (recur tail (set.add [module head] output)) + + #.None + output))) + (template [<macro> <function>] [(syntax: #export (<macro> {coverage (<c>.tuple (<>.many <c>.any))} condition) @@ -301,16 +324,9 @@ (.list (~+ coverage))) (~ test))))))) -(def: coverage_separator - Text - (text.from_code 31)) - (def: (covering' module coverage test) (-> Text Text Test Test) - (let [coverage (|> coverage - (text.split_all_with ..coverage_separator) - (list\map (|>> [module])) - (set.from_list name.hash))] + (let [coverage (..decode_coverage module coverage)] (|> (..context module test) (random\map (promise\map (function (_ [counters documentation]) [(update@ #expected_coverage (set.union coverage) counters) @@ -322,9 +338,12 @@ [#let [module (name.module module)] definitions (meta.definitions module) #let [coverage (|> definitions - (list.filter (|>> product.right product.left)) - (list\map product.left) - (text.join_with ..coverage_separator))]] + (list\fold (function (_ [short [exported? _]] aggregate) + (if exported? + (#.Cons short aggregate) + aggregate)) + #.Nil) + ..encode_coverage)]] (wrap (list (` ((~! ..covering') (~ (code.text module)) (~ (code.text coverage)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux index 205b12183..ba12035c7 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux @@ -129,7 +129,7 @@ (/.install "=" (binary (product.uncurry _.=))) (/.install "<" (binary (product.uncurry _.<))) (/.install "i64" (unary (!unary "math.floor"))) - (/.install "encode" (unary (!unary "tostring"))) + (/.install "encode" (unary (_.apply/2 (_.var "string.format") (_.string "%.17f")))) (/.install "decode" (unary ..f64//decode))))) (def: (text//char [paramO subjectO]) @@ -142,7 +142,7 @@ (def: (text//index [startO partO textO]) (Trinary Expression) - (//runtime.text//index textO partO (_.+ (_.int +1) startO))) + (//runtime.text//index textO partO startO)) (def: text_procs Bundle @@ -171,10 +171,7 @@ (|> /.empty (/.install "log" (unary ..io//log!)) (/.install "error" (unary (!unary "error"))) - (/.install "current-time" (nullary (function (_ _) - (|> (_.var "os.time") - (_.apply/* (list)) - (_.* (_.int +1,000))))))))) + (/.install "current-time" (nullary (function.constant (//runtime.io//current_time //runtime.unit))))))) (def: #export bundle Bundle diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux index 818575720..6a2101fe3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux @@ -118,7 +118,12 @@ Statement (_.statement (|> (_.var "table.insert") (_.apply/* (list @savepoint - (//runtime.array//copy @cursor)))))) + (_.apply/* (list @cursor + (_.int +1) + (_.length @cursor) + (_.int +1) + (_.table (list))) + (_.var "table.move"))))))) (def: restore! Statement diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux index 3aa3a9ca7..4d3253d48 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux @@ -85,28 +85,51 @@ initialize_self! (list.indices arity)) pack (|>> (list) _.array) - unpack (|>> (list) _.apply/* (|> (_.var "table.unpack"))) + unpack (_.apply/1 (_.var "table.unpack")) @var_args (_.var "...")] #let [[definition instantiation] (with_closure closureO+ @self (list @var_args) ($_ _.then (_.local/1 @curried (pack @var_args)) (_.local/1 @num_args (_.length @curried)) - (_.cond (list [(|> @num_args (_.= (_.int +0))) - (_.return @self)] - [(|> @num_args (_.= arityO)) + (_.cond (list [(|> @num_args (_.= arityO)) ($_ _.then initialize! (_.set_label @scope) body!)] [(|> @num_args (_.> arityO)) - (let [arity_inputs (//runtime.array//sub (_.int +0) arityO @curried) - extra_inputs (//runtime.array//sub arityO @num_args @curried)] + (let [arity_inputs (_.apply/5 (_.var "table.move") + @curried + (_.int +1) + arityO + (_.int +1) + (_.array (list))) + extra_inputs (_.apply/5 (_.var "table.move") + @curried + (_.+ (_.int +1) arityO) + @num_args + (_.int +1) + (_.array (list)))] (_.return (|> @self (_.apply/* (list (unpack arity_inputs))) (_.apply/* (list (unpack extra_inputs))))))]) ## (|> @num_args (_.< arityO)) (_.return (_.closure (list @var_args) - (_.return (|> @self (_.apply/* (list (unpack (//runtime.array//concat @curried (pack @var_args)))))))))) + (let [@extra_args (_.var "extra_args")] + ($_ _.then + (_.local/1 @extra_args (pack @var_args)) + (_.return (|> (_.array (list)) + (_.apply/5 (_.var "table.move") + @curried + (_.int +1) + @num_args + (_.int +1)) + (_.apply/5 (_.var "table.move") + @extra_args + (_.int +1) + (_.length @extra_args) + (_.+ (_.int +1) @num_args)) + unpack + (_.apply/1 @self)))))))) ))] _ (/////generation.execute! definition) _ (/////generation.save! (%.nat (product.right function_name)) definition)] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index 84db5eb1d..503969782 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -64,7 +64,7 @@ (def: (flag value) (-> Bit Literal) (if value - (_.string "") + ..unit _.nil)) (def: #export variant_tag_field "_lux_tag") @@ -165,96 +165,71 @@ (def: last_index (|>> _.length (_.- (_.int +1)))) -## No need to turn tuple//left and tuple//right into loops, as Lua -## does tail-call optimization. -## https://www.lua.org/pil/6.3.html -(runtime: (tuple//left lefts tuple) - (with_vars [last_right] - ($_ _.then - (_.let (list last_right) (..last_index tuple)) - (_.if (_.> lefts last_right) - ## No need for recursion - (_.return (..nth lefts tuple)) - ## Needs recursion - (_.return (tuple//left (_.- last_right lefts) - (..nth last_right tuple))))))) - -(runtime: (array//sub from to array) - (with_vars [temp idx] - ($_ _.then - (_.let (list temp) (_.array (list))) - (_.for_step idx from (_.- (_.int +1) to) (_.int +1) - (|> (_.var "table.insert") - (_.apply/* (list temp (..nth idx array))) - _.statement)) - (_.return temp)))) - -(runtime: (tuple//right lefts tuple) - (with_vars [last_right right_index] - ($_ _.then - (_.let (list last_right) (..last_index tuple)) - (_.let (list right_index) (_.+ (_.int +1) lefts)) - (_.cond (list [(_.= last_right right_index) - (_.return (..nth right_index tuple))] - [(_.> last_right right_index) - ## Needs recursion. - (_.return (tuple//right (_.- last_right lefts) - (..nth last_right tuple)))]) - (_.return (array//sub right_index (_.length tuple) tuple))) - ))) - -(runtime: (sum//get sum wantsLast wantedTag) +(with_expansions [<recur> (as_is ($_ _.then + (_.set (list lefts) (_.- last_index_right lefts)) + (_.set (list tuple) (..nth last_index_right tuple))))] + (runtime: (tuple//left lefts tuple) + (with_vars [last_index_right] + (<| (_.while (_.bool true)) + ($_ _.then + (_.local/1 last_index_right (..last_index tuple)) + (_.if (_.> lefts last_index_right) + ## No need for recursion + (_.return (..nth lefts tuple)) + ## Needs recursion + <recur>))))) + + (runtime: (tuple//right lefts tuple) + (with_vars [last_index_right right_index] + (<| (_.while (_.bool true)) + ($_ _.then + (_.local/1 last_index_right (..last_index tuple)) + (_.local/1 right_index (_.+ (_.int +1) lefts)) + (_.cond (list [(_.= last_index_right right_index) + (_.return (..nth right_index tuple))] + [(_.> last_index_right right_index) + ## Needs recursion. + <recur>]) + (_.return (_.apply/* (list tuple + (_.+ (_.int +1) right_index) + (_.length tuple) + (_.int +1) + (_.array (list))) + (_.var "table.move")))) + ))))) + +(runtime: (sum//get sum wants_last wanted_tag) (let [no_match! (_.return _.nil) sum_tag (_.the ..variant_tag_field sum) sum_flag (_.the ..variant_flag_field sum) sum_value (_.the ..variant_value_field sum) - is_last? (_.= (_.string "") sum_flag) + is_last? (_.= ..unit sum_flag) + extact_match! (_.return sum_value) test_recursion! (_.if is_last? ## Must recurse. - (_.return (sum//get sum_value wantsLast (_.- sum_tag wantedTag))) - no_match!)] - (_.cond (list [(_.= sum_tag wantedTag) - (_.if (_.= wantsLast sum_flag) - (_.return sum_value) - test_recursion!)] - - [(_.> sum_tag wantedTag) - test_recursion!] - - [(_.and (_.< sum_tag wantedTag) - (_.= (_.string "") wantsLast)) - (_.return (variant' (_.- wantedTag sum_tag) sum_flag sum_value))]) - - no_match!))) - -(runtime: (array//copy array) - (with_vars [temp idx] - ($_ _.then - (_.let (list temp) (_.array (list))) - (<| (_.for_step idx (_.int +1) (_.length array) (_.int +1)) - (_.statement (|> (_.var "table.insert") (_.apply/* (list temp (_.nth idx array)))))) - (_.return temp)))) - -(runtime: (array//concat left right) - (with_vars [temp idx] - (let [copy! (function (_ input output) - (<| (_.for_step idx (_.int +1) (_.length input) (_.int +1)) - (_.statement (|> (_.var "table.insert") (_.apply/* (list output (_.nth idx input)))))))] - ($_ _.then - (_.let (list temp) (_.array (list))) - (copy! left temp) - (copy! right temp) - (_.return temp))))) + ($_ _.then + (_.set (list wanted_tag) (_.- sum_tag wanted_tag)) + (_.set (list sum) sum_value)) + no_match!) + extrac_sub_variant! (_.return (variant' (_.- wanted_tag sum_tag) sum_flag sum_value))] + (<| (_.while (_.bool true)) + (_.cond (list [(_.= sum_tag wanted_tag) + (_.if (_.= wants_last sum_flag) + extact_match! + test_recursion!)] + [(_.< wanted_tag sum_tag) + test_recursion!] + [(_.and (_.> wanted_tag sum_tag) + (_.= ..unit wants_last)) + extrac_sub_variant!]) + no_match!)))) (def: runtime//adt Statement ($_ _.then @tuple//left - @array//sub @tuple//right @sum//get - @array//copy - @array//concat )) (runtime: (lux//try risky) @@ -307,7 +282,7 @@ (runtime: (i64//char subject) (with_expansions [<rembulan> (_.return (_.apply/1 (_.var "string.char") subject)) <normal> (_.return (_.apply/1 (_.var "utf8.char") subject))] - (for {@.lua <normal>} + (for {@.lua (_.return <normal>)} (_.if ..on_rembulan? <rembulan> <normal>)))) @@ -320,18 +295,61 @@ @i64//char )) +(def: (find_byte_index subject param start) + (-> Expression Expression Expression Expression) + (_.apply/4 (_.var "string.find") subject param start (_.bool #1))) + +(def: (char_index subject byte_index) + (-> Expression Expression Expression) + (|> byte_index + (_.apply/3 (_.var "utf8.len") subject (_.int +1)))) + +(def: (byte_index subject char_index) + (-> Expression Expression Expression) + (|> char_index + (_.+ (_.int +1)) + (_.apply/2 (_.var "utf8.offset") subject))) + +(def: lux_index + (-> Expression Expression) + (_.- (_.int +1))) + (runtime: (text//index subject param start) - (with_vars [idx] - ($_ _.then - (_.local/1 idx (_.apply/* (list subject param start (_.bool #1)) - (_.var "string.find"))) - (_.if (_.= _.nil idx) - (_.return ..none) - (_.return (..some (_.- (_.int +1) idx))))))) + (with_expansions [<rembulan> ($_ _.then + (_.local/1 byte_index (|> start + (_.+ (_.int +1)) + (..find_byte_index subject param))) + (_.if (_.= _.nil byte_index) + (_.return ..none) + (_.return (..some (..lux_index byte_index))))) + <normal> ($_ _.then + (_.local/1 byte_index (|> start + (..byte_index subject) + (..find_byte_index subject param))) + (_.if (_.= _.nil byte_index) + (_.return ..none) + (_.return (..some (|> byte_index + (..char_index subject) + ..lux_index)))))] + (with_vars [byte_index] + (for {@.lua <normal>} + (_.if ..on_rembulan? + <rembulan> + <normal>))))) (runtime: (text//clip text offset length) - (_.return (_.apply/* (list text (_.+ (_.int +1) offset) (_.+ offset length)) - (_.var "string.sub")))) + (with_expansions [<rembulan> (_.return (_.apply/3 (_.var "string.sub") text (_.+ (_.int +1) offset) (_.+ offset length))) + <normal> (_.return (_.apply/3 (_.var "string.sub") + text + (..byte_index text offset) + (|> (_.+ offset length) + ## (_.+ (_.int +1)) + (..byte_index text) + (_.- (_.int +1)))))] + (for {@.lua <normal>} + (_.if ..on_rembulan? + <rembulan> + <normal>)))) (runtime: (text//size subject) (with_expansions [<rembulan> (_.return (_.apply/1 (_.var "string.len") subject)) @@ -380,6 +398,22 @@ @array//write )) +(runtime: (io//current_time _) + (with_expansions [<rembulan> (_.return (_.int +0)) + <normal> (_.return (|> (_.var "os.time") + (_.apply/* (list)) + (_.* (_.int +1,000))))] + (for {@.lua <normal>} + (_.if ..on_rembulan? + <rembulan> + <normal>)))) + +(def: runtime//io + Statement + ($_ _.then + @io//current_time + )) + (def: runtime Statement ($_ _.then @@ -388,6 +422,7 @@ ..runtime//i64 ..runtime//text ..runtime//array + ..runtime//io )) (def: #export artifact ..prefix) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index 9a6c1a832..2b96b1beb 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -14,7 +14,7 @@ ["%" format (#+ format)]] [collection ["." list ("#\." monad fold)] - ["dict" dictionary (#+ Dictionary)]]] + ["." dictionary (#+ Dictionary)]]] ["." macro ["." code] [syntax (#+ syntax:)]] @@ -116,46 +116,47 @@ [idx tag_list sig_type] (meta.resolve_tag member)] (wrap [idx sig_type]))) -(def: (prepare_definitions source_module target_module constants) - (-> Text Text (List [Text Definition]) (List [Name Type])) - (do list.monad - [[name [exported? def_type def_anns def_value]] constants] - (if (and (annotation.structure? def_anns) - (or (text\= target_module source_module) - exported?)) - (list [[source_module name] def_type]) - (list)))) +(def: (prepare_definitions source_module target_module constants aggregate) + (-> Text Text (List [Text Definition]) (-> (List [Name Type]) (List [Name Type]))) + (list\fold (function (_ [name [exported? def_type def_anns def_value]] aggregate) + (if (and (annotation.structure? def_anns) + (or (text\= target_module source_module) + exported?)) + (#.Cons [[source_module name] def_type] aggregate) + aggregate)) + aggregate + constants)) (def: local_env (Meta (List [Name Type])) (do meta.monad [local_batches meta.locals #let [total_locals (list\fold (function (_ [name type] table) - (try.default table (dict.try_put name type table))) + (try.default table (dictionary.try_put name type table))) (: (Dictionary Text Type) - (dict.new text.hash)) + (dictionary.new text.hash)) (list\join local_batches))]] (wrap (|> total_locals - dict.entries + dictionary.entries (list\map (function (_ [name type]) [["" name] type])))))) (def: local_structs (Meta (List [Name Type])) (do {! meta.monad} - [this_module_name meta.current_module_name] - (\ ! map (prepare_definitions this_module_name this_module_name) - (meta.definitions this_module_name)))) + [this_module_name meta.current_module_name + definitions (meta.definitions this_module_name)] + (wrap (prepare_definitions this_module_name this_module_name definitions #.Nil)))) (def: imported_structs (Meta (List [Name Type])) (do {! meta.monad} [this_module_name meta.current_module_name - imp_mods (meta.imported_modules this_module_name) - export_batches (monad.map ! (function (_ imp_mod) - (\ ! map (prepare_definitions imp_mod this_module_name) - (meta.definitions imp_mod))) - imp_mods)] - (wrap (list\join export_batches)))) + imported_modules (meta.imported_modules this_module_name) + accessible_definitions (monad.map ! meta.definitions imported_modules)] + (wrap (list\fold (function (_ [imported_module definitions] tail) + (prepare_definitions imported_module this_module_name definitions tail)) + #.Nil + (list.zip/2 imported_modules accessible_definitions))))) (def: (apply_function_type func arg) (-> Type Type (Check Type)) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 63298038f..69f5a17db 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -886,20 +886,17 @@ (flush [] #io host.Boolean) (close [] #io host.Boolean)) - (host.import: io - (#static open [host.String host.String] #io #? LuaFile)) + (host.import: (io/open [host.String host.String] #io #? LuaFile)) - (host.import: package - (#static config host.String)) + (host.import: (package/config host.String)) - (host.import: os - (#static rename [host.String host.String] #io #? host.Boolean) - (#static remove [host.String] #io #? host.Boolean) - (#static execute [host.String] #io #? host.Boolean)) + (host.import: (os/rename [host.String host.String] #io #? host.Boolean)) + (host.import: (os/remove [host.String] #io #? host.Boolean)) + (host.import: (os/execute [host.String] #io #? host.Boolean)) (def: default_separator Text - (|> (package::config) + (|> (package/config) (text.split_all_with text.new_line) list.head (maybe.default "/"))) @@ -929,7 +926,7 @@ (..can_modify (function (<name> data) (do {! io.monad} - [?file (io::open [path <mode>])] + [?file (io/open [path <mode>])] (case ?file (#.Some file) (do ! @@ -962,7 +959,7 @@ (..can_query (function (_ _) (do {! io.monad} - [?file (io::open [path "rb"])] + [?file (io/open [path "rb"])] (case ?file (#.Some file) (do ! @@ -1007,7 +1004,7 @@ (..can_open (function (move destination) (do io.monad - [?verdict (os::rename [path destination])] + [?verdict (os/rename [path destination])] (wrap (if (case ?verdict (#.Some verdict) verdict @@ -1021,7 +1018,7 @@ (..can_delete (function (delete _) (do io.monad - [?verdict (os::remove [path])] + [?verdict (os/remove [path])] (wrap (if (case ?verdict (#.Some verdict) verdict @@ -1055,7 +1052,7 @@ (..can_delete (function (discard _) (do io.monad - [?verdict (os::remove [path])] + [?verdict (os/remove [path])] (wrap (if (case ?verdict (#.Some verdict) verdict @@ -1069,7 +1066,7 @@ (def: (default_file path) (-> Path (IO (Try (File IO)))) (do {! io.monad} - [?file (io::open [path "r"])] + [?file (io/open [path "r"])] (case ?file (#try.Success file) (do ! @@ -1088,7 +1085,7 @@ (case ?file (#try.Failure _) (do {! io.monad} - [?file (io::open [path "w+b"])] + [?file (io/open [path "w+b"])] (case ?file (#.Some file) (do ! @@ -1130,7 +1127,7 @@ (..can_open (function (create_directory path) (do io.monad - [?verdict (os::execute [(format "mkdir " path)])] + [?verdict (os/execute [(format "mkdir " path)])] (wrap (case ?verdict (#.Some verdict) (#try.Success (..directory path)) diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux index 1d6b099ad..7763bed2c 100644 --- a/stdlib/source/lux/world/program.lux +++ b/stdlib/source/lux/world/program.lux @@ -184,17 +184,14 @@ (read [host.String] #io #? host.String) (close [] #io host.Boolean)) - (host.import: io - (#static popen [host.String] #io #try #? LuaFile)) - - (import: os - (#static getenv [host.String] #io #? host.String) - (#static exit [host.Integer] #io Nothing)) + (host.import: (io/popen [host.String] #io #try #? LuaFile)) + (host.import: (os/getenv [host.String] #io #? host.String)) + (host.import: (os/exit [host.Integer] #io Nothing)) (def: (run_command default command) (-> Text Text (IO Text)) (do {! io.monad} - [outcome (io::popen [command])] + [outcome (io/popen [command])] (case outcome (#try.Success outcome) (case outcome @@ -297,4 +294,4 @@ ## else (..default_exit! code)) @.python (sys::exit code) - @.lua (os::exit [code])})))) + @.lua (os/exit [code])})))) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 376a7cd3e..33f0d963b 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -8,20 +8,20 @@ ["." / #_ ["#." binary] ["#." bit] + ["#." color + ["#/." named]] ["#." identity] ["#." lazy] ["#." maybe] ["#." name] ["#." product] ["#." sum] - ["#." color - ["#/." named]] + ["#." text] ["#." format #_ ["#/." binary] ["#/." json] ["#/." tar] ["#/." xml]] - ["#." text] ["#." collection]]) ## TODO: Get rid of this ASAP @@ -57,8 +57,7 @@ /sum.test /text.test ..format - /collection.test - )] + /collection.test)] ($_ _.and (!bundle test0) (!bundle test1) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 10000ff52..c842ebe9c 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -392,31 +392,33 @@ (def: #export test Test (<| (_.covering /._) - (_.for [/.Tar] - ($_ _.and - (_.cover [/.writer /.parser] - (|> row.empty - (format.run /.writer) - (<b>.run /.parser) - (\ try.monad map row.empty?) - (try.default false))) - (_.cover [/.invalid_end_of_archive] - (let [dump (format.run /.writer row.empty)] - (case (<b>.run /.parser (binary\compose dump dump)) - (#try.Success _) - false - - (#try.Failure error) - (exception.match? /.invalid_end_of_archive error)))) - - ..path - ..name - ..small - ..big - (_.for [/.Entry] - ($_ _.and - ..entry - ..mode - ..ownership - )) - )))) + (_.for [/.Tar]) + (do random.monad + [_ (wrap [])] + ($_ _.and + (_.cover [/.writer /.parser] + (|> row.empty + (format.run /.writer) + (<b>.run /.parser) + (\ try.monad map row.empty?) + (try.default false))) + (_.cover [/.invalid_end_of_archive] + (let [dump (format.run /.writer row.empty)] + (case (<b>.run /.parser (binary\compose dump dump)) + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.invalid_end_of_archive error)))) + + ..path + ..name + ..small + ..big + (_.for [/.Entry] + ($_ _.and + ..entry + ..mode + ..ownership + )) + )))) diff --git a/stdlib/source/test/lux/data/lazy.lux b/stdlib/source/test/lux/data/lazy.lux index 5900817e4..86d28d753 100644 --- a/stdlib/source/test/lux/data/lazy.lux +++ b/stdlib/source/test/lux/data/lazy.lux @@ -9,6 +9,8 @@ ["$." apply] ["$." monad] ["$." equivalence]]}] + [data + ["." product]] [math ["." random (#+ Random)] [number @@ -31,31 +33,35 @@ (def: #export test Test - (<| (_.covering /._) - (do random.monad - [left random.nat - right random.nat - #let [expected (n.* left right)]] - (_.for [/.Lazy] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (..lazy random.nat))) - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) + (with_expansions [<eager> (: [Nat Nat] + [(n.+ left right) + (n.* left right)])] + (<| (_.covering /._) + (do random.monad + [left random.nat + right random.nat + #let [expected <eager>]] + (_.for [/.Lazy] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (..lazy random.nat))) + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) - (_.cover [/.freeze] - (let [lazy (/.freeze (n.* left right))] - (n.= expected - (/.thaw lazy)))) + (_.cover [/.freeze] + (let [lazy (/.freeze <eager>) + (^open "\=") (product.equivalence n.equivalence n.equivalence)] + (\= expected + (/.thaw lazy)))) - (_.cover [/.thaw] - (let [lazy (/.freeze (n.* left right))] - (and (not (is? expected - (/.thaw lazy))) - (is? (/.thaw lazy) - (/.thaw lazy))))) - ))))) + (_.cover [/.thaw] + (let [lazy (/.freeze <eager>)] + (and (not (is? expected + (/.thaw lazy))) + (is? (/.thaw lazy) + (/.thaw lazy))))) + )))))) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 983649a89..28ba6fef5 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -56,7 +56,7 @@ left (random.unicode 1) right (random.unicode 1) #let [full (\ /.monoid compose inner outer) - fake_index (.nat -1)]] + fake_index (dec 0)]] (`` ($_ _.and (~~ (template [<affix> <predicate>] [(_.cover [<affix> <predicate>] @@ -82,7 +82,7 @@ [inner (random.unicode 1) outer (random.filter (|>> (\ /.equivalence = inner) not) (random.unicode 1)) - #let [fake_index (.nat -1)]] + #let [fake_index (dec 0)]] ($_ _.and (_.cover [/.contains?] (let [full (\ /.monoid compose inner outer)] diff --git a/stdlib/source/test/lux/data/text/encoding.lux b/stdlib/source/test/lux/data/text/encoding.lux index c5b985f50..c2b438232 100644 --- a/stdlib/source/test/lux/data/text/encoding.lux +++ b/stdlib/source/test/lux/data/text/encoding.lux @@ -12,7 +12,7 @@ ["." maybe] ["." text ("#\." equivalence)] [collection - ["." list ("#\." functor)] + ["." list ("#\." fold)] ["." set]]] [macro ["." template]] @@ -180,14 +180,17 @@ [((: (-> Any (List /.Encoding)) (function (_ _) (`` (list (~~ (template.splice <by_letter>)))))) - 123)] + [])] <encodings>)] (def: all_encodings (list.concat (list <named>))) (def: unique_encodings - (set.from_list text.hash (list\map /.name ..all_encodings))) + (list\fold (function (_ encoding set) + (set.add (/.name encoding) set)) + (set.new text.hash) + ..all_encodings)) (def: verdict (n.= (list.size ..all_encodings) |