aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lux-js/source/program.lux22
-rw-r--r--stdlib/source/lux/data/binary.lux7
-rw-r--r--stdlib/source/lux/data/collection/list.lux31
-rw-r--r--stdlib/source/lux/data/format/tar.lux28
-rw-r--r--stdlib/source/lux/data/text/encoding.lux44
-rw-r--r--stdlib/source/lux/debug.lux4
-rw-r--r--stdlib/source/lux/host.js.lux58
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux51
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux4
-rw-r--r--stdlib/source/lux/world/file.lux2
-rw-r--r--stdlib/source/program/compositor.lux5
-rw-r--r--stdlib/source/test/lux/extension.lux18
-rw-r--r--stdlib/source/test/lux/host.js.lux102
15 files changed, 276 insertions, 111 deletions
diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux
index bd7dded23..18b31c415 100644
--- a/lux-js/source/program.lux
+++ b/lux-js/source/program.lux
@@ -501,16 +501,17 @@
(do try.monad
[handler (try.from-maybe (..ensure-macro (:coerce Macro handler)))
#let [to-js (: (-> Any java/lang/Object)
- (|>> (:coerce (Array java/lang/Object)) js-structure (:coerce java/lang/Object)))]]
- (jdk/nashorn/api/scripting/JSObject::call #.None
- (|> (array.new 2)
- (: (Array java/lang/Object))
- (array.write 0 (to-js name))
- (array.write 1 (to-js phase))
- (array.write 2 (to-js archive))
- (array.write 3 (to-js parameters))
- (array.write 4 (to-js state)))
- (:coerce jdk/nashorn/api/scripting/JSObject handler)))))
+ (|>> (:coerce (Array java/lang/Object)) js-structure (:coerce java/lang/Object)))]
+ output (jdk/nashorn/api/scripting/JSObject::call #.None
+ (|> (array.new 5)
+ (: (Array java/lang/Object))
+ (array.write 0 name)
+ (array.write 1 (to-js phase))
+ (array.write 2 (to-js archive))
+ (array.write 3 (to-js parameters))
+ (array.write 4 (to-js state)))
+ (:coerce jdk/nashorn/api/scripting/JSObject handler))]
+ (lux-object (:coerce java/lang/Object output)))))
(def: (declare-success! _)
(-> Any (Promise Any))
@@ -528,6 +529,7 @@
generation.bundle
extension/bundle.empty
(..program reference.artifact)
+ [(& Register Text) _.Expression _.Statement]
..extender
service
[(packager.package _.use-strict _.code _.then)
diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux
index 30c2bc193..ed038a709 100644
--- a/stdlib/source/lux/data/binary.lux
+++ b/stdlib/source/lux/data/binary.lux
@@ -75,7 +75,8 @@
(new [ArrayBuffer])
(length host.Number))
- (type: #export Binary Uint8Array))}))
+ (type: #export Binary
+ Uint8Array))}))
(template: (!size binary)
(for {@.old
@@ -267,9 +268,9 @@
## Default
(let [source-input (n.- source-offset (!size source))
target-output (n.- target-offset (!size target))]
- (if (n.<= target-output source-input)
+ (if (n.<= source-input target-output)
(loop [idx 0]
- (if (n.< source-input idx)
+ (if (n.< target-output idx)
(exec (!write (n.+ target-offset idx)
(!read (n.+ source-offset idx) source)
target)
diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux
index ce0d8f031..e694a6161 100644
--- a/stdlib/source/lux/data/collection/list.lux
+++ b/stdlib/source/lux/data/collection/list.lux
@@ -219,17 +219,28 @@
(def: #export (search-all check xs)
(All [a b]
(-> (-> a (Maybe b)) (List a) (List b)))
- (case xs
- #.Nil
- #.Nil
+ (for {## TODO: Stop relying on this ASAP.
+ @.js
+ (fold (function (_ head tail)
+ (case (check head)
+ (#.Some head)
+ (#.Cons head tail)
+
+ #.None
+ tail))
+ #.Nil
+ (reverse xs))}
+ (case xs
+ #.Nil
+ #.Nil
- (#.Cons x xs')
- (case (check x)
- (#.Some output)
- (#.Cons output (search-all check xs'))
-
- #.None
- (search-all check xs'))))
+ (#.Cons x xs')
+ (case (check x)
+ (#.Some output)
+ (#.Cons output (search-all check xs'))
+
+ #.None
+ (search-all check xs')))))
(def: #export (interpose sep xs)
{#.doc "Puts a value between every two elements in the list."}
diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux
index b803e6453..544540418 100644
--- a/stdlib/source/lux/data/format/tar.lux
+++ b/stdlib/source/lux/data/format/tar.lux
@@ -172,7 +172,10 @@
(binary.fold n.+ 0))
(def: checksum-checksum
- (|> ..dummy-checksum :representation encoding.to-utf8 ..checksum))
+ (|> ..dummy-checksum
+ :representation
+ encoding.to-utf8
+ ..checksum))
(def: checksum-code
(-> Binary Checksum)
@@ -727,17 +730,15 @@
(def: end-of-archive-size Size (n.* 2 ..block-size))
-(def: end-of-archive
- Binary
- (binary.create ..end-of-archive-size))
-
-(def: #export (writer tar)
+(def: #export writer
(Writer Tar)
- (format@compose (row@fold (function (_ next total)
- (format@compose total (..entry-writer next)))
- format@identity
- tar)
- (format.segment ..end-of-archive-size ..end-of-archive)))
+ (let [end-of-archive (binary.create ..end-of-archive-size)]
+ (function (_ tar)
+ (format@compose (row@fold (function (_ next total)
+ (format@compose total (..entry-writer next)))
+ format@identity
+ tar)
+ (format.segment ..end-of-archive-size end-of-archive)))))
(exception: #export (wrong-checksum {expected Nat} {actual Nat})
(exception.report
@@ -755,7 +756,10 @@
## add-in the checksum of the spaces.
(def: (expected-checksum checksum header)
(-> Checksum Binary Nat)
- (let [|checksum| (|> checksum ..from-checksum encoding.to-utf8 ..checksum)]
+ (let [|checksum| (|> checksum
+ ..from-checksum
+ encoding.to-utf8
+ ..checksum)]
(|> (..checksum header)
(n.- |checksum|)
(n.+ ..checksum-checksum))))
diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux
index 1ef044080..ae1e11021 100644
--- a/stdlib/source/lux/data/text/encoding.lux
+++ b/stdlib/source/lux/data/text/encoding.lux
@@ -1,6 +1,7 @@
(.module:
[lux #*
["@" target]
+ ["." host]
[abstract
[codec (#+ Codec)]]
[control
@@ -8,8 +9,7 @@
[data
[binary (#+ Binary)]]
[type
- abstract]
- ["." host]])
+ abstract]])
## https://docs.oracle.com/javase/8/docs/technotes/guides/intl/encoding.doc.html
@@ -182,7 +182,14 @@
@.js
(as-is (host.import: Uint8Array)
-
+
+ ## On Node
+ (host.import: Buffer
+ (#static from #as from|encode [host.String host.String] Buffer)
+ (#static from #as from|decode [Uint8Array] Buffer)
+ (toString [host.String] host.String))
+
+ ## On the browser
(host.import: TextEncoder
(new [host.String])
(encode [host.String] Uint8Array))
@@ -204,8 +211,19 @@
(java/lang/String::getBytes (..name ..utf-8) value)
@.js
- (|> (TextEncoder::new [(..name ..utf-8)])
- (TextEncoder::encode [value]))}))
+ (cond host.on-nashorn?
+ (:coerce Binary ("js object do" "getBytes" value ["utf8"]))
+
+ host.on-node-js?
+ (|> (Buffer::from|encode [value "utf8"])
+ ## This coercion is valid as per NodeJS's documentation:
+ ## https://nodejs.org/api/buffer.html#buffer_buffers_and_typedarrays
+ (:coerce Uint8Array))
+
+ ## On the browser
+ (|> (TextEncoder::new [(..name ..utf-8)])
+ (TextEncoder::encode [value]))
+ )}))
(def: #export (from-utf8 value)
(-> Binary (Try Text))
@@ -216,8 +234,20 @@
(#try.Success (java/lang/String::new value (..name ..utf-8)))
@.js
- (#try.Success (|> (TextDecoder::new [(..name ..utf-8)])
- (TextDecoder::decode [value])))}))
+ (cond host.on-nashorn?
+ (|> ("js object new" ("js constant" "java.lang.String") [value "utf8"])
+ (:coerce Text)
+ #try.Success)
+
+ host.on-node-js?
+ (|> (Buffer::from|decode [value])
+ (Buffer::toString ["utf8"])
+ #try.Success)
+
+ ## On the browser
+ (|> (TextDecoder::new [(..name ..utf-8)])
+ (TextDecoder::decode [value])
+ #try.Success))}))
(structure: #export UTF-8
(Codec Binary Text)
diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux
index f46c3334b..d4f12e9fe 100644
--- a/stdlib/source/lux/debug.lux
+++ b/stdlib/source/lux/debug.lux
@@ -119,8 +119,8 @@
<type-of>
(`` (|> value (~~ (template.splice <then>)))))
(["boolean" [(:coerce .Bit) %.bit]]
- ["string" [(:coerce .Text) %t]]
- ["number" [(:coerce .Frac) %f]]
+ ["string" [(:coerce .Text) %.text]]
+ ["number" [(:coerce .Frac) %.frac]]
["undefined" [JSON::stringify]])
"object"
diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux
index cf7902a8f..eb0da3594 100644
--- a/stdlib/source/lux/host.js.lux
+++ b/stdlib/source/lux/host.js.lux
@@ -8,7 +8,8 @@
["<c>" code (#+ Parser)]]]
[data
["." product]
- [text
+ ["." maybe]
+ ["." text
["%" format (#+ format)]]
[collection
["." list ("#@." functor)]]]
@@ -64,7 +65,7 @@
<c>.local-identifier
..nullable)))
-(type: Common-Method [Text (List Nullable) Bit Nullable])
+(type: Common-Method [Text (Maybe Text) (List Nullable) Bit Nullable])
(type: Static-Method Common-Method)
(type: Virtual-Method Common-Method)
@@ -76,6 +77,7 @@
(Parser Common-Method)
($_ <>.and
<c>.local-identifier
+ (<>.maybe (<>.after (<c>.this! (' #as)) <c>.local-identifier))
(<c>.tuple (<>.some ..nullable))
(<>.parses? (<c>.this! (' #try)))
..nullable))
@@ -145,6 +147,15 @@
..static-method
))
+(syntax: #export (try expression)
+ {#.doc (doc (case (try (risky-computation input))
+ (#.Right success)
+ (do-something success)
+
+ (#.Left error)
+ (recover-from-failure error)))}
+ (wrap (list (` ("lux try" ((~! io.io) (~ expression)))))))
+
(def: (with-try try? without-try)
(-> Bit Code Code)
(if try?
@@ -179,8 +190,10 @@
(with-gensyms [g!object]
(let [qualify (: (-> Text Code)
(|>> (format class "::") code.local-identifier))
- g!type (code.local-identifier class)]
- (wrap (list& (` (type: (~ g!type) (..Object (primitive (~ (code.text class))))))
+ g!type (code.local-identifier class)
+ real-class (text.replace-all "/" "." class)]
+ (wrap (list& (` (type: (~ g!type)
+ (..Object (primitive (~ (code.text real-class))))))
(list@map (function (_ member)
(case member
(#Constructor inputsT)
@@ -191,7 +204,7 @@
(~ g!type))
(:assume
("js object new"
- ("js constant" (~ (code.text class)))
+ ("js constant" (~ (code.text real-class)))
[(~+ (list@map (with-null g!temp) g!inputs))])))))
(#Field [field fieldT])
@@ -204,12 +217,17 @@
(#Method method)
(case method
- (#Static [method inputsT try? outputT])
- (make-function (qualify method) g!temp method inputsT try? outputT)
+ (#Static [method alias inputsT try? outputT])
+ (..make-function (qualify (maybe.default method alias))
+ g!temp
+ (format real-class "." method)
+ inputsT
+ try?
+ outputT)
- (#Virtual [method inputsT try? outputT])
+ (#Virtual [method alias inputsT try? outputT])
(let [g!inputs (input-variables inputsT)]
- (` (def: ((~ (qualify method))
+ (` (def: ((~ (qualify (maybe.default method alias)))
[(~+ (list@map product.right g!inputs))]
(~ g!object))
(-> [(~+ (list@map nullable-type inputsT))]
@@ -224,8 +242,12 @@
[(~+ (list@map (with-null g!temp) g!inputs))])))))))))))
members)))))
- (#Function [name inputsT try? outputT])
- (wrap (list (make-function (code.local-identifier name) g!temp name inputsT try? outputT)))
+ (#Function [name alias inputsT try? outputT])
+ (wrap (list (..make-function (code.local-identifier (maybe.default name alias))
+ g!temp
+ name
+ inputsT
+ try? outputT)))
)))
(syntax: #export (type-of object)
@@ -256,3 +278,17 @@
_
false)))
+
+(template: (!defined? constant)
+ (case (..type-of ("js constant" constant))
+ "undefined"
+ false
+
+ _
+ true))
+
+(def: #export on-nashorn?
+ Bit
+ (and (!defined? "java")
+ (!defined? "java.lang")
+ (!defined? "java.lang.Object")))
diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux
index 88bf45304..a1dff7792 100644
--- a/stdlib/source/lux/tool/compiler/default/init.lux
+++ b/stdlib/source/lux/tool/compiler/default/init.lux
@@ -49,7 +49,7 @@
["." artifact]
["." document]]]]])
-(def: #export (state target module expander host-analysis host generate generation-bundle host-directive-bundle program extender)
+(def: #export (state target module expander host-analysis host generate generation-bundle host-directive-bundle program anchorT,expressionT,directiveT extender)
(All [anchor expression directive]
(-> Host
Module
@@ -60,7 +60,7 @@
(///generation.Bundle anchor expression directive)
(///directive.Bundle anchor expression directive)
(Program expression directive)
- Extender
+ [Type Type Type] Extender
(///directive.State+ anchor expression directive)))
(let [synthesis-state [synthesisE.bundle ///synthesis.init]
generation-state [generation-bundle (///generation.state host module)]
@@ -68,7 +68,7 @@
analysis-state [(analysisE.bundle eval host-analysis)
(///analysis.state (///analysis.info ///version.version target))]]
[(dictionary.merge host-directive-bundle
- (luxD.bundle expander host-analysis program extender))
+ (luxD.bundle expander host-analysis program anchorT,expressionT,directiveT extender))
{#///directive.analysis {#///directive.state analysis-state
#///directive.phase (analysisP.phase expander)}
#///directive.synthesis {#///directive.state synthesis-state
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index f162cc157..0580372c1 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -179,7 +179,7 @@
(///phase.run' state)
(:: try.monad map product.left)))
- (def: #export (initialize static module expander host-analysis platform generation-bundle host-directive-bundle program extender
+ (def: #export (initialize static module expander host-analysis platform generation-bundle host-directive-bundle program anchorT,expressionT,directiveT extender
import compilation-sources)
(All [<type-vars>]
(-> Static
@@ -190,7 +190,7 @@
<Bundle>
(///directive.Bundle <type-vars>)
(Program expression directive)
- Extender
+ [Type Type Type] Extender
Import (List Context)
(Promise (Try [<State+> Archive]))))
(do (try.with promise.monad)
@@ -203,6 +203,7 @@
generation-bundle
host-directive-bundle
program
+ anchorT,expressionT,directiveT
extender)]
_ (ioW.enable (get@ #&file-system platform) static)
[archive analysis-state bundles] (ioW.thaw (get@ #host platform) (get@ #&file-system platform) static import compilation-sources)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
index 59557b6de..090f81842 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
@@ -303,10 +303,10 @@
(define-alias alias def-name)))]
(wrap /////directive.no-requirements)))]))
-(template [<description> <mame> <type> <scope> <definer>]
- [(def: (<mame> extender)
+(template [<description> <mame> <def-type> <type> <scope> <definer>]
+ [(def: (<mame> [anchorT expressionT directiveT] extender)
(All [anchor expression directive]
- (-> Extender
+ (-> [Type Type Type] Extender
(Handler anchor expression directive)))
(function (handler extension-name phase archive inputsC+)
(case inputsC+
@@ -314,10 +314,7 @@
(do phase.monad
[[_ _ name] (evaluate! archive Text nameC)
[_ handlerV] (<definer> archive (:coerce Text name)
- (:by-example [anchor expression directive]
- {(Handler anchor expression directive)
- handler}
- <type>)
+ (type <def-type>)
valueC)
_ (<| <scope>
(///.install extender (:coerce Text name))
@@ -333,10 +330,26 @@
_
(phase.throw ///.invalid-syntax [extension-name %.code inputsC+]))))]
- ["Analysis" def::analysis /////analysis.Handler /////directive.lift-analysis ..analyser]
- ["Synthesis" def::synthesis /////synthesis.Handler /////directive.lift-synthesis ..synthesizer]
- ["Generation" def::generation (/////generation.Handler anchor expression directive) /////directive.lift-generation ..generator]
- ["Directive" def::directive (/////directive.Handler anchor expression directive) (<|) ..directive]
+ ["Analysis"
+ def::analysis
+ /////analysis.Handler /////analysis.Handler
+ /////directive.lift-analysis
+ ..analyser]
+ ["Synthesis"
+ def::synthesis
+ /////synthesis.Handler /////synthesis.Handler
+ /////directive.lift-synthesis
+ ..synthesizer]
+ ["Generation"
+ def::generation
+ (/////generation.Handler anchorT expressionT directiveT) (/////generation.Handler anchor expression directive)
+ /////directive.lift-generation
+ ..generator]
+ ["Directive"
+ def::directive
+ (/////directive.Handler anchorT expressionT directiveT) (/////directive.Handler anchor expression directive)
+ (<|)
+ ..directive]
)
## TODO; Both "prepare-program" and "define-program" exist only
@@ -393,11 +406,12 @@
_
(phase.throw ///.invalid-syntax [extension-name %.code inputsC+]))))
-(def: (bundle::def expander host-analysis program extender)
+(def: (bundle::def expander host-analysis program anchorT,expressionT,directiveT extender)
(All [anchor expression directive]
(-> Expander
/////analysis.Bundle
(Program expression directive)
+ [Type Type Type]
Extender
(Bundle anchor expression directive)))
(<| (///bundle.prefix "def")
@@ -405,21 +419,22 @@
(dictionary.put "module" def::module)
(dictionary.put "alias" def::alias)
(dictionary.put "type tagged" (def::type-tagged expander host-analysis))
- (dictionary.put "analysis" (def::analysis extender))
- (dictionary.put "synthesis" (def::synthesis extender))
- (dictionary.put "generation" (def::generation extender))
- (dictionary.put "directive" (def::directive extender))
+ (dictionary.put "analysis" (def::analysis anchorT,expressionT,directiveT extender))
+ (dictionary.put "synthesis" (def::synthesis anchorT,expressionT,directiveT extender))
+ (dictionary.put "generation" (def::generation anchorT,expressionT,directiveT extender))
+ (dictionary.put "directive" (def::directive anchorT,expressionT,directiveT extender))
(dictionary.put "program" (def::program program))
)))
-(def: #export (bundle expander host-analysis program extender)
+(def: #export (bundle expander host-analysis program anchorT,expressionT,directiveT extender)
(All [anchor expression directive]
(-> Expander
/////analysis.Bundle
(Program expression directive)
+ [Type Type Type]
Extender
(Bundle anchor expression directive)))
(<| (///bundle.prefix "lux")
(|> ///bundle.empty
(dictionary.put "def" (lux::def expander host-analysis))
- (dictionary.merge (..bundle::def expander host-analysis program extender)))))
+ (dictionary.merge (..bundle::def expander host-analysis program anchorT,expressionT,directiveT extender)))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
index 7c18df1b9..40322f88b 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
@@ -155,8 +155,8 @@
(runtime: (lux//try op)
(with-vars [ex]
- (_.try (_.return (_.apply/1 op ..unit))
- [ex (_.return (|> ex (_.do "toString" (list))))])))
+ (_.try (_.return (..right (_.apply/1 op ..unit)))
+ [ex (_.return (..left (|> ex (_.do "toString" (list)))))])))
(def: length
(-> Expression Computation)
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 709704e95..4fd43bf15 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -492,7 +492,7 @@
(..can-query
(function (size _)
(|> (Fs::statSync [path] (!fs))
- (:: try.monad map (|>> Stats::size frac-to-nat))
+ (:: try.monad map (|>> Stats::size f.nat))
io.io))))
(def: last-modified
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index f208fb73e..63c398bf9 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -91,7 +91,7 @@
(with-expansions [<parameters> (as-is anchor expression artifact)]
(def: #export (compiler static
- expander host-analysis platform generation-bundle host-directive-bundle program extender
+ expander host-analysis platform generation-bundle host-directive-bundle program anchorT,expressionT,directiveT extender
service
packager,package)
(All [<parameters>]
@@ -102,6 +102,7 @@
(generation.Bundle <parameters>)
(directive.Bundle <parameters>)
(Program expression artifact)
+ [Type Type Type]
Extender
Service
[Packager Path]
@@ -119,7 +120,7 @@
platform}
{(Promise (Try [(directive.State+ <parameters>)
Archive]))
- (:assume (platform.initialize static compilation-module expander host-analysis platform generation-bundle host-directive-bundle program extender
+ (:assume (platform.initialize static compilation-module expander host-analysis platform generation-bundle host-directive-bundle program anchorT,expressionT,directiveT extender
import compilation-sources))})
[archive state] (:share [<parameters>]
{(Platform <parameters>)
diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
index 9aa8ae987..154cb8ea2 100644
--- a/stdlib/source/test/lux/extension.lux
+++ b/stdlib/source/test/lux/extension.lux
@@ -1,7 +1,8 @@
(.module:
[lux #*
["@" target
- ["." jvm]]
+ ["." jvm]
+ ["." js]]
[abstract
[monad (#+ do)]]
[control
@@ -51,13 +52,16 @@
))
(for {@.old
- (as-is)
+ (as-is)}
+
+ (generation: (..my-generation self phase archive {parameters (<>.some <s>.any)})
+ (do phase.monad
+ []
+ (wrap (for {@.jvm
+ (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self))))
- @.jvm
- (as-is (generation: (..my-generation self phase archive {parameters (<>.some <s>.any)})
- (do phase.monad
- []
- (wrap (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self))))))))})
+ @.js
+ (js.string self)})))))
(for {@.old
(as-is)}
diff --git a/stdlib/source/test/lux/host.js.lux b/stdlib/source/test/lux/host.js.lux
index faf9f6b5f..9112716ca 100644
--- a/stdlib/source/test/lux/host.js.lux
+++ b/stdlib/source/test/lux/host.js.lux
@@ -1,28 +1,88 @@
(.module:
[lux #*
- ["&" host]
- [math ["r" random]]]
- lux/test)
+ ["_" test (#+ Test)]
+ [math
+ ["." random (#+ Random)]]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try]]
+ [data
+ ["." text ("#@." equivalence)]
+ [number
+ ["." nat]
+ ["." frac]]]]
+ {1
+ ["." /]})
-(context: "JavaScript operations"
- ($_ seq
- (test "Null equals itself."
- (is? (&.null) (&.null)))
+(/.import: Uint8Array)
- (test "Undefined equals itself."
- (is? (&.undef) (&.undef)))
+## On Nashorn
+(/.import: java/lang/String
+ (new [Uint8Array /.String])
+ (getBytes [/.String] Uint8Array))
- (test "Can reference JavaScript objects."
- (is? (&.ref "Math") (&.ref "Math")))
+## On Node
+(/.import: Buffer
+ (#static from [/.String /.String] Buffer)
+ (toString [/.String] /.String))
- (test "Can create objects and access their fields."
- (|> (&.object "foo" "BAR")
- (&.get "foo" Text)
- (is? "BAR")))
+## On the browser
+(/.import: TextEncoder
+ (new [/.String])
+ (encode [/.String] Uint8Array))
- (test "Can call JavaScript functions"
- (and (is? +124.0
- (&.call! (&.ref "Math.ceil" &.Function) [+123.45] Frac))
- (is? +124.0
- (&.call! (&.ref "Math") "ceil" [+123.45] Frac))))
- ))
+(/.import: TextDecoder
+ (new [/.String])
+ (decode [Uint8Array] /.String))
+
+(def: #export test
+ Test
+ (do {@ random.monad}
+ [boolean random.bit
+ number (:: @ map (|>> (nat.% 100) nat.frac) random.nat)
+ string (random.ascii 5)
+ function (:: @ map (function (_ shift)
+ (: (-> Nat Nat)
+ (nat.+ shift)))
+ random.nat)
+ ## I64s get compiled as JavaScript objects with a specific structure.
+ object random.nat]
+ (<| (_.covering /._)
+ ($_ _.and
+ (_.cover [/.on-browser? /.on-node-js? /.on-nashorn?]
+ (or /.on-nashorn?
+ /.on-node-js?
+ /.on-browser?))
+ (_.cover [/.type-of]
+ (and (text@= "boolean" (/.type-of boolean))
+ (text@= "number" (/.type-of number))
+ (text@= "string" (/.type-of string))
+ (text@= "function" (/.type-of function))
+ (text@= "object" (/.type-of object))))
+ (_.cover [/.try]
+ (case (/.try (error! string))
+ (#try.Success _)
+ false
+
+ (#try.Failure error)
+ (text@= string error)))
+ (_.cover [/.import:]
+ (let [encoding "utf8"]
+ (text@= string
+ (cond /.on-nashorn?
+ (let [binary (java/lang/String::getBytes [encoding] (:coerce java/lang/String string))]
+ (|> (java/lang/String::new [binary encoding])
+ (:coerce Text)))
+
+ /.on-node-js?
+ (|> (Buffer::from [string encoding])
+ (Buffer::toString [encoding]))
+
+ ## On the browser
+ (let [binary (|> (TextEncoder::new [encoding])
+ (TextEncoder::encode [string]))]
+ (|> (TextDecoder::new [encoding])
+ (TextDecoder::decode [binary])))
+ ))))
+ ))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-02 22:00:13 +0000