diff options
Diffstat (limited to 'stdlib')
18 files changed, 425 insertions, 250 deletions
diff --git a/stdlib/project.lux b/stdlib/project.lux index ff120c7cf..c2611040d 100644 --- a/stdlib/project.lux +++ b/stdlib/project.lux @@ -2,7 +2,7 @@ [... An optional identity for the project. ... It can also be specified or overriden in a non-default profile. ... This will be the name given to the project when installed/deployed as a dependency. - "identity" ["com.github.luxlang" "stdlib" "0.7.0"] + "identity" ["com.github.luxlang" "stdlib" "0.8.0-SNAPSHOT"] ... Every piece of information, and the whole "info" bundle, are optional. "info" ["name" "stdlib" @@ -46,37 +46,37 @@ ... The following are alternative profiles to use in various situations. "jvm" [... "lux" specifies the dependency to fetch and use as the compiler. - "lux" ["com.github.luxlang" "lux-jvm" "0.7.0" "jar"] + "lux" ["com.github.luxlang" "lux-jvm" "0.8.0-SNAPSHOT" "jar"] "dependencies" [["com.github.luxlang" "lux-jvm-function" "0.6.5" "jar"]] ... "dependencies" is an optional list of dependencies to fetch. ... The dependencies have the same shape as when specifying the compiler. ... When omitting the packaging format of the dependency, "tar" will be assumed. ... "dependencies" [["org.ow2.asm" "asm-all" "5.0.3" "jar"] - ... ["com.github.luxlang" "stdlib" "0.6.4"]] + ... ["com.github.luxlang" "stdlib" "0.8.0-SNAPSHOT"]] ... The OS command to use when running JVM tests. The default is described below. ... "java" ["java" "-jar"] ] "js" - ["lux" ["com.github.luxlang" "lux-js" "0.7.0" "js"] + ["lux" ["com.github.luxlang" "lux-js" "0.8.0-SNAPSHOT" "js"] ... The OS command to use when running JS tests. The default is described below. ... "js" ["node" "--stack_size=8192"] ] "lua" - ["lux" ["com.github.luxlang" "lux-lua" "0.7.0" "jar"] + ["lux" ["com.github.luxlang" "lux-lua" "0.8.0-SNAPSHOT" "jar"] ... The OS command to use when running Lua tests. The default is described below. ... "lua" ["lua"] ] "python" - ["lux" ["com.github.luxlang" "lux-python" "0.7.0" "jar"] + ["lux" ["com.github.luxlang" "lux-python" "0.8.0-SNAPSHOT" "jar"] ... The OS command to use when running Python tests. The default is described below. ... "python" ["python3"] ] "ruby" - ["lux" ["com.github.luxlang" "lux-ruby" "0.7.0" "jar"] + ["lux" ["com.github.luxlang" "lux-ruby" "0.8.0-SNAPSHOT" "jar"] ... The OS command to use when running Ruby tests. The default is described below. ... "ruby" ["ruby"] ] diff --git a/stdlib/source/library/lux/abstract/monad/indexed.lux b/stdlib/source/library/lux/abstract/monad/indexed.lux index 602d65137..c752236c6 100644 --- a/stdlib/source/library/lux/abstract/monad/indexed.lux +++ b/stdlib/source/library/lux/abstract/monad/indexed.lux @@ -13,16 +13,16 @@ [syntax (.only syntax)]]]]] ["[0]" //]) -(type .public (IxMonad m) +(type .public (Monad !) (Interface - (is (All (_ p a) - (-> a (m p p a))) + (is (All (_ condition value) + (-> value (! condition condition value))) in) - (is (All (_ ii it io vi vo) - (-> (-> vi (m it io vo)) - (m ii it vi) - (m ii io vo))) + (is (All (_ pre interim post input output) + (-> (-> input (! interim post output)) + (-> (! pre interim input) + (! pre post output)))) then))) (type Binding @@ -85,11 +85,9 @@ {.#Some name} (let [name (code.local name)] (` (let [(, name) (, monad) - [..in (,' in) - ..then (, g!then)] (, name)] + [..in (,' in) ..then (, g!then)] (, name)] (, body)))) {.#None} - (` (let [[..in (,' in) - ..then (, g!then)] (, monad)] + (` (let [[..in (,' in) ..then (, g!then)] (, monad)] (, body)))))))))) diff --git a/stdlib/source/library/lux/ffi.lux b/stdlib/source/library/lux/ffi.lux index 850ac3b83..bac9d29bd 100644 --- a/stdlib/source/library/lux/ffi.lux +++ b/stdlib/source/library/lux/ffi.lux @@ -13,7 +13,7 @@ ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format]] [collection - ["[0]" list (.use "[1]#[0]" monad mix)]]] + ["[0]" list (.use "[1]#[0]" monoid monad mix)]]] ["[0]" meta (.only) ["[0]" code (.only) ["<[1]>" \\parser (.only Parser)]] @@ -25,6 +25,165 @@ ["@" target (.only) ["[0]" js]]]]]) +... These extensions must be defined this way because importing any of the modules +... normally used when writing extensions would introduce a circular dependency +... because the Archive type depends on Binary, and that module depends on this ffi module. +(def extension_name + (syntax (_ []) + (do meta.monad + [module meta.current_module_name + unique_id meta.seed] + (in (list (code.text (%.format module " " (%.nat unique_id)))))))) + +(def extension_analysis + (template (_ <name> <parameter>) + [{5 #1 [<name> <parameter>]}])) + +(def text_analysis + (template (_ <it>) + [{0 #0 {5 #1 <it>}}])) + +(def analysis + (template (_ <name> <bindings> <parser> <inputs> <body>) + [("lux def analysis" <name> + (.function (_ name phase archive inputs) + (.function (_ state) + (let [<bindings> [name phase archive state]] + (when (<code>.result <parser> inputs) + {try.#Failure error} + {try.#Failure (%.format "Invalid inputs for extension: " (%.text name) + text.\n error)} + + {try.#Success <inputs>} + <body>)))))])) + +(def generation + (template (_ <name> <bindings> <inputs> <body>) + [("lux def generation" <name> + (.function (_ name phase archive inputs) + (.function (_ state) + (let [<bindings> [name phase archive state]] + (when inputs + <inputs> + <body> + + _ + {try.#Failure (%.format "Invalid inputs for extension: " (%.text name))})))))])) + +(for @.js (with_expansions [<undefined> (..extension_name) + <undefined?> (..extension_name) + <object> (..extension_name) + <set> (..extension_name)] + (these (analysis <undefined> + [name phase archive state] + <code>.end + _ + {try.#Success [state (extension_analysis name (list))]}) + + (generation <undefined> + [name phase archive state] + (list) + {try.#Success [state js.undefined]}) + + (def .public undefined + (template (undefined) + [(.is ..Undefined (<undefined>))])) + + (analysis <undefined?> + [name phase archive state] + <code>.any + it + (do try.monad + [[state it] (phase archive (` (.is .Any (, it))) state)] + (in [state (extension_analysis name (list it))]))) + + (generation <undefined?> + [name phase archive state] + (list it) + (do try.monad + [[state it] (phase archive it state)] + (in [state (js.= js.undefined it)]))) + + (def .public undefined? + (template (undefined? <it>) + [(.as .Bit (.is .Any (<undefined?> <it>)))])) + + (analysis <object> + [name phase archive state] + (<>.some (<>.and <code>.text <code>.any)) + it + (do [! try.monad] + [[state output] (monad.mix ! (.function (_ [key value] [state output]) + (do ! + [[state value] (phase archive (` (.is .Any (, value))) state)] + (in [state (list.partial value (text_analysis key) output)]))) + [state (list)] + it)] + (in [state (extension_analysis name (list.reversed output))]))) + + (def text_synthesis + (template (_ <it>) + [{0 #0 {2 #1 <it>}}])) + + (def (pairs it) + (All (_ a) (-> (List a) (List [a a]))) + (when it + (list.partial left right tail) + (list.partial [left right] (pairs tail)) + + (list) + (list) + + _ + (.undefined))) + + (generation <object> + [name phase archive state] + (list.partial head_key head_value tail) + (do [! try.monad] + [[state output] (monad.mix ! + (.function (_ [key value] [state output]) + (when key + (text_synthesis key) + (do try.monad + [[state value] (phase archive value state)] + (in [state (list.partial [key value] output)])) + + _ + (.undefined))) + [state (list)] + (pairs (list.partial head_key head_value tail)))] + (in [state (js.object (list.reversed output))]))) + + (def .public object + (syntax (_ [it (<>.some <code>.any)]) + (in (list (` (.as (..Object .Any) + (<object> (,* it)))))))) + + (analysis <set> + [name phase archive state] + (all <>.and <code>.text <code>.any <code>.any) + [field value object] + (do try.monad + [[state value] (phase archive (` (.is .Any (, value))) state) + [state object] (phase archive (` (.is (..Object .Any) (, object))) state)] + (in [state (extension_analysis name (list (text_analysis field) value object))]))) + + (generation <set> + [name phase archive state] + (list (text_synthesis field) value object) + (do try.monad + [[state value] (phase archive value state) + [state object] (phase archive object state)] + (in [state (js.set (js.the field object) value)]))) + + (def .public set + (syntax (_ [field <code>.any + value <code>.any + object <code>.any]) + (in (list (` (.as .Any (<set> (, field) (, value) (, object)))))))) + ))) + (with_expansions [<constant> (for @.js "js constant" @.python "python constant" @.lua "lua constant" @@ -45,6 +204,9 @@ @.lua "lua object get" @.ruby "ruby object get" (these)) + <set> (for @.lua "lua object set" + @.ruby "ruby object set" + (these)) <import> (for @.python "python import" @.lua "lua import" @.ruby "ruby import" @@ -448,15 +610,27 @@ g!parameters (..parameters :parameters:) g!class_variables (list#each code.local class_parameters) g!class (` ((, (code.local (maybe.else class_name alias))) (,* g!class_variables))) - :output: [#optional? false #mandatory g!class]] + :output: [#optional? false #mandatory g!class] + unquantified_type (` (.-> (,* (when :parameters: + (list) + (list (` .Any)) + + _ + (list#each ..output_type :parameters:))) + (, (|> :output: + ..output_type + (..input_type input))))) + quantified_type (when (list#composite g!class_variables g!input_variables) + (list) + unquantified_type + + _ + (` (.All ((, g!it) (,* g!class_variables) (,* g!input_variables)) + (, unquantified_type))))] (` (.def ((, g!it) (,* (when g!parameters {.#End} (list g!it) _ (list#each (the #mandatory) g!parameters)))) - (.All ((, g!it) (,* g!class_variables) (,* g!input_variables)) - (.-> (,* (list#each ..output_type :parameters:)) - (, (|> :output: - ..output_type - (..input_type input))))) + (, quantified_type) (.as_expected (, (<| (..input_term input) (..lux_optional :output:) @@ -465,6 +639,11 @@ (, (..imported class_name)))))) [(,* (list#each ..host_optional g!parameters))])))))))))) + (def (optional_value type value) + (-> Optional Code Optional) + [#optional? (the #optional? type) + #mandatory value]) + (def (static_field_definition import! [class_name class_parameters] alias namespace it) (-> (List Code) Declaration Alias Namespace (Named Output) Code) (let [field (the #name it) @@ -472,18 +651,41 @@ (maybe.else field) (..namespaced namespace class_name alias) code.local) - :field: (the #anonymous it)] + :field: (the #anonymous it) + get (` (.as (io.IO (, (..output_type :field:))) + (io.io (, (<| (lux_optional :field:) + (for @.js (` (<constant> (, (code.text (%.format (..host_path class_name) "." field))))) + @.ruby (` (<constant> (, (code.text (%.format (..host_path class_name) "::" field))))) + ... else + (` (<get> (, (code.text field)) + (, (..imported class_name)))))))))) + set (` (.as (io.IO .Any) + (io.io (, (for @.js (` (..set (, (code.text field)) + (, (host_optional (optional_value :field: (` ((,' ,) (, g!it)))))) + (.as (..Object .Any) + (<constant> (, (code.text (..host_path class_name))))))) + @.ruby (` (<set> (, (code.text field)) + (, (host_optional (optional_value :field: (` ((,' ,) (, g!it)))))) + (<constant> (, (code.text (..host_path class_name)))))) + @.python (` (<apply> (<constant> "setattr") + [(, (..imported class_name)) + (, (code.text field)) + (, (host_optional (optional_value :field: (` ((,' ,) (, g!it))))))])) + ... else + (` (<set> (, (code.text field)) + (, (host_optional (optional_value :field: (` ((,' ,) (, g!it)))))) + (, (..imported class_name)))))))))] (` (def (, g!it) - (syntax ((, g!it) []) + (syntax ((, g!it) [(, g!it) (<>.maybe <code>.any)]) (.at meta.monad (,' in) (.list (`' (.exec (,* import!) - (.as (, (..output_type :field:)) - (, (<| (lux_optional :field:) - (for @.js (` (<constant> (, (code.text (%.format (..host_path class_name) "." field))))) - @.ruby (` (<constant> (, (code.text (%.format (..host_path class_name) "::" field))))) - (` (<get> (, (code.text field)) - (, (..imported class_name))))))))))))))))) + ((,' ,) (when (, g!it) + {.#None} + (`' (, get)) + + {.#Some (, g!it)} + (`' (, set))))))))))))) (def (virtual_field_definition [class_name class_parameters] alias namespace it) (-> Declaration Alias Namespace (Named Output) Code) @@ -677,141 +879,6 @@ ("js apply" ("js constant" "Object.prototype.toString.call")) (as Text) (text#= "[object process]"))) - (maybe.else false))) - - ... These extensions must be defined this way because importing any of the modules - ... normally used when writing extensions would introduce a circular dependency - ... because the Archive type depends on Binary, and that module depends on this ffi module. - (def extension_name - (syntax (_ []) - (do meta.monad - [module meta.current_module_name - unique_id meta.seed] - (in (list (code.text (%.format module " " (%.nat unique_id)))))))) - - (with_expansions [<undefined> (..extension_name) - <undefined?> (..extension_name) - <object> (..extension_name)] - (these (def extension_analysis - (template (_ <name> <parameter>) - [{5 #1 [<name> <parameter>]}])) - - (def text_analysis - (template (_ <it>) - [{0 #0 {5 #1 <it>}}])) - - (def analysis - (template (_ <name> <bindings> <parser> <inputs> <body>) - [("lux def analysis" <name> - (.function (_ name phase archive inputs) - (.function (_ state) - (let [<bindings> [name phase archive state]] - (when (<code>.result <parser> inputs) - {try.#Failure error} - {try.#Failure (%.format "Invalid inputs for extension: " (%.text name) - text.\n error)} - - {try.#Success <inputs>} - <body>)))))])) - - (def generation - (template (_ <name> <bindings> <inputs> <body>) - [("lux def generation" <name> - (.function (_ name phase archive inputs) - (.function (_ state) - (let [<bindings> [name phase archive state]] - (when inputs - <inputs> - <body> - - _ - {try.#Failure (%.format "Invalid inputs for extension: " (%.text name))})))))])) - - (analysis <undefined> - [name phase archive state] - <code>.end - _ - {try.#Success [state (extension_analysis name (list))]}) - - (generation <undefined> - [name phase archive state] - (list) - {try.#Success [state js.undefined]}) - - (def .public undefined - (template (undefined) - [(.is ..Undefined (<undefined>))])) - - (analysis <undefined?> - [name phase archive state] - <code>.any - it - (do try.monad - [[state it] (phase archive (` (.is .Any (, it))) state)] - (in [state (extension_analysis name (list it))]))) - - (generation <undefined?> - [name phase archive state] - (list it) - (do try.monad - [[state it] (phase archive it state)] - (in [state (js.= js.undefined it)]))) - - (def .public undefined? - (template (undefined? <it>) - [(.as .Bit (.is .Any (<undefined?> <it>)))])) - - (analysis <object> - [name phase archive state] - (<>.some (<>.and <code>.text <code>.any)) - it - (do [! try.monad] - [[state output] (monad.mix ! (.function (_ [key value] [state output]) - (do ! - [[state value] (phase archive (` (.is .Any (, value))) state)] - (in [state (list.partial value (text_analysis key) output)]))) - [state (list)] - it)] - (in [state (extension_analysis name (list.reversed output))]))) - - (def text_synthesis - (template (_ <it>) - [{0 #0 {2 #1 <it>}}])) - - (def (pairs it) - (All (_ a) (-> (List a) (List [a a]))) - (when it - (list.partial left right tail) - (list.partial [left right] (pairs tail)) - - (list) - (list) - - _ - (.undefined))) - - (generation <object> - [name phase archive state] - (list.partial head_key head_value tail) - (do [! try.monad] - [[state output] (monad.mix ! - (.function (_ [key value] [state output]) - (when key - (text_synthesis key) - (do try.monad - [[state value] (phase archive value state)] - (in [state (list.partial [key value] output)])) - - _ - (.undefined))) - [state (list)] - (pairs (list.partial head_key head_value tail)))] - (in [state (js.object (list.reversed output))]))) - - (def .public object - (syntax (_ [it (<>.some <code>.any)]) - (in (list (` (.as (..Object .Any) - (<object> (,* it)))))))) - ))) + (maybe.else false)))) (these)) ) diff --git a/stdlib/source/library/lux/ffi/export.js.lux b/stdlib/source/library/lux/ffi/export.js.lux index 3f8561b78..2f9e4e99d 100644 --- a/stdlib/source/library/lux/ffi/export.js.lux +++ b/stdlib/source/library/lux/ffi/export.js.lux @@ -76,7 +76,7 @@ $exports (/.the "exports" $module) definition (/.define (/.var name) term) export (/.when (/.not (/.= (/.string "undefined") (/.type_of $module))) - (/.set (/.the name $exports) (/.var name))) + (/.statement (/.set (/.the name $exports) (/.var name)))) code (all /.then definition export)] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux index 73a240682..8848c781d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux @@ -722,18 +722,19 @@ (io//log message) (let [console (_.var "console") print (_.var "print") - end! (_.return ..unit)] - (<| (_.if (|> console _.type_of (_.= (_.string "undefined")) _.not - (_.and (_.the "log" console))) + end! (_.return ..unit) + + has_console? (|> console _.type_of (_.= (_.string "undefined")) _.not) + node_or_browser? (|> has_console? + (_.and (_.the "log" console))) + nashorn? (|> print _.type_of (_.= (_.string "undefined")) _.not)] + (<| (_.if node_or_browser? (all _.then (_.statement (|> console (_.do "log" (list message)))) end!)) - (_.if (|> print _.type_of (_.= (_.string "undefined")) _.not) + (_.if nashorn? (all _.then - (_.statement (_.apply_1 print (_.? (_.= (_.string "string") - (_.type_of message)) - message - (_.apply_1 (_.var "JSON.stringify") message)))) + (_.statement (_.apply_1 print message)) end!)) end!))) diff --git a/stdlib/source/library/lux/meta/compiler/meta.lux b/stdlib/source/library/lux/meta/compiler/meta.lux index 00e782b29..259d09b6e 100644 --- a/stdlib/source/library/lux/meta/compiler/meta.lux +++ b/stdlib/source/library/lux/meta/compiler/meta.lux @@ -6,4 +6,4 @@ (def .public version Version - 00,02,00) + 00,03,00) diff --git a/stdlib/source/library/lux/meta/target/js.lux b/stdlib/source/library/lux/meta/target/js.lux index 37792d6bc..0a56ad62a 100644 --- a/stdlib/source/library/lux/meta/target/js.lux +++ b/stdlib/source/library/lux/meta/target/js.lux @@ -312,8 +312,8 @@ (abstraction (format "var " (representation name) " = " (representation value) ..statement_suffix))) (def .public (set name value) - (-> Location Expression Statement) - (abstraction (format (representation name) " = " (representation value) ..statement_suffix))) + (-> Location Expression Expression) + (abstraction (format (representation name) " = " (representation value)))) (def .public (throw message) (-> Expression Statement) diff --git a/stdlib/source/library/lux/meta/type/resource.lux b/stdlib/source/library/lux/meta/type/resource.lux index 904ee3129..acf620981 100644 --- a/stdlib/source/library/lux/meta/type/resource.lux +++ b/stdlib/source/library/lux/meta/type/resource.lux @@ -3,7 +3,7 @@ [lux (.except) [abstract ["[0]" monad (.only Monad do) - [indexed (.only IxMonad)]]] + ["[0]" indexed]]] [control ["<>" parser] ["[0]" maybe] @@ -26,23 +26,23 @@ [// [primitive (.except)]]) -(type .public (Procedure monad input output value) - (-> input (monad [output value]))) +(type .public (Procedure ! input output value) + (-> input (! [output value]))) -(type .public (Linear monad value) +(type .public (Linear ! value) (All (_ keys) - (Procedure monad keys keys value))) + (Procedure ! keys keys value))) -(type .public (Affine monad permissions value) +(type .public (Affine ! permissions value) (All (_ keys) - (Procedure monad keys [permissions keys] value))) + (Procedure ! keys [permissions keys] value))) -(type .public (Relevant monad permissions value) +(type .public (Relevant ! permissions value) (All (_ keys) - (Procedure monad [permissions keys] keys value))) + (Procedure ! [permissions keys] keys value))) (def .public (monad monad) - (All (_ !) (-> (Monad !) (IxMonad (Procedure !)))) + (All (_ !) (-> (Monad !) (indexed.Monad (Procedure !)))) (implementation (def (in value) (function (_ keys) diff --git a/stdlib/source/library/lux/meta/version.lux b/stdlib/source/library/lux/meta/version.lux index b25439e57..e9b83c9bd 100644 --- a/stdlib/source/library/lux/meta/version.lux +++ b/stdlib/source/library/lux/meta/version.lux @@ -20,7 +20,7 @@ (def .public latest Version - 00,07,00) + 00,08,00) (def .public current (syntax (_ []) diff --git a/stdlib/source/library/lux/world/console.lux b/stdlib/source/library/lux/world/console.lux index 440063bca..ac83dcc9f 100644 --- a/stdlib/source/library/lux/world/console.lux +++ b/stdlib/source/library/lux/world/console.lux @@ -121,7 +121,7 @@ (def !read (template (_ <type> <query>) - [(let [it (process::stdin)] + [(let [it (io.run! (process::stdin))] (when (Readable_Stream::read it) {.#Some buffer} (let [input (Buffer::toString buffer)] @@ -158,7 +158,7 @@ (async.async []))] (exec (Writable_Stream::write it (ffi.function (_ []) Any (io.run! (write! {try.#Success []}))) - (process::stdout)) + (io.run! (process::stdout))) read!))) (def close diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index 11adc36a7..16e205fe7 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -323,8 +323,6 @@ (ffi.import FsConstants "[1]::[0]" (F_OK ffi.Number) - (R_OK ffi.Number) - (W_OK ffi.Number) (X_OK ffi.Number)) (ffi.import Error @@ -527,9 +525,6 @@ (ffi.import os "[1]::[0]" - ("static" F_OK ffi.Integer) - ("static" R_OK ffi.Integer) - ("static" W_OK ffi.Integer) ("static" X_OK ffi.Integer) ("static" mkdir [ffi.String] "io" "try" "?" Any) @@ -549,7 +544,7 @@ ("static" getmtime [ffi.String] "io" "try" ffi.Float)) (def python_separator - (os/path::sep)) + (io.run! (os/path::sep))) (`` (def .public default (System IO) @@ -598,7 +593,9 @@ instant.absolute)))) (def (can_execute? path) - (os::access path (os::X_OK))) + (do io.monad + [permission (os::X_OK)] + (os::access path permission))) (def (read path) (do (try.with io.monad) diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index 5a3d4363a..e05272386 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -15,8 +15,7 @@ ["[1][0]" functor (.only) ["[1]/[0]" contravariant]] ["[1][0]" interval] - ["[1][0]" monad (.only) - ["[1]/[0]" free]] + ["[1][0]" monad] ["[1][0]" monoid] ["[1][0]" order]]) @@ -27,13 +26,6 @@ /functor/contravariant.test )) -(def monad - Test - (all _.and - /monad.test - /monad/free.test - )) - (def comonad Test (all _.and @@ -54,6 +46,6 @@ /monoid.test /order.test ..functor - ..monad + /monad.test ..comonad )) diff --git a/stdlib/source/test/lux/abstract/monad.lux b/stdlib/source/test/lux/abstract/monad.lux index 67f039fd6..f0ff7096c 100644 --- a/stdlib/source/test/lux/abstract/monad.lux +++ b/stdlib/source/test/lux/abstract/monad.lux @@ -12,7 +12,10 @@ [test ["_" property (.only Test)]]]] [\\library - ["[0]" / (.only Monad do)]]) + ["[0]" / (.only Monad do)]] + ["[0]" / + ["[1][0]" free] + ["[1][0]" indexed]]) (def .public test Test @@ -62,4 +65,7 @@ (n.+ part whole))) 0) (is (Identity Nat))))) + + /free.test + /indexed.test )))) diff --git a/stdlib/source/test/lux/abstract/monad/indexed.lux b/stdlib/source/test/lux/abstract/monad/indexed.lux new file mode 100644 index 000000000..62b09daa4 --- /dev/null +++ b/stdlib/source/test/lux/abstract/monad/indexed.lux @@ -0,0 +1,47 @@ +(.require + [library + [lux (.except) + [abstract + ["[0]" monad (.only do)]] + [math + ["[0]" random] + [number + ["n" nat]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(type (Effect input output value) + (-> input [output value])) + +(def monad + (/.Monad Effect) + (implementation + (def (in it) + (function (_ input) + [input it])) + + (def (then $ @) + (function (_ pre) + (let [[interim input] (@ pre)] + (($ input) interim)))))) + +(def .public test + Test + (<| (_.covering /._) + (_.for [/.Monad]) + (do random.monad + [left random.nat + right random.nat + .let [expected (n.+ left right)]]) + (all _.and + (_.coverage [/.do] + (let [it (is (Effect [] [] Nat) + (/.do ..monad + [left' (in left) + right' (in right)] + (in (n.+ left right)))) + [_ actual] (it [])] + (n.= expected actual))) + ))) diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index 1612f17b4..a41f52a8d 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -1,11 +1,15 @@ (.require [library [lux (.except) + ["[0]" ffi] [abstract [monad (.only do)]] [control ["[0]" try (.use "[1]#[0]" functor)] - ["[0]" exception]] + ["[0]" exception] + ["[0]" io] + [concurrency + ["[0]" atom]]] [data ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format (.only format)]] @@ -231,11 +235,71 @@ (type My_Text Text) +(for @.jvm (these (ffi.import java/lang/String + "[1]::[0]") + + (ffi.import java/io/ByteArrayOutputStream + "[1]::[0]" + (new []) + (toString [] java/lang/String)) + + (ffi.import java/io/OutputStream + "[1]::[0]") + + (ffi.import java/io/PrintStream + "[1]::[0]" + (new [java/io/OutputStream])) + + (ffi.import java/lang/System + "[1]::[0]" + ("static" out java/io/PrintStream) + ("static" setOut [java/io/PrintStream] void)) + + (def system_output + java/io/PrintStream + (io.run! (java/lang/System::out)))) + @.js (these (ffi.import console + "[1]::[0]" + ("static" log (-> Text Any)))) + @.python (these (ffi.import io/StringIO + "[1]::[0]" + (new []) + (getvalue [] Text)) + + (ffi.import sys + "[1]::[0]" + ("static" stdout io/StringIO)))) + +(def with_out + (template (_ <body>) + [(for @.jvm (ffi.synchronized ..system_output + (let [buffer (java/io/ByteArrayOutputStream::new) + _ (java/lang/System::setOut (java/io/PrintStream::new buffer)) + output <body> + _ (java/lang/System::setOut ..system_output)] + [(ffi.of_string (java/io/ByteArrayOutputStream::toString buffer)) + output])) + @.js (let [old (io.run! (console::log)) + buffer (atom.atom "") + _ (io.run! (console::log (function (_ it) + (io.run! (atom.write! (format it text.\n) buffer))))) + output <body> + _ (io.run! (console::log old))] + [(io.run! (atom.read! buffer)) + output]) + @.python (let [old (io.run! (sys::stdout)) + buffer (io/StringIO::new []) + _ (io.run! (sys::stdout buffer)) + output <body> + _ (io.run! (sys::stdout old))] + [(io/StringIO::getvalue buffer) + output]))])) + (def .public test Test (<| (_.covering /._) (do random.monad - [message (random.lower_case 5)] + [expected_message (random.lower_case 5)] (all _.and ..inspection ..representation @@ -264,8 +328,7 @@ /.inspection) true)) (_.coverage [/.log!] - (exec - (/.log! (format (%.symbol (symbol /.log!)) - " works: " (%.text message))) - true)) + (let [[actual_message _] (with_out (/.log! expected_message))] + (text#= (format expected_message text.\n) + actual_message))) )))) diff --git a/stdlib/source/test/lux/ffi.py.lux b/stdlib/source/test/lux/ffi.py.lux index a61678e06..5e005f9ff 100644 --- a/stdlib/source/test/lux/ffi.py.lux +++ b/stdlib/source/test/lux/ffi.py.lux @@ -3,6 +3,8 @@ [lux (.except) [abstract [monad (.only do)]] + [control + ["[0]" io]] [math ["[0]" random] [number @@ -61,8 +63,10 @@ (is (Ex (_ a) (/.Object a)))) true)) (_.coverage [/.import] - (and (i.= (os::R_OK) (os::R_OK)) - (not (i.= (os::W_OK) (os::R_OK))))) + (and (i.= (io.run! (os::R_OK)) + (io.run! (os::R_OK))) + (not (i.= (io.run! (os::W_OK)) + (io.run! (os::R_OK)))))) $/export.test ))))) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/coverage.lux b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/coverage.lux index 9aa2277d3..1a04f77e1 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/coverage.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/coverage.lux @@ -105,7 +105,7 @@ right? random.bit .let [lefts (//complex.lefts right? tag)] [sub_coverage sub_pattern] again] - (in [{/.#Variant (if right? {.#Some tag} {.#None}) + (in [{/.#Variant (if right? {.#Some (++ tag)} {.#None}) (dictionary.of_list n.hash (list [tag sub_coverage]))} {//pattern.#Complex {//complex.#Variant diff --git a/stdlib/source/test/lux/meta/target/js.lux b/stdlib/source/test/lux/meta/target/js.lux index 9867d5085..eda7a2f72 100644 --- a/stdlib/source/test/lux/meta/target/js.lux +++ b/stdlib/source/test/lux/meta/target/js.lux @@ -348,7 +348,7 @@ (/.apply (/.closure (list $foreign) (all /.then (/.declare $local) - (/.set $local (/.number number/1)) + (/.statement (/.set $local (/.number number/1))) (/.return $local))) (list (/.number number/0))))) ))) @@ -365,30 +365,30 @@ (and (expression (|>> (as Frac) (f.= (f.+ number/0 number/0))) (/.apply (/.closure (list $foreign) (all /.then - (/.set $foreign (/.+ $foreign $foreign)) + (/.statement (/.set $foreign (/.+ $foreign $foreign))) (/.return $foreign))) (list (/.number number/0)))) (expression (|>> (as Frac) (f.= (f.+ number/0 number/0))) (let [@ (/.at (/.int +0) $foreign)] (/.apply (/.closure (list $foreign) (all /.then - (/.set $foreign (/.array (list $foreign))) - (/.set @ (/.+ @ @)) + (/.statement (/.set $foreign (/.array (list $foreign)))) + (/.statement (/.set @ (/.+ @ @))) (/.return @))) (list (/.number number/0))))) (expression (|>> (as Frac) (f.= (f.+ number/0 number/0))) (let [@ (/.the field $foreign)] (/.apply (/.closure (list $foreign) (all /.then - (/.set $foreign (/.object (list [field $foreign]))) - (/.set @ (/.+ @ @)) + (/.statement (/.set $foreign (/.object (list [field $foreign])))) + (/.statement (/.set @ (/.+ @ @))) (/.return @))) (list (/.number number/0))))))) (_.coverage [/.delete] (and (and (expression (|>> (as Bit)) (/.apply (/.closure (list) (all /.then - (/.set $foreign (/.number number/0)) + (/.statement (/.set $foreign (/.number number/0))) (/.return (/.delete $foreign)))) (list))) (expression (|>> (as Bit) not) @@ -399,7 +399,7 @@ (let [@ (/.at (/.int +0) $foreign)] (/.apply (/.closure (list $foreign) (all /.then - (/.set $foreign (/.array (list $foreign))) + (/.statement (/.set $foreign (/.array (list $foreign)))) (/.return (|> (/.= (/.boolean true) (/.delete @)) (/.and (/.= /.undefined @)))))) (list (/.number number/0))))) @@ -407,7 +407,7 @@ (let [@ (/.the field $foreign)] (/.apply (/.closure (list $foreign) (all /.then - (/.set $foreign (/.object (list [field $foreign]))) + (/.statement (/.set $foreign (/.object (list [field $foreign])))) (/.return (|> (/.= (/.boolean true) (/.delete @)) (/.and (/.= /.undefined @)))))) (list (/.number number/0))))) @@ -424,7 +424,7 @@ (let [@ (/.at (/.int +0) $foreign)] (/.apply (/.closure (list $foreign) (all /.then - (/.set $foreign (/.array (list $foreign))) + (/.statement (/.set $foreign (/.array (list $foreign)))) (/.statement (<js> @)) (/.return @))) (list (/.int int/0))))) @@ -432,7 +432,7 @@ (let [@ (/.the field $foreign)] (/.apply (/.closure (list $foreign) (all /.then - (/.set $foreign (/.object (list [field $foreign]))) + (/.statement (/.set $foreign (/.object (list [field $foreign])))) (/.statement (<js> @)) (/.return @))) (list (/.int int/0)))))] @@ -472,8 +472,8 @@ (all /.then (/.when (/.= (/.int (.int expected_inner_iterations)) $inner_index) /.break) - (/.set $output (/.+ $input $output)) - (/.set $inner_index (/.+ (/.int +1) $inner_index)) + (/.statement (/.set $output (/.+ $input $output))) + (/.statement (/.set $inner_index (/.+ (/.int +1) $inner_index))) )) (/.return $output))) (list (/.int input)))))) @@ -486,10 +486,10 @@ (/.define $output (/.int +0)) (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) (all /.then - (/.set $inner_index (/.+ (/.int +1) $inner_index)) + (/.statement (/.set $inner_index (/.+ (/.int +1) $inner_index))) (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) /.continue) - (/.set $output (/.+ $input $output)) + (/.statement (/.set $output (/.+ $input $output))) )) (/.return $output))) (list (/.int input)))))) @@ -514,10 +514,10 @@ (/.break_at @outer)) (/.when (/.= (/.int (.int expected_inner_iterations)) $inner_index) /.break) - (/.set $output (/.+ $input $output)) - (/.set $inner_index (/.+ (/.int +1) $inner_index)) + (/.statement (/.set $output (/.+ $input $output))) + (/.statement (/.set $inner_index (/.+ (/.int +1) $inner_index))) )) - (/.set $outer_index (/.+ (/.int +1) $outer_index)) + (/.statement (/.set $outer_index (/.+ (/.int +1) $outer_index))) ))) (/.return $output))) (list (/.int input)))))) @@ -533,16 +533,16 @@ (/.with_label @outer (/.while (/.< (/.int (.int full_outer_iterations)) $outer_index) (all /.then - (/.set $outer_index (/.+ (/.int +1) $outer_index)) + (/.statement (/.set $outer_index (/.+ (/.int +1) $outer_index))) (/.define $inner_index (/.int +0)) (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) (all /.then - (/.set $inner_index (/.+ (/.int +1) $inner_index)) + (/.statement (/.set $inner_index (/.+ (/.int +1) $inner_index))) (/.when (/.<= (/.int (.int expected_outer_iterations)) $outer_index) (/.continue_at @outer)) (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) /.continue) - (/.set $output (/.+ $input $output)) + (/.statement (/.set $output (/.+ $input $output))) )) ) )) @@ -570,8 +570,8 @@ (/.define $output (/.int +0)) (/.while (/.< (/.int (.int iterations)) $index) (all /.then - (/.set $output (/.+ $input $output)) - (/.set $index (/.+ (/.int +1) $index)) + (/.statement (/.set $output (/.+ $input $output))) + (/.statement (/.set $index (/.+ (/.int +1) $index))) )) (/.return $output))) (list (/.int input))))) @@ -583,8 +583,8 @@ (/.define $output (/.int +0)) (/.do_while (/.< (/.int (.int iterations)) $index) (all /.then - (/.set $output (/.+ $input $output)) - (/.set $index (/.+ (/.int +1) $index)) + (/.statement (/.set $output (/.+ $input $output))) + (/.statement (/.set $index (/.+ (/.int +1) $index))) )) (/.return $output))) (list (/.int input))))) @@ -596,7 +596,7 @@ (/.for $index (/.int +0) (/.< (/.int (.int iterations)) $index) (/.++ $index) - (/.set $output (/.+ $input $output))) + (/.statement (/.set $output (/.+ $input $output)))) (/.return $output))) (list (/.int input))))) (_.for [/.Label] @@ -697,7 +697,7 @@ (/.apply_1 (/.closure (list $arg/0) (all /.then (/.function_definition $class (list) - (/.set (/.the field $this) $arg/0)) + (/.statement (/.set (/.the field $this) $arg/0))) (/.return (/.the field (/.new $class (list)))))) (/.number number/0))))) ..test|apply @@ -808,14 +808,14 @@ (all /.then /.use_strict (/.declare $arg/0) - (/.set $arg/0 (/.number number/0)) + (/.statement (/.set $arg/0 (/.number number/0))) (/.return $arg/0))) (list))) (|> (/.apply (/.closure (list) (all /.then /.use_strict ... (/.declare $arg/0) - (/.set $arg/0 (/.number number/0)) + (/.statement (/.set $arg/0 (/.number number/0))) (/.return $arg/0))) (list)) ..eval |