diff options
Diffstat (limited to 'stdlib/source/library')
44 files changed, 2275 insertions, 2271 deletions
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> - @.jvm <jvm>] + (for @.old <jvm> + @.jvm <jvm> (as_is))) -(with_expansions [<new> (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 [<new> (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)) - <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"] + <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)) - <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"] + <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 [<jvm> (java/util/concurrent/atomic/AtomicReference a)] - (for [@.old <jvm> - @.jvm <jvm>] + (for @.old <jvm> + @.jvm <jvm> (array.Array a))) (def: .public (atom value) (All (_ a) (-> a (Atom a))) (:abstraction (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::new value)] - (for [@.old <jvm> - @.jvm <jvm>] + (for @.old <jvm> + @.jvm <jvm> (<write> 0 value (<new> 1)))))) (def: .public (read! atom) (All (_ a) (-> (Atom a) (IO a))) (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::get (:representation atom))] - (for [@.old <jvm> - @.jvm <jvm>] + (for @.old <jvm> + @.jvm <jvm> (io.io (<read> 0 (:representation atom)))))) (def: .public (compare_and_swap! current new atom) (All (_ a) (-> a a (Atom a) (IO Bit))) (io.io (with_expansions [<jvm> (ffi.of_boolean (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom)))] - (for [@.old <jvm> - @.jvm <jvm>] + (for @.old <jvm> + @.jvm <jvm> (let [old (<read> 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>) - @.jvm (as_is <jvm>) + (for @.old (as_is <jvm>) + @.jvm (as_is <jvm>) - @.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 [<default> 1 - <jvm> (<| (configuration.for [... TODO: Remove this when Rembulan is no longer being used. - ["lua_compiler?" ""] - <default>]) + <jvm> (<| (configuration.for ["lua_compiler?" ""] + ... TODO: Remove this when Rembulan is no longer being used. + <default>) (|> (java/lang/Runtime::getRuntime) (java/lang/Runtime::availableProcessors) ffi.of_int .nat))] - (for [@.old <jvm> - @.jvm <jvm>] + (for @.old <jvm> + @.jvm <jvm> ... Default <default>))) @@ -89,10 +89,10 @@ .int ffi.as_int java/util/concurrent/ScheduledThreadPoolExecutor::new)))] - (for [@.old <jvm> - @.jvm <jvm> - @.js (as_is) - @.python (as_is)] + (for @.old <jvm> + @.jvm <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> - @.jvm <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> + @.jvm <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 <side> family) {.#Item next side'} - {.#Some (for [@.old - [#family {.#Some (|> family - (has <side> side') - (revised <op_side> (|>> {.#Item (the #node zipper)})))} - #node next]] + {.#Some (for @.old + [#family {.#Some (|> family + (has <side> side') + (revised <op_side> (|>> {.#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> side') @@ -153,11 +153,11 @@ {.#None} {.#Item last prevs} - {.#Some (for [@.old [#family {.#Some (|> family - (has <side> {.#End}) - (revised <op_side> (|>> {.#Item (the #node zipper)} - (list#composite prevs))))} - #node last]] + {.#Some (for @.old [#family {.#Some (|> family + (has <side> {.#End}) + (revised <op_side> (|>> {.#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 <side> {.#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 + <default> (: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 - <default> - (: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 <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>) - @.jvm (as_is <jvm>) - @.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>) + @.jvm (as_is <jvm>) + @.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 [<jvm> [0 function.identity]] - (for [@.old <jvm> - @.jvm <jvm> - @.js [0 function.identity] - @.lua [0 function.identity]] + (for @.old <jvm> + @.jvm <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> - @.jvm <jvm> - @.js (let [[capacity transform] (:representation buffer) - then! (: (-> (JS_Array Text) (JS_Array Text)) + (for @.old <jvm> + @.jvm <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 [<jvm> (|>> :representation product.left)] - (for [@.old <jvm> - @.jvm <jvm> - @.js <jvm> - @.lua <jvm>] + (for @.old <jvm> + @.jvm <jvm> + @.js <jvm> + @.lua <jvm> ... default (|>> :representation (sequence#mix (function (_ chunk total) @@ -117,15 +117,15 @@ transform java/lang/StringBuilder::toString ffi.of_string))] - (for [@.old <jvm> - @.jvm <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> + @.jvm <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>) - @.jvm (as_is <jvm>) + (for @.old (as_is <jvm>) + @.jvm (as_is <jvm>) - @.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 [<jvm> {try.#Success (ffi.of_string (java/lang/String::new value (ffi.as_string (//.name //.utf_8))))}] - (for [@.old <jvm> - @.jvm <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> + @.jvm <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>) - @.jvm (as_is <jvm>) - - @.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>) + @.jvm (as_is <jvm>) + + @.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 [<adaption> (for [@.lua (~~ (as_is ..tuple_array))] + (with_expansions [<adaption> (for @.lua (~~ (as_is ..tuple_array)) (~~ (as_is)))] (`` (|>> (:as (array.Array Any)) <adaption> @@ -177,206 +177,206 @@ (tuple_inspection inspection value))) {.#None}) (ffi.of_string (java/lang/Object::toString object)))))] - (for [@.old <jvm> - @.jvm <jvm> - - @.js - (case (ffi.type_of value) - (^template [<type_of> <then>] - [<type_of> - (`` (|> value (~~ (template.spliced <then>))))]) - (["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 [<type_of> <class_of> <then>] - [(^or <type_of> <class_of>) - (`` (|> value (~~ (template.spliced <then>))))]) - (["<type 'bool'>" "<class 'bool'>" [(:as .Bit) %.bit]] - ["<type 'int'>" "<class 'int'>" [(:as .Int) %.int]] - ["<type 'float'>" "<class 'float'>" [(:as .Frac) %.frac]] - ["<type 'str'>" "<class 'str'>" [(:as .Text) %.text]] - ["<type 'unicode'>" "<class 'unicode'>" [(:as .Text) %.text]]) - - (^or "<type 'list'>" "<class 'list'>") - (tuple_inspection inspection value) - - (^or "<type 'tuple'>" "<class 'tuple'>") - (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 [<type_of> <then>] - [<type_of> - (`` (|> value (~~ (template.spliced <then>))))]) - (["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 <literal>) - [(|> <literal> - (:as ..Object) - Object::class)] - - (to_s <object>) - [(|> <object> - (:as ..Object) - Object::to_s)]] - (let [value_class (class_of value)] - (`` (cond (~~ (template [<literal> <type> <format>] - [(same? (class_of <literal>) value_class) - (|> value (:as <type>) <format>)] - - [#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 [<type_of> <then>] - [<type_of> - (`` (|> value (~~ (template.spliced <then>))))]) - (["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 [<when> <then>] - [(<when> value) - (`` (|> value (~~ (template.spliced <then>))))] - - [..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> + @.jvm <jvm> + + @.js + (case (ffi.type_of value) + (^template [<type_of> <then>] + [<type_of> + (`` (|> value (~~ (template.spliced <then>))))]) + (["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 [<type_of> <class_of> <then>] + [(^or <type_of> <class_of>) + (`` (|> value (~~ (template.spliced <then>))))]) + (["<type 'bool'>" "<class 'bool'>" [(:as .Bit) %.bit]] + ["<type 'int'>" "<class 'int'>" [(:as .Int) %.int]] + ["<type 'float'>" "<class 'float'>" [(:as .Frac) %.frac]] + ["<type 'str'>" "<class 'str'>" [(:as .Text) %.text]] + ["<type 'unicode'>" "<class 'unicode'>" [(:as .Text) %.text]]) + + (^or "<type 'list'>" "<class 'list'>") + (tuple_inspection inspection value) + + (^or "<type 'tuple'>" "<class 'tuple'>") + (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 [<type_of> <then>] + [<type_of> + (`` (|> value (~~ (template.spliced <then>))))]) + (["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 <literal>) + [(|> <literal> + (:as ..Object) + Object::class)] + + (to_s <object>) + [(|> <object> + (:as ..Object) + Object::to_s)]] + (let [value_class (class_of value)] + (`` (cond (~~ (template [<literal> <type> <format>] + [(same? (class_of <literal>) value_class) + (|> value (:as <type>) <format>)] + + [#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 [<type_of> <then>] + [<type_of> + (`` (|> value (~~ (template.spliced <then>))))]) + (["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 [<when> <then>] + [(<when> value) + (`` (|> value (~~ (template.spliced <then>))))] + + [..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 [<constant> (for [@.js "js constant" - @.python "python constant" - @.lua "lua constant" - @.ruby "ruby constant"]) - <apply> (for [@.js "js apply" - @.python "python apply" - @.lua "lua apply" - @.ruby "ruby apply"]) - <new> (for [@.js "js object new" - @.python "python apply"] +(with_expansions [<constant> (for @.js "js constant" + @.python "python constant" + @.lua "lua constant" + @.ruby "ruby constant") + <apply> (for @.js "js apply" + @.python "python apply" + @.lua "lua apply" + @.ruby "ruby apply") + <new> (for @.js "js object new" + @.python "python apply" (as_is)) - <do> (for [@.js "js object do" - @.python "python object do" - @.lua "lua object do" - @.ruby "ruby object do"]) - <get> (for [@.js "js object get" - @.python "python object get" - @.lua "lua object get" - @.ruby "ruby object get"] + <do> (for @.js "js object do" + @.python "python object do" + @.lua "lua object do" + @.ruby "ruby object do") + <get> (for @.js "js object get" + @.python "python object get" + @.lua "lua object get" + @.ruby "ruby object get" (as_is)) - <import> (for [@.python "python import" - @.lua "lua import" - @.ruby "ruby import"] + <import> (for @.python "python import" + @.lua "lua import" + @.ruby "ruby import" (as_is)) - <function> (for [@.js "js function" - @.python "python function" - @.lua "lua function"] + <function> (for @.js "js function" + @.python "python function" + @.lua "lua function" (as_is))] (abstract: .public (Object brand) Any) - (with_expansions [<un_common> (for [@.js (as_is [Symbol] - [Null] - [Undefined]) - @.python (as_is [None] - [Dict]) - @.lua (as_is [Nil] - [Table]) - @.ruby (as_is [Nil])]) + (with_expansions [<un_common> (for @.js (as_is [Symbol] + [Null] + [Undefined]) + @.python (as_is [None] + [Dict]) + @.lua (as_is [Nil] + [Table]) + @.ruby (as_is [Nil])) <un_common> <un_common>] (template [<name>] [(with_expansions [<brand> (template.symbol [<name> "'"])] @@ -74,13 +74,13 @@ <un_common> )) - (with_expansions [<un_common> (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 [<un_common> (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])) <un_common> <un_common>] (template [<name> <type>] [(type: .public <name> @@ -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:) (` (<constant> (~ (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:) - (` (<new> (~ (for [@.js (` (<constant> (~ (code.text (..host_path class_name))))) - @.python (` (.:as ..Function - (~ (..imported class_name))))])) + (` (<new> (~ (for @.js (` (<constant> (~ (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 (` (<constant> (~ (code.text (%.format (..host_path class_name) "." field))))) - @.ruby (` (<constant> (~ (code.text (%.format (..host_path class_name) "::" field)))))] + (for @.js (` (<constant> (~ (code.text (%.format (..host_path class_name) "." field))))) + @.ruby (` (<constant> (~ (code.text (%.format (..host_path class_name) "::" field))))) (` (<get> (~ (code.text field)) (~ (..imported class_name)))))))))))))))) @@ -516,8 +516,8 @@ (|> it (has #alias {.#Some name}) (..procedure_definition import! - (for [@.js (` (<constant> (~ (code.text (%.format (..host_path class_name) "." method))))) - @.ruby (` (<constant> (~ (code.text (%.format (..host_path class_name) "::" method)))))] + (for @.js (` (<constant> (~ (code.text (%.format (..host_path class_name) "." method))))) + @.ruby (` (<constant> (~ (code.text (%.format (..host_path class_name) "::" method))))) (` (<get> (~ (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] (<code>.form ($_ <>.and <code>.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 <code>.any - [head tail] (<code>.tuple (<>.and <code>.local_symbol (<>.some <code>.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? <global>) - [(.case (..global Any <global>) - {.#None} - .false - - {.#Some _} - .true)]) - - (template [<name> <global>] - [(def: .public <name> - Bit - (!defined? <global>))] - - [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 <code>.any + [head tail] (<code>.tuple (<>.and <code>.local_symbol (<>.some <code>.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? <global>) + [(.case (..global Any <global>) + {.#None} + .false + + {.#Some _} + .true)]) + + (template [<name> <global>] + [(def: .public <name> + Bit + (!defined? <global>))] + + [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 [<name> <method>] - [(def: .public (<name> it) - (-> Frac Frac) - (<method> 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 [<name> <method>] - [(def: .public <name> - (-> Frac Frac) - (|>> !double - ["D"] - ("jvm member invoke static" [] "java.lang.Math" <method> []) - !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 [<name> <method>] - [(def: .public <name> - (-> Frac Frac) - (|>> [] - ("js apply" ("js constant" <method>)) - (: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 [<name> <method>] - [(def: .public <name> - (-> Frac Frac) - (|>> [] - ("python object do" <method> ("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 [<name> <method>] - [(def: .public <name> - (-> Frac Frac) - (|>> [] - ("lua apply" ("lua constant" <method>)) - (: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 [<name> <method>] - [(def: .public <name> - (-> Frac Frac) - (|>> [] - ("ruby apply" ("ruby constant" <method>)) - (: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 [<name> <method>] - [(def: .public (<name> it) - (-> Frac Frac) - (|> ("ruby object do" <method> 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 [<name> <method>] - [(def: .public <name> - (-> Frac Frac) - (|>> ("php apply" ("php constant" <method>)) - (: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 [<name> <method>] - [(def: .public <name> - (-> Frac Frac) - (|>> ("scheme apply" ("scheme constant" <method>)) - (: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 [<name> <method>] + [(def: .public (<name> it) + (-> Frac Frac) + (<method> 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 [<name> <method>] + [(def: .public <name> + (-> Frac Frac) + (|>> !double + ["D"] + ("jvm member invoke static" [] "java.lang.Math" <method> []) + !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 [<name> <method>] + [(def: .public <name> + (-> Frac Frac) + (|>> [] + ("js apply" ("js constant" <method>)) + (: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 [<name> <method>] + [(def: .public <name> + (-> Frac Frac) + (|>> [] + ("python object do" <method> ("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 [<name> <method>] + [(def: .public <name> + (-> Frac Frac) + (|>> [] + ("lua apply" ("lua constant" <method>)) + (: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 [<name> <method>] + [(def: .public <name> + (-> Frac Frac) + (|>> [] + ("ruby apply" ("ruby constant" <method>)) + (: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 [<name> <method>] + [(def: .public (<name> it) + (-> Frac Frac) + (|> ("ruby object do" <method> 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 [<name> <method>] + [(def: .public <name> + (-> Frac Frac) + (|>> ("php apply" ("php constant" <method>)) + (: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 [<name> <method>] + [(def: .public <name> + (-> Frac Frac) + (|>> ("scheme apply" ("scheme constant" <method>)) + (: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 (<code>.tuple (<>.some (<>.and ..configuration <code>.any))) +(syntax: .public (for [specializations (<>.some (<>.and ..configuration <code>.any)) default (<>.maybe <code>.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 (<code>.tuple (<>.some (<>.and <code>.text <code>.any))) +(syntax: .public (for [specializations (<>.some (<>.and <code>.text <code>.any)) default (<>.maybe <code>.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 <code>.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 [<cast> (for [@.old - (<|) - - @.jvm - "jvm object cast"])] + (with_expansions [<cast> (for @.old + (<|) + + @.jvm + "jvm object cast")] (<| <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 [<else> (in (debug.log! report))] - (.for [@.js (case console.default - {.#None} - <else> + (.for @.js (case console.default + {.#None} + <else> - {.#Some console} - (console.write_line report console))] + {.#Some console} + (console.write_line report console)) <else>))] (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 [<field> <type> <post_processing>] [(def: .public (<field> 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 [<else> (in (debug.log! report))] - (for [@.js (case console.default - {.#None} - <else> - - {.#Some console} - (console.write_line report console))] + (for @.js (case console.default + {.#None} + <else> + + {.#Some console} + (console.write_line report console)) <else>))) .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 <normal>] + (for @.lua <normal> (_.if ..on_rembulan? <rembulan> <normal>))))) @@ -359,7 +359,7 @@ (..byte_index text) (_.- (_.int +1)))) (_.var "string.sub")))] - (for [@.lua <normal>] + (for @.lua <normal> (_.if ..on_rembulan? <rembulan> <normal>)))) @@ -367,7 +367,7 @@ (runtime: (text//size subject) (with_expansions [<rembulan> (_.return (_.apply (list subject) (_.var "string.len"))) <normal> (_.return (_.apply (list subject) (_.var "utf8.len")))] - (for [@.lua <normal>] + (for @.lua <normal> (_.if ..on_rembulan? <rembulan> <normal>)))) @@ -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 <normal>] + (for @.lua <normal> (_.if ..on_rembulan? <rembulan> <normal>)))) 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 [<label> (format "u" (%.nat (if ..universe 1 0)))] - (for [@.lua <label> - @.ruby <label> - @.php <label> - @.scheme <label>] + (for @.lua <label> + @.ruby <label> + @.php <label> + @.scheme <label> ""))) (def: .public (artifact [module artifact]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux index 0b1d000b4..971b9391f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux @@ -53,9 +53,9 @@ ["[0]" frac]]]]]) (template: (inline: <declaration> <type> <body>) - [(for [@.python (def: <declaration> <type> <body>) - ... TODO: No longer skip inlining Lua after Rembulan isn't being used anymore. - @.lua (def: <declaration> <type> <body>)] + [(for @.python (def: <declaration> <type> <body>) + ... TODO: No longer skip inlining Lua after Rembulan isn't being used anymore. + @.lua (def: <declaration> <type> <body>) (template: <declaration> [<body>]))]) ... TODO: Implement "lux syntax char case!" as a custom extension. diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux index 143b3bce9..e397214b4 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux @@ -97,5 +97,5 @@ (|> path (# fs read) (# ! each (|>> [name]))))))] - (in (dictionary.of_list text.hash (for [@.old (:as (List [Text Binary]) pairs)] + (in (dictionary.of_list text.hash (for @.old (:as (List [Text Binary]) pairs) pairs))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux index a807e083c..f4125ab61 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -267,8 +267,8 @@ (def: (cache_parser customs) (-> (List Custom) (Parser [(module.Module Any) Registry])) - (case (for [@.old (:as (List (Custom Any Any Any)) - customs)] + (case (for @.old (:as (List (Custom Any Any Any)) + customs) customs) {.#End} (..parser $.key $.parser) diff --git a/stdlib/source/library/lux/type.lux b/stdlib/source/library/lux/type.lux index cd1aaa867..e0b7a4f0e 100644 --- a/stdlib/source/library/lux/type.lux +++ b/stdlib/source/library/lux/type.lux @@ -179,8 +179,9 @@ (Equivalence Type) (def: (= x y) - (or (for [... TODO: Remove this once JPHP is gone. - @.php false] + (or (for @.php + ... TODO: Remove this once JPHP is gone. + false (same? x y)) (case [x y] [{.#Primitive xname xparams} {.#Primitive yname yparams}] diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux index e7ed19839..757eac347 100644 --- a/stdlib/source/library/lux/type/check.lux +++ b/stdlib/source/library/lux/type/check.lux @@ -637,8 +637,9 @@ ... Type-check to ensure that the 'expected' type subsumes the 'actual' type. (def: (check' assumptions expected actual) (Checker Type) - (if (for [... TODO: Remove this once JPHP is gone. - @.php false] + (if (for @.php + ... TODO: Remove this once JPHP is gone. + false (same? expected actual)) (check#in assumptions) (with_exception ..type_check_failed [expected actual] diff --git a/stdlib/source/library/lux/world/console.lux b/stdlib/source/library/lux/world/console.lux index 781a11c29..b8f3f6cbc 100644 --- a/stdlib/source/library/lux/world/console.lux +++ b/stdlib/source/library/lux/world/console.lux @@ -93,74 +93,74 @@ (def: close (|>> (exception.except ..cannot_close) in)))))))))] - (for [@.old (as_is <jvm>) - @.jvm (as_is <jvm>) - @.js (as_is (ffi.import: Buffer - "[1]::[0]" - (toString [] ffi.String)) - - (ffi.import: Readable_Stream - "[1]::[0]" - (read [] "?" Buffer) - (unshift "as" unshift|String [ffi.String] ffi.Boolean) - (unshift "as" unshift|Buffer [Buffer] ffi.Boolean)) - - (ffi.import: Writable_Stream - "[1]::[0]" - (write [ffi.String ffi.Function] ffi.Boolean) - (once [ffi.String ffi.Function] Any)) - - (ffi.import: process - "[1]::[0]" - ("static" stdout Writable_Stream) - ("static" stdin Readable_Stream)) - - (exception: .public cannot_read) - - (template: (!read <type> <query>) - [(let [it (process::stdin)] - (case (Readable_Stream::read it) - {.#Some buffer} - (let [input (Buffer::toString buffer)] - (case (: (Maybe [<type> Text]) - <query>) - {.#Some [head tail]} - (exec - (Readable_Stream::unshift|String tail it) - (async#in {try.#Success head})) - - {.#None} - (exec - (Readable_Stream::unshift|Buffer buffer it) - (async#in (exception.except ..cannot_read []))))) - - {.#None} - (async#in (exception.except ..cannot_read []))))]) - - (def: .public default - (Maybe (Console Async)) - (if ffi.on_node_js? - {.#Some (implementation - (def: (read _) - (!read Char (do maybe.monad - [head (text.char 0 input) - [_ tail] (text.split_at 1 input)] - (in [head tail])))) - - (def: (read_line _) - (!read Text (text.split_by text.\n input))) - - (def: (write it) - (let [[read! write!] (: [(async.Async (Try [])) (async.Resolver (Try []))] - (async.async []))] - (exec - (Writable_Stream::write it (ffi.function (_ []) Any (io.run! (write! {try.#Success []}))) - (process::stdout)) - read!))) - - (def: close - (|>> (exception.except ..cannot_close) async#in)))} - {.#None})))] + (for @.old (as_is <jvm>) + @.jvm (as_is <jvm>) + @.js (as_is (ffi.import: Buffer + "[1]::[0]" + (toString [] ffi.String)) + + (ffi.import: Readable_Stream + "[1]::[0]" + (read [] "?" Buffer) + (unshift "as" unshift|String [ffi.String] ffi.Boolean) + (unshift "as" unshift|Buffer [Buffer] ffi.Boolean)) + + (ffi.import: Writable_Stream + "[1]::[0]" + (write [ffi.String ffi.Function] ffi.Boolean) + (once [ffi.String ffi.Function] Any)) + + (ffi.import: process + "[1]::[0]" + ("static" stdout Writable_Stream) + ("static" stdin Readable_Stream)) + + (exception: .public cannot_read) + + (template: (!read <type> <query>) + [(let [it (process::stdin)] + (case (Readable_Stream::read it) + {.#Some buffer} + (let [input (Buffer::toString buffer)] + (case (: (Maybe [<type> Text]) + <query>) + {.#Some [head tail]} + (exec + (Readable_Stream::unshift|String tail it) + (async#in {try.#Success head})) + + {.#None} + (exec + (Readable_Stream::unshift|Buffer buffer it) + (async#in (exception.except ..cannot_read []))))) + + {.#None} + (async#in (exception.except ..cannot_read []))))]) + + (def: .public default + (Maybe (Console Async)) + (if ffi.on_node_js? + {.#Some (implementation + (def: (read _) + (!read Char (do maybe.monad + [head (text.char 0 input) + [_ tail] (text.split_at 1 input)] + (in [head tail])))) + + (def: (read_line _) + (!read Text (text.split_by text.\n input))) + + (def: (write it) + (let [[read! write!] (: [(async.Async (Try [])) (async.Resolver (Try []))] + (async.async []))] + (exec + (Writable_Stream::write it (ffi.function (_ []) Any (io.run! (write! {try.#Success []}))) + (process::stdout)) + read!))) + + (def: close + (|>> (exception.except ..cannot_close) async#in)))} + {.#None}))) (as_is))) (def: .public (write_line message console) diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index c2e799be8..63fa2e88b 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -25,8 +25,8 @@ ["[0]" list ("[1]#[0]" functor)] ["[0]" dictionary {"+" Dictionary}]]] ["[0]" ffi - (~~ (.for ["JavaScript" (~~ (.as_is ["[0]" node_js])) - "{old}" (~~ (.as_is ["node_js" //control/thread]))] + (~~ (.for "JavaScript" (~~ (.as_is ["[0]" node_js])) + "{old}" (~~ (.as_is ["node_js" //control/thread])) (~~ (.as_is))))] [macro ["[0]" template]] @@ -298,662 +298,662 @@ java/io/File::new (java/io/File::renameTo (java/io/File::new (ffi.as_string destination))))) )))] - (for [@.old (as_is <for_jvm>) - @.jvm (as_is <for_jvm>) - - @.js - (as_is (ffi.import: Buffer - "[1]::[0]" - ("static" from [Binary] ..Buffer)) - - (ffi.import: FileDescriptor - "[1]::[0]") - - (ffi.import: Stats - "[1]::[0]" - (size ffi.Number) - (mtimeMs ffi.Number) - (isFile [] ffi.Boolean) - (isDirectory [] ffi.Boolean)) - - (ffi.import: FsConstants - "[1]::[0]" - (F_OK ffi.Number) - (R_OK ffi.Number) - (W_OK ffi.Number) - (X_OK ffi.Number)) - - (ffi.import: Error - "[1]::[0]" - (toString [] ffi.String)) - - (template: (with_async <write> <type> <body>) - [(template.with_locals [<read>] - (let [[<read> <write>] (: [(Async <type>) (async.Resolver <type>)] - (async.async []))] - (exec - <body> - <read>)))]) - - (ffi.import: Fs - "[1]::[0]" - (constants FsConstants) - (readFile [ffi.String ffi.Function] Any) - (appendFile [ffi.String Buffer ffi.Function] Any) - (writeFile [ffi.String Buffer ffi.Function] Any) - (stat [ffi.String ffi.Function] Any) - (access [ffi.String ffi.Number ffi.Function] Any) - (rename [ffi.String ffi.String ffi.Function] Any) - (utimes [ffi.String ffi.Number ffi.Number ffi.Function] Any) - (readdir [ffi.String ffi.Function] Any) - (mkdir [ffi.String ffi.Function] Any) - (unlink [ffi.String ffi.Function] Any) - (rmdir [ffi.String ffi.Function] Any)) - - (def: (any_callback write!) - (-> (async.Resolver (Try Any)) ffi.Function) - (<| (ffi.function (_ [error Error]) Any) - io.run! - write! - (if (ffi.null? error) - {try.#Success []} - {try.#Failure (Error::toString error)}))) - - (def: (value_callback write!) - (All (_ a) (-> (async.Resolver (Try a)) ffi.Function)) - (<| (ffi.function (_ [error Error datum Any]) Any) - io.run! - write! - (if (ffi.null? error) - {try.#Success (:expected datum)} - {try.#Failure (Error::toString error)}))) - - (ffi.import: JsPath - "[1]::[0]" - (sep ffi.String)) - - (def: .public default - (Maybe (System Async)) - (do maybe.monad - [node_fs (node_js.require "fs") - node_path (node_js.require "path") - .let [node_fs (:as ..Fs node_fs) - js_separator (if ffi.on_node_js? - (JsPath::sep (:as ..JsPath node_path)) - "/")]] - (in (: (System Async) - (`` (implementation - (def: separator - js_separator) - - (~~ (template [<name> <method>] - [(def: (<name> path) - (do async.monad - [?stats (with_async write! (Try Stats) - (Fs::stat path (..value_callback write!) - node_fs))] - (in (case ?stats - {try.#Success stats} - (<method> stats) - - {try.#Failure _} - false))))] - - [file? Stats::isFile] - [directory? Stats::isDirectory] - )) - - (def: (make_directory path) - (do async.monad - [outcome (with_async write! (Try Any) - (Fs::access path - (|> node_fs Fs::constants FsConstants::F_OK) - (..any_callback write!) - node_fs))] - (case outcome - {try.#Success _} - (in (exception.except ..cannot_make_directory [path])) - - {try.#Failure _} - (with_async write! (Try Any) - (Fs::mkdir path (..any_callback write!) node_fs))))) - - (~~ (template [<name> <method>] - [(def: (<name> path) - (do [! (try.with async.monad)] - [subs (with_async write! (Try (Array ffi.String)) - (Fs::readdir path (..value_callback write!) node_fs))] - (|> subs - (array.list {.#None}) - (list#each (|>> (format path js_separator))) - (monad.each ! (function (_ sub) - (# ! each (|>> <method> [sub]) - (with_async write! (Try Stats) - (Fs::stat sub (..value_callback write!) node_fs))))) - (# ! each (|>> (list.only product.right) - (list#each product.left))))))] - - [directory_files Stats::isFile] - [sub_directories Stats::isDirectory] - )) - - (def: (file_size path) - (do (try.with async.monad) - [stats (with_async write! (Try Stats) - (Fs::stat path (..value_callback write!) - node_fs))] - (in (|> stats - Stats::size - f.nat)))) - - (def: (last_modified path) - (do (try.with async.monad) - [stats (with_async write! (Try Stats) - (Fs::stat path (..value_callback write!) - node_fs))] - (in (|> stats - Stats::mtimeMs - f.int - duration.of_millis - instant.absolute)))) - - (def: (can_execute? path) - (# async.monad each - (|>> (case> {try.#Success _} - true - - {try.#Failure _} - false) - {try.#Success}) + (for @.old (as_is <for_jvm>) + @.jvm (as_is <for_jvm>) + + @.js + (as_is (ffi.import: Buffer + "[1]::[0]" + ("static" from [Binary] ..Buffer)) + + (ffi.import: FileDescriptor + "[1]::[0]") + + (ffi.import: Stats + "[1]::[0]" + (size ffi.Number) + (mtimeMs ffi.Number) + (isFile [] ffi.Boolean) + (isDirectory [] ffi.Boolean)) + + (ffi.import: FsConstants + "[1]::[0]" + (F_OK ffi.Number) + (R_OK ffi.Number) + (W_OK ffi.Number) + (X_OK ffi.Number)) + + (ffi.import: Error + "[1]::[0]" + (toString [] ffi.String)) + + (template: (with_async <write> <type> <body>) + [(template.with_locals [<read>] + (let [[<read> <write>] (: [(Async <type>) (async.Resolver <type>)] + (async.async []))] + (exec + <body> + <read>)))]) + + (ffi.import: Fs + "[1]::[0]" + (constants FsConstants) + (readFile [ffi.String ffi.Function] Any) + (appendFile [ffi.String Buffer ffi.Function] Any) + (writeFile [ffi.String Buffer ffi.Function] Any) + (stat [ffi.String ffi.Function] Any) + (access [ffi.String ffi.Number ffi.Function] Any) + (rename [ffi.String ffi.String ffi.Function] Any) + (utimes [ffi.String ffi.Number ffi.Number ffi.Function] Any) + (readdir [ffi.String ffi.Function] Any) + (mkdir [ffi.String ffi.Function] Any) + (unlink [ffi.String ffi.Function] Any) + (rmdir [ffi.String ffi.Function] Any)) + + (def: (any_callback write!) + (-> (async.Resolver (Try Any)) ffi.Function) + (<| (ffi.function (_ [error Error]) Any) + io.run! + write! + (if (ffi.null? error) + {try.#Success []} + {try.#Failure (Error::toString error)}))) + + (def: (value_callback write!) + (All (_ a) (-> (async.Resolver (Try a)) ffi.Function)) + (<| (ffi.function (_ [error Error datum Any]) Any) + io.run! + write! + (if (ffi.null? error) + {try.#Success (:expected datum)} + {try.#Failure (Error::toString error)}))) + + (ffi.import: JsPath + "[1]::[0]" + (sep ffi.String)) + + (def: .public default + (Maybe (System Async)) + (do maybe.monad + [node_fs (node_js.require "fs") + node_path (node_js.require "path") + .let [node_fs (:as ..Fs node_fs) + js_separator (if ffi.on_node_js? + (JsPath::sep (:as ..JsPath node_path)) + "/")]] + (in (: (System Async) + (`` (implementation + (def: separator + js_separator) + + (~~ (template [<name> <method>] + [(def: (<name> path) + (do async.monad + [?stats (with_async write! (Try Stats) + (Fs::stat path (..value_callback write!) + node_fs))] + (in (case ?stats + {try.#Success stats} + (<method> stats) + + {try.#Failure _} + false))))] + + [file? Stats::isFile] + [directory? Stats::isDirectory] + )) + + (def: (make_directory path) + (do async.monad + [outcome (with_async write! (Try Any) + (Fs::access path + (|> node_fs Fs::constants FsConstants::F_OK) + (..any_callback write!) + node_fs))] + (case outcome + {try.#Success _} + (in (exception.except ..cannot_make_directory [path])) + + {try.#Failure _} (with_async write! (Try Any) - (Fs::access path - (|> node_fs Fs::constants FsConstants::X_OK) - (..any_callback write!) - node_fs)))) - - (def: (read path) - (with_async write! (Try Binary) - (Fs::readFile path (..value_callback write!) - node_fs))) - - (def: (delete path) - (do (try.with async.monad) - [stats (with_async write! (Try Stats) - (Fs::stat path (..value_callback write!) node_fs))] + (Fs::mkdir path (..any_callback write!) node_fs))))) + + (~~ (template [<name> <method>] + [(def: (<name> path) + (do [! (try.with async.monad)] + [subs (with_async write! (Try (Array ffi.String)) + (Fs::readdir path (..value_callback write!) node_fs))] + (|> subs + (array.list {.#None}) + (list#each (|>> (format path js_separator))) + (monad.each ! (function (_ sub) + (# ! each (|>> <method> [sub]) + (with_async write! (Try Stats) + (Fs::stat sub (..value_callback write!) node_fs))))) + (# ! each (|>> (list.only product.right) + (list#each product.left))))))] + + [directory_files Stats::isFile] + [sub_directories Stats::isDirectory] + )) + + (def: (file_size path) + (do (try.with async.monad) + [stats (with_async write! (Try Stats) + (Fs::stat path (..value_callback write!) + node_fs))] + (in (|> stats + Stats::size + f.nat)))) + + (def: (last_modified path) + (do (try.with async.monad) + [stats (with_async write! (Try Stats) + (Fs::stat path (..value_callback write!) + node_fs))] + (in (|> stats + Stats::mtimeMs + f.int + duration.of_millis + instant.absolute)))) + + (def: (can_execute? path) + (# async.monad each + (|>> (case> {try.#Success _} + true + + {try.#Failure _} + false) + {try.#Success}) (with_async write! (Try Any) - (if (Stats::isFile stats) - (Fs::unlink path (..any_callback write!) node_fs) - (Fs::rmdir path (..any_callback write!) node_fs))))) - - (def: (modify time_stamp path) - (with_async write! (Try Any) - (let [when (|> time_stamp instant.relative duration.millis i.frac)] - (Fs::utimes path when when (..any_callback write!) + (Fs::access path + (|> node_fs Fs::constants FsConstants::X_OK) + (..any_callback write!) node_fs)))) - (~~ (template [<name> <method>] - [(def: (<name> data path) - (with_async write! (Try Any) - (<method> path (Buffer::from data) (..any_callback write!) - node_fs)))] - - [write Fs::writeFile] - [append Fs::appendFile] - )) - - (def: (move destination origin) - (with_async write! (Try Any) - (Fs::rename origin destination (..any_callback write!) - node_fs)))))))))) - - @.python - (as_is (type: (Tuple/2 left right) - (Primitive "python_tuple[2]" [left right])) - - (ffi.import: PyFile - "[1]::[0]" - (read [] "io" "try" Binary) - (write [Binary] "io" "try" "?" Any) - (close [] "io" "try" "?" Any)) - - (ffi.import: (open [ffi.String ffi.String] "io" "try" PyFile)) - (ffi.import: (tuple [[ffi.Integer ffi.Integer]] (Tuple/2 ffi.Integer ffi.Integer))) - - (ffi.import: os - "[1]::[0]" - ("static" F_OK ffi.Integer) - ("static" R_OK ffi.Integer) - ("static" W_OK ffi.Integer) - ("static" X_OK ffi.Integer) - - ("static" mkdir [ffi.String] "io" "try" "?" Any) - ("static" access [ffi.String ffi.Integer] "io" "try" ffi.Boolean) - ("static" remove [ffi.String] "io" "try" "?" Any) - ("static" rmdir [ffi.String] "io" "try" "?" Any) - ("static" rename [ffi.String ffi.String] "io" "try" "?" Any) - ("static" utime [ffi.String (Tuple/2 ffi.Integer ffi.Integer)] "io" "try" "?" Any) - ("static" listdir [ffi.String] "io" "try" (Array ffi.String))) - - (ffi.import: os/path - "[1]::[0]" - ("static" isfile [ffi.String] "io" "try" ffi.Boolean) - ("static" isdir [ffi.String] "io" "try" ffi.Boolean) - ("static" sep ffi.String) - ("static" getsize [ffi.String] "io" "try" ffi.Integer) - ("static" getmtime [ffi.String] "io" "try" ffi.Float)) - - (def: python_separator - (os/path::sep)) - - (`` (implementation: .public default - (System IO) - - (def: separator - ..python_separator) - - (~~ (template [<name> <method>] - [(def: <name> - (|>> <method> - (io#each (|>> (try.else false)))))] - - [file? os/path::isfile] - [directory? os/path::isdir] - )) - - (def: make_directory - os::mkdir) - - (~~ (template [<name> <method>] - [(def: (<name> path) - (let [! (try.with io.monad)] - (|> path - os::listdir - (# ! each (|>> (array.list {.#None}) - (list#each (|>> (format path ..python_separator))) - (monad.each ! (function (_ sub) - (# ! each (|>> [sub]) (<method> sub)))) - (# ! each (|>> (list.only product.right) - (list#each product.left))))) - (# ! conjoint))))] - - [directory_files os/path::isfile] - [sub_directories os/path::isdir] - )) - - (def: file_size - (|>> os/path::getsize - (# (try.with io.monad) each (|>> .nat)))) - - (def: last_modified - (|>> os/path::getmtime - (# (try.with io.monad) each (|>> f.int - (i.* +1,000) - duration.of_millis - instant.absolute)))) - - (def: (can_execute? path) - (os::access path (os::X_OK))) - - (def: (read path) - (do (try.with io.monad) - [file (..open path "rb") - data (PyFile::read file) - _ (PyFile::close file)] - (in data))) - - (def: (delete path) - (do (try.with io.monad) - [? (os/path::isfile path)] - (if ? - (os::remove path) - (os::rmdir path)))) - - (def: (modify time_stamp path) - (let [when (|> time_stamp instant.relative duration.millis (i./ +1,000))] - (os::utime path (..tuple [when when])))) - - (~~ (template [<name> <mode>] - [(def: (<name> data path) - (do (try.with io.monad) - [file (..open path <mode>) - _ (PyFile::write data file)] - (PyFile::close file)))] - - [write "w+b"] - [append "ab"] - )) - - (def: (move destination origin) - (os::rename origin destination)) - ))) - - @.ruby - (as_is (ffi.import: Time - "[1]::[0]" - ("static" at [Frac] Time) - (to_f [] Frac)) - - (ffi.import: Stat - "[1]::[0]" - (executable? [] Bit) - (size Int) - (mtime [] Time)) - - (ffi.import: File "as" RubyFile - "[1]::[0]" - ("static" SEPARATOR ffi.String) - ("static" open [Path ffi.String] "io" "try" RubyFile) - ("static" stat [Path] "io" "try" Stat) - ("static" delete [Path] "io" "try" Int) - ("static" file? [Path] "io" "try" Bit) - ("static" directory? [Path] "io" "try" Bit) - ("static" utime [Time Time Path] "io" "try" Int) - - (read [] "io" "try" Binary) - (write [Binary] "io" "try" Int) - (flush [] "io" "try" "?" Any) - (close [] "io" "try" "?" Any)) - - (ffi.import: Dir - "[1]::[0]" - ("static" open [Path] "io" "try" Dir) - - (children [] "io" "try" (Array Path)) - (close [] "io" "try" "?" Any)) - - (ffi.import: "fileutils" FileUtils - "[1]::[0]" - ("static" move [Path Path] "io" "try" "?" Any) - ("static" rmdir [Path] "io" "try" "?" Any) - ("static" mkdir [Path] "io" "try" "?" Any)) - - (def: ruby_separator - Text - (..RubyFile::SEPARATOR)) - - (`` (implementation: .public default - (System IO) - - (def: separator - ..ruby_separator) - - (~~ (template [<name> <test>] - [(def: <name> - (|>> <test> - (io#each (|>> (try.else false)))))] - - [file? RubyFile::file?] - [directory? RubyFile::directory?] - )) - - (def: make_directory - FileUtils::mkdir) - - (~~ (template [<name> <test>] - [(def: (<name> path) - (do [! (try.with io.monad)] - [self (Dir::open path) - children (Dir::children self) - output (loop [input (|> children - (array.list {.#None}) - (list#each (|>> (format path ..ruby_separator)))) - output (: (List ..Path) - (list))] - (case input - {.#End} - (in output) - - {.#Item head tail} - (do ! - [verdict (<test> head)] - (again tail (if verdict - {.#Item head output} - output))))) - _ (Dir::close self)] - (in output)))] - - [directory_files RubyFile::file?] - [sub_directories RubyFile::directory?] - )) - - (~~ (template [<name> <pipeline>] - [(def: <name> - (let [! (try.with io.monad)] - (|>> RubyFile::stat - (# ! each (`` (|>> (~~ (template.spliced <pipeline>))))))))] - - [file_size [Stat::size .nat]] - [last_modified [Stat::mtime - Time::to_f - (f.* +1,000.0) - f.int - duration.of_millis - instant.absolute]] - [can_execute? [Stat::executable?]] - )) - - (def: (read path) - (do (try.with io.monad) - [file (RubyFile::open path "rb") - data (RubyFile::read file) - _ (RubyFile::close file)] - (in data))) - - (def: (delete path) - (do (try.with io.monad) - [? (RubyFile::file? path)] - (if ? - (RubyFile::delete path) - (FileUtils::rmdir path)))) - - (def: (modify moment path) - (let [moment (|> moment - instant.relative - duration.millis - i.frac - (f./ +1,000.0) - Time::at)] - (RubyFile::utime moment moment path))) - - (~~ (template [<mode> <name>] - [(def: (<name> data path) - (do [! (try.with io.monad)] - [file (RubyFile::open path <mode>) - data (RubyFile::write data file) - _ (RubyFile::flush file) - _ (RubyFile::close file)] - (in [])))] - - ["wb" write] - ["ab" append] - )) - - (def: (move destination origin) - (do (try.with io.monad) - [_ (FileUtils::move origin destination)] - (in []))) - ))) - - ... @.php - ... (as_is (ffi.import: (FILE_APPEND Int)) - ... ... https://www.php.net/manual/en/dir.constants.php - ... (ffi.import: (DIRECTORY_SEPARATOR ffi.String)) - ... ... https://www.php.net/manual/en/function.pack.php - ... ... https://www.php.net/manual/en/function.unpack.php - ... (ffi.import: (unpack [ffi.String ffi.String] Binary)) - ... ... https://www.php.net/manual/en/ref.filesystem.php - ... ... https://www.php.net/manual/en/function.file-get-contents.php - ... (ffi.import: (file_get_contents [Path] "io" "try" ffi.String)) - ... ... https://www.php.net/manual/en/function.file-put-contents.php - ... (ffi.import: (file_put_contents [Path ffi.String Int] "io" "try" ffi.Integer)) - ... (ffi.import: (filemtime [Path] "io" "try" ffi.Integer)) - ... (ffi.import: (filesize [Path] "io" "try" ffi.Integer)) - ... (ffi.import: (is_executable [Path] "io" "try" ffi.Boolean)) - ... (ffi.import: (touch [Path ffi.Integer] "io" "try" ffi.Boolean)) - ... (ffi.import: (rename [Path Path] "io" "try" ffi.Boolean)) - ... (ffi.import: (unlink [Path] "io" "try" ffi.Boolean)) - - ... ... https://www.php.net/manual/en/function.rmdir.php - ... (ffi.import: (rmdir [Path] "io" "try" ffi.Boolean)) - ... ... https://www.php.net/manual/en/function.scandir.php - ... (ffi.import: (scandir [Path] "io" "try" (Array Path))) - ... ... https://www.php.net/manual/en/function.is-file.php - ... (ffi.import: (is_file [Path] "io" "try" ffi.Boolean)) - ... ... https://www.php.net/manual/en/function.is-dir.php - ... (ffi.import: (is_dir [Path] "io" "try" ffi.Boolean)) - ... ... https://www.php.net/manual/en/function.mkdir.php - ... (ffi.import: (mkdir [Path] "io" "try" ffi.Boolean)) - - ... (def: byte_array_format "C*") - ... (def: default_separator (..DIRECTORY_SEPARATOR)) - - ... (template [<name>] - ... [(exception: .public (<name> [file Path]) - ... (exception.report - ... ["Path" file]))] - - ... [cannot_write_to_file] - ... ) - - ... (`` (implementation: (file path) - ... (-> Path (File IO)) - - ... (~~ (template [<name> <mode>] - ... [(def: (<name> data) - ... (do [! (try.with io.monad)] - ... [outcome (..file_put_contents [path ("php pack" ..byte_array_format data) <mode>])] - ... (if (bit#= false (:as Bit outcome)) - ... (# io.monad in (exception.except ..cannot_write_to_file [path])) - ... (in []))))] - - ... [over_write +0] - ... [append (..FILE_APPEND)] - ... )) - - ... (def: (content _) - ... (do [! (try.with io.monad)] - ... [data (..file_get_contents [path])] - ... (if (bit#= false (:as Bit data)) - ... (# io.monad in (exception.except ..cannot_find_file [path])) - ... (in (..unpack [..byte_array_format data]))))) - - ... (def: path - ... path) - - ... (~~ (template [<name> <ffi> <pipeline>] - ... [(def: (<name> _) - ... (do [! (try.with io.monad)] - ... [value (<ffi> [path])] - ... (if (bit#= false (:as Bit value)) - ... (# io.monad in (exception.except ..cannot_find_file [path])) - ... (in (`` (|> value (~~ (template.spliced <pipeline>))))))))] - - ... [size ..filesize [.nat]] - ... [last_modified ..filemtime [(i.* +1,000) duration.of_millis instant.absolute]] - ... )) - - ... (def: (can_execute? _) - ... (..is_executable [path])) - - ... (def: (modify moment) - ... (do [! (try.with io.monad)] - ... [verdict (..touch [path (|> moment instant.relative duration.millis (i./ +1,000))])] - ... (if (bit#= false (:as Bit verdict)) - ... (# io.monad in (exception.except ..cannot_find_file [path])) - ... (in [])))) - - ... (def: (move destination) - ... (do [! (try.with io.monad)] - ... [verdict (..rename [path destination])] - ... (if (bit#= false (:as Bit verdict)) - ... (# io.monad in (exception.except ..cannot_find_file [path])) - ... (in (file destination))))) - - ... (def: (delete _) - ... (do (try.with io.monad) - ... [verdict (..unlink [path])] - ... (if (bit#= false (:as Bit verdict)) - ... (# io.monad in (exception.except ..cannot_find_file [path])) - ... (in [])))) - ... )) - - ... (`` (implementation: (directory path) - ... (-> Path (Directory IO)) - - ... (def: scope - ... path) - - ... (~~ (template [<name> <test> <constructor> <capability>] - ... [(def: (<name> _) - ... (do [! (try.with io.monad)] - ... [children (..scandir [path])] - ... (loop [input (|> children - ... (array.list {.#None}) - ... (list.only (function (_ child) - ... (not (or (text#= "." child) - ... (text#= ".." child)))))) - ... output (: (List (<capability> IO)) - ... (list))] - ... (case input - ... {.#End} - ... (in output) - - ... {.#Item head tail} - ... (do ! - ... [verdict (<test> head)] - ... (if verdict - ... (again tail {.#Item (<constructor> head) output}) - ... (again tail output)))))))] - - ... [files ..is_file ..file File] - ... [directories ..is_dir directory Directory] - ... )) - - ... (def: (discard _) - ... (do (try.with io.monad) - ... [verdict (..rmdir [path])] - ... (if (bit#= false (:as Bit verdict)) - ... (# io.monad in (exception.except ..cannot_find_directory [path])) - ... (in [])))) - ... )) - - ... (`` (implementation: .public default - ... (System IO) - - ... (~~ (template [<name> <test> <constructor> <exception>] - ... [(def: (<name> path) - ... (do [! (try.with io.monad)] - ... [verdict (<test> path)] - ... (# io.monad in - ... (if verdict - ... {try.#Success (<constructor> path)} - ... (exception.except <exception> [path])))))] - - ... [file ..is_file ..file ..cannot_find_file] - ... [directory ..is_dir ..directory ..cannot_find_directory] - ... )) - - ... (def: (make_file path) - ... (do [! (try.with io.monad)] - ... [verdict (..touch [path (|> instant.now io.run! instant.relative duration.millis (i./ +1,000))])] - ... (# io.monad in - ... (if verdict - ... {try.#Success (..file path)} - ... (exception.except ..cannot_make_file [path]))))) - - ... (def: (make_directory path) - ... (do [! (try.with io.monad)] - ... [verdict (..mkdir path)] - ... (# io.monad in - ... (if verdict - ... {try.#Success (..directory path)} - ... (exception.except ..cannot_make_directory [path]))))) - - ... (def: separator - ... ..default_separator) - ... )) - ... ) - ] + (def: (read path) + (with_async write! (Try Binary) + (Fs::readFile path (..value_callback write!) + node_fs))) + + (def: (delete path) + (do (try.with async.monad) + [stats (with_async write! (Try Stats) + (Fs::stat path (..value_callback write!) node_fs))] + (with_async write! (Try Any) + (if (Stats::isFile stats) + (Fs::unlink path (..any_callback write!) node_fs) + (Fs::rmdir path (..any_callback write!) node_fs))))) + + (def: (modify time_stamp path) + (with_async write! (Try Any) + (let [when (|> time_stamp instant.relative duration.millis i.frac)] + (Fs::utimes path when when (..any_callback write!) + node_fs)))) + + (~~ (template [<name> <method>] + [(def: (<name> data path) + (with_async write! (Try Any) + (<method> path (Buffer::from data) (..any_callback write!) + node_fs)))] + + [write Fs::writeFile] + [append Fs::appendFile] + )) + + (def: (move destination origin) + (with_async write! (Try Any) + (Fs::rename origin destination (..any_callback write!) + node_fs)))))))))) + + @.python + (as_is (type: (Tuple/2 left right) + (Primitive "python_tuple[2]" [left right])) + + (ffi.import: PyFile + "[1]::[0]" + (read [] "io" "try" Binary) + (write [Binary] "io" "try" "?" Any) + (close [] "io" "try" "?" Any)) + + (ffi.import: (open [ffi.String ffi.String] "io" "try" PyFile)) + (ffi.import: (tuple [[ffi.Integer ffi.Integer]] (Tuple/2 ffi.Integer ffi.Integer))) + + (ffi.import: os + "[1]::[0]" + ("static" F_OK ffi.Integer) + ("static" R_OK ffi.Integer) + ("static" W_OK ffi.Integer) + ("static" X_OK ffi.Integer) + + ("static" mkdir [ffi.String] "io" "try" "?" Any) + ("static" access [ffi.String ffi.Integer] "io" "try" ffi.Boolean) + ("static" remove [ffi.String] "io" "try" "?" Any) + ("static" rmdir [ffi.String] "io" "try" "?" Any) + ("static" rename [ffi.String ffi.String] "io" "try" "?" Any) + ("static" utime [ffi.String (Tuple/2 ffi.Integer ffi.Integer)] "io" "try" "?" Any) + ("static" listdir [ffi.String] "io" "try" (Array ffi.String))) + + (ffi.import: os/path + "[1]::[0]" + ("static" isfile [ffi.String] "io" "try" ffi.Boolean) + ("static" isdir [ffi.String] "io" "try" ffi.Boolean) + ("static" sep ffi.String) + ("static" getsize [ffi.String] "io" "try" ffi.Integer) + ("static" getmtime [ffi.String] "io" "try" ffi.Float)) + + (def: python_separator + (os/path::sep)) + + (`` (implementation: .public default + (System IO) + + (def: separator + ..python_separator) + + (~~ (template [<name> <method>] + [(def: <name> + (|>> <method> + (io#each (|>> (try.else false)))))] + + [file? os/path::isfile] + [directory? os/path::isdir] + )) + + (def: make_directory + os::mkdir) + + (~~ (template [<name> <method>] + [(def: (<name> path) + (let [! (try.with io.monad)] + (|> path + os::listdir + (# ! each (|>> (array.list {.#None}) + (list#each (|>> (format path ..python_separator))) + (monad.each ! (function (_ sub) + (# ! each (|>> [sub]) (<method> sub)))) + (# ! each (|>> (list.only product.right) + (list#each product.left))))) + (# ! conjoint))))] + + [directory_files os/path::isfile] + [sub_directories os/path::isdir] + )) + + (def: file_size + (|>> os/path::getsize + (# (try.with io.monad) each (|>> .nat)))) + + (def: last_modified + (|>> os/path::getmtime + (# (try.with io.monad) each (|>> f.int + (i.* +1,000) + duration.of_millis + instant.absolute)))) + + (def: (can_execute? path) + (os::access path (os::X_OK))) + + (def: (read path) + (do (try.with io.monad) + [file (..open path "rb") + data (PyFile::read file) + _ (PyFile::close file)] + (in data))) + + (def: (delete path) + (do (try.with io.monad) + [? (os/path::isfile path)] + (if ? + (os::remove path) + (os::rmdir path)))) + + (def: (modify time_stamp path) + (let [when (|> time_stamp instant.relative duration.millis (i./ +1,000))] + (os::utime path (..tuple [when when])))) + + (~~ (template [<name> <mode>] + [(def: (<name> data path) + (do (try.with io.monad) + [file (..open path <mode>) + _ (PyFile::write data file)] + (PyFile::close file)))] + + [write "w+b"] + [append "ab"] + )) + + (def: (move destination origin) + (os::rename origin destination)) + ))) + + @.ruby + (as_is (ffi.import: Time + "[1]::[0]" + ("static" at [Frac] Time) + (to_f [] Frac)) + + (ffi.import: Stat + "[1]::[0]" + (executable? [] Bit) + (size Int) + (mtime [] Time)) + + (ffi.import: File "as" RubyFile + "[1]::[0]" + ("static" SEPARATOR ffi.String) + ("static" open [Path ffi.String] "io" "try" RubyFile) + ("static" stat [Path] "io" "try" Stat) + ("static" delete [Path] "io" "try" Int) + ("static" file? [Path] "io" "try" Bit) + ("static" directory? [Path] "io" "try" Bit) + ("static" utime [Time Time Path] "io" "try" Int) + + (read [] "io" "try" Binary) + (write [Binary] "io" "try" Int) + (flush [] "io" "try" "?" Any) + (close [] "io" "try" "?" Any)) + + (ffi.import: Dir + "[1]::[0]" + ("static" open [Path] "io" "try" Dir) + + (children [] "io" "try" (Array Path)) + (close [] "io" "try" "?" Any)) + + (ffi.import: "fileutils" FileUtils + "[1]::[0]" + ("static" move [Path Path] "io" "try" "?" Any) + ("static" rmdir [Path] "io" "try" "?" Any) + ("static" mkdir [Path] "io" "try" "?" Any)) + + (def: ruby_separator + Text + (..RubyFile::SEPARATOR)) + + (`` (implementation: .public default + (System IO) + + (def: separator + ..ruby_separator) + + (~~ (template [<name> <test>] + [(def: <name> + (|>> <test> + (io#each (|>> (try.else false)))))] + + [file? RubyFile::file?] + [directory? RubyFile::directory?] + )) + + (def: make_directory + FileUtils::mkdir) + + (~~ (template [<name> <test>] + [(def: (<name> path) + (do [! (try.with io.monad)] + [self (Dir::open path) + children (Dir::children self) + output (loop [input (|> children + (array.list {.#None}) + (list#each (|>> (format path ..ruby_separator)))) + output (: (List ..Path) + (list))] + (case input + {.#End} + (in output) + + {.#Item head tail} + (do ! + [verdict (<test> head)] + (again tail (if verdict + {.#Item head output} + output))))) + _ (Dir::close self)] + (in output)))] + + [directory_files RubyFile::file?] + [sub_directories RubyFile::directory?] + )) + + (~~ (template [<name> <pipeline>] + [(def: <name> + (let [! (try.with io.monad)] + (|>> RubyFile::stat + (# ! each (`` (|>> (~~ (template.spliced <pipeline>))))))))] + + [file_size [Stat::size .nat]] + [last_modified [Stat::mtime + Time::to_f + (f.* +1,000.0) + f.int + duration.of_millis + instant.absolute]] + [can_execute? [Stat::executable?]] + )) + + (def: (read path) + (do (try.with io.monad) + [file (RubyFile::open path "rb") + data (RubyFile::read file) + _ (RubyFile::close file)] + (in data))) + + (def: (delete path) + (do (try.with io.monad) + [? (RubyFile::file? path)] + (if ? + (RubyFile::delete path) + (FileUtils::rmdir path)))) + + (def: (modify moment path) + (let [moment (|> moment + instant.relative + duration.millis + i.frac + (f./ +1,000.0) + Time::at)] + (RubyFile::utime moment moment path))) + + (~~ (template [<mode> <name>] + [(def: (<name> data path) + (do [! (try.with io.monad)] + [file (RubyFile::open path <mode>) + data (RubyFile::write data file) + _ (RubyFile::flush file) + _ (RubyFile::close file)] + (in [])))] + + ["wb" write] + ["ab" append] + )) + + (def: (move destination origin) + (do (try.with io.monad) + [_ (FileUtils::move origin destination)] + (in []))) + ))) + + ... @.php + ... (as_is (ffi.import: (FILE_APPEND Int)) + ... ... https://www.php.net/manual/en/dir.constants.php + ... (ffi.import: (DIRECTORY_SEPARATOR ffi.String)) + ... ... https://www.php.net/manual/en/function.pack.php + ... ... https://www.php.net/manual/en/function.unpack.php + ... (ffi.import: (unpack [ffi.String ffi.String] Binary)) + ... ... https://www.php.net/manual/en/ref.filesystem.php + ... ... https://www.php.net/manual/en/function.file-get-contents.php + ... (ffi.import: (file_get_contents [Path] "io" "try" ffi.String)) + ... ... https://www.php.net/manual/en/function.file-put-contents.php + ... (ffi.import: (file_put_contents [Path ffi.String Int] "io" "try" ffi.Integer)) + ... (ffi.import: (filemtime [Path] "io" "try" ffi.Integer)) + ... (ffi.import: (filesize [Path] "io" "try" ffi.Integer)) + ... (ffi.import: (is_executable [Path] "io" "try" ffi.Boolean)) + ... (ffi.import: (touch [Path ffi.Integer] "io" "try" ffi.Boolean)) + ... (ffi.import: (rename [Path Path] "io" "try" ffi.Boolean)) + ... (ffi.import: (unlink [Path] "io" "try" ffi.Boolean)) + + ... ... https://www.php.net/manual/en/function.rmdir.php + ... (ffi.import: (rmdir [Path] "io" "try" ffi.Boolean)) + ... ... https://www.php.net/manual/en/function.scandir.php + ... (ffi.import: (scandir [Path] "io" "try" (Array Path))) + ... ... https://www.php.net/manual/en/function.is-file.php + ... (ffi.import: (is_file [Path] "io" "try" ffi.Boolean)) + ... ... https://www.php.net/manual/en/function.is-dir.php + ... (ffi.import: (is_dir [Path] "io" "try" ffi.Boolean)) + ... ... https://www.php.net/manual/en/function.mkdir.php + ... (ffi.import: (mkdir [Path] "io" "try" ffi.Boolean)) + + ... (def: byte_array_format "C*") + ... (def: default_separator (..DIRECTORY_SEPARATOR)) + + ... (template [<name>] + ... [(exception: .public (<name> [file Path]) + ... (exception.report + ... ["Path" file]))] + + ... [cannot_write_to_file] + ... ) + + ... (`` (implementation: (file path) + ... (-> Path (File IO)) + + ... (~~ (template [<name> <mode>] + ... [(def: (<name> data) + ... (do [! (try.with io.monad)] + ... [outcome (..file_put_contents [path ("php pack" ..byte_array_format data) <mode>])] + ... (if (bit#= false (:as Bit outcome)) + ... (# io.monad in (exception.except ..cannot_write_to_file [path])) + ... (in []))))] + + ... [over_write +0] + ... [append (..FILE_APPEND)] + ... )) + + ... (def: (content _) + ... (do [! (try.with io.monad)] + ... [data (..file_get_contents [path])] + ... (if (bit#= false (:as Bit data)) + ... (# io.monad in (exception.except ..cannot_find_file [path])) + ... (in (..unpack [..byte_array_format data]))))) + + ... (def: path + ... path) + + ... (~~ (template [<name> <ffi> <pipeline>] + ... [(def: (<name> _) + ... (do [! (try.with io.monad)] + ... [value (<ffi> [path])] + ... (if (bit#= false (:as Bit value)) + ... (# io.monad in (exception.except ..cannot_find_file [path])) + ... (in (`` (|> value (~~ (template.spliced <pipeline>))))))))] + + ... [size ..filesize [.nat]] + ... [last_modified ..filemtime [(i.* +1,000) duration.of_millis instant.absolute]] + ... )) + + ... (def: (can_execute? _) + ... (..is_executable [path])) + + ... (def: (modify moment) + ... (do [! (try.with io.monad)] + ... [verdict (..touch [path (|> moment instant.relative duration.millis (i./ +1,000))])] + ... (if (bit#= false (:as Bit verdict)) + ... (# io.monad in (exception.except ..cannot_find_file [path])) + ... (in [])))) + + ... (def: (move destination) + ... (do [! (try.with io.monad)] + ... [verdict (..rename [path destination])] + ... (if (bit#= false (:as Bit verdict)) + ... (# io.monad in (exception.except ..cannot_find_file [path])) + ... (in (file destination))))) + + ... (def: (delete _) + ... (do (try.with io.monad) + ... [verdict (..unlink [path])] + ... (if (bit#= false (:as Bit verdict)) + ... (# io.monad in (exception.except ..cannot_find_file [path])) + ... (in [])))) + ... )) + + ... (`` (implementation: (directory path) + ... (-> Path (Directory IO)) + + ... (def: scope + ... path) + + ... (~~ (template [<name> <test> <constructor> <capability>] + ... [(def: (<name> _) + ... (do [! (try.with io.monad)] + ... [children (..scandir [path])] + ... (loop [input (|> children + ... (array.list {.#None}) + ... (list.only (function (_ child) + ... (not (or (text#= "." child) + ... (text#= ".." child)))))) + ... output (: (List (<capability> IO)) + ... (list))] + ... (case input + ... {.#End} + ... (in output) + + ... {.#Item head tail} + ... (do ! + ... [verdict (<test> head)] + ... (if verdict + ... (again tail {.#Item (<constructor> head) output}) + ... (again tail output)))))))] + + ... [files ..is_file ..file File] + ... [directories ..is_dir directory Directory] + ... )) + + ... (def: (discard _) + ... (do (try.with io.monad) + ... [verdict (..rmdir [path])] + ... (if (bit#= false (:as Bit verdict)) + ... (# io.monad in (exception.except ..cannot_find_directory [path])) + ... (in [])))) + ... )) + + ... (`` (implementation: .public default + ... (System IO) + + ... (~~ (template [<name> <test> <constructor> <exception>] + ... [(def: (<name> path) + ... (do [! (try.with io.monad)] + ... [verdict (<test> path)] + ... (# io.monad in + ... (if verdict + ... {try.#Success (<constructor> path)} + ... (exception.except <exception> [path])))))] + + ... [file ..is_file ..file ..cannot_find_file] + ... [directory ..is_dir ..directory ..cannot_find_directory] + ... )) + + ... (def: (make_file path) + ... (do [! (try.with io.monad)] + ... [verdict (..touch [path (|> instant.now io.run! instant.relative duration.millis (i./ +1,000))])] + ... (# io.monad in + ... (if verdict + ... {try.#Success (..file path)} + ... (exception.except ..cannot_make_file [path]))))) + + ... (def: (make_directory path) + ... (do [! (try.with io.monad)] + ... [verdict (..mkdir path)] + ... (# io.monad in + ... (if verdict + ... {try.#Success (..directory path)} + ... (exception.except ..cannot_make_directory [path]))))) + + ... (def: separator + ... ..default_separator) + ... )) + ... ) + (as_is))) (def: .public (exists? monad fs path) diff --git a/stdlib/source/library/lux/world/file/watch.lux b/stdlib/source/library/lux/world/file/watch.lux index 5ad94c22e..a5828f116 100644 --- a/stdlib/source/library/lux/world/file/watch.lux +++ b/stdlib/source/library/lux/world/file/watch.lux @@ -457,6 +457,6 @@ (async.future (..default_poll watcher))) ))))) )] - (for [@.old (as_is <jvm>) - @.jvm (as_is <jvm>)] + (for @.old (as_is <jvm>) + @.jvm (as_is <jvm>) (as_is))) diff --git a/stdlib/source/library/lux/world/net/http/client.lux b/stdlib/source/library/lux/world/net/http/client.lux index 85e9c2cbd..9ce51d32a 100644 --- a/stdlib/source/library/lux/world/net/http/client.lux +++ b/stdlib/source/library/lux/world/net/http/client.lux @@ -215,8 +215,8 @@ (in [(.nat (ffi.of_int status)) [//.#headers headers //.#body (..default_body input)]]))))))] - (for [@.old (as_is <jvm>) - @.jvm (as_is <jvm>)] + (for @.old (as_is <jvm>) + @.jvm (as_is <jvm>) (as_is))) (implementation: .public (async client) diff --git a/stdlib/source/library/lux/world/program.lux b/stdlib/source/library/lux/world/program.lux index cb3c96f19..c3870d14d 100644 --- a/stdlib/source/library/lux/world/program.lux +++ b/stdlib/source/library/lux/world/program.lux @@ -24,8 +24,8 @@ ["[0]" dictionary {"+" Dictionary}] ["[0]" list ("[1]#[0]" functor)]]] ["[0]" ffi {"+" import:} - (~~ (.for ["JavaScript" (~~ (.as_is ["[0]" node_js])) - "{old}" (~~ (.as_is ["node_js" //math]))] + (~~ (.for "JavaScript" (~~ (.as_is ["[0]" node_js])) + "{old}" (~~ (.as_is ["node_js" //math])) (~~ (.as_is))))] ["[0]" macro ["[0]" template]] @@ -144,144 +144,144 @@ (jvm##consume iterator)} {.#End})) )] - (for [@.old (as_is <jvm>) - @.jvm (as_is <jvm>) - @.js (as_is (def: default_exit! - (-> Exit (IO Nothing)) - (|>> %.int panic! io.io)) - - (import: NodeJs_Process - "[1]::[0]" - (exit [ffi.Number] "io" Nothing) - (cwd [] "io" Path)) - - (def: (exit_node_js! code) - (-> Exit (IO Nothing)) - (case (ffi.global ..NodeJs_Process [process]) - {.#Some process} - (NodeJs_Process::exit (i.frac code) process) - - {.#None} - (..default_exit! code))) - - (import: Browser_Window + (for @.old (as_is <jvm>) + @.jvm (as_is <jvm>) + @.js (as_is (def: default_exit! + (-> Exit (IO Nothing)) + (|>> %.int panic! io.io)) + + (import: NodeJs_Process + "[1]::[0]" + (exit [ffi.Number] "io" Nothing) + (cwd [] "io" Path)) + + (def: (exit_node_js! code) + (-> Exit (IO Nothing)) + (case (ffi.global ..NodeJs_Process [process]) + {.#Some process} + (NodeJs_Process::exit (i.frac code) process) + + {.#None} + (..default_exit! code))) + + (import: Browser_Window + "[1]::[0]" + (close [] Nothing)) + + (import: Browser_Location + "[1]::[0]" + (reload [] Nothing)) + + (def: (exit_browser! code) + (-> Exit (IO Nothing)) + (case [(ffi.global ..Browser_Window [window]) + (ffi.global ..Browser_Location [location])] + [{.#Some window} {.#Some location}] + (exec + (Browser_Window::close window) + (Browser_Location::reload location) + (..default_exit! code)) + + [{.#Some window} {.#None}] + (exec + (Browser_Window::close window) + (..default_exit! code)) + + [{.#None} {.#Some location}] + (exec + (Browser_Location::reload location) + (..default_exit! code)) + + [{.#None} {.#None}] + (..default_exit! code))) + + (import: Object + "[1]::[0]" + ("static" entries [Object] (Array (Array ffi.String)))) + + (import: NodeJs_OS + "[1]::[0]" + (homedir [] "io" Path))) + @.python (as_is (import: os + "[1]::[0]" + ("static" getcwd [] "io" ffi.String) + ("static" _exit [ffi.Integer] "io" Nothing)) + + (import: os/path + "[1]::[0]" + ("static" expanduser [ffi.String] "io" ffi.String)) + + (import: os/environ + "[1]::[0]" + ("static" keys [] "io" (Array ffi.String)) + ("static" get [ffi.String] "io" "?" ffi.String))) + @.lua (as_is (ffi.import: LuaFile "[1]::[0]" - (close [] Nothing)) + (read [ffi.String] "io" "?" ffi.String) + (close [] "io" ffi.Boolean)) + + (ffi.import: (io/popen [ffi.String] "io" "try" "?" LuaFile)) + (ffi.import: (os/getenv [ffi.String] "io" "?" ffi.String)) + (ffi.import: (os/exit [ffi.Integer] "io" Nothing)) + + (def: (run_command default command) + (-> Text Text (IO Text)) + (do [! io.monad] + [outcome (io/popen [command])] + (case outcome + {try.#Success outcome} + (case outcome + {.#Some file} + (do ! + [?output (LuaFile::read "*l" file) + _ (LuaFile::close file)] + (in (maybe.else default ?output))) + + {.#None} + (in default)) + + {try.#Failure _} + (in default))))) + @.ruby (as_is (ffi.import: Env + "[1]::[0]" + ("static" keys [] (Array Text)) + ("static" fetch [Text] "io" "?" Text)) - (import: Browser_Location - "[1]::[0]" - (reload [] Nothing)) - - (def: (exit_browser! code) - (-> Exit (IO Nothing)) - (case [(ffi.global ..Browser_Window [window]) - (ffi.global ..Browser_Location [location])] - [{.#Some window} {.#Some location}] - (exec - (Browser_Window::close window) - (Browser_Location::reload location) - (..default_exit! code)) - - [{.#Some window} {.#None}] - (exec - (Browser_Window::close window) - (..default_exit! code)) - - [{.#None} {.#Some location}] - (exec - (Browser_Location::reload location) - (..default_exit! code)) - - [{.#None} {.#None}] - (..default_exit! code))) - - (import: Object - "[1]::[0]" - ("static" entries [Object] (Array (Array ffi.String)))) + (ffi.import: "fileutils" FileUtils + "[1]::[0]" + ("static" pwd Path)) + + (ffi.import: Dir + "[1]::[0]" + ("static" home Path)) - (import: NodeJs_OS - "[1]::[0]" - (homedir [] "io" Path))) - @.python (as_is (import: os - "[1]::[0]" - ("static" getcwd [] "io" ffi.String) - ("static" _exit [ffi.Integer] "io" Nothing)) - - (import: os/path - "[1]::[0]" - ("static" expanduser [ffi.String] "io" ffi.String)) - - (import: os/environ - "[1]::[0]" - ("static" keys [] "io" (Array ffi.String)) - ("static" get [ffi.String] "io" "?" ffi.String))) - @.lua (as_is (ffi.import: LuaFile + (ffi.import: Kernel "[1]::[0]" - (read [ffi.String] "io" "?" ffi.String) - (close [] "io" ffi.Boolean)) - - (ffi.import: (io/popen [ffi.String] "io" "try" "?" LuaFile)) - (ffi.import: (os/getenv [ffi.String] "io" "?" ffi.String)) - (ffi.import: (os/exit [ffi.Integer] "io" Nothing)) - - (def: (run_command default command) - (-> Text Text (IO Text)) - (do [! io.monad] - [outcome (io/popen [command])] - (case outcome - {try.#Success outcome} - (case outcome - {.#Some file} - (do ! - [?output (LuaFile::read "*l" file) - _ (LuaFile::close file)] - (in (maybe.else default ?output))) - - {.#None} - (in default)) - - {try.#Failure _} - (in default))))) - @.ruby (as_is (ffi.import: Env - "[1]::[0]" - ("static" keys [] (Array Text)) - ("static" fetch [Text] "io" "?" Text)) - - (ffi.import: "fileutils" FileUtils - "[1]::[0]" - ("static" pwd Path)) - - (ffi.import: Dir - "[1]::[0]" - ("static" home Path)) - - (ffi.import: Kernel - "[1]::[0]" - ("static" exit [Int] "io" Nothing))) - - ... @.php - ... (as_is (ffi.import: (exit [Int] "io" Nothing)) - ... ... https://www.php.net/manual/en/function.exit.php - ... (ffi.import: (getcwd [] "io" ffi.String)) - ... ... https://www.php.net/manual/en/function.getcwd.php - ... (ffi.import: (getenv "as" getenv/1 [ffi.String] "io" ffi.String)) - ... (ffi.import: (getenv "as" getenv/0 [] "io" (Array ffi.String))) - ... ... https://www.php.net/manual/en/function.getenv.php - ... ... https://www.php.net/manual/en/function.array-keys.php - ... (ffi.import: (array_keys [(Array ffi.String)] (Array ffi.String))) - ... ) - - ... @.scheme - ... (as_is (ffi.import: (exit [Int] "io" Nothing)) - ... ... https://srfi.schemers.org/srfi-98/srfi-98.html - ... (abstract: Pair Any) - ... (abstract: PList Any) - ... (ffi.import: (get-environment-variables [] "io" PList)) - ... (ffi.import: (car [Pair] Text)) - ... (ffi.import: (cdr [Pair] Text)) - ... (ffi.import: (car "as" head [PList] Pair)) - ... (ffi.import: (cdr "as" tail [PList] PList))) - ] + ("static" exit [Int] "io" Nothing))) + + ... @.php + ... (as_is (ffi.import: (exit [Int] "io" Nothing)) + ... ... https://www.php.net/manual/en/function.exit.php + ... (ffi.import: (getcwd [] "io" ffi.String)) + ... ... https://www.php.net/manual/en/function.getcwd.php + ... (ffi.import: (getenv "as" getenv/1 [ffi.String] "io" ffi.String)) + ... (ffi.import: (getenv "as" getenv/0 [] "io" (Array ffi.String))) + ... ... https://www.php.net/manual/en/function.getenv.php + ... ... https://www.php.net/manual/en/function.array-keys.php + ... (ffi.import: (array_keys [(Array ffi.String)] (Array ffi.String))) + ... ) + + ... @.scheme + ... (as_is (ffi.import: (exit [Int] "io" Nothing)) + ... ... https://srfi.schemers.org/srfi-98/srfi-98.html + ... (abstract: Pair Any) + ... (abstract: PList Any) + ... (ffi.import: (get-environment-variables [] "io" PList)) + ... (ffi.import: (car [Pair] Text)) + ... (ffi.import: (cdr [Pair] Text)) + ... (ffi.import: (car "as" head [PList] Pair)) + ... (ffi.import: (cdr "as" tail [PList] PList))) + (as_is))) (implementation: .public default @@ -294,40 +294,40 @@ ..jvm##consume (list#each (|>> ffi.of_string)) io.io)] - (for [@.old <jvm> - @.jvm <jvm> - @.js (io.io (if ffi.on_node_js? - (case (ffi.global Object [process env]) - {.#Some process/env} - (|> (Object::entries [process/env]) - (array.list {.#None}) - (list#each (|>> (array.read! 0) maybe.trusted))) - - {.#None} - (list)) - (list))) - @.python (# io.monad each (array.list {.#None}) (os/environ::keys [])) - ... Lua offers no way to get all the environment variables available. - @.lua (io.io (list)) - @.ruby (io.io (array.list {.#None} (Env::keys []))) - ... @.php (do io.monad - ... [environment (..getenv/0 [])] - ... (in (|> environment - ... ..array_keys - ... (array.list {.#None}) - ... (list#each (function (_ variable) - ... [variable ("php array read" (:as Nat variable) environment)])) - ... (dictionary.of_list text.hash)))) - ... @.scheme (do io.monad - ... [input (..get-environment-variables [])] - ... (loop [input input - ... output environment.empty] - ... (if ("scheme object nil?" input) - ... (in output) - ... (let [entry (..head input)] - ... (again (..tail input) - ... (dictionary.has (..car entry) (..cdr entry) output)))))) - ]))) + (for @.old <jvm> + @.jvm <jvm> + @.js (io.io (if ffi.on_node_js? + (case (ffi.global Object [process env]) + {.#Some process/env} + (|> (Object::entries [process/env]) + (array.list {.#None}) + (list#each (|>> (array.read! 0) maybe.trusted))) + + {.#None} + (list)) + (list))) + @.python (# io.monad each (array.list {.#None}) (os/environ::keys [])) + ... Lua offers no way to get all the environment variables available. + @.lua (io.io (list)) + @.ruby (io.io (array.list {.#None} (Env::keys []))) + ... @.php (do io.monad + ... [environment (..getenv/0 [])] + ... (in (|> environment + ... ..array_keys + ... (array.list {.#None}) + ... (list#each (function (_ variable) + ... [variable ("php array read" (:as Nat variable) environment)])) + ... (dictionary.of_list text.hash)))) + ... @.scheme (do io.monad + ... [input (..get-environment-variables [])] + ... (loop [input input + ... output environment.empty] + ... (if ("scheme object nil?" input) + ... (in output) + ... (let [entry (..head input)] + ... (again (..tail input) + ... (dictionary.has (..car entry) (..cdr entry) output)))))) + ))) (def: (variable name) (template.let [(!fetch <method> <post>) @@ -340,23 +340,23 @@ {.#None} (exception.except ..unknown_environment_variable [name]))))]] (with_expansions [<jvm> (!fetch (<| java/lang/System::resolveEnv ffi.as_string) ffi.of_string)] - (for [@.old <jvm> - @.jvm <jvm> - @.js (io.io (if ffi.on_node_js? - (case (do maybe.monad - [process/env (ffi.global Object [process env])] - (array.read! (:as Nat name) - (:as (Array Text) process/env))) - {.#Some value} - {try.#Success value} - - {.#None} - (exception.except ..unknown_environment_variable [name])) - (exception.except ..unknown_environment_variable [name]))) - @.python (!fetch os/environ::get |>) - @.lua (!fetch os/getenv |>) - @.ruby (!fetch Env::fetch |>) - ])))) + (for @.old <jvm> + @.jvm <jvm> + @.js (io.io (if ffi.on_node_js? + (case (do maybe.monad + [process/env (ffi.global Object [process env])] + (array.read! (:as Nat name) + (:as (Array Text) process/env))) + {.#Some value} + {try.#Success value} + + {.#None} + (exception.except ..unknown_environment_variable [name])) + (exception.except ..unknown_environment_variable [name]))) + @.python (!fetch os/environ::get |>) + @.lua (!fetch os/getenv |>) + @.ruby (!fetch Env::fetch |>) + )))) (def: home (io.run! @@ -365,23 +365,23 @@ (maybe#each (|>> ffi.of_string)) (maybe.else "") io.io)] - (for [@.old <jvm> - @.jvm <jvm> - @.js (if ffi.on_node_js? - (|> (node_js.require "os") - maybe.trusted - (:as NodeJs_OS) - NodeJs_OS::homedir) - <default>) - @.python (os/path::expanduser "~") - @.lua (..run_command "~" "echo ~") - @.ruby (io.io (Dir::home)) - ... @.php (do io.monad - ... [output (..getenv/1 ["HOME"])] - ... (in (if (bit#= false (:as Bit output)) - ... "~" - ... output))) - ] + (for @.old <jvm> + @.jvm <jvm> + @.js (if ffi.on_node_js? + (|> (node_js.require "os") + maybe.trusted + (:as NodeJs_OS) + NodeJs_OS::homedir) + <default>) + @.python (os/path::expanduser "~") + @.lua (..run_command "~" "echo ~") + @.ruby (io.io (Dir::home)) + ... @.php (do io.monad + ... [output (..getenv/1 ["HOME"])] + ... (in (if (bit#= false (:as Bit output)) + ... "~" + ... output))) + ... TODO: Replace dummy implementation. <default>)))) @@ -392,30 +392,30 @@ (maybe#each (|>> ffi.of_string)) (maybe.else "") io.io)] - (for [@.old <jvm> - @.jvm <jvm> - @.js (if ffi.on_node_js? - (case (ffi.global ..NodeJs_Process [process]) - {.#Some process} - (NodeJs_Process::cwd process) - - {.#None} - (io.io <default>)) - (io.io <default>)) - @.python (os::getcwd []) - @.lua (do io.monad - [.let [default <default>] - on_windows (..run_command default "cd")] - (if (same? default on_windows) - (..run_command default "pwd") - (in on_windows))) - @.ruby (io.io (FileUtils::pwd)) - ... @.php (do io.monad - ... [output (..getcwd [])] - ... (in (if (bit#= false (:as Bit output)) - ... "." - ... output))) - ] + (for @.old <jvm> + @.jvm <jvm> + @.js (if ffi.on_node_js? + (case (ffi.global ..NodeJs_Process [process]) + {.#Some process} + (NodeJs_Process::cwd process) + + {.#None} + (io.io <default>)) + (io.io <default>)) + @.python (os::getcwd []) + @.lua (do io.monad + [.let [default <default>] + on_windows (..run_command default "cd")] + (if (same? default on_windows) + (..run_command default "pwd") + (in on_windows))) + @.ruby (io.io (FileUtils::pwd)) + ... @.php (do io.monad + ... [output (..getcwd [])] + ... (in (if (bit#= false (:as Bit output)) + ... "." + ... output))) + ... TODO: Replace dummy implementation. (io.io <default>))))) @@ -423,19 +423,19 @@ (with_expansions [<jvm> (do io.monad [_ (java/lang/System::exit (ffi.as_int code))] (in (undefined)))] - (for [@.old <jvm> - @.jvm <jvm> - @.js (cond ffi.on_node_js? - (..exit_node_js! code) - - ffi.on_browser? - (..exit_browser! code) - - ... else - (..default_exit! code)) - @.python (os::_exit code) - @.lua (os/exit code) - @.ruby (Kernel::exit code) - ... @.php (..exit [code]) - ... @.scheme (..exit [code]) - ])))) + (for @.old <jvm> + @.jvm <jvm> + @.js (cond ffi.on_node_js? + (..exit_node_js! code) + + ffi.on_browser? + (..exit_browser! code) + + ... else + (..default_exit! code)) + @.python (os::_exit code) + @.lua (os/exit code) + @.ruby (Kernel::exit code) + ... @.php (..exit [code]) + ... @.scheme (..exit [code]) + )))) diff --git a/stdlib/source/library/lux/world/shell.lux b/stdlib/source/library/lux/world/shell.lux index 22f63e05b..154fb6290 100644 --- a/stdlib/source/library/lux/world/shell.lux +++ b/stdlib/source/library/lux/world/shell.lux @@ -306,8 +306,8 @@ process (java/lang/ProcessBuilder::start builder)] (..default_process process)))) )] - (for [@.old (as_is <jvm>) - @.jvm (as_is <jvm>)] + (for @.old (as_is <jvm>) + @.jvm (as_is <jvm>) (as_is))) (type: .public (Mock s) |