aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library
diff options
context:
space:
mode:
authorEduardo Julian2022-08-17 02:54:41 -0400
committerEduardo Julian2022-08-17 02:54:41 -0400
commit261172e7a4cff7b9978eec4c0d32e963cbe7486e (patch)
treebf3c79319eef3bda7e1efe6612e3d6ea546e1e85 /stdlib/source/library
parent0f9bc13a34b729d9ae9db31276feb2a66785d06b (diff)
Proper testing for debug.log!
Diffstat (limited to 'stdlib/source/library')
-rw-r--r--stdlib/source/library/lux/abstract/monad/indexed.lux20
-rw-r--r--stdlib/source/library/lux/ffi.lux369
-rw-r--r--stdlib/source/library/lux/ffi/export.js.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux17
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta.lux2
-rw-r--r--stdlib/source/library/lux/meta/target/js.lux4
-rw-r--r--stdlib/source/library/lux/meta/type/resource.lux20
-rw-r--r--stdlib/source/library/lux/meta/version.lux2
-rw-r--r--stdlib/source/library/lux/world/console.lux4
-rw-r--r--stdlib/source/library/lux/world/file.lux11
10 files changed, 257 insertions, 194 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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-01 04:17:32 +0000