diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/library/lux/abstract/monad/indexed.lux | 20 | ||||
| -rw-r--r-- | stdlib/source/library/lux/ffi.lux | 369 | ||||
| -rw-r--r-- | stdlib/source/library/lux/ffi/export.js.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux | 17 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/compiler/meta.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/target/js.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/type/resource.lux | 20 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/version.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/library/lux/world/console.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/library/lux/world/file.lux | 11 | ||||
| -rw-r--r-- | stdlib/source/test/lux/abstract.lux | 12 | ||||
| -rw-r--r-- | stdlib/source/test/lux/abstract/monad.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/test/lux/abstract/monad/indexed.lux | 47 | ||||
| -rw-r--r-- | stdlib/source/test/lux/debug.lux | 75 | ||||
| -rw-r--r-- | stdlib/source/test/lux/ffi.py.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta/compiler/language/lux/analysis/coverage.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta/target/js.lux | 58 |
17 files changed, 418 insertions, 243 deletions
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 |