From 261172e7a4cff7b9978eec4c0d32e963cbe7486e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 17 Aug 2022 02:54:41 -0400 Subject: Proper testing for debug.log! --- .../source/library/lux/abstract/monad/indexed.lux | 20 +- stdlib/source/library/lux/ffi.lux | 369 ++++++++++++--------- stdlib/source/library/lux/ffi/export.js.lux | 2 +- .../language/lux/phase/generation/js/runtime.lux | 17 +- stdlib/source/library/lux/meta/compiler/meta.lux | 2 +- stdlib/source/library/lux/meta/target/js.lux | 4 +- stdlib/source/library/lux/meta/type/resource.lux | 20 +- stdlib/source/library/lux/meta/version.lux | 2 +- stdlib/source/library/lux/world/console.lux | 4 +- stdlib/source/library/lux/world/file.lux | 11 +- 10 files changed, 257 insertions(+), 194 deletions(-) (limited to 'stdlib/source/library') 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 (_ ) + [{5 #1 [ ]}])) + +(def text_analysis + (template (_ ) + [{0 #0 {5 #1 }}])) + +(def analysis + (template (_ ) + [("lux def analysis" + (.function (_ name phase archive inputs) + (.function (_ state) + (let [ [name phase archive state]] + (when (.result inputs) + {try.#Failure error} + {try.#Failure (%.format "Invalid inputs for extension: " (%.text name) + text.\n error)} + + {try.#Success } + )))))])) + +(def generation + (template (_ ) + [("lux def generation" + (.function (_ name phase archive inputs) + (.function (_ state) + (let [ [name phase archive state]] + (when inputs + + + + _ + {try.#Failure (%.format "Invalid inputs for extension: " (%.text name))})))))])) + +(for @.js (with_expansions [ (..extension_name) + (..extension_name) + (..extension_name) + (..extension_name)] + (these (analysis + [name phase archive state] + .end + _ + {try.#Success [state (extension_analysis name (list))]}) + + (generation + [name phase archive state] + (list) + {try.#Success [state js.undefined]}) + + (def .public undefined + (template (undefined) + [(.is ..Undefined ())])) + + (analysis + [name phase archive state] + .any + it + (do try.monad + [[state it] (phase archive (` (.is .Any (, it))) state)] + (in [state (extension_analysis name (list it))]))) + + (generation + [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? ) + [(.as .Bit (.is .Any ( )))])) + + (analysis + [name phase archive state] + (<>.some (<>.and .text .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 (_ ) + [{0 #0 {2 #1 }}])) + + (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 + [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 .any)]) + (in (list (` (.as (..Object .Any) + ( (,* it)))))))) + + (analysis + [name phase archive state] + (all <>.and .text .any .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 + [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 .any + value .any + object .any]) + (in (list (` (.as .Any ( (, field) (, value) (, object)))))))) + ))) + (with_expansions [ (for @.js "js constant" @.python "python constant" @.lua "lua constant" @@ -45,6 +204,9 @@ @.lua "lua object get" @.ruby "ruby object get" (these)) + (for @.lua "lua object set" + @.ruby "ruby object set" + (these)) (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 (` ( (, (code.text (%.format (..host_path class_name) "." field))))) + @.ruby (` ( (, (code.text (%.format (..host_path class_name) "::" field))))) + ... else + (` ( (, (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) + ( (, (code.text (..host_path class_name))))))) + @.ruby (` ( (, (code.text field)) + (, (host_optional (optional_value :field: (` ((,' ,) (, g!it)))))) + ( (, (code.text (..host_path class_name)))))) + @.python (` ( ( "setattr") + [(, (..imported class_name)) + (, (code.text field)) + (, (host_optional (optional_value :field: (` ((,' ,) (, g!it))))))])) + ... else + (` ( (, (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 .any)]) (.at meta.monad (,' in) (.list (`' (.exec (,* import!) - (.as (, (..output_type :field:)) - (, (<| (lux_optional :field:) - (for @.js (` ( (, (code.text (%.format (..host_path class_name) "." field))))) - @.ruby (` ( (, (code.text (%.format (..host_path class_name) "::" field))))) - (` ( (, (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 [ (..extension_name) - (..extension_name) - (..extension_name)] - (these (def extension_analysis - (template (_ ) - [{5 #1 [ ]}])) - - (def text_analysis - (template (_ ) - [{0 #0 {5 #1 }}])) - - (def analysis - (template (_ ) - [("lux def analysis" - (.function (_ name phase archive inputs) - (.function (_ state) - (let [ [name phase archive state]] - (when (.result inputs) - {try.#Failure error} - {try.#Failure (%.format "Invalid inputs for extension: " (%.text name) - text.\n error)} - - {try.#Success } - )))))])) - - (def generation - (template (_ ) - [("lux def generation" - (.function (_ name phase archive inputs) - (.function (_ state) - (let [ [name phase archive state]] - (when inputs - - - - _ - {try.#Failure (%.format "Invalid inputs for extension: " (%.text name))})))))])) - - (analysis - [name phase archive state] - .end - _ - {try.#Success [state (extension_analysis name (list))]}) - - (generation - [name phase archive state] - (list) - {try.#Success [state js.undefined]}) - - (def .public undefined - (template (undefined) - [(.is ..Undefined ())])) - - (analysis - [name phase archive state] - .any - it - (do try.monad - [[state it] (phase archive (` (.is .Any (, it))) state)] - (in [state (extension_analysis name (list it))]))) - - (generation - [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? ) - [(.as .Bit (.is .Any ( )))])) - - (analysis - [name phase archive state] - (<>.some (<>.and .text .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 (_ ) - [{0 #0 {2 #1 }}])) - - (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 - [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 .any)]) - (in (list (` (.as (..Object .Any) - ( (,* 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 (_ ) - [(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) -- cgit v1.2.3