diff options
| -rw-r--r-- | documentation/bookmark/compiler.md | 1 | ||||
| -rw-r--r-- | lux-js/source/program.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/library/lux/data/text/buffer.lux | 28 | ||||
| -rw-r--r-- | stdlib/source/library/lux/ffi.js.lux | 57 | ||||
| -rw-r--r-- | stdlib/source/library/lux/world/file.lux | 195 | ||||
| -rw-r--r-- | stdlib/source/program/compositor.lux | 17 | ||||
| -rw-r--r-- | stdlib/source/specification/lux/abstract/hash.lux | 7 | ||||
| -rw-r--r-- | stdlib/source/test/lux.lux | 93 | ||||
| -rw-r--r-- | stdlib/source/test/lux/ffi.js.lux | 11 |
9 files changed, 309 insertions, 102 deletions
diff --git a/documentation/bookmark/compiler.md b/documentation/bookmark/compiler.md index 6cb381190..ea86dca98 100644 --- a/documentation/bookmark/compiler.md +++ b/documentation/bookmark/compiler.md @@ -1,5 +1,6 @@ # Methodology +1. [Nada Amin's keynote "Staged Relational Interpreters: Running Backwards, Faster"](https://www.twitch.tv/videos/1011771746) 1. [Scope herding with delimited continuations](https://blog.moertel.com/posts/2005-09-13-scope-herding-with-delimited-continuations.html) 1. [Compiling with Continuations by Andrew W. Appel](https://www.amazon.com/dp/0521416957) 1. [Collapsing Towers of Interpreters](https://www.cs.purdue.edu/homes/rompf/papers/amin-popl18.pdf) diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux index 295aba2ce..ac43d9dd2 100644 --- a/lux-js/source/program.lux +++ b/lux-js/source/program.lux @@ -574,7 +574,7 @@ (IO (Platform [Register Text] _.Expression _.Statement)) (do io.monad [host ..host] - (wrap {#platform.&file_system (file.async file.default) + (wrap {#platform.&file_system file.default #platform.host host #platform.phase js.generate #platform.runtime runtime.generate diff --git a/stdlib/source/library/lux/data/text/buffer.lux b/stdlib/source/library/lux/data/text/buffer.lux index 5766d25ef..166f87a3b 100644 --- a/stdlib/source/library/lux/data/text/buffer.lux +++ b/stdlib/source/library/lux/data/text/buffer.lux @@ -1,8 +1,8 @@ (.module: [library [lux #* - [ffi (#+ import:)] ["@" target] + ["." ffi (#+ import:)] [control ["." function]] [data @@ -36,6 +36,10 @@ (toString [] java/lang/String)]))] (`` (for {@.old (as_is <jvm>) @.jvm (as_is <jvm>) + @.js (as_is (import: (JS_Array a) + ["#::." + (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)) @@ -46,6 +50,7 @@ (`` (abstract: #export 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))]} ## default (Row Text)) @@ -57,6 +62,7 @@ (:abstraction (with_expansions [<jvm> [0 function.identity]] (for {@.old <jvm> @.jvm <jvm> + @.js [0 function.identity] @.lua [0 function.identity]} ## default row.empty)))) @@ -74,14 +80,22 @@ (|>> transform (append! chunk))]))] (for {@.old <jvm> @.jvm <jvm> + @.js (let [[capacity transform] (:representation buffer) + append! (: (-> (JS_Array Text) (JS_Array Text)) + (function (_ array) + (exec + (JS_Array::push [chunk] array) + array)))] + (:abstraction [(n.+ (//.size chunk) capacity) + (|>> transform append!)])) @.lua (let [[capacity transform] (:representation buffer) - append! (: (-> Text (array.Array Text) (array.Array Text)) - (function (_ chunk array) + append! (: (-> (array.Array Text) (array.Array Text)) + (function (_ array) (exec (table/insert [array chunk]) array)))] (:abstraction [(n.+ (//.size chunk) capacity) - (|>> transform (append! chunk))]))} + (|>> transform append!)]))} ## default (|> buffer :representation (row.add chunk) :abstraction)))) @@ -90,6 +104,7 @@ (with_expansions [<jvm> (|>> :representation product.left)] (for {@.old <jvm> @.jvm <jvm> + @.js <jvm> @.lua <jvm>} ## default (|>> :representation @@ -105,6 +120,11 @@ java/lang/StringBuilder::toString))] (for {@.old <jvm> @.jvm <jvm> + @.js (let [[capacity transform] (:representation buffer)] + (|> (array.new 0) + (:as (JS_Array Text)) + transform + (JS_Array::join [""]))) @.lua (let [[capacity transform] (:representation buffer)] (table/concat [(transform (array.new 0)) ""]))} ## default diff --git a/stdlib/source/library/lux/ffi.js.lux b/stdlib/source/library/lux/ffi.js.lux index aae11fc1d..8d092aa02 100644 --- a/stdlib/source/library/lux/ffi.js.lux +++ b/stdlib/source/library/lux/ffi.js.lux @@ -6,7 +6,7 @@ [monad (#+ do)]] [control ["." io] - ["<>" parser + ["<>" parser ("#\." monad) ["<.>" code (#+ Parser)]]] [data ["." product] @@ -149,6 +149,14 @@ ("js object null"))) input)) +(def: #export (null _) + (-> Any Nothing) + (:assume ("js object null"))) + +(def: #export null? + (-> Any Bit) + (|>> "js object null?")) + (def: (without_null g!temp [nullable? outputT] output) (-> Code Nullable Code Code) (if nullable? @@ -161,13 +169,23 @@ (~ g!temp) (.error! "Null is an invalid value.")))))) +(type: Class_Declaration + [Text (List Text)]) + (type: Import - (#Class [Text Text (List Member)]) + (#Class [Class_Declaration Text (List Member)]) (#Function Static_Method)) +(def: class_declaration + (Parser Class_Declaration) + (<>.either (<>.and <code>.local_identifier + (<>\wrap (list))) + (<code>.form (<>.and <code>.local_identifier + (<>.some <code>.local_identifier))))) + (def: import (Parser Import) - (<>.or (<>.and <code>.local_identifier + (<>.or (<>.and ..class_declaration (<>.default ["" (list)] (<code>.tuple (<>.and <code>.text (<>.some member))))) @@ -217,17 +235,19 @@ (syntax: #export (import: {import ..import}) (with_gensyms [g!temp] (case import - (#Class [class format members]) + (#Class [[class_name class_parameters] format members]) (with_gensyms [g!object] (let [qualify (: (-> Text Code) (function (_ member_name) (|> format - (text.replace_all "#" class) + (text.replace_all "#" class_name) (text.replace_all "." member_name) code.local_identifier))) - g!type (code.local_identifier class) - real_class (text.replace_all "/" "." class)] - (wrap (list& (` (type: (~ g!type) + class_parameters (list\map code.local_identifier class_parameters) + declaration (` ((~ (code.local_identifier class_name)) + (~+ class_parameters))) + real_class (text.replace_all "/" "." class_name)] + (wrap (list& (` (type: (~ declaration) (..Object (primitive (~ (code.text real_class)))))) (list\map (function (_ member) (case member @@ -235,8 +255,9 @@ (let [g!inputs (input_variables inputsT)] (` (def: ((~ (qualify "new")) [(~+ (list\map product.right g!inputs))]) - (-> [(~+ (list\map nullable_type inputsT))] - (~ g!type)) + (All [(~+ class_parameters)] + (-> [(~+ (list\map nullable_type inputsT))] + (~ declaration))) (:assume ("js object new" ("js constant" (~ (code.text real_class))) @@ -250,8 +271,9 @@ ("js constant" (~ (code.text (%.format real_class "." field)))))))))) (` (def: ((~ (qualify field)) (~ g!object)) - (-> (~ g!type) - (~ (nullable_type fieldT))) + (All [(~+ class_parameters)] + (-> (~ declaration) + (~ (nullable_type fieldT)))) (:assume (~ (without_null g!temp fieldT (` ("js object get" (~ (code.text field)) (~ g!object))))))))) @@ -271,11 +293,12 @@ (` (def: ((~ (qualify (maybe.default method alias))) [(~+ (list\map product.right g!inputs))] (~ g!object)) - (-> [(~+ (list\map nullable_type inputsT))] - (~ g!type) - (~ (|> (nullable_type outputT) - (try_type try?) - (io_type io?)))) + (All [(~+ class_parameters)] + (-> [(~+ (list\map nullable_type inputsT))] + (~ declaration) + (~ (|> (nullable_type outputT) + (try_type try?) + (io_type io?))))) (:assume (~ (<| (with_io io?) (with_try try?) diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index 3a7b4463d..d59faa1c1 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -307,8 +307,8 @@ ["#::." (size ffi.Number) (mtimeMs ffi.Number) - (isFile [] #io #try ffi.Boolean) - (isDirectory [] #io #try ffi.Boolean)]) + (isFile [] ffi.Boolean) + (isDirectory [] ffi.Boolean)]) (ffi.import: FsConstants ["#::." @@ -316,21 +316,51 @@ (R_OK ffi.Number) (W_OK ffi.Number) (X_OK ffi.Number)]) + + (ffi.import: Error + ["#::." + (toString [] ffi.String)]) + + (template: (with_promise <write> <type> <body>) + (template.with_locals [<read>] + (let [[<read> <write>] (: [(Promise <type>) (promise.Resolver <type>)] + (promise.promise []))] + (exec + <body> + <read>)))) (ffi.import: Fs ["#::." (constants FsConstants) - (readFileSync [ffi.String] #io #try Binary) - (appendFileSync [ffi.String Buffer] #io #try Any) - (writeFileSync [ffi.String Buffer] #io #try Any) - (statSync [ffi.String] #io #try Stats) - (accessSync [ffi.String ffi.Number] #io #try Any) - (renameSync [ffi.String ffi.String] #io #try Any) - (utimesSync [ffi.String ffi.Number ffi.Number] #io #try Any) - (unlinkSync [ffi.String] #io #try Any) - (readdirSync [ffi.String] #io #try (Array ffi.String)) - (mkdirSync [ffi.String] #io #try Any) - (rmdirSync [ffi.String] #io #try Any)]) + (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!) + (-> (promise.Resolver (Try Any)) ffi.Function) + (<| (ffi.closure [error]) + io.run + write! + (if (ffi.null? error) + (#try.Success []) + (#try.Failure (Error::toString [] (:as Error error)))))) + + (def: (value_callback write!) + (All [a] (-> (promise.Resolver (Try a)) ffi.Function)) + (<| (ffi.closure [error datum]) + io.run + write! + (if (ffi.null? error) + (#try.Success (:assume datum)) + (#try.Failure (Error::toString [] (:as Error error)))))) (ffi.import: JsPath ["#::." @@ -372,51 +402,57 @@ "/")) (`` (implementation: #export default - (System IO) + (System Promise) (def: separator ..js_separator) (~~ (template [<name> <method>] [(def: (<name> path) - (do {! io.monad} - [?stats (Fs::statSync [path] (..node_fs []))] - (case ?stats - (#try.Success stats) - (|> stats - (<method> []) - (\ ! map (|>> (try.default false)))) - - (#try.Failure _) - (wrap false))))] + (do promise.monad + [?stats (with_promise write! (Try Stats) + (Fs::stat [path (..value_callback write!)] + (..node_fs [])))] + (wrap (case ?stats + (#try.Success stats) + (<method> [] stats) + + (#try.Failure _) + false))))] [file? Stats::isFile] [directory? Stats::isDirectory] )) (def: (make_directory path) - (let [node_fs (..node_fs [])] - (do io.monad - [outcome (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::F_OK)] node_fs)] - (case outcome - (#try.Success _) - (wrap (exception.throw ..cannot_make_directory [path])) - - (#try.Failure _) - (Fs::mkdirSync [path] node_fs))))) + (do promise.monad + [#let [node_fs (..node_fs [])] + outcome (with_promise write! (Try Any) + (Fs::access [path + (|> node_fs Fs::constants FsConstants::F_OK) + (..any_callback write!)] + node_fs))] + (case outcome + (#try.Success _) + (wrap (exception.throw ..cannot_make_directory [path])) + + (#try.Failure _) + (with_promise write! (Try Any) + (Fs::mkdir [path (..any_callback write!)] node_fs))))) (~~ (template [<name> <method>] [(def: (<name> path) - (do {! (try.with io.monad)} + (do {! (try.with promise.monad)} [#let [node_fs (..node_fs [])] - subs (Fs::readdirSync [path] node_fs)] + subs (with_promise write! (Try (Array ffi.String)) + (Fs::readdir [path (..value_callback write!)] node_fs))] (|> subs array.to_list (list\map (|>> (format path ..js_separator))) (monad.map ! (function (_ sub) - (do ! - [stats (Fs::statSync [sub] node_fs)] - (\ ! map (|>> [sub]) (<method> [] stats))))) + (\ ! map (|>> (<method> []) [sub]) + (with_promise write! (Try Stats) + (Fs::stat [sub (..value_callback write!)] node_fs))))) (\ ! map (|>> (list.filter product.right) (list\map product.left))))))] @@ -425,58 +461,75 @@ )) (def: (file_size path) - (let [! (try.with io.monad)] - (|> (..node_fs []) - (Fs::statSync [path]) - (\ ! map (|>> Stats::size - f.nat))))) + (do (try.with promise.monad) + [stats (with_promise write! (Try Stats) + (Fs::stat [path (..value_callback write!)] + (..node_fs [])))] + (wrap (|> stats + Stats::size + f.nat)))) (def: (last_modified path) - (let [! (try.with io.monad)] - (|> (..node_fs []) - (Fs::statSync [path]) - (\ ! map (|>> Stats::mtimeMs - f.int - duration.from_millis - instant.absolute))))) + (do (try.with promise.monad) + [stats (with_promise write! (Try Stats) + (Fs::stat [path (..value_callback write!)] + (..node_fs [])))] + (wrap (|> stats + Stats::mtimeMs + f.int + duration.from_millis + instant.absolute)))) (def: (can_execute? path) (let [node_fs (..node_fs [])] - (|> node_fs - (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::X_OK)]) - (io\map (|>> (case> (#try.Success _) - true - - (#try.Failure _) - false) - #try.Success))))) + (\ promise.monad map + (|>> (case> (#try.Success _) + true + + (#try.Failure _) + false) + #try.Success) + (with_promise write! (Try Any) + (Fs::access [path + (|> node_fs Fs::constants FsConstants::X_OK) + (..any_callback write!)] + node_fs))))) (def: (read path) - (Fs::readFileSync [path] (..node_fs []))) + (with_promise write! (Try Binary) + (Fs::readFile [path (..value_callback write!)] + (..node_fs [])))) (def: (delete path) - (do {! (try.with io.monad)} + (do (try.with promise.monad) [#let [node_fs (..node_fs [])] - stats (Fs::statSync [path] node_fs) - verdict (Stats::isFile [] stats)] - (if verdict - (Fs::unlinkSync [path] node_fs) - (Fs::rmdirSync [path] node_fs)))) + stats (with_promise write! (Try Stats) + (Fs::stat [path (..value_callback write!)] node_fs))] + (with_promise 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) - (let [when (|> time_stamp instant.relative duration.to_millis i.frac)] - (Fs::utimesSync [path when when] (..node_fs [])))) + (with_promise write! (Try Any) + (let [when (|> time_stamp instant.relative duration.to_millis i.frac)] + (Fs::utimes [path when when (..any_callback write!)] + (..node_fs []))))) (~~ (template [<name> <method>] [(def: (<name> data path) - (<method> [path (Buffer::from data)] (..node_fs [])))] + (with_promise write! (Try Any) + (<method> [path (Buffer::from data) (..any_callback write!)] + (..node_fs []))))] - [write Fs::writeFileSync] - [append Fs::appendFileSync] + [write Fs::writeFile] + [append Fs::appendFile] )) (def: (move destination origin) - (Fs::renameSync [origin destination] (..node_fs []))) + (with_promise write! (Try Any) + (Fs::rename [origin destination (..any_callback write!)] + (..node_fs [])))) ))) @.python diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 6c0f700c2..bc96e7ae0 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -2,9 +2,10 @@ [library [lux (#- Module) [type (#+ :share)] + ["@" target] ["." debug] [abstract - [monad (#+ Monad do)]] + [monad (#+ do)]] [control ["." io (#+ IO io)] ["." try (#+ Try)] @@ -83,14 +84,14 @@ (format "Duration: ")))]] (wrap output))) -(def: (package! monad fs [packager package] static archive context) - (All [!] (-> (Monad !) (file.System !) [Packager file.Path] Static Archive Context (! (Try Any)))) +(def: (package! fs [packager package] static archive context) + (-> (file.System Promise) [Packager file.Path] Static Archive Context (Promise (Try Any))) (case (packager archive context) (#try.Success content) (\ fs write content package) (#try.Failure error) - (\ monad wrap (#try.Failure error)))) + (\ promise.monad wrap (#try.Failure error)))) (with_expansions [<parameters> (as_is anchor expression artifact)] (def: #export (compiler static @@ -135,7 +136,13 @@ (:assume (platform.compile import static expander platform compilation [archive state]))) _ (ioW.freeze (get@ #platform.&file_system platform) static archive) program_context (promise\wrap ($/program.context archive)) - _ (promise.future (..package! io.monad file.default packager,package static archive program_context))] + _ (..package! (for {@.old (file.async file.default) + @.jvm (file.async file.default) + @.js file.default}) + packager,package + static + archive + program_context)] (wrap (debug.log! "Compilation complete!")))) (#/cli.Export export) diff --git a/stdlib/source/specification/lux/abstract/hash.lux b/stdlib/source/specification/lux/abstract/hash.lux index 4722a48a0..e55c8b549 100644 --- a/stdlib/source/specification/lux/abstract/hash.lux +++ b/stdlib/source/specification/lux/abstract/hash.lux @@ -4,8 +4,6 @@ ["_" test (#+ Test)] [abstract [monad (#+ do)]] - [data - ["." bit ("#\." equivalence)]] [math ["." random (#+ Random)] [number @@ -19,5 +17,6 @@ [parameter random subject random] (_.cover [/.Hash] - (bit\= (\= parameter subject) - (n.= (\hash parameter) (\hash subject)))))) + (if (\= parameter subject) + (n.= (\hash parameter) (\hash subject)) + true)))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index dffa24069..e7ad9d03c 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -619,6 +619,98 @@ (text\= static_char))) ))) +(type: Small + {#small_left Nat + #small_right Text}) + +(type: Big + {#big_left Nat + #big_right Small}) + +(def: for_slot + Test + (do random.monad + [start/s random.nat + start/b random.nat + shift/s random.nat + shift/b random.nat + text (random.ascii/lower 1) + #let [expected/s (n.+ shift/s start/s) + expected/b (n.+ shift/b start/b) + + sample {#big_left start/b + #big_right {#small_left start/s + #small_right text}}]] + ($_ _.and + (_.cover [/.get@] + (and (and (|> sample + (/.get@ #big_left) + (is? start/b)) + (|> sample + ((/.get@ #big_left)) + (is? start/b))) + (and (|> sample + (/.get@ [#big_right #small_left]) + (is? start/s)) + (|> sample + ((/.get@ [#big_right #small_left])) + (is? start/s))))) + (_.cover [/.set@] + (and (and (|> sample + (/.set@ #big_left shift/b) + (/.get@ #big_left) + (is? shift/b)) + (|> sample + ((/.set@ #big_left shift/b)) + (/.get@ #big_left) + (is? shift/b)) + (|> sample + ((/.set@ #big_left) shift/b) + (/.get@ #big_left) + (is? shift/b))) + (and (|> sample + (/.set@ [#big_right #small_left] shift/s) + (/.get@ [#big_right #small_left]) + (is? shift/s)) + (|> sample + ((/.set@ [#big_right #small_left] shift/s)) + (/.get@ [#big_right #small_left]) + (is? shift/s)) + (|> sample + ((/.set@ [#big_right #small_left]) shift/s) + (/.get@ [#big_right #small_left]) + (is? shift/s))))) + (_.cover [/.update@] + (and (and (|> sample + (/.update@ #big_left (n.+ shift/b)) + (/.get@ #big_left) + (n.= expected/b)) + (|> sample + ((/.update@ #big_left (n.+ shift/b))) + (/.get@ #big_left) + (n.= expected/b)) + (|> sample + ((: (-> (-> Nat Nat) (-> Big Big)) + (/.update@ #big_left)) + (n.+ shift/b)) + (/.get@ #big_left) + (n.= expected/b))) + (and (|> sample + (/.update@ [#big_right #small_left] (n.+ shift/s)) + (/.get@ [#big_right #small_left]) + (n.= expected/s)) + (|> sample + ((/.update@ [#big_right #small_left] (n.+ shift/s))) + (/.get@ [#big_right #small_left]) + (n.= expected/s)) + (|> sample + ((: (-> (-> Nat Nat) (-> Big Big)) + (/.update@ [#big_right #small_left])) + (n.+ shift/s)) + (/.get@ [#big_right #small_left]) + (n.= expected/s))))) + ))) + (def: test Test (<| (_.covering /._) @@ -645,6 +737,7 @@ ..for_function ..for_template ..for_static + ..for_slot ..sub_tests ))) diff --git a/stdlib/source/test/lux/ffi.js.lux b/stdlib/source/test/lux/ffi.js.lux index 70ca96929..6e8a38684 100644 --- a/stdlib/source/test/lux/ffi.js.lux +++ b/stdlib/source/test/lux/ffi.js.lux @@ -82,6 +82,17 @@ [/.Undefined] )) )) + (_.cover [/.null] + (exec + (: Nat (/.null [])) + (: Text (/.null [])) + (: (All [a] (-> a a)) (/.null [])) + true)) + (_.cover [/.null?] + (and (/.null? (/.null [])) + (not (/.null? 0)) + (not (/.null? "0")) + (not (/.null? (|>>))))) (_.cover [/.constant] (|> (/.constant /.Function [parseFloat]) "js object null?" |