diff options
-rw-r--r-- | stdlib/source/lux/control/region.lux | 3 | ||||
-rw-r--r-- | stdlib/source/lux/data/coll/array.lux | 5 | ||||
-rw-r--r-- | stdlib/source/lux/host.jvm.lux | 15 | ||||
-rw-r--r-- | stdlib/source/lux/type/resource.lux | 15 | ||||
-rw-r--r-- | stdlib/source/lux/world/file.lux | 33 | ||||
-rw-r--r-- | stdlib/test/test/lux/type/resource.lux | 6 |
6 files changed, 44 insertions, 33 deletions
diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux index 4be0e722e..8df68bf8e 100644 --- a/stdlib/source/lux/control/region.lux +++ b/stdlib/source/lux/control/region.lux @@ -101,7 +101,8 @@ [(#e.Success f) (#e.Success a)] (wrap [cleaners (#e.Success (f a))]) - (^or [(#e.Error error) _] [_ (#e.Error error)]) + (^or [(#e.Error error) _] + [_ (#e.Error error)]) (wrap [cleaners (#e.Error error)])))))) (struct: #export (Monad<Region> Monad<m>) diff --git a/stdlib/source/lux/data/coll/array.lux b/stdlib/source/lux/data/coll/array.lux index 0e4afb4a5..00f4173e0 100644 --- a/stdlib/source/lux/data/coll/array.lux +++ b/stdlib/source/lux/data/coll/array.lux @@ -32,8 +32,9 @@ ("lux array remove" xs i)) (def: #export (copy length src-start src-array dest-start dest-array) - (All [a] (-> Nat Nat (Array a) Nat (Array a) - (Array a))) + (All [a] + (-> Nat Nat (Array a) Nat (Array a) + (Array a))) (if (n/= +0 length) dest-array (list/fold (function [offset target] diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 954e55416..edf361067 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -575,8 +575,9 @@ (def: (make-constructor-parser params class-name arg-decls) (-> (List Type-Paramameter) Text (List ArgDecl) (Syntax Code)) (do p.Monad<Parser> - [[_ args] (: (Syntax [Unit (List Code)]) - (s.form ($_ p.seq (s.this (' ::new!)) (s.tuple (p.exactly (list.size arg-decls) s.any))))) + [args (: (Syntax (List Code)) + (s.form (p.after (s.this (' ::new!)) + (s.tuple (p.exactly (list.size arg-decls) s.any))))) #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]] (wrap (` ((~ (code.text (format "jvm new" ":" class-name ":" (text.join-with "," arg-decls')))) (~+ args)))))) @@ -585,8 +586,9 @@ (-> (List Type-Paramameter) Text Text (List ArgDecl) (Syntax Code)) (do p.Monad<Parser> [#let [dotted-name (format "::" method-name "!")] - [_ args] (: (Syntax [Unit (List Code)]) - (s.form ($_ p.seq (s.this (code.symbol ["" dotted-name])) (s.tuple (p.exactly (list.size arg-decls) s.any))))) + args (: (Syntax (List Code)) + (s.form (p.after (s.this (code.symbol ["" dotted-name])) + (s.tuple (p.exactly (list.size arg-decls) s.any))))) #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]] (wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class-name ":" method-name ":" (text.join-with "," arg-decls')))) (~+ args)))))) @@ -596,8 +598,9 @@ (-> (List Type-Paramameter) Text Text (List ArgDecl) (Syntax Code)) (do p.Monad<Parser> [#let [dotted-name (format "::" method-name "!")] - [_ args] (: (Syntax [Unit (List Code)]) - (s.form ($_ p.seq (s.this (code.symbol ["" dotted-name])) (s.tuple (p.exactly (list.size arg-decls) s.any))))) + args (: (Syntax (List Code)) + (s.form (p.after (s.this (code.symbol ["" dotted-name])) + (s.tuple (p.exactly (list.size arg-decls) s.any))))) #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]] (wrap (`' ((~ (code.text (format <jvm-op> ":" class-name ":" method-name ":" (text.join-with "," arg-decls')))) (~' _jvm_this) (~+ args))))))] diff --git a/stdlib/source/lux/type/resource.lux b/stdlib/source/lux/type/resource.lux index 6da339ea8..d57c25976 100644 --- a/stdlib/source/lux/type/resource.lux +++ b/stdlib/source/lux/type/resource.lux @@ -46,7 +46,7 @@ [[keysT value] (input keysI)] ((f value) keysT))))) -(do-template [<name> <m> <monad> <execute>] +(do-template [<name> <m> <monad> <execute> <lift>] [(def: #export <name> (IxMonad (Procedure <m>)) (IxMonad<Procedure> <monad>)) @@ -55,10 +55,17 @@ (All [v] (-> (Linear <m> v) (<m> v))) (do <monad> [[_ output] (procedure [])] - (wrap output)))] + (wrap output))) - [IxMonad<Sync> IO io.Monad<IO> sync] - [IxMonad<Async> Promise promise.Monad<Promise> async] + (def: #export (<lift> procedure) + (All [v] (-> (<m> v) (Linear <m> v))) + (function [keys] + (do <monad> + [output procedure] + (wrap [keys output]))))] + + [IxMonad<Sync> IO io.Monad<IO> run lift] + [IxMonad<Async> Promise promise.Monad<Promise> run! lift!] ) (abstract: #export Ordered {} []) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index b173fa5ba..92d9a7540 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -2,8 +2,7 @@ lux (lux (control [monad #+ do] ["ex" exception #+ exception:]) - (data ["E" error] - (coll [array])) + (data (coll [array])) (time ["i" instant] ["d" duration]) (world [blob #+ Blob]) @@ -52,7 +51,7 @@ (do-template [<name> <flag>] [(def: #export (<name> data file) (-> Blob File (Process Unit)) - (do (E.ErrorT io.Monad<IO>) + (do io.Monad<Process> [stream (FileOutputStream::new [(java/io/File::new file) <flag>]) _ (OutputStream::write [data] stream) _ (OutputStream::flush [] stream)] @@ -64,7 +63,7 @@ (def: #export (read file) (-> File (Process Blob)) - (do (E.ErrorT io.Monad<IO>) + (do io.Monad<Process> [#let [file' (java/io/File::new file)] size (java/io/File::length [] file') #let [data (blob.create (int-to-nat size))] @@ -77,13 +76,13 @@ (def: #export (size file) (-> File (Process Nat)) - (do (E.ErrorT io.Monad<IO>) + (do io.Monad<Process> [size (java/io/File::length [] (java/io/File::new file))] (wrap (int-to-nat size)))) (def: #export (files dir) (-> File (Process (List File))) - (do (E.ErrorT io.Monad<IO>) + (do io.Monad<Process> [?files (java/io/File::listFiles [] (java/io/File::new dir))] (case ?files (#.Some files) @@ -98,14 +97,14 @@ (-> File (Process Bool)) (<method> [] (java/io/File::new file)))] - [exists? java/io/File::exists] - [make-dir java/io/File::mkdirs] - [delete java/io/File::delete] - [file? java/io/File::isFile] - [directory? java/io/File::isDirectory] - [can-read? java/io/File::canRead] - [can-write? java/io/File::canWrite] - [can-execute? java/io/File::canExecute] + [exists? java/io/File::exists] + [make-directory java/io/File::mkdirs] + [delete java/io/File::delete] + [file? java/io/File::isFile] + [directory? java/io/File::isDirectory] + [can-read? java/io/File::canRead] + [can-write? java/io/File::canWrite] + [can-execute? java/io/File::canExecute] ) (def: #export (move target source) @@ -113,13 +112,13 @@ (java/io/File::renameTo [(java/io/File::new target)] (java/io/File::new source))) -(def: #export (get-last-modified file) +(def: #export (last-modified file) (-> File (Process i.Instant)) - (do (E.ErrorT io.Monad<IO>) + (do io.Monad<Process> [millis (java/io/File::lastModified [] (java/io/File::new file))] (wrap (|> millis d.from-millis i.absolute)))) -(def: #export (set-last-modified time file) +(def: #export (modify time file) (-> i.Instant File (Process Bool)) (java/io/File::setLastModified [(|> time i.relative d.to-millis)] (java/io/File::new file))) diff --git a/stdlib/test/test/lux/type/resource.lux b/stdlib/test/test/lux/type/resource.lux index 3681a7ce1..b02a8d583 100644 --- a/stdlib/test/test/lux/type/resource.lux +++ b/stdlib/test/test/lux/type/resource.lux @@ -11,7 +11,7 @@ (test "Can produce and consume keys in an ordered manner." (<| (n/= (n/+ +123 +456)) io.run - resource.sync + resource.run (do resource.IxMonad<Sync> [res|left (resource.ordered +123) res|right (resource.ordered +456) @@ -22,7 +22,7 @@ (test "Can exchange commutative keys." (<| (n/= (n/+ +123 +456)) io.run - resource.sync + resource.run (do resource.IxMonad<Sync> [res|left (resource.commutative +123) res|right (resource.commutative +456) @@ -34,7 +34,7 @@ (test "Can group and un-group keys." (<| (n/= (n/+ +123 +456)) io.run - resource.sync + resource.run (do resource.IxMonad<Sync> [res|left (resource.commutative +123) res|right (resource.commutative +456) |