From 4965597043aca57a05760113f1851e96dad1eaf8 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 14 Mar 2022 06:14:57 -0400 Subject: Leaner syntax for the "for" macro. --- stdlib/source/documentation/lux.lux | 4 +- stdlib/source/documentation/lux/extension.lux | 58 +- stdlib/source/documentation/lux/world/console.lux | 6 +- stdlib/source/documentation/lux/world/file.lux | 10 +- .../source/documentation/lux/world/file/watch.lux | 6 +- .../documentation/lux/world/net/http/client.lux | 2 +- stdlib/source/documentation/lux/world/shell.lux | 4 +- stdlib/source/library/lux.lux | 99 +- stdlib/source/library/lux/abstract/apply.lux | 8 +- .../library/lux/control/concurrency/atom.lux | 56 +- .../library/lux/control/concurrency/thread.lux | 70 +- stdlib/source/library/lux/control/thread.lux | 62 +- stdlib/source/library/lux/control/writer.lux | 14 +- stdlib/source/library/lux/data/collection/list.lux | 29 +- .../library/lux/data/collection/tree/zipper.lux | 34 +- stdlib/source/library/lux/data/text.lux | 220 ++-- stdlib/source/library/lux/data/text/buffer.lux | 90 +- .../source/library/lux/data/text/encoding/utf8.lux | 256 ++-- stdlib/source/library/lux/debug.lux | 518 ++++---- stdlib/source/library/lux/ffi.lux | 236 ++-- stdlib/source/library/lux/math.lux | 562 ++++----- stdlib/source/library/lux/meta/configuration.lux | 2 +- stdlib/source/library/lux/meta/version.lux | 2 +- stdlib/source/library/lux/program.lux | 8 +- stdlib/source/library/lux/target/jvm/constant.lux | 78 +- stdlib/source/library/lux/target/jvm/loader.lux | 10 +- stdlib/source/library/lux/target/python.lux | 16 +- stdlib/source/library/lux/test.lux | 10 +- stdlib/source/library/lux/time/instant.lux | 74 +- .../library/lux/tool/compiler/default/platform.lux | 46 +- .../language/lux/phase/extension/analysis/js.lux | 2 +- .../language/lux/phase/extension/analysis/lua.lux | 6 +- .../language/lux/phase/extension/analysis/php.lux | 6 +- .../lux/phase/extension/analysis/python.lux | 12 +- .../language/lux/phase/extension/analysis/ruby.lux | 6 +- .../lux/phase/extension/analysis/scheme.lux | 5 +- .../lux/phase/extension/generation/lua/common.lux | 2 +- .../language/lux/phase/generation/lua/runtime.lux | 8 +- .../lux/phase/generation/python/runtime.lux | 2 +- .../language/lux/phase/generation/reference.lux | 31 +- .../lux/tool/compiler/language/lux/syntax.lux | 6 +- .../lux/tool/compiler/meta/cache/module.lux | 2 +- .../library/lux/tool/compiler/meta/io/archive.lux | 4 +- stdlib/source/library/lux/type.lux | 5 +- stdlib/source/library/lux/type/check.lux | 5 +- stdlib/source/library/lux/world/console.lux | 136 +- stdlib/source/library/lux/world/file.lux | 1308 ++++++++++---------- stdlib/source/library/lux/world/file/watch.lux | 4 +- .../source/library/lux/world/net/http/client.lux | 4 +- stdlib/source/library/lux/world/program.lux | 488 ++++---- stdlib/source/library/lux/world/shell.lux | 4 +- stdlib/source/program/compositor.lux | 20 +- stdlib/source/test/lux.lux | 76 +- .../source/test/lux/control/concurrency/async.lux | 55 +- .../test/lux/control/concurrency/semaphore.lux | 61 +- stdlib/source/test/lux/debug.lux | 90 +- stdlib/source/test/lux/extension.lux | 96 +- stdlib/source/test/lux/math/number/frac.lux | 8 +- stdlib/source/test/lux/meta/configuration.lux | 33 +- stdlib/source/test/lux/meta/version.lux | 8 +- stdlib/source/test/lux/static.lux | 2 +- stdlib/source/test/lux/target/jvm.lux | 313 ++--- stdlib/source/test/lux/type/poly/equivalence.lux | 50 +- stdlib/source/test/lux/type/poly/functor.lux | 30 +- stdlib/source/test/lux/type/poly/json.lux | 100 +- stdlib/source/unsafe/lux/data/binary.lux | 244 ++-- stdlib/source/unsafe/lux/data/collection/array.lux | 191 ++- 67 files changed, 3007 insertions(+), 3006 deletions(-) (limited to 'stdlib') diff --git a/stdlib/source/documentation/lux.lux b/stdlib/source/documentation/lux.lux index 64241e5ff..efa13a913 100644 --- a/stdlib/source/documentation/lux.lux +++ b/stdlib/source/documentation/lux.lux @@ -853,8 +853,8 @@ [(def: js "JavaScript") - (for ["JVM" (do jvm stuff) - js (do js stuff)] + (for "JVM" (do jvm stuff) + js (do js stuff) (do default stuff))]) (documentation: /.`` diff --git a/stdlib/source/documentation/lux/extension.lux b/stdlib/source/documentation/lux/extension.lux index bda9aaa7b..f2a0dca26 100644 --- a/stdlib/source/documentation/lux/extension.lux +++ b/stdlib/source/documentation/lux/extension.lux @@ -1,29 +1,29 @@ (.using - [library - [lux "*" - ["$" documentation {"+" documentation:}] - ["[0]" debug] - [control - ["<>" parser - ["<[0]>" code]]] - [data - [text - ["%" format {"+" format}]] - [collection - ["[0]" sequence]]] - [macro - ["[0]" template]] - ["@" target - ["[0]" jvm]] - [tool - [compiler - ["[0]" phase] - [language - [lux - [phase - ["[0]" directive]]]]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["$" documentation {"+" documentation:}] + ["[0]" debug] + [control + ["<>" parser + ["<[0]>" code]]] + [data + [text + ["%" format {"+" format}]] + [collection + ["[0]" sequence]]] + [macro + ["[0]" template]] + ["@" target + ["[0]" jvm]] + [tool + [compiler + ["[0]" phase] + [language + [lux + [phase + ["[0]" directive]]]]]]]] + [\\library + ["[0]" /]]) (documentation: /.analysis: "Mechanism for defining extensions to Lux's analysis/type-checking infrastructure." @@ -38,10 +38,10 @@ (documentation: /.generation: "" [(generation: ("my generation" self phase archive [pass_through .any]) - (for [@.jvm - (# phase.monad each (|>> {jvm.#Embedded} - sequence.sequence) - (phase archive pass_through))] + (for @.jvm + (# phase.monad each (|>> {jvm.#Embedded} + sequence.sequence) + (phase archive pass_through)) (phase archive pass_through)))]) (documentation: /.directive: diff --git a/stdlib/source/documentation/lux/world/console.lux b/stdlib/source/documentation/lux/world/console.lux index c091e6d36..63c9c60f5 100644 --- a/stdlib/source/documentation/lux/world/console.lux +++ b/stdlib/source/documentation/lux/world/console.lux @@ -38,8 +38,8 @@ ..Mock ..mock ($.default /.async) - (~~ (for [@.jvm (~~ (as_is ($.default /.cannot_open) - ($.default /.cannot_close) - ($.default /.default)))] + (~~ (for @.jvm (~~ (as_is ($.default /.cannot_open) + ($.default /.cannot_close) + ($.default /.default))) (~~ (as_is))))] [])))) diff --git a/stdlib/source/documentation/lux/world/file.lux b/stdlib/source/documentation/lux/world/file.lux index e2f203abe..c9f9168a1 100644 --- a/stdlib/source/documentation/lux/world/file.lux +++ b/stdlib/source/documentation/lux/world/file.lux @@ -72,10 +72,10 @@ ($.default /.cannot_make_directory) ($.default /.cannot_find_directory) ($.default /.cannot_read_all_data) - (~~ (for [@.jvm (~~ (as_is ($.default /.cannot_modify_file) - ($.default /.default))) - @.js (~~ (as_is ($.default /.default))) - @.python (~~ (as_is ($.default /.default))) - @.ruby (~~ (as_is ($.default /.default)))] + (~~ (for @.jvm (~~ (as_is ($.default /.cannot_modify_file) + ($.default /.default))) + @.js (~~ (as_is ($.default /.default))) + @.python (~~ (as_is ($.default /.default))) + @.ruby (~~ (as_is ($.default /.default))) (~~ (as_is))))] [/watch.documentation])))) diff --git a/stdlib/source/documentation/lux/world/file/watch.lux b/stdlib/source/documentation/lux/world/file/watch.lux index 14b9faa0a..3db866343 100644 --- a/stdlib/source/documentation/lux/world/file/watch.lux +++ b/stdlib/source/documentation/lux/world/file/watch.lux @@ -34,8 +34,8 @@ \n "Must be given a path separator for the file-system.") [(mock separator)]) -(for [@.jvm (as_is (documentation: /.default - "The default watcher for the default file-system."))] +(for @.jvm (as_is (documentation: /.default + "The default watcher for the default file-system.")) (as_is)) (.def: .public documentation @@ -56,6 +56,6 @@ ($.default /.all) ($.default /.not_being_watched) ($.default /.cannot_poll_a_non_existent_directory) - (~~ (for [@.jvm (~~ (as_is ..default))] + (~~ (for @.jvm (~~ (as_is ..default)) (~~ (as_is))))] [])))) diff --git a/stdlib/source/documentation/lux/world/net/http/client.lux b/stdlib/source/documentation/lux/world/net/http/client.lux index a11e8a0bb..17912d11e 100644 --- a/stdlib/source/documentation/lux/world/net/http/client.lux +++ b/stdlib/source/documentation/lux/world/net/http/client.lux @@ -48,6 +48,6 @@ ..trace ($.default /.async) ($.default /.headers) - (~~ (for [@.jvm (~~ (as_is ($.default /.default)))] + (~~ (for @.jvm (~~ (as_is ($.default /.default))) (~~ (as_is))))] [])))) diff --git a/stdlib/source/documentation/lux/world/shell.lux b/stdlib/source/documentation/lux/world/shell.lux index 0a39e0c6a..b1b8a1de5 100644 --- a/stdlib/source/documentation/lux/world/shell.lux +++ b/stdlib/source/documentation/lux/world/shell.lux @@ -50,7 +50,7 @@ ($.default /.normal) ($.default /.error) ($.default /.async) - (~~ (for [@.jvm (~~ (as_is ($.default /.no_more_output) - ($.default /.default)))] + (~~ (for @.jvm (~~ (as_is ($.default /.no_more_output) + ($.default /.default))) (~~ (as_is))))] [])))) diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 09f0a9e4c..6120a52be 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -2584,6 +2584,17 @@ {#None} {#Some [tokens (list)]})) +(def:' .private (maybeP itP tokens) + (All (_ a) + (-> (Parser a) + (Parser (Maybe a)))) + (case (itP tokens) + {#Some [tokens it]} + {#Some [tokens {#Some it}]} + + {#None} + {#Some [tokens {#None}]})) + (def:' .private (tupleP itP tokens) (All (_ a) (-> (Parser a) (Parser a))) @@ -4882,52 +4893,41 @@ (target_pick target options' default))))) (macro: .public (for tokens) - (do meta_monad - [target ..target] - (case tokens - (^ (list [_ {#Tuple options}])) - (case (pairs options) - {#Some options} - (target_pick target options {#None}) - - {#None} - (failure (..wrong_syntax_error (symbol ..for)))) - - (^ (list [_ {#Tuple options}] default)) - (case (pairs options) - {#Some options} - (target_pick target options {#Some default}) - - {#None} - (failure (..wrong_syntax_error (symbol ..for)))) + (case (..parsed (..andP (..someP (..andP ..anyP ..anyP)) + (..maybeP ..anyP)) + tokens) + {.#Some [options default]} + (do meta_monad + [target ..target] + (target_pick target options default)) - _ - (failure (..wrong_syntax_error (symbol ..for)))))) + {.#None} + (failure (..wrong_syntax_error (symbol ..for))))) ... TODO: Delete "scope_type_vars" (including the #scope_type_vars Lux state) and ":parameter" ASAP. -(for ["{old}" (as_is (def: (scope_type_vars state) - (Meta (List Nat)) - (case state - [..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - {#Right [state scope_type_vars]})) - - (macro: .public (:parameter tokens) - (case tokens - (^ (list [_ {#Nat idx}])) - (do meta_monad - [stvs ..scope_type_vars] - (case (..item idx (list#reversed stvs)) - {#Some var_id} - (in (list (` {.#Ex (~ (nat$ var_id))}))) - - {#None} - (failure (text#composite "Indexed-type does not exist: " (nat#encoded idx))))) +(for "{old}" (as_is (def: (scope_type_vars state) + (Meta (List Nat)) + (case state + [..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] + {#Right [state scope_type_vars]})) + + (macro: .public (:parameter tokens) + (case tokens + (^ (list [_ {#Nat idx}])) + (do meta_monad + [stvs ..scope_type_vars] + (case (..item idx (list#reversed stvs)) + {#Some var_id} + (in (list (` {.#Ex (~ (nat$ var_id))}))) - _ - (failure (..wrong_syntax_error (symbol ..$))))))] + {#None} + (failure (text#composite "Indexed-type does not exist: " (nat#encoded idx))))) + + _ + (failure (..wrong_syntax_error (symbol ..$)))))) (as_is)) (macro: .public (using _imports) @@ -4946,13 +4946,14 @@ =module (` ("lux def module" (~ =imports)))] g!_ (..generated_symbol "")] (in {#Item =module - (for [... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. - ... Without it, I get this strange error - ... {library/lux/tool/compiler/language/lux/generation.no_buffer_for_saving_code} - ... Artifact ID: 0 - ... Which only ever happens for the Python compiler. - "Python" (list& (` ("lux def" (~ g!_) [] #0)) - =refers)] + (for "Python" + ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. + ... Without it, I get this strange error + ... {library/lux/tool/compiler/language/lux/generation.no_buffer_for_saving_code} + ... Artifact ID: 0 + ... Which only ever happens for the Python compiler. + (list& (` ("lux def" (~ g!_) [] #0)) + =refers) =refers)}))) (def: (embedded_expansions code) diff --git a/stdlib/source/library/lux/abstract/apply.lux b/stdlib/source/library/lux/abstract/apply.lux index a7cc3d764..6a509bb0a 100644 --- a/stdlib/source/library/lux/abstract/apply.lux +++ b/stdlib/source/library/lux/abstract/apply.lux @@ -26,10 +26,10 @@ (def: (on fgx fgf) ... TODO: Switch from this version to the one below (in comments) ASAP. - (for [@.old (let [fgf' (# f_apply on - fgf - (# f_monad in (function (_ gf gx) (# g_apply on gx gf))))] - (:expected (# f_apply on (:expected fgx) (:expected fgf'))))] + (for @.old (let [fgf' (# f_apply on + fgf + (# f_monad in (function (_ gf gx) (# g_apply on gx gf))))] + (:expected (# f_apply on (:expected fgx) (:expected fgf')))) (let [fgf' (# f_apply on fgf (# f_monad in (function (_ gf gx) (# g_apply on gx gf))))] diff --git a/stdlib/source/library/lux/control/concurrency/atom.lux b/stdlib/source/library/lux/control/concurrency/atom.lux index 5685495a2..5ce90157e 100644 --- a/stdlib/source/library/lux/control/concurrency/atom.lux +++ b/stdlib/source/library/lux/control/concurrency/atom.lux @@ -20,57 +20,57 @@ (new [a]) (get [] "io" a) (compareAndSet [a a] boolean)]))] - (for [@.old - @.jvm ] + (for @.old + @.jvm (as_is))) -(with_expansions [ (for [@.js "js array new" - @.python "python array new" - @.lua "lua array new" - @.ruby "ruby array new" - @.php "php array new" - @.scheme "scheme array new"] +(with_expansions [ (for @.js "js array new" + @.python "python array new" + @.lua "lua array new" + @.ruby "ruby array new" + @.php "php array new" + @.scheme "scheme array new" (as_is)) - (for [@.js "js array write" - @.python "python array write" - @.lua "lua array write" - @.ruby "ruby array write" - @.php "php array write" - @.scheme "scheme array write"] + (for @.js "js array write" + @.python "python array write" + @.lua "lua array write" + @.ruby "ruby array write" + @.php "php array write" + @.scheme "scheme array write" (as_is)) - (for [@.js "js array read" - @.python "python array read" - @.lua "lua array read" - @.ruby "ruby array read" - @.php "php array read" - @.scheme "scheme array read"] + (for @.js "js array read" + @.python "python array read" + @.lua "lua array read" + @.ruby "ruby array read" + @.php "php array read" + @.scheme "scheme array read" (as_is))] (abstract: .public (Atom a) (with_expansions [ (java/util/concurrent/atomic/AtomicReference a)] - (for [@.old - @.jvm ] + (for @.old + @.jvm (array.Array a))) (def: .public (atom value) (All (_ a) (-> a (Atom a))) (:abstraction (with_expansions [ (java/util/concurrent/atomic/AtomicReference::new value)] - (for [@.old - @.jvm ] + (for @.old + @.jvm ( 0 value ( 1)))))) (def: .public (read! atom) (All (_ a) (-> (Atom a) (IO a))) (with_expansions [ (java/util/concurrent/atomic/AtomicReference::get (:representation atom))] - (for [@.old - @.jvm ] + (for @.old + @.jvm (io.io ( 0 (:representation atom)))))) (def: .public (compare_and_swap! current new atom) (All (_ a) (-> a a (Atom a) (IO Bit))) (io.io (with_expansions [ (ffi.of_boolean (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom)))] - (for [@.old - @.jvm ] + (for @.old + @.jvm (let [old ( 0 (:representation atom))] (if (same? old current) (exec diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux index 7a21363b1..5f164eaae 100644 --- a/stdlib/source/library/lux/control/concurrency/thread.lux +++ b/stdlib/source/library/lux/control/concurrency/thread.lux @@ -48,17 +48,17 @@ ["[1]::[0]" (new [int]) (schedule [java/lang/Runnable long java/util/concurrent/TimeUnit] "io" (java/util/concurrent/ScheduledFuture java/lang/Object))]))] - (for [@.old (as_is ) - @.jvm (as_is ) + (for @.old (as_is ) + @.jvm (as_is ) - @.js - (as_is (ffi.import: (setTimeout [ffi.Function ffi.Number] "io" Any))) + @.js + (as_is (ffi.import: (setTimeout [ffi.Function ffi.Number] "io" Any))) - @.python - (ffi.import: threading/Timer - "[1]::[0]" - (new [ffi.Float ffi.Function]) - (start [] "io" "?" Any))] + @.python + (ffi.import: threading/Timer + "[1]::[0]" + (new [ffi.Float ffi.Function]) + (start [] "io" "?" Any)) ... Default (type: Thread @@ -71,15 +71,15 @@ (def: .public parallelism Nat (with_expansions [ 1 - (<| (configuration.for [... TODO: Remove this when Rembulan is no longer being used. - ["lua_compiler?" ""] - ]) + (<| (configuration.for ["lua_compiler?" ""] + ... TODO: Remove this when Rembulan is no longer being used. + ) (|> (java/lang/Runtime::getRuntime) (java/lang/Runtime::availableProcessors) ffi.of_int .nat))] - (for [@.old - @.jvm ] + (for @.old + @.jvm ... Default ))) @@ -89,10 +89,10 @@ .int ffi.as_int java/util/concurrent/ScheduledThreadPoolExecutor::new)))] - (for [@.old - @.jvm - @.js (as_is) - @.python (as_is)] + (for @.old + @.jvm + @.js (as_is) + @.python (as_is) ... Default (as_is (def: started? @@ -125,19 +125,19 @@ 0 (java/util/concurrent/Executor::execute runnable runner) _ (java/util/concurrent/ScheduledThreadPoolExecutor::schedule runnable (.int milli_seconds) java/util/concurrent/TimeUnit::MILLISECONDS runner))))] - (for [@.old - @.jvm - - @.js - (..setTimeout (ffi.function (_ []) Any (..execute! action)) - (n.frac milli_seconds)) - - @.python - (do io.monad - [_ (|> (ffi.function (_ []) Any (..execute! action)) - (threading/Timer::new (|> milli_seconds n.frac (f./ +1,000.0))) - threading/Timer::start)] - (in []))] + (for @.old + @.jvm + + @.js + (..setTimeout (ffi.function (_ []) Any (..execute! action)) + (n.frac milli_seconds)) + + @.python + (do io.monad + [_ (|> (ffi.function (_ []) Any (..execute! action)) + (threading/Timer::new (|> milli_seconds n.frac (f./ +1,000.0))) + threading/Timer::start)] + (in [])) ... Default (do [! io.monad] @@ -148,10 +148,10 @@ ..runner)] (in []))))) -(for [@.old (as_is) - @.jvm (as_is) - @.js (as_is) - @.python (as_is)] +(for @.old (as_is) + @.jvm (as_is) + @.js (as_is) + @.python (as_is) ... Default (as_is (exception: .public cannot_continue_running_threads) diff --git a/stdlib/source/library/lux/control/thread.lux b/stdlib/source/library/lux/control/thread.lux index 02fc925c5..b07c213a1 100644 --- a/stdlib/source/library/lux/control/thread.lux +++ b/stdlib/source/library/lux/control/thread.lux @@ -1,18 +1,18 @@ (.using - [library - [lux "*" - ["@" target] - [abstract - [functor {"+" Functor}] - [apply {"+" Apply}] - [monad {"+" Monad do}]] - [control - ["[0]" io {"+" IO}]] - [data - [collection - ["[0]" array {"+" Array}]]] - [type - abstract]]]) + [library + [lux "*" + ["@" target] + [abstract + [functor {"+" Functor}] + [apply {"+" Apply}] + [monad {"+" Monad do}]] + [control + ["[0]" io {"+" IO}]] + [data + [collection + ["[0]" array {"+" Array}]]] + [type + abstract]]]) (type: .public (Thread ! a) (-> ! a)) @@ -30,23 +30,23 @@ (def: .public (read! box) (All (_ ! a) (-> (Box ! a) (Thread ! a))) (function (_ !) - (for [@.old - ("jvm aaload" (:representation box) 0) - - @.jvm - ("jvm array read object" - (|> 0 - (:as (Primitive "java.lang.Long")) - "jvm object cast" - "jvm conversion long-to-int") - (:representation box)) - - @.js ("js array read" 0 (:representation box)) - @.python ("python array read" 0 (:representation box)) - @.lua ("lua array read" 0 (:representation box)) - @.ruby ("ruby array read" 0 (:representation box)) - @.php ("php array read" 0 (:representation box)) - @.scheme ("scheme array read" 0 (:representation box))]))) + (for @.old + ("jvm aaload" (:representation box) 0) + + @.jvm + ("jvm array read object" + (|> 0 + (:as (Primitive "java.lang.Long")) + "jvm object cast" + "jvm conversion long-to-int") + (:representation box)) + + @.js ("js array read" 0 (:representation box)) + @.python ("python array read" 0 (:representation box)) + @.lua ("lua array read" 0 (:representation box)) + @.ruby ("ruby array read" 0 (:representation box)) + @.php ("php array read" 0 (:representation box)) + @.scheme ("scheme array read" 0 (:representation box))))) (def: .public (write! value box) (All (_ a) (-> a (All (_ !) (-> (Box ! a) (Thread ! Any))))) diff --git a/stdlib/source/library/lux/control/writer.lux b/stdlib/source/library/lux/control/writer.lux index 06676e8eb..852891255 100644 --- a/stdlib/source/library/lux/control/writer.lux +++ b/stdlib/source/library/lux/control/writer.lux @@ -62,13 +62,13 @@ (def: (conjoint MlMla) (do monad - [[l1 Mla] (for [@.old - (: {.#Apply (Writer (:parameter 0) - {.#Apply (Writer (:parameter 0) - (:parameter 2)) - (:parameter 1)}) - (:parameter 1)} - MlMla)] + [[l1 Mla] (for @.old + (: {.#Apply (Writer (:parameter 0) + {.#Apply (Writer (:parameter 0) + (:parameter 2)) + (:parameter 1)}) + (:parameter 1)} + MlMla) ... On new compiler MlMla) [l2 a] Mla] diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index 41e616a8e..4992f3ae0 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -212,17 +212,17 @@ (def: .public (all check xs) (All (_ a b) (-> (-> a (Maybe b)) (List a) (List b))) - (for [... TODO: Stop relying on this ASAP. - @.js - (mix (function (_ head tail) - (case (check head) - {.#Some head} - {.#Item head tail} - - {.#None} - tail)) - {.#End} - (reversed xs))] + (for @.js + ... TODO: Stop relying on this ASAP. + (mix (function (_ head tail) + (case (check head) + {.#Some head} + {.#Item head tail} + + {.#None} + tail)) + {.#End} + (reversed xs)) (case xs {.#End} {.#End} @@ -585,10 +585,9 @@ (do [! monad] [lMla MlMla ... TODO: Remove this version ASAP and use one below. - lla (for [@.old - (: {.#Apply (type (List (List (:parameter 1)))) - (:parameter 0)} - (monad.all ! lMla))] + lla (for @.old (: {.#Apply (type (List (List (:parameter 1)))) + (:parameter 0)} + (monad.all ! lMla)) (monad.all ! lMla))] (in (..together lla))))) diff --git a/stdlib/source/library/lux/data/collection/tree/zipper.lux b/stdlib/source/library/lux/data/collection/tree/zipper.lux index 108a486d2..da4a69951 100644 --- a/stdlib/source/library/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/library/lux/data/collection/tree/zipper.lux @@ -103,13 +103,13 @@ (do maybe.monad [family (the #family zipper)] (in (let [(^open "_[0]") family] - (for [@.old - (revised #node (: (-> (Tree (:parameter 0)) - (Tree (:parameter 0))) - (has //.#children (list#composite (list.reversed _#lefts) - {.#Item (the #node zipper) - _#rights}))) - _#parent)] + (for @.old + (revised #node (: (-> (Tree (:parameter 0)) + (Tree (:parameter 0))) + (has //.#children (list#composite (list.reversed _#lefts) + {.#Item (the #node zipper) + _#rights}))) + _#parent) (has [#node //.#children] (list#composite (list.reversed _#lefts) {.#Item (the #node zipper) @@ -123,11 +123,11 @@ {.#Some family} (case (the family) {.#Item next side'} - {.#Some (for [@.old - [#family {.#Some (|> family - (has side') - (revised (|>> {.#Item (the #node zipper)})))} - #node next]] + {.#Some (for @.old + [#family {.#Some (|> family + (has side') + (revised (|>> {.#Item (the #node zipper)})))} + #node next] (let [move (: (All (_ a) (-> (List (Tree a)) (Zipper a) (Family Zipper a) (Family Zipper a))) (function (_ side' zipper) (|>> (has side') @@ -153,11 +153,11 @@ {.#None} {.#Item last prevs} - {.#Some (for [@.old [#family {.#Some (|> family - (has {.#End}) - (revised (|>> {.#Item (the #node zipper)} - (list#composite prevs))))} - #node last]] + {.#Some (for @.old [#family {.#Some (|> family + (has {.#End}) + (revised (|>> {.#Item (the #node zipper)} + (list#composite prevs))))} + #node last] (let [move (: (All (_ a) (-> (List (Tree a)) (Zipper a) (Family Zipper a) (Family Zipper a))) (function (_ prevs zipper) (|>> (has {.#End}) diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index 2f6d9fe7e..043736329 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -182,29 +182,29 @@ [[pre post] (..split_by pattern template)] (in ($_ "lux text concat" pre replacement post))))) -(for [@.js (as_is (macro: (defined? tokens lux) - (case tokens - (^ (list it)) - {.#Right [lux (list (` (.case ("js type-of" ("js constant" (~ it))) - "undefined" - .false - - (~' _) - .true)))]} - - _ - {.#Left ""})) - (macro: (if_nashorn tokens lux) - (case tokens - (^ (list then else)) - {.#Right [lux (list (if (and (..defined? "java") - (..defined? "java.lang") - (..defined? "java.lang.Object")) - then - else))]} - - _ - {.#Left ""})))] +(for @.js (as_is (macro: (defined? tokens lux) + (case tokens + (^ (list it)) + {.#Right [lux (list (` (.case ("js type-of" ("js constant" (~ it))) + "undefined" + .false + + (~' _) + .true)))]} + + _ + {.#Left ""})) + (macro: (if_nashorn tokens lux) + (case tokens + (^ (list then else)) + {.#Right [lux (list (if (and (..defined? "java") + (..defined? "java.lang") + (..defined? "java.lang.Object")) + then + else))]} + + _ + {.#Left ""}))) (as_is)) (def: .public (replaced pattern replacement template) @@ -218,39 +218,39 @@ {.#None} ("lux text concat" left right)))] - (for [@.old + (for @.old + (:as Text + ("jvm invokevirtual:java.lang.String:replace:java.lang.CharSequence,java.lang.CharSequence" + (:as (Primitive "java.lang.String") template) + (:as (Primitive "java.lang.CharSequence") pattern) + (:as (Primitive "java.lang.CharSequence") replacement))) + @.jvm + (:as Text + ("jvm member invoke virtual" [] "java.lang.String" "replace" [] + (:as (Primitive "java.lang.String") template) + ["Ljava/lang/CharSequence;" (:as (Primitive "java.lang.CharSequence") pattern)] + ["Ljava/lang/CharSequence;" (:as (Primitive "java.lang.CharSequence") replacement)])) + @.js + ... TODO: Remove this when Nashorn is no longer being used. + (..if_nashorn + (:as Text - ("jvm invokevirtual:java.lang.String:replace:java.lang.CharSequence,java.lang.CharSequence" - (:as (Primitive "java.lang.String") template) - (:as (Primitive "java.lang.CharSequence") pattern) - (:as (Primitive "java.lang.CharSequence") replacement))) - @.jvm - (:as Text - ("jvm member invoke virtual" [] "java.lang.String" "replace" [] - (:as (Primitive "java.lang.String") template) - ["Ljava/lang/CharSequence;" (:as (Primitive "java.lang.CharSequence") pattern)] - ["Ljava/lang/CharSequence;" (:as (Primitive "java.lang.CharSequence") replacement)])) - @.js - ... TODO: Remove this when Nashorn is no longer being used. - (..if_nashorn - - (:as Text - ("js object do" "replaceAll" template [pattern replacement]))) - @.python - (:as Text - ("python object do" "replace" template [pattern replacement])) - ... TODO @.lua - @.ruby - (:as Text - ("ruby object do" "gsub" template [pattern replacement])) - @.php - (:as Text - ("php apply" (:expected ("php constant" "str_replace")) - pattern replacement template)) - ... TODO @.scheme - ... TODO @.common_lisp - ... TODO @.r - ] + ("js object do" "replaceAll" template [pattern replacement]))) + @.python + (:as Text + ("python object do" "replace" template [pattern replacement])) + ... TODO @.lua + @.ruby + (:as Text + ("ruby object do" "gsub" template [pattern replacement])) + @.php + (:as Text + ("php apply" (:expected ("php constant" "str_replace")) + pattern replacement template)) + ... TODO @.scheme + ... TODO @.common_lisp + ... TODO @.r + ... Inefficient default ))) @@ -282,21 +282,21 @@ (def: &equivalence ..equivalence) (def: (hash input) - (for [@.old - (|> input - (: (Primitive "java.lang.String")) - "jvm invokevirtual:java.lang.String:hashCode:" - "jvm convert int-to-long" - (:as Nat)) - - @.jvm - (|> input - (:as (Primitive "java.lang.String")) - ("jvm member invoke virtual" [] "java.lang.String" "hashCode" []) - "jvm conversion int-to-long" - "jvm object cast" - (: (Primitive "java.lang.Long")) - (:as Nat))] + (for @.old + (|> input + (: (Primitive "java.lang.String")) + "jvm invokevirtual:java.lang.String:hashCode:" + "jvm convert int-to-long" + (:as Nat)) + + @.jvm + (|> input + (:as (Primitive "java.lang.String")) + ("jvm member invoke virtual" [] "java.lang.String" "hashCode" []) + "jvm conversion int-to-long" + "jvm object cast" + (: (Primitive "java.lang.Long")) + (:as Nat)) ... Platform-independent default. (let [length ("lux text size" input)] (loop [index 0 @@ -352,46 +352,46 @@ (def: .public (lower_cased value) (-> Text Text) - (for [@.old - (:as Text - ("jvm invokevirtual:java.lang.String:toLowerCase:" - (:as (Primitive "java.lang.String") value))) - @.jvm - (:as Text - ("jvm member invoke virtual" [] "java.lang.String" "toLowerCase" [] - (:as (Primitive "java.lang.String") value))) - @.js - (:as Text - ("js object do" "toLowerCase" value [])) - @.python - (:as Text - ("python object do" "lower" value [])) - @.lua - (:as Text - ("lua apply" ("lua constant" "string.lower") [value])) - @.ruby - (:as Text - ("ruby object do" "downcase" value []))])) + (for @.old + (:as Text + ("jvm invokevirtual:java.lang.String:toLowerCase:" + (:as (Primitive "java.lang.String") value))) + @.jvm + (:as Text + ("jvm member invoke virtual" [] "java.lang.String" "toLowerCase" [] + (:as (Primitive "java.lang.String") value))) + @.js + (:as Text + ("js object do" "toLowerCase" value [])) + @.python + (:as Text + ("python object do" "lower" value [])) + @.lua + (:as Text + ("lua apply" ("lua constant" "string.lower") [value])) + @.ruby + (:as Text + ("ruby object do" "downcase" value [])))) (def: .public (upper_cased value) (-> Text Text) - (for [@.old - (:as Text - ("jvm invokevirtual:java.lang.String:toUpperCase:" - (:as (Primitive "java.lang.String") value))) - @.jvm - (:as Text - ("jvm member invoke virtual" [] "java.lang.String" "toUpperCase" [] - (:as (Primitive "java.lang.String") value))) - @.js - (:as Text - ("js object do" "toUpperCase" value [])) - @.python - (:as Text - ("python object do" "upper" value [])) - @.lua - (:as Text - ("lua apply" ("lua constant" "string.upper") [value])) - @.ruby - (:as Text - ("ruby object do" "upcase" value []))])) + (for @.old + (:as Text + ("jvm invokevirtual:java.lang.String:toUpperCase:" + (:as (Primitive "java.lang.String") value))) + @.jvm + (:as Text + ("jvm member invoke virtual" [] "java.lang.String" "toUpperCase" [] + (:as (Primitive "java.lang.String") value))) + @.js + (:as Text + ("js object do" "toUpperCase" value [])) + @.python + (:as Text + ("python object do" "upper" value [])) + @.lua + (:as Text + ("lua apply" ("lua constant" "string.upper") [value])) + @.ruby + (:as Text + ("ruby object do" "upcase" value [])))) diff --git a/stdlib/source/library/lux/data/text/buffer.lux b/stdlib/source/library/lux/data/text/buffer.lux index 18b4e74c7..78652d3fe 100644 --- a/stdlib/source/library/lux/data/text/buffer.lux +++ b/stdlib/source/library/lux/data/text/buffer.lux @@ -34,34 +34,34 @@ ["[1]::[0]" (new [int]) (toString [] java/lang/String)]))] - (`` (for [@.old (as_is ) - @.jvm (as_is ) - @.js (as_is (import: (JS_Array a) - "[1]::[0]" - (push [a] a) - (join [Text] Text))) - @.lua (as_is (import: (table/concat [(array.Array Text) Text] Text)) - ...https://www.lua.org/manual/5.3/manual.html#pdf-table.concat - (import: (table/insert [(array.Array Text) Text] "?" Nothing)) - ... https://www.lua.org/manual/5.3/manual.html#pdf-table.insert - )] + (`` (for @.old (as_is ) + @.jvm (as_is ) + @.js (as_is (import: (JS_Array a) + "[1]::[0]" + (push [a] a) + (join [Text] Text))) + @.lua (as_is (import: (table/concat [(array.Array Text) Text] Text)) + ...https://www.lua.org/manual/5.3/manual.html#pdf-table.concat + (import: (table/insert [(array.Array Text) Text] "?" Nothing)) + ... https://www.lua.org/manual/5.3/manual.html#pdf-table.insert + ) (as_is)))) (`` (abstract: .public Buffer - (for [@.old [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)] - @.jvm [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)] - @.js [Nat (-> (JS_Array Text) (JS_Array Text))] - @.lua [Nat (-> (array.Array Text) (array.Array Text))]] + (for @.old [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)] + @.jvm [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)] + @.js [Nat (-> (JS_Array Text) (JS_Array Text))] + @.lua [Nat (-> (array.Array Text) (array.Array Text))] ... default (Sequence Text)) (def: .public empty Buffer (:abstraction (with_expansions [ [0 function.identity]] - (for [@.old - @.jvm - @.js [0 function.identity] - @.lua [0 function.identity]] + (for @.old + @.jvm + @.js [0 function.identity] + @.lua [0 function.identity] ... default sequence.empty)))) @@ -76,34 +76,34 @@ builder)))] (:abstraction [(n.+ (//.size chunk) capacity) (|>> transform (then! chunk))]))] - (for [@.old - @.jvm - @.js (let [[capacity transform] (:representation buffer) - then! (: (-> (JS_Array Text) (JS_Array Text)) + (for @.old + @.jvm + @.js (let [[capacity transform] (:representation buffer) + then! (: (-> (JS_Array Text) (JS_Array Text)) + (function (_ array) + (exec + (JS_Array::push chunk array) + array)))] + (:abstraction [(n.+ (//.size chunk) capacity) + (|>> transform then!)])) + @.lua (let [[capacity transform] (:representation buffer) + then! (: (-> (array.Array Text) (array.Array Text)) (function (_ array) (exec - (JS_Array::push chunk array) + (table/insert array chunk) array)))] (:abstraction [(n.+ (//.size chunk) capacity) (|>> transform then!)])) - @.lua (let [[capacity transform] (:representation buffer) - then! (: (-> (array.Array Text) (array.Array Text)) - (function (_ array) - (exec - (table/insert array chunk) - array)))] - (:abstraction [(n.+ (//.size chunk) capacity) - (|>> transform then!)]))] ... default (|> buffer :representation (sequence.suffix chunk) :abstraction)))) (def: .public size (-> Buffer Nat) (with_expansions [ (|>> :representation product.left)] - (for [@.old - @.jvm - @.js - @.lua ] + (for @.old + @.jvm + @.js + @.lua ... default (|>> :representation (sequence#mix (function (_ chunk total) @@ -117,15 +117,15 @@ transform java/lang/StringBuilder::toString ffi.of_string))] - (for [@.old - @.jvm - @.js (let [[capacity transform] (:representation buffer)] - (|> (array.empty 0) - (:as (JS_Array Text)) - transform - (JS_Array::join ""))) - @.lua (let [[capacity transform] (:representation buffer)] - (table/concat (transform (array.empty 0)) ""))] + (for @.old + @.jvm + @.js (let [[capacity transform] (:representation buffer)] + (|> (array.empty 0) + (:as (JS_Array Text)) + transform + (JS_Array::join ""))) + @.lua (let [[capacity transform] (:representation buffer)] + (table/concat (transform (array.empty 0)) "")) ... default (sequence#mix (function (_ chunk total) (format total chunk)) diff --git a/stdlib/source/library/lux/data/text/encoding/utf8.lux b/stdlib/source/library/lux/data/text/encoding/utf8.lux index 915d6b895..9b13114a4 100644 --- a/stdlib/source/library/lux/data/text/encoding/utf8.lux +++ b/stdlib/source/library/lux/data/text/encoding/utf8.lux @@ -15,145 +15,145 @@ ["[1]::[0]" (new [[byte] java/lang/String]) (getBytes [java/lang/String] [byte])]))] - (for [@.old (as_is ) - @.jvm (as_is ) + (for @.old (as_is ) + @.jvm (as_is ) - @.js - (as_is (ffi.import: Uint8Array - "[1]::[0]") + @.js + (as_is (ffi.import: Uint8Array + "[1]::[0]") - ... On Node - (ffi.import: Buffer - "[1]::[0]" - ("static" from "as" from|encoded [ffi.String ffi.String] Buffer) - ("static" from "as" from|decoded [Uint8Array] Buffer) - (toString [ffi.String] ffi.String)) + ... On Node + (ffi.import: Buffer + "[1]::[0]" + ("static" from "as" from|encoded [ffi.String ffi.String] Buffer) + ("static" from "as" from|decoded [Uint8Array] Buffer) + (toString [ffi.String] ffi.String)) - ... On the browser - (ffi.import: TextEncoder - "[1]::[0]" - (new [ffi.String]) - (encode [ffi.String] Uint8Array)) - - (ffi.import: TextDecoder - "[1]::[0]" - (new [ffi.String]) - (decode [Uint8Array] ffi.String))) - - @.ruby - (as_is (ffi.import: String - "[1]::[0]" - (encode [Text] String) - (force_encoding [Text] Text) - (bytes [] Binary)) - - (ffi.import: Array - "[1]::[0]" - (pack [Text] String))) - - @.php - (as_is (ffi.import: Almost_Binary) - (ffi.import: (unpack [ffi.String ffi.String] Almost_Binary)) - (ffi.import: (array_values [Almost_Binary] Binary)) - (def: php_byte_array_format "C*")) - - @.scheme - ... https://srfi.schemers.org/srfi-140/srfi-140.html - (as_is (ffi.import: (string->utf8 [Text] Binary)) - (ffi.import: (utf8->string [Binary] Text)))] + ... On the browser + (ffi.import: TextEncoder + "[1]::[0]" + (new [ffi.String]) + (encode [ffi.String] Uint8Array)) + + (ffi.import: TextDecoder + "[1]::[0]" + (new [ffi.String]) + (decode [Uint8Array] ffi.String))) + + @.ruby + (as_is (ffi.import: String + "[1]::[0]" + (encode [Text] String) + (force_encoding [Text] Text) + (bytes [] Binary)) + + (ffi.import: Array + "[1]::[0]" + (pack [Text] String))) + + @.php + (as_is (ffi.import: Almost_Binary) + (ffi.import: (unpack [ffi.String ffi.String] Almost_Binary)) + (ffi.import: (array_values [Almost_Binary] Binary)) + (def: php_byte_array_format "C*")) + + @.scheme + ... https://srfi.schemers.org/srfi-140/srfi-140.html + (as_is (ffi.import: (string->utf8 [Text] Binary)) + (ffi.import: (utf8->string [Binary] Text))) (as_is))) (def: (encoded value) (-> Text Binary) - (for [@.old - (java/lang/String::getBytes (ffi.as_string (//.name //.utf_8)) - (ffi.as_string value)) - - @.jvm - (java/lang/String::getBytes (ffi.as_string (//.name //.utf_8)) - (ffi.as_string value)) - - @.js - (cond ffi.on_nashorn? - (:as Binary ("js object do" "getBytes" value ["utf8"])) - - ffi.on_node_js? - (|> (Buffer::from|encoded value "utf8") - ... This coercion is valid as per NodeJS's documentation: - ... https://nodejs.org/api/buffer.html#buffer_buffers_and_typedarrays - (:as Uint8Array)) - - ... On the browser - (|> (TextEncoder::new (//.name //.utf_8)) - (TextEncoder::encode [value])) - ) - - @.python - (:as Binary ("python apply" (:expected ("python constant" "bytearray")) [value "utf-8"])) - - @.lua - ("lua utf8 encode" value) - - @.ruby - (|> value - (:as String) - (String::encode "UTF-8") - (String::bytes)) - - @.php - (|> (..unpack [..php_byte_array_format value]) - ..array_values - ("php object new" "ArrayObject") - (:as Binary)) - - @.scheme - (..string->utf8 value)])) + (for @.old + (java/lang/String::getBytes (ffi.as_string (//.name //.utf_8)) + (ffi.as_string value)) + + @.jvm + (java/lang/String::getBytes (ffi.as_string (//.name //.utf_8)) + (ffi.as_string value)) + + @.js + (cond ffi.on_nashorn? + (:as Binary ("js object do" "getBytes" value ["utf8"])) + + ffi.on_node_js? + (|> (Buffer::from|encoded value "utf8") + ... This coercion is valid as per NodeJS's documentation: + ... https://nodejs.org/api/buffer.html#buffer_buffers_and_typedarrays + (:as Uint8Array)) + + ... On the browser + (|> (TextEncoder::new (//.name //.utf_8)) + (TextEncoder::encode [value])) + ) + + @.python + (:as Binary ("python apply" (:expected ("python constant" "bytearray")) [value "utf-8"])) + + @.lua + ("lua utf8 encode" value) + + @.ruby + (|> value + (:as String) + (String::encode "UTF-8") + (String::bytes)) + + @.php + (|> (..unpack [..php_byte_array_format value]) + ..array_values + ("php object new" "ArrayObject") + (:as Binary)) + + @.scheme + (..string->utf8 value))) (def: (decoded value) (-> Binary (Try Text)) (with_expansions [ {try.#Success (ffi.of_string (java/lang/String::new value (ffi.as_string (//.name //.utf_8))))}] - (for [@.old - @.jvm - - @.js - (cond ffi.on_nashorn? - (|> ("js object new" ("js constant" "java.lang.String") [value "utf8"]) - (:as Text) - {try.#Success}) - - ffi.on_node_js? - (|> (Buffer::from|decoded value) - (Buffer::toString "utf8") - {try.#Success}) - - ... On the browser - (|> (TextDecoder::new (//.name //.utf_8)) - (TextDecoder::decode value) - {try.#Success})) - - @.python - (try (:as Text ("python object do" "decode" (:expected value) ["utf-8"]))) - - @.lua - {try.#Success ("lua utf8 decode" value)} - - @.ruby - (|> value - (:as Array) - (Array::pack "C*") - (:as String) - (String::force_encoding "UTF-8") - {try.#Success}) - - @.php - (|> value - ("php pack" ..php_byte_array_format) - {try.#Success}) - - @.scheme - (|> value - ..utf8->string - {try.#Success})]))) + (for @.old + @.jvm + + @.js + (cond ffi.on_nashorn? + (|> ("js object new" ("js constant" "java.lang.String") [value "utf8"]) + (:as Text) + {try.#Success}) + + ffi.on_node_js? + (|> (Buffer::from|decoded value) + (Buffer::toString "utf8") + {try.#Success}) + + ... On the browser + (|> (TextDecoder::new (//.name //.utf_8)) + (TextDecoder::decode value) + {try.#Success})) + + @.python + (try (:as Text ("python object do" "decode" (:expected value) ["utf-8"]))) + + @.lua + {try.#Success ("lua utf8 decode" value)} + + @.ruby + (|> value + (:as Array) + (Array::pack "C*") + (:as String) + (String::force_encoding "UTF-8") + {try.#Success}) + + @.php + (|> value + ("php pack" ..php_byte_array_format) + {try.#Success}) + + @.scheme + (|> value + ..utf8->string + {try.#Success})))) (implementation: .public codec (Codec Binary Text) diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index a807c8ba1..ef90dc663 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -66,73 +66,73 @@ (intValue [] int) (longValue [] long) (doubleValue [] double)]))] - (for [@.old (as_is ) - @.jvm (as_is ) - - @.js - (as_is (import: JSON - "[1]::[0]" - ("static" stringify [.Any] ffi.String)) - (import: Array - "[1]::[0]" - ("static" isArray [.Any] ffi.Boolean))) - - @.python - (as_is (type: PyType - (Primitive "python_type")) - - (import: (type [.Any] PyType)) - (import: (str [.Any] ffi.String))) - - @.lua - (as_is (import: (type [.Any] ffi.String)) - (import: (tostring [.Any] ffi.String)) - - (import: math - "[1]::[0]" - ("static" type [.Any] "?" ffi.String))) - - @.ruby - (as_is (import: Class - "[1]::[0]") - - (import: Object - "[1]::[0]" - (class [] Class) - (to_s [] ffi.String))) - - @.php - (as_is (import: (gettype [.Any] ffi.String)) - (import: (strval [.Any] ffi.String))) - - @.scheme - (as_is (import: (boolean? [.Any] Bit)) - (import: (integer? [.Any] Bit)) - (import: (real? [.Any] Bit)) - (import: (string? [.Any] Bit)) - (import: (vector? [.Any] Bit)) - (import: (pair? [.Any] Bit)) - (import: (car [.Any] .Any)) - (import: (cdr [.Any] .Any)) - (import: (format [Text .Any] Text))) - ])) + (for @.old (as_is ) + @.jvm (as_is ) + + @.js + (as_is (import: JSON + "[1]::[0]" + ("static" stringify [.Any] ffi.String)) + (import: Array + "[1]::[0]" + ("static" isArray [.Any] ffi.Boolean))) + + @.python + (as_is (type: PyType + (Primitive "python_type")) + + (import: (type [.Any] PyType)) + (import: (str [.Any] ffi.String))) + + @.lua + (as_is (import: (type [.Any] ffi.String)) + (import: (tostring [.Any] ffi.String)) + + (import: math + "[1]::[0]" + ("static" type [.Any] "?" ffi.String))) + + @.ruby + (as_is (import: Class + "[1]::[0]") + + (import: Object + "[1]::[0]" + (class [] Class) + (to_s [] ffi.String))) + + @.php + (as_is (import: (gettype [.Any] ffi.String)) + (import: (strval [.Any] ffi.String))) + + @.scheme + (as_is (import: (boolean? [.Any] Bit)) + (import: (integer? [.Any] Bit)) + (import: (real? [.Any] Bit)) + (import: (string? [.Any] Bit)) + (import: (vector? [.Any] Bit)) + (import: (pair? [.Any] Bit)) + (import: (car [.Any] .Any)) + (import: (cdr [.Any] .Any)) + (import: (format [Text .Any] Text))) + )) (def: Inspector (.type (Format Any))) -(for [@.lua (def: (tuple_array tuple) - (-> (array.Array Any) (array.Array Any)) - (array.of_list - (loop [idx 0] - (let [member ("lua array read" idx tuple)] - (if ("lua object nil?" member) - {.#End} - {.#Item member (again (++ idx))})))))] +(for @.lua (def: (tuple_array tuple) + (-> (array.Array Any) (array.Array Any)) + (array.of_list + (loop [idx 0] + (let [member ("lua array read" idx tuple)] + (if ("lua object nil?" member) + {.#End} + {.#Item member (again (++ idx))}))))) (as_is)) (def: (tuple_inspection inspection) (-> Inspector Inspector) - (with_expansions [ (for [@.lua (~~ (as_is ..tuple_array))] + (with_expansions [ (for @.lua (~~ (as_is ..tuple_array)) (~~ (as_is)))] (`` (|>> (:as (array.Array Any)) @@ -177,206 +177,206 @@ (tuple_inspection inspection value))) {.#None}) (ffi.of_string (java/lang/Object::toString object)))))] - (for [@.old - @.jvm - - @.js - (case (ffi.type_of value) - (^template [ ] - [ - (`` (|> value (~~ (template.spliced ))))]) - (["boolean" [(:as .Bit) %.bit]] - ["number" [(:as .Frac) %.frac]] - ["string" [(:as .Text) %.text]] - ["undefined" [JSON::stringify]]) - - "object" - (let [variant_tag ("js object get" "_lux_tag" value) - variant_flag ("js object get" "_lux_flag" value) - variant_value ("js object get" "_lux_value" value)] - (cond (not (or ("js object undefined?" variant_tag) - ("js object undefined?" variant_flag) - ("js object undefined?" variant_value))) - (|> (%.format (JSON::stringify variant_tag) - " " (%.bit (not ("js object null?" variant_flag))) - " " (inspection variant_value)) - (text.enclosed ["{" "}"])) - - (not (or ("js object undefined?" ("js object get" "_lux_low" value)) - ("js object undefined?" ("js object get" "_lux_high" value)))) - (|> value (:as .Int) %.int) - - (Array::isArray value) - (tuple_inspection inspection value) - - ... else - (JSON::stringify value))) - - _ - (JSON::stringify value)) - - @.python - (case (..str (..type value)) - (^template [ ] - [(^or ) - (`` (|> value (~~ (template.spliced ))))]) - (["" "" [(:as .Bit) %.bit]] - ["" "" [(:as .Int) %.int]] - ["" "" [(:as .Frac) %.frac]] - ["" "" [(:as .Text) %.text]] - ["" "" [(:as .Text) %.text]]) - - (^or "" "") - (tuple_inspection inspection value) - - (^or "" "") - (let [variant (:as (array.Array Any) value)] - (case (array.size variant) - 3 (let [variant_tag ("python array read" 0 variant) - variant_flag ("python array read" 1 variant) - variant_value ("python array read" 2 variant)] - (if (or ("python object none?" variant_tag) - ("python object none?" variant_value)) - (..str value) - (|> (%.format (|> variant_tag (:as .Nat) %.nat) - " " (|> variant_flag "python object none?" not %.bit) - " " (inspection variant_value)) - (text.enclosed ["{" "}"])))) - _ (..str value))) - - _ - (..str value)) - - @.lua - (case (..type value) - (^template [ ] - [ - (`` (|> value (~~ (template.spliced ))))]) - (["boolean" [(:as .Bit) %.bit]] - ["string" [(:as .Text) %.text]] - ["nil" [(new> "nil" [])]]) - - "number" - (case (math::type value) - {.#Some "integer"} (|> value (:as .Int) %.int) - {.#Some "float"} (|> value (:as .Frac) %.frac) - - _ - (..tostring value)) - - "table" - (let [variant_tag ("lua object get" "_lux_tag" value) - variant_flag ("lua object get" "_lux_flag" value) - variant_value ("lua object get" "_lux_value" value)] - (if (or ("lua object nil?" variant_tag) - ("lua object nil?" variant_value)) - (tuple_inspection inspection value) - (|> (%.format (|> variant_tag (:as .Nat) %.nat) - " " (%.bit (not ("lua object nil?" variant_flag))) - " " (inspection variant_value)) - (text.enclosed ["{" "}"])))) - - _ - (..tostring value)) - - @.ruby - (template.let [(class_of ) - [(|> - (:as ..Object) - Object::class)] - - (to_s ) - [(|> - (:as ..Object) - Object::to_s)]] - (let [value_class (class_of value)] - (`` (cond (~~ (template [ ] - [(same? (class_of ) value_class) - (|> value (:as ) )] - - [#0 Bit %.bit] - [#1 Bit %.bit] - [+1 Int %.int] - [+1.0 Frac %.frac] - ["" Text %.text] - [("ruby object nil") Any (new> "nil" [])] - )) - - (same? (class_of {.#None}) value_class) - (let [variant_tag ("ruby object get" "_lux_tag" value) - variant_flag ("ruby object get" "_lux_flag" value) - variant_value ("ruby object get" "_lux_value" value)] - (if (or ("ruby object nil?" variant_tag) - ("ruby object nil?" variant_value)) - (tuple_inspection inspection value) - (|> (%.format (|> variant_tag (:as .Nat) %.nat) - " " (%.bit (not ("ruby object nil?" variant_flag))) - " " (inspection variant_value)) - (text.enclosed ["{" "}"])))) - - (same? (class_of [[] []]) value_class) - (tuple_inspection inspection value) - - ... else - (to_s value))))) - - @.php - (case (..gettype value) - (^template [ ] - [ - (`` (|> value (~~ (template.spliced ))))]) - (["boolean" [(:as .Bit) %.bit]] - ["integer" [(:as .Int) %.int]] - ["double" [(:as .Frac) %.frac]] - ["string" [(:as .Text) %.text]] - ["NULL" [(new> "null" [])]] - ["array" [(tuple_inspection inspection)]]) - - "object" - (let [variant_tag ("php object get" "_lux_tag" value) - variant_flag ("php object get" "_lux_flag" value) - variant_value ("php object get" "_lux_value" value)] - (if (or ("php object null?" variant_tag) - ("php object null?" variant_value)) - (..strval value) - (|> (%.format (|> variant_tag (:as .Nat) %.nat) - " " (%.bit (not ("php object null?" variant_flag))) - " " (inspection variant_value)) - (text.enclosed ["{" "}"])))) - - _ - (..strval value)) - - @.scheme - (`` (cond (~~ (template [ ] - [( value) - (`` (|> value (~~ (template.spliced ))))] - - [..boolean? [(:as .Bit) %.bit]] - [..integer? [(:as .Int) %.int]] - [..real? [(:as .Frac) %.frac]] - [..string? [(:as .Text) %.text]] - ["scheme object nil?" [(new> "()" [])]] - [..vector? [(tuple_inspection inspection)]])) - - (..pair? value) - (let [variant_tag (..car value) - variant_rest (..cdr value)] - (if (and (..integer? variant_tag) - (i.> +0 (:as Int variant_tag)) - (..pair? variant_rest)) - (let [variant_flag (..car variant_rest) - variant_value (..cdr variant_rest)] - (|> (%.format (|> variant_tag (:as .Nat) %.nat) - " " (%.bit (not ("scheme object nil?" variant_flag))) - " " (inspection variant_value)) - (text.enclosed ["{" "}"]))) - (..format ["~s" value]))) - - ... else - (..format ["~s" value]) - )) - ]))) + (for @.old + @.jvm + + @.js + (case (ffi.type_of value) + (^template [ ] + [ + (`` (|> value (~~ (template.spliced ))))]) + (["boolean" [(:as .Bit) %.bit]] + ["number" [(:as .Frac) %.frac]] + ["string" [(:as .Text) %.text]] + ["undefined" [JSON::stringify]]) + + "object" + (let [variant_tag ("js object get" "_lux_tag" value) + variant_flag ("js object get" "_lux_flag" value) + variant_value ("js object get" "_lux_value" value)] + (cond (not (or ("js object undefined?" variant_tag) + ("js object undefined?" variant_flag) + ("js object undefined?" variant_value))) + (|> (%.format (JSON::stringify variant_tag) + " " (%.bit (not ("js object null?" variant_flag))) + " " (inspection variant_value)) + (text.enclosed ["{" "}"])) + + (not (or ("js object undefined?" ("js object get" "_lux_low" value)) + ("js object undefined?" ("js object get" "_lux_high" value)))) + (|> value (:as .Int) %.int) + + (Array::isArray value) + (tuple_inspection inspection value) + + ... else + (JSON::stringify value))) + + _ + (JSON::stringify value)) + + @.python + (case (..str (..type value)) + (^template [ ] + [(^or ) + (`` (|> value (~~ (template.spliced ))))]) + (["" "" [(:as .Bit) %.bit]] + ["" "" [(:as .Int) %.int]] + ["" "" [(:as .Frac) %.frac]] + ["" "" [(:as .Text) %.text]] + ["" "" [(:as .Text) %.text]]) + + (^or "" "") + (tuple_inspection inspection value) + + (^or "" "") + (let [variant (:as (array.Array Any) value)] + (case (array.size variant) + 3 (let [variant_tag ("python array read" 0 variant) + variant_flag ("python array read" 1 variant) + variant_value ("python array read" 2 variant)] + (if (or ("python object none?" variant_tag) + ("python object none?" variant_value)) + (..str value) + (|> (%.format (|> variant_tag (:as .Nat) %.nat) + " " (|> variant_flag "python object none?" not %.bit) + " " (inspection variant_value)) + (text.enclosed ["{" "}"])))) + _ (..str value))) + + _ + (..str value)) + + @.lua + (case (..type value) + (^template [ ] + [ + (`` (|> value (~~ (template.spliced ))))]) + (["boolean" [(:as .Bit) %.bit]] + ["string" [(:as .Text) %.text]] + ["nil" [(new> "nil" [])]]) + + "number" + (case (math::type value) + {.#Some "integer"} (|> value (:as .Int) %.int) + {.#Some "float"} (|> value (:as .Frac) %.frac) + + _ + (..tostring value)) + + "table" + (let [variant_tag ("lua object get" "_lux_tag" value) + variant_flag ("lua object get" "_lux_flag" value) + variant_value ("lua object get" "_lux_value" value)] + (if (or ("lua object nil?" variant_tag) + ("lua object nil?" variant_value)) + (tuple_inspection inspection value) + (|> (%.format (|> variant_tag (:as .Nat) %.nat) + " " (%.bit (not ("lua object nil?" variant_flag))) + " " (inspection variant_value)) + (text.enclosed ["{" "}"])))) + + _ + (..tostring value)) + + @.ruby + (template.let [(class_of ) + [(|> + (:as ..Object) + Object::class)] + + (to_s ) + [(|> + (:as ..Object) + Object::to_s)]] + (let [value_class (class_of value)] + (`` (cond (~~ (template [ ] + [(same? (class_of ) value_class) + (|> value (:as ) )] + + [#0 Bit %.bit] + [#1 Bit %.bit] + [+1 Int %.int] + [+1.0 Frac %.frac] + ["" Text %.text] + [("ruby object nil") Any (new> "nil" [])] + )) + + (same? (class_of {.#None}) value_class) + (let [variant_tag ("ruby object get" "_lux_tag" value) + variant_flag ("ruby object get" "_lux_flag" value) + variant_value ("ruby object get" "_lux_value" value)] + (if (or ("ruby object nil?" variant_tag) + ("ruby object nil?" variant_value)) + (tuple_inspection inspection value) + (|> (%.format (|> variant_tag (:as .Nat) %.nat) + " " (%.bit (not ("ruby object nil?" variant_flag))) + " " (inspection variant_value)) + (text.enclosed ["{" "}"])))) + + (same? (class_of [[] []]) value_class) + (tuple_inspection inspection value) + + ... else + (to_s value))))) + + @.php + (case (..gettype value) + (^template [ ] + [ + (`` (|> value (~~ (template.spliced ))))]) + (["boolean" [(:as .Bit) %.bit]] + ["integer" [(:as .Int) %.int]] + ["double" [(:as .Frac) %.frac]] + ["string" [(:as .Text) %.text]] + ["NULL" [(new> "null" [])]] + ["array" [(tuple_inspection inspection)]]) + + "object" + (let [variant_tag ("php object get" "_lux_tag" value) + variant_flag ("php object get" "_lux_flag" value) + variant_value ("php object get" "_lux_value" value)] + (if (or ("php object null?" variant_tag) + ("php object null?" variant_value)) + (..strval value) + (|> (%.format (|> variant_tag (:as .Nat) %.nat) + " " (%.bit (not ("php object null?" variant_flag))) + " " (inspection variant_value)) + (text.enclosed ["{" "}"])))) + + _ + (..strval value)) + + @.scheme + (`` (cond (~~ (template [ ] + [( value) + (`` (|> value (~~ (template.spliced ))))] + + [..boolean? [(:as .Bit) %.bit]] + [..integer? [(:as .Int) %.int]] + [..real? [(:as .Frac) %.frac]] + [..string? [(:as .Text) %.text]] + ["scheme object nil?" [(new> "()" [])]] + [..vector? [(tuple_inspection inspection)]])) + + (..pair? value) + (let [variant_tag (..car value) + variant_rest (..cdr value)] + (if (and (..integer? variant_tag) + (i.> +0 (:as Int variant_tag)) + (..pair? variant_rest)) + (let [variant_flag (..car variant_rest) + variant_value (..cdr variant_rest)] + (|> (%.format (|> variant_tag (:as .Nat) %.nat) + " " (%.bit (not ("scheme object nil?" variant_flag))) + " " (inspection variant_value)) + (text.enclosed ["{" "}"]))) + (..format ["~s" value]))) + + ... else + (..format ["~s" value]) + )) + ))) (exception: .public (cannot_represent_value [type Type]) (exception.report diff --git a/stdlib/source/library/lux/ffi.lux b/stdlib/source/library/lux/ffi.lux index 81a569b6e..f5b578b62 100644 --- a/stdlib/source/library/lux/ffi.lux +++ b/stdlib/source/library/lux/ffi.lux @@ -23,44 +23,44 @@ [type abstract]]]) -(with_expansions [ (for [@.js "js constant" - @.python "python constant" - @.lua "lua constant" - @.ruby "ruby constant"]) - (for [@.js "js apply" - @.python "python apply" - @.lua "lua apply" - @.ruby "ruby apply"]) - (for [@.js "js object new" - @.python "python apply"] +(with_expansions [ (for @.js "js constant" + @.python "python constant" + @.lua "lua constant" + @.ruby "ruby constant") + (for @.js "js apply" + @.python "python apply" + @.lua "lua apply" + @.ruby "ruby apply") + (for @.js "js object new" + @.python "python apply" (as_is)) - (for [@.js "js object do" - @.python "python object do" - @.lua "lua object do" - @.ruby "ruby object do"]) - (for [@.js "js object get" - @.python "python object get" - @.lua "lua object get" - @.ruby "ruby object get"] + (for @.js "js object do" + @.python "python object do" + @.lua "lua object do" + @.ruby "ruby object do") + (for @.js "js object get" + @.python "python object get" + @.lua "lua object get" + @.ruby "ruby object get" (as_is)) - (for [@.python "python import" - @.lua "lua import" - @.ruby "ruby import"] + (for @.python "python import" + @.lua "lua import" + @.ruby "ruby import" (as_is)) - (for [@.js "js function" - @.python "python function" - @.lua "lua function"] + (for @.js "js function" + @.python "python function" + @.lua "lua function" (as_is))] (abstract: .public (Object brand) Any) - (with_expansions [ (for [@.js (as_is [Symbol] - [Null] - [Undefined]) - @.python (as_is [None] - [Dict]) - @.lua (as_is [Nil] - [Table]) - @.ruby (as_is [Nil])]) + (with_expansions [ (for @.js (as_is [Symbol] + [Null] + [Undefined]) + @.python (as_is [None] + [Dict]) + @.lua (as_is [Nil] + [Table]) + @.ruby (as_is [Nil])) ] (template [] [(with_expansions [ (template.symbol [ "'"])] @@ -74,13 +74,13 @@ )) - (with_expansions [ (for [@.js (as_is [Number Frac]) - @.python (as_is [Integer Int] - [Float Frac]) - @.lua (as_is [Integer Int] - [Float Frac]) - @.ruby (as_is [Integer Int] - [Float Frac])]) + (with_expansions [ (for @.js (as_is [Number Frac]) + @.python (as_is [Integer Int] + [Float Frac]) + @.lua (as_is [Integer Int] + [Float Frac]) + @.ruby (as_is [Integer Int] + [Float Frac])) ] (template [ ] [(type: .public @@ -231,8 +231,8 @@ (`` (`` (type: Sub (Variant - (~~ (for [@.lua (~~ (as_is)) - @.ruby (~~ (as_is))] + (~~ (for @.lua (~~ (as_is)) + @.ruby (~~ (as_is)) {#Constructor Constructor})) {#Field Field} {#Method Method})))) @@ -240,8 +240,8 @@ (`` (`` (def: sub (Parser Sub) ($_ <>.or - (~~ (for [@.lua (~~ (as_is)) - @.ruby (~~ (as_is))] + (~~ (for @.lua (~~ (as_is)) + @.ruby (~~ (as_is)) ..constructor)) ..field ..method @@ -294,14 +294,14 @@ (~ g!it') (.panic! "Invalid output."))))))))))] - (~~ (for [@.js [null "js object null" - null? "js object null?"] - @.python [none "python object none" - none? "python object none?"] - @.lua [nil "lua object nil" - nil? "lua object nil?"] - @.ruby [nil "ruby object nil" - nil? "ruby object nil?"]])) + (~~ (for @.js [null "js object null" + null? "js object null?"] + @.python [none "python object none" + none? "python object none?"] + @.lua [nil "lua object nil" + nil? "lua object nil?"] + @.ruby [nil "ruby object nil" + nil? "ruby object nil?"])) )) (type: Declaration @@ -402,7 +402,7 @@ (def: host_path (text.replaced .module_separator ..class_separator)) - (for [@.js (as_is)] + (for @.js (as_is) (def: (imported class) (-> Text Code) (case (text.all_split_by .module_separator class) @@ -431,8 +431,8 @@ (~ (<| (lux_optional :output:) (` ( (~ (code.text (..host_path (the #name it)))))))))))))) - (for [@.lua (as_is) - @.ruby (as_is)] + (for @.lua (as_is) + @.ruby (as_is) (def: (constructor_definition [class_name class_parameters] alias namespace it) (-> Declaration Alias Namespace Constructor Code) (let [g!it (|> it @@ -458,9 +458,9 @@ (.:expected (~ (<| (..input_term input) (..lux_optional :output:) - (` ( (~ (for [@.js (` ( (~ (code.text (..host_path class_name))))) - @.python (` (.:as ..Function - (~ (..imported class_name))))])) + (` ( (~ (for @.js (` ( (~ (code.text (..host_path class_name))))) + @.python (` (.:as ..Function + (~ (..imported class_name)))))) [(~+ (list#each ..host_optional g!parameters))])))))))))) (def: (static_field_definition import! [class_name class_parameters] alias namespace it) @@ -477,8 +477,8 @@ (~+ 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)))))] + (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)))))))))))))))) @@ -516,8 +516,8 @@ (|> it (has #alias {.#Some name}) (..procedure_definition import! - (for [@.js (` ( (~ (code.text (%.format (..host_path class_name) "." method))))) - @.ruby (` ( (~ (code.text (%.format (..host_path class_name) "::" method)))))] + (for @.js (` ( (~ (code.text (%.format (..host_path class_name) "." method))))) + @.ruby (` ( (~ (code.text (%.format (..host_path class_name) "::" method))))) (` ( (~ (code.text method)) (.:as (..Object .Any) (~ (..imported class_name)))))))))) @@ -588,8 +588,8 @@ [(~+ g!class_variables)])))) (list#each (.function (_ member) (`` (`` (case member - (~~ (for [@.lua (~~ (as_is)) - @.ruby (~~ (as_is))] + (~~ (for @.lua (~~ (as_is)) + @.ruby (~~ (as_is)) (~~ (as_is {#Constructor it} (..constructor_definition class alias namespace it))))) @@ -601,7 +601,7 @@ (the #members it))))) ))) - (for [@.ruby (as_is)] + (for @.ruby (as_is) (syntax: .public (function [[self inputs] (.form ($_ <>.and .local_symbol @@ -617,59 +617,59 @@ (.function ((~ (code.local_symbol self)) [(~+ (list#each product.left inputs))]) (~ term)))))))) - (for [@.js (as_is (template: .public (type_of object) - [("js type-of" object)]) - - (syntax: .public (global [type .any - [head tail] (.tuple (<>.and .local_symbol (<>.some .local_symbol)))]) - (with_symbols [g!_] - (let [global (` ("js constant" (~ (code.text head))))] - (case tail - {.#End} - (in (list (` (: (.Maybe (~ type)) - (case (..type_of (~ global)) - "undefined" - {.#None} - - (~ g!_) - {.#Some (:as (~ type) (~ global))}))))) - - {.#Item [next tail]} - (let [separator "."] - (in (list (` (: (.Maybe (~ type)) - (case (..type_of (~ global)) - "undefined" - {.#None} - - (~ g!_) - (..global (~ type) [(~ (code.local_symbol (%.format head "." next))) - (~+ (list#each code.local_symbol tail))]))))))))))) - - (template: (!defined? ) - [(.case (..global Any ) - {.#None} - .false - - {.#Some _} - .true)]) - - (template [ ] - [(def: .public - Bit - (!defined? ))] - - [on_browser? [window]] - [on_nashorn? [java lang Object]] - ) - - (def: .public on_node_js? - Bit - (|> (..global (Object Any) [process]) - (maybe#each (|>> [] - ("js apply" ("js constant" "Object.prototype.toString.call")) - (:as Text) - (text#= "[object process]"))) - (maybe.else false))) - )] + (for @.js (as_is (template: .public (type_of object) + [("js type-of" object)]) + + (syntax: .public (global [type .any + [head tail] (.tuple (<>.and .local_symbol (<>.some .local_symbol)))]) + (with_symbols [g!_] + (let [global (` ("js constant" (~ (code.text head))))] + (case tail + {.#End} + (in (list (` (: (.Maybe (~ type)) + (case (..type_of (~ global)) + "undefined" + {.#None} + + (~ g!_) + {.#Some (:as (~ type) (~ global))}))))) + + {.#Item [next tail]} + (let [separator "."] + (in (list (` (: (.Maybe (~ type)) + (case (..type_of (~ global)) + "undefined" + {.#None} + + (~ g!_) + (..global (~ type) [(~ (code.local_symbol (%.format head "." next))) + (~+ (list#each code.local_symbol tail))]))))))))))) + + (template: (!defined? ) + [(.case (..global Any ) + {.#None} + .false + + {.#Some _} + .true)]) + + (template [ ] + [(def: .public + Bit + (!defined? ))] + + [on_browser? [window]] + [on_nashorn? [java lang Object]] + ) + + (def: .public on_node_js? + Bit + (|> (..global (Object Any) [process]) + (maybe#each (|>> [] + ("js apply" ("js constant" "Object.prototype.toString.call")) + (:as Text) + (text#= "[object process]"))) + (maybe.else false))) + ) (as_is)) ) diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index ec1e0c5d9..f9df0dd73 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -18,287 +18,287 @@ [tau +6.28318530717958647692] ) -(for [@.old - (as_is (template [ ] - [(def: .public ( it) - (-> Frac Frac) - ( it))] - - [cos "jvm invokestatic:java.lang.Math:cos:double"] - [sin "jvm invokestatic:java.lang.Math:sin:double"] - [tan "jvm invokestatic:java.lang.Math:tan:double"] - - [acos "jvm invokestatic:java.lang.Math:acos:double"] - [asin "jvm invokestatic:java.lang.Math:asin:double"] - [atan "jvm invokestatic:java.lang.Math:atan:double"] - - [exp "jvm invokestatic:java.lang.Math:exp:double"] - [log "jvm invokestatic:java.lang.Math:log:double"] - - [ceil "jvm invokestatic:java.lang.Math:ceil:double"] - [floor "jvm invokestatic:java.lang.Math:floor:double"] - - [root/2 "jvm invokestatic:java.lang.Math:sqrt:double"] - [root/3 "jvm invokestatic:java.lang.Math:cbrt:double"] - ) - (def: .public (pow param subject) - (-> Frac Frac Frac) - ("jvm invokestatic:java.lang.Math:pow:double,double" subject param))) - - @.jvm - (as_is (template: (!double value) - [(|> value - (:as (Primitive "java.lang.Double")) - "jvm object cast")]) - - (template: (!frac value) - [(|> value - "jvm object cast" - (: (Primitive "java.lang.Double")) - (:as Frac))]) - - (template [ ] - [(def: .public - (-> Frac Frac) - (|>> !double - ["D"] - ("jvm member invoke static" [] "java.lang.Math" []) - !frac))] - - [cos "cos"] - [sin "sin"] - [tan "tan"] - - [acos "acos"] - [asin "asin"] - [atan "atan"] - - [exp "exp"] - [log "log"] - - [ceil "ceil"] - [floor "floor"] - - [root/2 "sqrt"] - [root/3 "cbrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (|> ("jvm member invoke static" [] "java.lang.Math" "pow" [] - ["D" (!double subject)] ["D" (!double param)]) - !frac))) - - @.js - (as_is (template [ ] - [(def: .public - (-> Frac Frac) - (|>> [] - ("js apply" ("js constant" )) - (:as Frac)))] - - [cos "Math.cos"] - [sin "Math.sin"] - [tan "Math.tan"] - - [acos "Math.acos"] - [asin "Math.asin"] - [atan "Math.atan"] - - [exp "Math.exp"] - [log "Math.log"] - - [ceil "Math.ceil"] - [floor "Math.floor"] - - [root/2 "Math.sqrt"] - [root/3 "Math.cbrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("js apply" ("js constant" "Math.pow") [subject param])))) - - @.python - (as_is (template [ ] - [(def: .public - (-> Frac Frac) - (|>> [] - ("python object do" ("python import" "math")) - (:as Frac)))] - - [cos "cos"] - [sin "sin"] - [tan "tan"] - - [acos "acos"] - [asin "asin"] - [atan "atan"] - - [exp "exp"] - [log "log"] - - [ceil "ceil"] - [floor "floor"] - - [root/2 "sqrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("python object do" "pow" ("python import" "math") [subject param]))) - - (def: .public (root/3 it) - (-> Frac Frac) - (if ("lux f64 <" +0.0 it) - (|> it - ("lux f64 *" -1.0) - (..pow ("lux f64 /" +3.0 +1.0)) - ("lux f64 *" -1.0)) - (|> it - (..pow ("lux f64 /" +3.0 +1.0)))))) - - @.lua - (as_is (template [ ] - [(def: .public - (-> Frac Frac) - (|>> [] - ("lua apply" ("lua constant" )) - (:as Frac)))] - - [cos "math.cos"] - [sin "math.sin"] - [tan "math.tan"] - - [acos "math.acos"] - [asin "math.asin"] - [atan "math.atan"] - - [exp "math.exp"] - [log "math.log"] - - [ceil "math.ceil"] - [floor "math.floor"] - - [root/2 "math.sqrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - ("lua power" param subject)) - - (def: .public (root/3 it) - (-> Frac Frac) - (if ("lux f64 <" +0.0 it) - (|> it - ("lux f64 *" -1.0) - (..pow ("lux f64 /" +3.0 +1.0)) - ("lux f64 *" -1.0)) - (|> it - (..pow ("lux f64 /" +3.0 +1.0)))))) - - @.ruby - (as_is (template [ ] - [(def: .public - (-> Frac Frac) - (|>> [] - ("ruby apply" ("ruby constant" )) - (:as Frac)))] - - [cos "Math.cos"] - [sin "Math.sin"] - [tan "Math.tan"] - - [acos "Math.acos"] - [asin "Math.asin"] - [atan "Math.atan"] - - [exp "Math.exp"] - [log "Math.log"] - - [root/2 "Math.sqrt"] - [root/3 "Math.cbrt"] - ) - - (template [ ] - [(def: .public ( it) - (-> Frac Frac) - (|> ("ruby object do" it []) - (:as Int) - ("lux i64 f64")))] - - [ceil "ceil"] - [floor "floor"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("ruby object do" "**" subject [param])))) - - @.php - (as_is (template [ ] - [(def: .public - (-> Frac Frac) - (|>> ("php apply" ("php constant" )) - (:as Frac)))] - - [cos "cos"] - [sin "sin"] - [tan "tan"] - - [acos "acos"] - [asin "asin"] - [atan "atan"] - - [exp "exp"] - [log "log"] - - [ceil "ceil"] - [floor "floor"] - - [root/2 "sqrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("php apply" ("php constant" "pow") subject param))) - - (def: .public root/3 - (-> Frac Frac) - (..pow ("lux f64 /" +3.0 +1.0)))) - - @.scheme - (as_is (template [ ] - [(def: .public - (-> Frac Frac) - (|>> ("scheme apply" ("scheme constant" )) - (:as Frac)))] - - [cos "cos"] - [sin "sin"] - [tan "tan"] - - [acos "acos"] - [asin "asin"] - [atan "atan"] - - [exp "exp"] - [log "log"] - - [ceil "ceiling"] - [floor "floor"] - - [root/2 "sqrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("scheme apply" ("scheme constant" "expt") subject param))) - - (def: .public root/3 - (-> Frac Frac) - (..pow ("lux f64 /" +3.0 +1.0)))) - ]) +(for @.old + (as_is (template [ ] + [(def: .public ( it) + (-> Frac Frac) + ( it))] + + [cos "jvm invokestatic:java.lang.Math:cos:double"] + [sin "jvm invokestatic:java.lang.Math:sin:double"] + [tan "jvm invokestatic:java.lang.Math:tan:double"] + + [acos "jvm invokestatic:java.lang.Math:acos:double"] + [asin "jvm invokestatic:java.lang.Math:asin:double"] + [atan "jvm invokestatic:java.lang.Math:atan:double"] + + [exp "jvm invokestatic:java.lang.Math:exp:double"] + [log "jvm invokestatic:java.lang.Math:log:double"] + + [ceil "jvm invokestatic:java.lang.Math:ceil:double"] + [floor "jvm invokestatic:java.lang.Math:floor:double"] + + [root/2 "jvm invokestatic:java.lang.Math:sqrt:double"] + [root/3 "jvm invokestatic:java.lang.Math:cbrt:double"] + ) + (def: .public (pow param subject) + (-> Frac Frac Frac) + ("jvm invokestatic:java.lang.Math:pow:double,double" subject param))) + + @.jvm + (as_is (template: (!double value) + [(|> value + (:as (Primitive "java.lang.Double")) + "jvm object cast")]) + + (template: (!frac value) + [(|> value + "jvm object cast" + (: (Primitive "java.lang.Double")) + (:as Frac))]) + + (template [ ] + [(def: .public + (-> Frac Frac) + (|>> !double + ["D"] + ("jvm member invoke static" [] "java.lang.Math" []) + !frac))] + + [cos "cos"] + [sin "sin"] + [tan "tan"] + + [acos "acos"] + [asin "asin"] + [atan "atan"] + + [exp "exp"] + [log "log"] + + [ceil "ceil"] + [floor "floor"] + + [root/2 "sqrt"] + [root/3 "cbrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (|> ("jvm member invoke static" [] "java.lang.Math" "pow" [] + ["D" (!double subject)] ["D" (!double param)]) + !frac))) + + @.js + (as_is (template [ ] + [(def: .public + (-> Frac Frac) + (|>> [] + ("js apply" ("js constant" )) + (:as Frac)))] + + [cos "Math.cos"] + [sin "Math.sin"] + [tan "Math.tan"] + + [acos "Math.acos"] + [asin "Math.asin"] + [atan "Math.atan"] + + [exp "Math.exp"] + [log "Math.log"] + + [ceil "Math.ceil"] + [floor "Math.floor"] + + [root/2 "Math.sqrt"] + [root/3 "Math.cbrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("js apply" ("js constant" "Math.pow") [subject param])))) + + @.python + (as_is (template [ ] + [(def: .public + (-> Frac Frac) + (|>> [] + ("python object do" ("python import" "math")) + (:as Frac)))] + + [cos "cos"] + [sin "sin"] + [tan "tan"] + + [acos "acos"] + [asin "asin"] + [atan "atan"] + + [exp "exp"] + [log "log"] + + [ceil "ceil"] + [floor "floor"] + + [root/2 "sqrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("python object do" "pow" ("python import" "math") [subject param]))) + + (def: .public (root/3 it) + (-> Frac Frac) + (if ("lux f64 <" +0.0 it) + (|> it + ("lux f64 *" -1.0) + (..pow ("lux f64 /" +3.0 +1.0)) + ("lux f64 *" -1.0)) + (|> it + (..pow ("lux f64 /" +3.0 +1.0)))))) + + @.lua + (as_is (template [ ] + [(def: .public + (-> Frac Frac) + (|>> [] + ("lua apply" ("lua constant" )) + (:as Frac)))] + + [cos "math.cos"] + [sin "math.sin"] + [tan "math.tan"] + + [acos "math.acos"] + [asin "math.asin"] + [atan "math.atan"] + + [exp "math.exp"] + [log "math.log"] + + [ceil "math.ceil"] + [floor "math.floor"] + + [root/2 "math.sqrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + ("lua power" param subject)) + + (def: .public (root/3 it) + (-> Frac Frac) + (if ("lux f64 <" +0.0 it) + (|> it + ("lux f64 *" -1.0) + (..pow ("lux f64 /" +3.0 +1.0)) + ("lux f64 *" -1.0)) + (|> it + (..pow ("lux f64 /" +3.0 +1.0)))))) + + @.ruby + (as_is (template [ ] + [(def: .public + (-> Frac Frac) + (|>> [] + ("ruby apply" ("ruby constant" )) + (:as Frac)))] + + [cos "Math.cos"] + [sin "Math.sin"] + [tan "Math.tan"] + + [acos "Math.acos"] + [asin "Math.asin"] + [atan "Math.atan"] + + [exp "Math.exp"] + [log "Math.log"] + + [root/2 "Math.sqrt"] + [root/3 "Math.cbrt"] + ) + + (template [ ] + [(def: .public ( it) + (-> Frac Frac) + (|> ("ruby object do" it []) + (:as Int) + ("lux i64 f64")))] + + [ceil "ceil"] + [floor "floor"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("ruby object do" "**" subject [param])))) + + @.php + (as_is (template [ ] + [(def: .public + (-> Frac Frac) + (|>> ("php apply" ("php constant" )) + (:as Frac)))] + + [cos "cos"] + [sin "sin"] + [tan "tan"] + + [acos "acos"] + [asin "asin"] + [atan "atan"] + + [exp "exp"] + [log "log"] + + [ceil "ceil"] + [floor "floor"] + + [root/2 "sqrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("php apply" ("php constant" "pow") subject param))) + + (def: .public root/3 + (-> Frac Frac) + (..pow ("lux f64 /" +3.0 +1.0)))) + + @.scheme + (as_is (template [ ] + [(def: .public + (-> Frac Frac) + (|>> ("scheme apply" ("scheme constant" )) + (:as Frac)))] + + [cos "cos"] + [sin "sin"] + [tan "tan"] + + [acos "acos"] + [asin "asin"] + [atan "atan"] + + [exp "exp"] + [log "log"] + + [ceil "ceiling"] + [floor "floor"] + + [root/2 "sqrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("scheme apply" ("scheme constant" "expt") subject param))) + + (def: .public root/3 + (-> Frac Frac) + (..pow ("lux f64 /" +3.0 +1.0)))) + ) (def: .public (round it) (-> Frac Frac) diff --git a/stdlib/source/library/lux/meta/configuration.lux b/stdlib/source/library/lux/meta/configuration.lux index 057466051..372189c39 100644 --- a/stdlib/source/library/lux/meta/configuration.lux +++ b/stdlib/source/library/lux/meta/configuration.lux @@ -86,7 +86,7 @@ (maybe.else false)) (subsumes? expected tail)))) -(syntax: .public (for [specializations (.tuple (<>.some (<>.and ..configuration .any))) +(syntax: .public (for [specializations (<>.some (<>.and ..configuration .any)) default (<>.maybe .any)]) (do meta.monad [actual meta.configuration] diff --git a/stdlib/source/library/lux/meta/version.lux b/stdlib/source/library/lux/meta/version.lux index 66bf8e6f5..4a8800ff4 100644 --- a/stdlib/source/library/lux/meta/version.lux +++ b/stdlib/source/library/lux/meta/version.lux @@ -30,7 +30,7 @@ (exception: .public invalid) -(syntax: .public (for [specializations (.tuple (<>.some (<>.and .text .any))) +(syntax: .public (for [specializations (<>.some (<>.and .text .any)) default (<>.maybe .any)]) (do meta.monad [current meta.version] diff --git a/stdlib/source/library/lux/program.lux b/stdlib/source/library/lux/program.lux index 469aa68e6..253bf9b54 100644 --- a/stdlib/source/library/lux/program.lux +++ b/stdlib/source/library/lux/program.lux @@ -28,10 +28,10 @@ (syntax: .public (program: [args ..arguments^ body .any]) (with_symbols [g!program g!args g!_ g!output g!message] - (let [initialization+event_loop (for [@.old body - @.jvm body - @.js body - @.python body] + (let [initialization+event_loop (for @.old body + @.jvm body + @.js body + @.python body (` ((~! do) (~! io.monad) [(~ g!output) (~ body) (~ g!_) (~! thread.run!)] diff --git a/stdlib/source/library/lux/target/jvm/constant.lux b/stdlib/source/library/lux/target/jvm/constant.lux index 8f6358470..2dddcee7b 100644 --- a/stdlib/source/library/lux/target/jvm/constant.lux +++ b/stdlib/source/library/lux/target/jvm/constant.lux @@ -1,36 +1,36 @@ (.using - [library - [lux "*" - ["@" target] - ["[0]" ffi {"+" import:}] - [abstract - [monad {"+" do}] - ["[0]" equivalence {"+" Equivalence}]] - [data - ["[0]" sum] - ["[0]" product] - ["[0]" text] - [format - ["[0]F" binary {"+" Writer} ("[1]#[0]" monoid)]]] - [macro - ["[0]" template]] - [math - [number - ["[0]" i32 {"+" I32}] - ["[0]" i64] - ["[0]" int] - ["[0]" frac]]] - [type - abstract]]] - ["[0]" / "_" - ["[1][0]" tag] - ["/[1]" // "_" - ["[1][0]" index {"+" Index}] - [type - ["[1][0]" category] - ["[1][0]" descriptor {"+" Descriptor}]] - [encoding - ["[1][0]" unsigned]]]]) + [library + [lux "*" + ["@" target] + ["[0]" ffi {"+" import:}] + [abstract + [monad {"+" do}] + ["[0]" equivalence {"+" Equivalence}]] + [data + ["[0]" sum] + ["[0]" product] + ["[0]" text] + [format + ["[0]F" binary {"+" Writer} ("[1]#[0]" monoid)]]] + [macro + ["[0]" template]] + [math + [number + ["[0]" i32 {"+" I32}] + ["[0]" i64] + ["[0]" int] + ["[0]" frac]]] + [type + abstract]]] + ["[0]" / "_" + ["[1][0]" tag] + ["/[1]" // "_" + ["[1][0]" index {"+" Index}] + [type + ["[1][0]" category] + ["[1][0]" descriptor {"+" Descriptor}]] + [encoding + ["[1][0]" unsigned]]]]) (type: .public UTF8 Text) @@ -69,13 +69,13 @@ (Equivalence java/lang/Float) (def: (= parameter subject) - (for [@.old - ("jvm feq" parameter subject) - - @.jvm - ("jvm float =" - ("jvm object cast" parameter) - ("jvm object cast" subject))]))) + (for @.old + ("jvm feq" parameter subject) + + @.jvm + ("jvm float =" + ("jvm object cast" parameter) + ("jvm object cast" subject))))) (import: java/lang/Double ["[1]::[0]" diff --git a/stdlib/source/library/lux/target/jvm/loader.lux b/stdlib/source/library/lux/target/jvm/loader.lux index 26e67f2e9..ce31e2e12 100644 --- a/stdlib/source/library/lux/target/jvm/loader.lux +++ b/stdlib/source/library/lux/target/jvm/loader.lux @@ -102,11 +102,11 @@ (def: .public (memory library) (-> Library java/lang/ClassLoader) - (with_expansions [ (for [@.old - (<|) - - @.jvm - "jvm object cast"])] + (with_expansions [ (for @.old + (<|) + + @.jvm + "jvm object cast")] (<| (object [] java/lang/ClassLoader [] [] diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index 237baadd7..2e991c91f 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -34,10 +34,10 @@ (-> Text Text) (text.enclosed ["(" ")"])) -(for [@.old (as_is (ffi.import: java/lang/CharSequence) - (ffi.import: java/lang/String - ["[1]::[0]" - (replace [java/lang/CharSequence java/lang/CharSequence] java/lang/String)]))] +(for @.old (as_is (ffi.import: java/lang/CharSequence) + (ffi.import: java/lang/String + ["[1]::[0]" + (replace [java/lang/CharSequence java/lang/CharSequence] java/lang/String)])) (as_is)) ... Added the carriage return for better Windows compatibility. @@ -48,10 +48,10 @@ (def: nested (-> Text Text) (.let [nested_new_line (format text.new_line text.tab)] - (for [@.old (|>> (format \n+) - (:as java/lang/String) - (java/lang/String::replace (:as java/lang/CharSequence text.new_line) - (:as java/lang/CharSequence nested_new_line)))] + (for @.old (|>> (format \n+) + (:as java/lang/String) + (java/lang/String::replace (:as java/lang/CharSequence text.new_line) + (:as java/lang/CharSequence nested_new_line))) (|>> (format \n+) (text.replaced text.new_line nested_new_line))))) diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux index ad817a70b..2ace74aa6 100644 --- a/stdlib/source/library/lux/test.lux +++ b/stdlib/source/library/lux/test.lux @@ -252,12 +252,12 @@ (..description duration tally) text.new_line)] _ (with_expansions [ (in (debug.log! report))] - (.for [@.js (case console.default - {.#None} - + (.for @.js (case console.default + {.#None} + - {.#Some console} - (console.write_line report console))] + {.#Some console} + (console.write_line report console)) ))] (async.future (# program.default exit (case (the #failures tally) diff --git a/stdlib/source/library/lux/time/instant.lux b/stdlib/source/library/lux/time/instant.lux index d435afeb3..c83d994e4 100644 --- a/stdlib/source/library/lux/time/instant.lux +++ b/stdlib/source/library/lux/time/instant.lux @@ -150,43 +150,43 @@ (def: .public now (IO Instant) - (io (..of_millis (for [@.old ("jvm invokestatic:java.lang.System:currentTimeMillis:") - @.jvm (|> ("jvm member invoke static" [] "java.lang.System" "currentTimeMillis" []) - ("jvm object cast") - (: (Primitive "java.lang.Long")) - (:as Int)) - @.js (let [date ("js object new" ("js constant" "Date") [])] - (|> ("js object do" "getTime" date []) - (:as Frac) - "lux f64 i64")) - @.python (let [time ("python import" "time")] - (|> ("python object do" "time" time []) - (:as Frac) - (f.* +1,000.0) - "lux f64 i64")) - @.lua (|> ("lua apply" ("lua constant" "os.time") []) - (:as Int) - (i.* +1,000)) - @.ruby (let [% ("ruby constant" "Time") - % ("ruby object do" "now" % [])] - (|> ("ruby object do" "to_f" % []) - (:as Frac) - (f.* +1,000.0) - "lux f64 i64")) - @.php (|> ("php constant" "time") - "php apply" - (:as Int) - (i.* +1,000)) - @.scheme (|> ("scheme constant" "current-second") - (:as Int) - (i.* +1,000) - ("scheme apply" ("scheme constant" "exact")) - ("scheme apply" ("scheme constant" "truncate"))) - @.common_lisp (|> ("common_lisp constant" "get-universal-time") - "common_lisp apply" - (:as Int) - (i.* +1,000)) - ])))) + (io (..of_millis (for @.old ("jvm invokestatic:java.lang.System:currentTimeMillis:") + @.jvm (|> ("jvm member invoke static" [] "java.lang.System" "currentTimeMillis" []) + ("jvm object cast") + (: (Primitive "java.lang.Long")) + (:as Int)) + @.js (let [date ("js object new" ("js constant" "Date") [])] + (|> ("js object do" "getTime" date []) + (:as Frac) + "lux f64 i64")) + @.python (let [time ("python import" "time")] + (|> ("python object do" "time" time []) + (:as Frac) + (f.* +1,000.0) + "lux f64 i64")) + @.lua (|> ("lua apply" ("lua constant" "os.time") []) + (:as Int) + (i.* +1,000)) + @.ruby (let [% ("ruby constant" "Time") + % ("ruby object do" "now" % [])] + (|> ("ruby object do" "to_f" % []) + (:as Frac) + (f.* +1,000.0) + "lux f64 i64")) + @.php (|> ("php constant" "time") + "php apply" + (:as Int) + (i.* +1,000)) + @.scheme (|> ("scheme constant" "current-second") + (:as Int) + (i.* +1,000) + ("scheme apply" ("scheme constant" "exact")) + ("scheme apply" ("scheme constant" "truncate"))) + @.common_lisp (|> ("common_lisp constant" "get-universal-time") + "common_lisp apply" + (:as Int) + (i.* +1,000)) + )))) (template [ ] [(def: .public ( instant) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index 1bccf29e7..6f4cd29e2 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -119,12 +119,12 @@ (do [! ..monad] [_ (: (Async (Try Any)) (cache/module.enable! async.monad system context @module)) - _ (for [@.python (|> entry - (the archive.#output) - sequence.list - (list.sub 128) - (monad.each ! (monad.each ! write_artifact!)) - (: (Action (List (List Any)))))] + _ (for @.python (|> entry + (the archive.#output) + sequence.list + (list.sub 128) + (monad.each ! (monad.each ! write_artifact!)) + (: (Action (List (List Any))))) (|> entry (the archive.#output) sequence.list @@ -776,12 +776,12 @@ (do ! [_ (let [report (..module_compilation_log module state)] (with_expansions [ (in (debug.log! report))] - (for [@.js (case console.default - {.#None} - - - {.#Some console} - (console.write_line report console))] + (for @.js (case console.default + {.#None} + + + {.#Some console} + (console.write_line report console)) ))) .let [entry (has [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)] _ (..cache_module context platform @module $.key $.writer (:as (archive.Entry .Module) entry))] @@ -795,17 +795,17 @@ [_ (cache/archive.cache! (the #&file_system platform) context archive)] (async#in {try.#Failure error}))))))) - (for [@.old (as_is (def: Fake_State - Type - {.#Primitive (%.nat (static.random_nat)) (list)}) + (for @.old (as_is (def: Fake_State + Type + {.#Primitive (%.nat (static.random_nat)) (list)}) - (def: Fake_Document - Type - {.#Primitive (%.nat (static.random_nat)) (list)}) + (def: Fake_Document + Type + {.#Primitive (%.nat (static.random_nat)) (list)}) - (def: Fake_Object - Type - {.#Primitive (%.nat (static.random_nat)) (list)}))] + (def: Fake_Object + Type + {.#Primitive (%.nat (static.random_nat)) (list)})) (as_is)) (def: (serial_compiler import context platform compilation_sources compiler) @@ -820,8 +820,8 @@ compilation_sources (the context.#host_module_extension context) module)] - (loop [customs (for [@.old (:as (List (///.Custom Fake_State Fake_Document Fake_Object)) - all_customs)] + (loop [customs (for @.old (:as (List (///.Custom Fake_State Fake_Document Fake_Object)) + all_customs) all_customs)] (case customs {.#End} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux index 9cb9fcf96..888c39155 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux @@ -202,7 +202,7 @@ [.let [inputT (type.tuple (list.repeated arity Any))] abstractionA (analysis/type.expecting (-> inputT Any) (phase archive abstractionC)) - _ (analysis/type.inference (for [@.js ffi.Function] + _ (analysis/type.inference (for @.js ffi.Function Any))] (in {analysis.#Extension extension (list (analysis.nat arity) abstractionA)})))])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux index e65c2db5e..ca7dfe9bb 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux @@ -27,15 +27,15 @@ ["[0]" phase]]]]]) (def: Nil - (for [@.lua ffi.Nil] + (for @.lua ffi.Nil Any)) (def: Object - (for [@.lua (type (ffi.Object Any))] + (for @.lua (type (ffi.Object Any)) Any)) (def: Function - (for [@.lua ffi.Function] + (for @.lua ffi.Function Any)) (def: array::new diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux index 7312fb9de..a90a68096 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux @@ -113,15 +113,15 @@ ))) (def: Null - (for [@.php ffi.Null] + (for @.php ffi.Null Any)) (def: Object - (for [@.php (type (ffi.Object Any))] + (for @.php (type (ffi.Object Any)) Any)) (def: Function - (for [@.php ffi.Function] + (for @.php ffi.Function Any)) (def: object::new diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux index 86affb036..f07d818d5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux @@ -111,23 +111,19 @@ ))) (def: None - (for [@.python - ffi.None] + (for @.python ffi.None Any)) (def: Object - (for [@.python - (type (ffi.Object Any))] + (for @.python (type (ffi.Object Any)) Any)) (def: Function - (for [@.python - ffi.Function] + (for @.python ffi.Function Any)) (def: Dict - (for [@.python - ffi.Dict] + (for @.python ffi.Dict Any)) (def: object::get diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux index 91259acc3..32c57de4e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux @@ -111,15 +111,15 @@ ))) (def: Nil - (for [@.ruby ffi.Nil] + (for @.ruby ffi.Nil Any)) (def: Object - (for [@.ruby (type (ffi.Object Any))] + (for @.ruby (type (ffi.Object Any)) Any)) (def: Function - (for [@.ruby ffi.Function] + (for @.ruby ffi.Function Any)) (def: object::get diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux index 659191e2f..488b39e2c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux @@ -113,12 +113,11 @@ ))) (def: Nil - (for [@.scheme - ffi.Nil] + (for @.scheme ffi.Nil Any)) (def: Function - (for [@.scheme ffi.Function] + (for @.scheme ffi.Function Any)) (def: bundle::object diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux index 15bc133a7..40b036496 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux @@ -206,7 +206,7 @@ (/.install "index" (trinary ..text//index)) (/.install "size" (unary //runtime.text//size)) ... TODO: Use version below once the Lua compiler becomes self-hosted. - ... (/.install "size" (unary (for [@.lua (!unary "utf8.len")] + ... (/.install "size" (unary (for @.lua (!unary "utf8.len") ... (!unary "string.len")))) (/.install "char" (binary ..text//char)) (/.install "clip" (trinary ..text//clip)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index 794bc1fd7..6cf9f2ff0 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -344,7 +344,7 @@ (..char_index subject) ..lux_index)))))] (with_vars [byte_index] - (for [@.lua ] + (for @.lua (_.if ..on_rembulan? ))))) @@ -359,7 +359,7 @@ (..byte_index text) (_.- (_.int +1)))) (_.var "string.sub")))] - (for [@.lua ] + (for @.lua (_.if ..on_rembulan? )))) @@ -367,7 +367,7 @@ (runtime: (text//size subject) (with_expansions [ (_.return (_.apply (list subject) (_.var "string.len"))) (_.return (_.apply (list subject) (_.var "utf8.len")))] - (for [@.lua ] + (for @.lua (_.if ..on_rembulan? )))) @@ -386,7 +386,7 @@ (_.if (_.= _.nil offset) (_.statement (_.error/1 (_.string "[Lux Error] Cannot get char from text."))) (_.return (_.apply (list text offset) (_.var "utf8.codepoint"))))))] - (for [@.lua ] + (for @.lua (_.if ..on_rembulan? )))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index 4e293bb74..13b55ccbd 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -292,7 +292,7 @@ [(_.> ..i64::+limit) ..i64::+iteration ..i64::+cap ..i64::-limit] [(_.< ..i64::-limit) ..i64::-iteration ..i64::-cap ..i64::+limit] )) - (_.return (for [@.python input] + (_.return (for @.python input ... This +- is only necessary to guarantee that values within the limits are always longs in Python 2 (|> input (_.+ ..i64::+limit) (_.- ..i64::+limit)))))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux index 2ef214588..50fae65d9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux @@ -20,23 +20,30 @@ ... This universe constant is for languages where one can't just turn all compiled definitions ... into the local variables of some scoping function. (def: .public universe - (for [ ... In the case of Lua, there is a limit of 200 locals in a function's scope. - @.lua (not ("lua script universe")) - ... Cannot make all definitions be local variables because of limitations with JRuby. - @.ruby (not ("ruby script universe")) - ... Cannot make all definitions be local variables because of limitations with PHP itself. - @.php (not ("php script universe")) - ... Cannot make all definitions be local variables because of limitations with Kawa. - @.scheme (not ("scheme script universe"))] + (for @.lua + ... In the case of Lua, there is a limit of 200 locals in a function's scope. + (not ("lua script universe")) + + @.ruby + ... Cannot make all definitions be local variables because of limitations with JRuby. + (not ("ruby script universe")) + + @.php + ... Cannot make all definitions be local variables because of limitations with PHP itself. + (not ("php script universe")) + + @.scheme + ... Cannot make all definitions be local variables because of limitations with Kawa. + (not ("scheme script universe")) #0)) (def: universe_label Text (with_expansions [