From d770066b9e2046ea172305dc08f271e1159f7b64 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 17 May 2019 00:44:29 -0400 Subject: Automatic type casting/coercion for Boolean/Bit and String/Text. --- stdlib/source/lux/control/concurrency/atom.lux | 18 +- stdlib/source/lux/control/concurrency/process.lux | 2 +- stdlib/source/lux/data/text/encoding.lux | 8 +- stdlib/source/lux/host.jvm.lux | 142 +++--- stdlib/source/lux/target/jvm/type.lux | 2 +- stdlib/source/lux/world/binary.lux | 96 ++-- stdlib/source/lux/world/file.lux | 572 ++++++++++++++-------- 7 files changed, 536 insertions(+), 304 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux/control/concurrency/atom.lux b/stdlib/source/lux/control/concurrency/atom.lux index d3fc1eca6..d16b485f7 100644 --- a/stdlib/source/lux/control/concurrency/atom.lux +++ b/stdlib/source/lux/control/concurrency/atom.lux @@ -20,7 +20,8 @@ (import: #long (java/util/concurrent/atomic/AtomicReference a) (new [a]) (get [] a) - (compareAndSet [a a] boolean))})) + (compareAndSet [a a] boolean)) + })) (`` (abstract: #export (Atom a) {#.doc "Atomic references that are safe to mutate concurrently."} @@ -29,7 +30,8 @@ (java/util/concurrent/atomic/AtomicReference a) (~~ (static @.jvm)) - (java/util/concurrent/atomic/AtomicReference a)}) + (java/util/concurrent/atomic/AtomicReference a) + }) (def: #export (atom value) (All [a] (-> a (Atom a))) @@ -37,7 +39,8 @@ (java/util/concurrent/atomic/AtomicReference::new value) (~~ (static @.jvm)) - (java/util/concurrent/atomic/AtomicReference::new value)}))) + (java/util/concurrent/atomic/AtomicReference::new value) + }))) (def: #export (read atom) (All [a] (-> (Atom a) (IO a))) @@ -45,7 +48,8 @@ (java/util/concurrent/atomic/AtomicReference::get (:representation atom)) (~~ (static @.jvm)) - (java/util/concurrent/atomic/AtomicReference::get (:representation atom))}))) + (java/util/concurrent/atomic/AtomicReference::get (:representation atom)) + }))) (def: #export (compare-and-swap current new atom) {#.doc (doc "Only mutates an atom if you can present its current value." @@ -55,10 +59,8 @@ (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom)) (~~ (static @.jvm)) - (|> (:representation atom) - (java/util/concurrent/atomic/AtomicReference::compareAndSet current new) - (: (primitive "java.lang.Boolean")) - (:coerce Bit))}))) + (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom)) + }))) )) (def: #export (update f atom) diff --git a/stdlib/source/lux/control/concurrency/process.lux b/stdlib/source/lux/control/concurrency/process.lux index 3a6b2cda7..fc5ad2050 100644 --- a/stdlib/source/lux/control/concurrency/process.lux +++ b/stdlib/source/lux/control/concurrency/process.lux @@ -72,7 +72,7 @@ (~~ (static @.jvm)) (|> (java/lang/Runtime::getRuntime) (java/lang/Runtime::availableProcessors) - (:coerce Nat))} + .nat)} ## Default 1))) diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux index 470265081..1ce536436 100644 --- a/stdlib/source/lux/data/text/encoding.lux +++ b/stdlib/source/lux/data/text/encoding.lux @@ -178,16 +178,16 @@ (~~ (static @.jvm)) (as-is (import: #long java/lang/String - (new [(Array byte) java/lang/String]) - (getBytes [java/lang/String] (Array byte))))})) + (new [[byte] java/lang/String]) + (getBytes [java/lang/String] [byte])))})) (def: #export (to-utf8 value) (-> Text Binary) (`` (for {(~~ (static @.old)) - (java/lang/String::getBytes (..name ..utf-8) (:coerce java/lang/String value)) + (java/lang/String::getBytes (..name ..utf-8) value) (~~ (static @.jvm)) - (java/lang/String::getBytes (..name ..utf-8) (:coerce java/lang/String value))}))) + (java/lang/String::getBytes (..name ..utf-8) value)}))) (def: #export (from-utf8 value) (-> Binary (Error Text)) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index c8d413421..9410972f8 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -33,14 +33,14 @@ [(def: #export .Type (#.Primitive #.Nil))] ## Boxes - [Boolean "java.lang.Boolean"] - [Byte "java.lang.Byte"] - [Short "java.lang.Short"] - [Integer "java.lang.Integer"] - [Long "java.lang.Long"] - [Float "java.lang.Float"] - [Double "java.lang.Double"] - [Character "java.lang.Character"] + [Boolean jvm.boolean-box] + [Byte jvm.byte-box] + [Short jvm.short-box] + [Integer jvm.int-box] + [Long jvm.long-box] + [Float jvm.float-box] + [Double jvm.double-box] + [Character jvm.char-box] ## Primitives [boolean jvm.boolean-reflection] @@ -68,14 +68,14 @@ (def: boxes (Dictionary Text Text) - (|> (list [jvm.boolean-descriptor "java.lang.Boolean"] - [jvm.byte-descriptor "java.lang.Byte"] - [jvm.short-descriptor "java.lang.Short"] - [jvm.int-descriptor "java.lang.Integer"] - [jvm.long-descriptor "java.lang.Long"] - [jvm.float-descriptor "java.lang.Float"] - [jvm.double-descriptor "java.lang.Double"] - [jvm.char-descriptor "java.lang.Character"]) + (|> (list [jvm.boolean-descriptor jvm.boolean-box] + [jvm.byte-descriptor jvm.byte-box] + [jvm.short-descriptor jvm.short-box] + [jvm.int-descriptor jvm.int-box] + [jvm.long-descriptor jvm.long-box] + [jvm.float-descriptor jvm.float-box] + [jvm.double-descriptor jvm.double-box] + [jvm.char-descriptor jvm.char-box]) (dictionary.from-list text.hash))) (def: reflections @@ -1491,6 +1491,11 @@ (-> Var Code) code.local-identifier) +(def: string-class "java.lang.String") + +(def: string-descriptor + (jvm.signature (jvm.class ..string-class (list)))) + (template [ ] [(def: ( mode [unboxed raw]) (-> Primitive-Mode [Text Code] Code) @@ -1520,29 +1525,32 @@ ( unboxed boxed refined) #.None - refined) - post-processed (case post - #.Nil - unboxed/boxed + refined)] + (case post + #.Nil + unboxed/boxed - _ - (` (.|> (~ unboxed/boxed) (~+ post))))] - post-processed))] + _ + (` (.|> (~ unboxed/boxed) (~+ post))))))] [#1 auto-convert-input ..unbox - [[jvm.byte-descriptor jvm.byte-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive "java.lang.Long"))) (` ..long-to-byte)) []] - [jvm.short-descriptor jvm.short-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive "java.lang.Long"))) (` ..long-to-short)) []] - [jvm.int-descriptor jvm.int-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive "java.lang.Long"))) (` ..long-to-int)) []] - [jvm.long-descriptor jvm.long-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive "java.lang.Long")))) []] - [jvm.float-descriptor jvm.float-descriptor (list (` (.: .Frac)) (` (.:coerce (.primitive "java.lang.Double"))) (` ..double-to-float)) []] - [jvm.double-descriptor jvm.double-descriptor (list (` (.: .Frac)) (` (.:coerce (.primitive "java.lang.Double")))) []]]] + [[jvm.boolean-descriptor jvm.boolean-descriptor (list (` (.: .Bit)) (` (.:coerce (.primitive (~ (code.text jvm.boolean-box)))))) []] + [jvm.byte-descriptor jvm.byte-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text jvm.long-box))))) (` ..long-to-byte)) []] + [jvm.short-descriptor jvm.short-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text jvm.long-box))))) (` ..long-to-short)) []] + [jvm.int-descriptor jvm.int-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text jvm.long-box))))) (` ..long-to-int)) []] + [jvm.long-descriptor jvm.long-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text jvm.long-box)))))) []] + [jvm.float-descriptor jvm.float-descriptor (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text jvm.double-box))))) (` ..double-to-float)) []] + [jvm.double-descriptor jvm.double-descriptor (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text jvm.double-box)))))) []] + [..string-descriptor ..string-descriptor (list (` (.: .Text)) (` (.:coerce (.primitive (~ (code.text ..string-class)))))) []]]] [#0 auto-convert-output ..box - [[jvm.byte-descriptor jvm.long-descriptor (list (` "jvm conversion byte-to-long")) [(` (.: (.primitive "java.lang.Long"))) (` (.:coerce .Int))]] - [jvm.short-descriptor jvm.long-descriptor (list (` "jvm conversion short-to-long")) [(` (.: (.primitive "java.lang.Long"))) (` (.:coerce .Int))]] - [jvm.int-descriptor jvm.long-descriptor (list (` "jvm conversion int-to-long")) [(` (.: (.primitive "java.lang.Long"))) (` (.:coerce .Int))]] - [jvm.long-descriptor jvm.long-descriptor (list) [(` (.: (.primitive "java.lang.Long"))) (` (.:coerce .Int))]] - [jvm.float-descriptor jvm.double-descriptor (list (` "jvm conversion float-to-double")) [(` (.: (.primitive "java.lang.Double"))) (` (.:coerce .Frac))]] - [jvm.double-descriptor jvm.double-descriptor (list) [(` (.: (.primitive "java.lang.Double"))) (` (.:coerce .Frac))]]]] + [[jvm.boolean-descriptor jvm.boolean-descriptor (list) [(` (.: (.primitive (~ (code.text jvm.boolean-box))))) (` (.:coerce .Bit))]] + [jvm.byte-descriptor jvm.long-descriptor (list (` "jvm conversion byte-to-long")) [(` (.: (.primitive (~ (code.text jvm.long-box))))) (` (.:coerce .Int))]] + [jvm.short-descriptor jvm.long-descriptor (list (` "jvm conversion short-to-long")) [(` (.: (.primitive (~ (code.text jvm.long-box))))) (` (.:coerce .Int))]] + [jvm.int-descriptor jvm.long-descriptor (list (` "jvm conversion int-to-long")) [(` (.: (.primitive (~ (code.text jvm.long-box))))) (` (.:coerce .Int))]] + [jvm.long-descriptor jvm.long-descriptor (list) [(` (.: (.primitive (~ (code.text jvm.long-box))))) (` (.:coerce .Int))]] + [jvm.float-descriptor jvm.double-descriptor (list (` "jvm conversion float-to-double")) [(` (.: (.primitive (~ (code.text jvm.double-box))))) (` (.:coerce .Frac))]] + [jvm.double-descriptor jvm.double-descriptor (list) [(` (.: (.primitive (~ (code.text jvm.double-box))))) (` (.:coerce .Frac))]] + [..string-descriptor ..string-descriptor (list) [(` (.: (.primitive (~ (code.text ..string-class))))) (` (.:coerce .Text))]]]] ) (def: (un-quote quoted) @@ -1590,11 +1598,13 @@ (#ConstructorDecl [commons _]) (do macro.monad [#let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) - jvm-interop (|> (` ("jvm member invoke constructor" - (~ (code.text full-name)) - (~+ (|> (jvm-invoke-inputs (get@ #import-member-mode commons) arg-classes arg-function-inputs) - (list.zip2 arg-classes) - (list@map ..decorate-input))))) + jvm-interop (|> [(jvm.signature (jvm.class full-name (list))) + (` ("jvm member invoke constructor" + (~ (code.text full-name)) + (~+ (|> (jvm-invoke-inputs (get@ #import-member-mode commons) arg-classes arg-function-inputs) + (list.zip2 arg-classes) + (list@map ..decorate-input)))))] + (auto-convert-output (get@ #import-member-mode commons)) (decorate-return-maybe member true full-name) (decorate-return-try member) (decorate-return-io member))]] @@ -1633,8 +1643,10 @@ (` ((~ (code.text jvm-op)) (~ (code.text full-name)) (~ (code.text import-method-name)) - (~+ (list@map (|>> un-quote ~ "jvm object cast" `) - object-ast)) + (~+ (|> object-ast + (list@map ..un-quote) + (list.zip2 (list (jvm.signature (jvm.class full-name (list))))) + (list@map (auto-convert-input (get@ #import-member-mode commons))))) (~+ (|> (jvm-invoke-inputs (get@ #import-member-mode commons) arg-classes arg-function-inputs) (list.zip2 arg-classes) (list@map ..decorate-input)))))] @@ -1710,7 +1722,7 @@ (All [a] (-> (primitive "java.lang.Class" [a]) Bit)) (|>> ("jvm member invoke virtual" "java.lang.Class" "isInterface") "jvm object cast" - (: (primitive "java.lang.Boolean")) + (: ..Boolean) (:coerce Bit))) (def: load-class @@ -1798,7 +1810,7 @@ (array java/lang/Object 10))} (let [g!size (` (|> (~ size) (.: .Nat) - (.:coerce (.primitive "java.lang.Long")) + (.:coerce (.primitive (~ (code.text jvm.long-box)))) "jvm object cast" "jvm conversion long-to-int"))] (case type @@ -1860,7 +1872,7 @@ (wrap (list (` (.|> ((~ g!extension) (~ array)) "jvm conversion int-to-long" "jvm object cast" - (.: (.primitive "java.lang.Long")) + (.: (.primitive (~ (code.text jvm.long-box)))) (.:coerce .Nat)))))) _ @@ -1878,7 +1890,7 @@ array-jvm-type (type->class-name array-type) #let [g!idx (` (.|> (~ idx) (.: .Nat) - (.:coerce (.primitive "java.lang.Long")) + (.:coerce (.primitive (~ (code.text jvm.long-box)))) "jvm object cast" "jvm conversion long-to-int"))]] (case array-jvm-type @@ -1886,15 +1898,15 @@ (wrap (list (` (.|> ( (~ g!idx) (~ array)) "jvm object cast" - (.: (.primitive ))))))) - (["[Z" "jvm array read boolean" "java.lang.Boolean"] - ["[B" "jvm array read byte" "java.lang.Byte"] - ["[S" "jvm array read short" "java.lang.Short"] - ["[I" "jvm array read int" "java.lang.Integer"] - ["[J" "jvm array read long" "java.lang.Long"] - ["[F" "jvm array read float" "java.lang.Float"] - ["[D" "jvm array read double" "java.lang.Double"] - ["[C" "jvm array read char" "java.lang.Character"]) + (.: (.primitive (~ (code.text ))))))))) + (["[Z" "jvm array read boolean" jvm.boolean-box] + ["[B" "jvm array read byte" jvm.byte-box] + ["[S" "jvm array read short" jvm.short-box] + ["[I" "jvm array read int" jvm.int-box] + ["[J" "jvm array read long" jvm.long-box] + ["[F" "jvm array read float" jvm.float-box] + ["[D" "jvm array read double" jvm.double-box] + ["[C" "jvm array read char" jvm.char-box]) _ (wrap (list (` ("jvm array read object" (~ g!idx) (~ array))))))) @@ -1914,24 +1926,24 @@ array-jvm-type (type->class-name array-type) #let [g!idx (` (.|> (~ idx) (.: .Nat) - (.:coerce (.primitive "java.lang.Long")) + (.:coerce (.primitive (~ (code.text jvm.long-box)))) "jvm object cast" "jvm conversion long-to-int"))]] (case array-jvm-type (^template [ ] (let [g!value (` (.|> (~ value) - (.:coerce (.primitive )) + (.:coerce (.primitive (~ (code.text )))) "jvm object cast"))] (wrap (list (` ( (~ g!idx) (~ g!value) (~ array))))))) - (["[Z" "jvm array write boolean" "java.lang.Boolean"] - ["[B" "jvm array write byte" "java.lang.Byte"] - ["[S" "jvm array write short" "java.lang.Short"] - ["[I" "jvm array write int" "java.lang.Integer"] - ["[J" "jvm array write long" "java.lang.Long"] - ["[F" "jvm array write float" "java.lang.Float"] - ["[D" "jvm array write double" "java.lang.Double"] - ["[C" "jvm array write char" "java.lang.Character"]) + (["[Z" "jvm array write boolean" jvm.boolean-box] + ["[B" "jvm array write byte" jvm.byte-box] + ["[S" "jvm array write short" jvm.short-box] + ["[I" "jvm array write int" jvm.int-box] + ["[J" "jvm array write long" jvm.long-box] + ["[F" "jvm array write float" jvm.float-box] + ["[D" "jvm array write double" jvm.double-box] + ["[C" "jvm array write char" jvm.char-box]) _ (wrap (list (` ("jvm array write object" (~ g!idx) (~ value) (~ array))))))) diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux index 6e3269df5..c6af8ffc5 100644 --- a/stdlib/source/lux/target/jvm/type.lux +++ b/stdlib/source/lux/target/jvm/type.lux @@ -95,7 +95,7 @@ (type: #export Var Text) -(with-expansions [ (as-is [Text (List Generic)])] +(with-expansions [ (as-is [Text (List Generic)])] (type: #export #rec Generic (#Var Var) (#Wildcard (Maybe [Bound Generic])) diff --git a/stdlib/source/lux/world/binary.lux b/stdlib/source/lux/world/binary.lux index f43edfa4f..56bf01620 100644 --- a/stdlib/source/lux/world/binary.lux +++ b/stdlib/source/lux/world/binary.lux @@ -1,10 +1,12 @@ (.module: [lux (#- i64) + ["." host (#+ import:)] + ["@" target] [abstract [monad (#+ do)] [equivalence (#+ Equivalence)]] [control - ["ex" exception (#+ exception:)]] + ["." exception (#+ exception:)]] [data ["." maybe] ["." error (#+ Error)] @@ -13,31 +15,47 @@ [text format] [collection - [array (#+ Array)]]] - ["." host (#+ import:)]]) + [array (#+ Array)]]]]) (exception: #export (index-out-of-bounds {size Nat} {index Nat}) - (ex.report ["Size" (%n size)] - ["Index" (%n index)])) + (exception.report + ["Size" (%n size)] + ["Index" (%n index)])) (template [] [(exception: #export ( {size Nat} {from Nat} {to Nat}) - (ex.report ["Size" (%n size)] - ["From" (%n from)] - ["To" (%n to)]))] + (exception.report + ["Size" (%n size)] + ["From" (%n from)] + ["To" (%n to)]))] [slice-out-of-bounds] [inverted-slice] ) -(type: #export Binary (host.type (Array byte))) +(`` (for {(~~ (static @.old)) + (as-is (type: #export Binary (host.type (Array byte))) -(import: java/lang/System - (#static arraycopy [Object int Object int int] #try void)) + (import: #long java/lang/Object) -(import: java/util/Arrays - (#static copyOfRange [(Array byte) int int] (Array byte)) - (#static equals [(Array byte) (Array byte)] boolean)) + (import: #long java/lang/System + (#static arraycopy [java/lang/Object int java/lang/Object int int] #try void)) + + (import: #long java/util/Arrays + (#static copyOfRange [(Array byte) int int] (Array byte)) + (#static equals [(Array byte) (Array byte)] boolean))) + + (~~ (static @.jvm)) + (as-is (type: #export Binary (host.type [byte])) + + (import: #long java/lang/Object) + + (import: #long java/lang/System + (#static arraycopy [java/lang/Object int java/lang/Object int int] #try void)) + + (import: #long java/util/Arrays + (#static copyOfRange [[byte] int int] [byte]) + (#static equals [[byte] [byte]] boolean)))})) (def: byte-mask I64 @@ -49,24 +67,36 @@ (def: byte (-> (I64 Any) (primitive "java.lang.Byte")) - (|>> .int host.long-to-byte)) + (`` (for {(~~ (static @.old)) + (|>> .int host.long-to-byte) + + (~~ (static @.jvm)) + (|>> .int (:coerce (primitive "java.lang.Long")) host.long-to-byte)}))) (template: (!size binary) - (host.array-length binary)) + (`` (for {(~~ (static @.old)) + (host.array-length binary) + + (~~ (static @.jvm)) + (host.array-length binary)}))) (def: #export size (-> Binary Nat) (|>> !size)) -(def: #export (create size) +(def: #export create (-> Nat Binary) - (host.array byte size)) + (`` (for {(~~ (static @.old)) + (|>> (host.array byte)) + + (~~ (static @.jvm)) + (|>> (host.array byte))}))) (def: #export (read/8 idx binary) (-> Nat Binary (Error I64)) (if (n/< (..!size binary) idx) (#error.Success (..i64 (host.array-read idx binary))) - (ex.throw index-out-of-bounds [(..!size binary) idx]))) + (exception.throw index-out-of-bounds [(..!size binary) idx]))) (def: #export (read/16 idx binary) (-> Nat Binary (Error I64)) @@ -74,7 +104,7 @@ (#error.Success ($_ i64.or (i64.left-shift 8 (..i64 (host.array-read idx binary))) (..i64 (host.array-read (n/+ 1 idx) binary)))) - (ex.throw index-out-of-bounds [(..!size binary) idx]))) + (exception.throw index-out-of-bounds [(..!size binary) idx]))) (def: #export (read/32 idx binary) (-> Nat Binary (Error I64)) @@ -84,7 +114,7 @@ (i64.left-shift 16 (..i64 (host.array-read (n/+ 1 idx) binary))) (i64.left-shift 8 (..i64 (host.array-read (n/+ 2 idx) binary))) (..i64 (host.array-read (n/+ 3 idx) binary)))) - (ex.throw index-out-of-bounds [(..!size binary) idx]))) + (exception.throw index-out-of-bounds [(..!size binary) idx]))) (def: #export (read/64 idx binary) (-> Nat Binary (Error I64)) @@ -98,7 +128,7 @@ (i64.left-shift 16 (..i64 (host.array-read (n/+ 5 idx) binary))) (i64.left-shift 8 (..i64 (host.array-read (n/+ 6 idx) binary))) (..i64 (host.array-read (n/+ 7 idx) binary)))) - (ex.throw index-out-of-bounds [(..!size binary) idx]))) + (exception.throw index-out-of-bounds [(..!size binary) idx]))) (def: #export (write/8 idx value binary) (-> Nat (I64 Any) Binary (Error Binary)) @@ -106,7 +136,7 @@ (exec (|> binary (host.array-write idx (..byte value))) (#error.Success binary)) - (ex.throw index-out-of-bounds [(..!size binary) idx]))) + (exception.throw index-out-of-bounds [(..!size binary) idx]))) (def: #export (write/16 idx value binary) (-> Nat (I64 Any) Binary (Error Binary)) @@ -115,7 +145,7 @@ (host.array-write idx (..byte (i64.logic-right-shift 8 value))) (host.array-write (n/+ 1 idx) (..byte value))) (#error.Success binary)) - (ex.throw index-out-of-bounds [(..!size binary) idx]))) + (exception.throw index-out-of-bounds [(..!size binary) idx]))) (def: #export (write/32 idx value binary) (-> Nat (I64 Any) Binary (Error Binary)) @@ -126,7 +156,7 @@ (host.array-write (n/+ 2 idx) (..byte (i64.logic-right-shift 8 value))) (host.array-write (n/+ 3 idx) (..byte value))) (#error.Success binary)) - (ex.throw index-out-of-bounds [(..!size binary) idx]))) + (exception.throw index-out-of-bounds [(..!size binary) idx]))) (def: #export (write/64 idx value binary) (-> Nat (I64 Any) Binary (Error Binary)) @@ -141,20 +171,20 @@ (host.array-write (n/+ 6 idx) (..byte (i64.logic-right-shift 8 value))) (host.array-write (n/+ 7 idx) (..byte value))) (#error.Success binary)) - (ex.throw index-out-of-bounds [(..!size binary) idx]))) + (exception.throw index-out-of-bounds [(..!size binary) idx]))) (def: #export (slice from to binary) (-> Nat Nat Binary (Error Binary)) (let [size (..!size binary)] (cond (not (n/<= to from)) - (ex.throw inverted-slice [size from to]) + (exception.throw inverted-slice [size from to]) (not (and (n/< size from) (n/< size to))) - (ex.throw slice-out-of-bounds [size from to]) + (exception.throw slice-out-of-bounds [size from to]) ## else - (#error.Success (Arrays::copyOfRange binary (:coerce Int from) (:coerce Int (inc to))))))) + (#error.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to))))))) (def: #export (slice' from binary) (-> Nat Binary (Error Binary)) @@ -162,10 +192,14 @@ (structure: #export equivalence (Equivalence Binary) (def: (= reference sample) - (Arrays::equals reference sample))) + (`` (for {(~~ (static @.old)) + (java/util/Arrays::equals reference sample) + + (~~ (static @.jvm)) + (java/util/Arrays::equals reference sample)})))) (def: #export (copy bytes source-offset source target-offset target) (-> Nat Nat Binary Nat Binary (Error Binary)) (do error.monad - [_ (System::arraycopy source (.int source-offset) target (.int target-offset) (.int bytes))] + [_ (java/lang/System::arraycopy source (.int source-offset) target (.int target-offset) (.int bytes))] (wrap target))) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 6fa386f05..f25a372fc 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -5,7 +5,7 @@ [abstract ["." monad (#+ Monad do)]] [control - ["ex" exception (#+ Exception exception:)] + ["." exception (#+ Exception exception:)] ["." io (#+ IO) ("#;." functor)] [concurrency ["." promise (#+ Promise)]] @@ -160,7 +160,8 @@ (template [] [(exception: #export ( {file Path}) - (ex.report ["Path" file]))] + (exception.report + ["Path" file]))] [cannot-create-file] [cannot-find-file] @@ -175,199 +176,382 @@ ) (exception: #export (cannot-move {target Path} {source Path}) - (ex.report ["Source" source] - ["Target" target])) + (exception.report + ["Source" source] + ["Target" target])) (exception: #export (cannot-modify {instant Instant} {file Path}) - (ex.report ["Instant" (%instant instant)] - ["Path" file])) - -(with-expansions [ (as-is (import: #long java/io/File - (new [String]) - (~~ (template [] - [( [] #io #try boolean)] - - [createNewFile] [mkdir] - [exists] [delete] - [isFile] [isDirectory] - [canRead] [canWrite] [canExecute])) - - (length [] #io #try long) - (listFiles [] #io #try #? (Array java/io/File)) - (getAbsolutePath [] #io #try String) - (renameTo [java/io/File] #io #try boolean) - (lastModified [] #io #try long) - (setLastModified [long] #io #try boolean) - (#static separator String)) - - (template: (!delete path exception) - (do io.monad - [outcome (java/io/File::delete (java/io/File::new path))] - (case outcome - (#error.Success #1) - (wrap (#error.Success [])) - - _ - (io.io (ex.throw exception [path]))))) - - (import: java/lang/AutoCloseable - (close [] #io #try void)) - - (import: java/io/OutputStream - (write [(Array byte)] #io #try void) - (flush [] #io #try void)) - - (import: java/io/FileOutputStream - (new [java/io/File boolean] #io #try)) - - (import: java/io/InputStream - (read [(Array byte)] #io #try int)) - - (import: java/io/FileInputStream - (new [java/io/File] #io #try)) - - (structure: (file path) - (-> Path (File IO)) - - (~~ (template [ ] - [(def: - (..can-modify - (function ( data) - (do (error.with io.monad) - [stream (FileOutputStream::new (java/io/File::new path) ) - _ (OutputStream::write data stream) - _ (OutputStream::flush stream)] - (AutoCloseable::close stream)))))] - - [over-write #0] - [append #1] - )) - - (def: content - (..can-query - (function (content _) - (do (error.with io.monad) - [#let [file (java/io/File::new path)] - size (java/io/File::length file) - #let [data (binary.create (.nat size))] - stream (FileInputStream::new file) - bytes-read (InputStream::read data stream) - _ (AutoCloseable::close stream)] - (if (i/= size bytes-read) - (wrap data) - (io.io (ex.throw cannot-read-all-data path))))))) - - (def: size - (..can-query - (function (size _) - (|> path - java/io/File::new - java/io/File::length - (:: (error.with io.monad) map .nat))))) - - (def: last-modified - (..can-query - (function (last-modified _) - (|> path - java/io/File::new - (java/io/File::lastModified) - (:: (error.with io.monad) map (|>> duration.from-millis instant.absolute)))))) - - (def: can-execute? - (..can-query - (function (can-execute? _) - (|> path - java/io/File::new - java/io/File::canExecute)))) - - (def: move - (..can-open - (function (move destination) - (do io.monad - [outcome (java/io/File::renameTo (java/io/File::new destination) - (java/io/File::new path))] - (case outcome - (#error.Success #1) - (wrap (#error.Success (file destination))) - - _ - (io.io (ex.throw cannot-move [destination path]))))))) - - (def: modify - (..can-modify - (function (modify time-stamp) - (do io.monad - [outcome (java/io/File::setLastModified (|> time-stamp instant.relative duration.to-millis) - (java/io/File::new path))] - (case outcome - (#error.Success #1) - (wrap (#error.Success [])) - - _ - (io.io (ex.throw cannot-modify [time-stamp path]))))))) - - (def: delete - (..can-delete - (function (delete _) - (!delete path cannot-delete-file))))) - - (structure: (directory path) - (-> Path (Directory IO)) - - (~~ (template [ ] - [(def: - (..can-query - (function ( _) - (do (error.with io.monad) - [?children (java/io/File::listFiles (java/io/File::new path))] - (case ?children - (#.Some children) - (|> children - array.to-list - (monad.filter @ (|>> )) - (:: @ map (monad.map @ (|>> java/io/File::getAbsolutePath (:: @ map )))) - (:: @ join)) - - #.None - (io.io (ex.throw not-a-directory [path])))))))] - - [files java/io/File::isFile file] - [directories java/io/File::isDirectory directory] - )) - - (def: discard - (..can-delete - (function (discard _) - (!delete path cannot-discard-directory))))) - - (structure: #export system (System IO) - (~~ (template [ ] - [(def: - (..can-open - (function ( path) - (do io.monad - [#let [file (java/io/File::new path)] - outcome ( file)] - (case outcome - (#error.Success #1) - (wrap (#error.Success ( path))) - - _ - (wrap (ex.throw [path])))))))] - - [file java/io/File::isFile ..file cannot-find-file] - [create-file java/io/File::createNewFile ..file cannot-create-file] - [directory java/io/File::isDirectory ..directory cannot-find-directory] - [create-directory java/io/File::mkdir ..directory cannot-create-directory] - )) - - (def: separator (java/io/File::separator)) - ))] - (`` (for {(~~ (static @.old)) - (as-is ) - - (~~ (static @.jvm)) - (as-is )}))) + (exception.report + ["Instant" (%instant instant)] + ["Path" file])) + +(`` (for {(~~ (static @.old)) + (as-is (import: #long java/lang/String) + + (import: #long java/io/File + (new [java/lang/String]) + (~~ (template [] + [( [] #io #try boolean)] + + [createNewFile] [mkdir] + [exists] [delete] + [isFile] [isDirectory] + [canRead] [canWrite] [canExecute])) + + (length [] #io #try long) + (listFiles [] #io #try #? (Array java/io/File)) + (getAbsolutePath [] #io #try java/lang/String) + (renameTo [java/io/File] #io #try boolean) + (lastModified [] #io #try long) + (setLastModified [long] #io #try boolean) + (#static separator java/lang/String)) + + (template: (!delete path exception) + (do io.monad + [outcome (java/io/File::delete (java/io/File::new path))] + (case outcome + (#error.Success #1) + (wrap (#error.Success [])) + + _ + (io.io (exception.throw exception [path]))))) + + (import: #long java/lang/AutoCloseable + (close [] #io #try void)) + + (import: java/io/OutputStream + (write [(Array byte)] #io #try void) + (flush [] #io #try void)) + + (import: java/io/FileOutputStream + (new [java/io/File boolean] #io #try)) + + (import: java/io/InputStream + (read [(Array byte)] #io #try int)) + + (import: java/io/FileInputStream + (new [java/io/File] #io #try)) + + (structure: (file path) + (-> Path (File IO)) + + (~~ (template [ ] + [(def: + (..can-modify + (function ( data) + (do (error.with io.monad) + [stream (FileOutputStream::new (java/io/File::new path) ) + _ (OutputStream::write data stream) + _ (OutputStream::flush stream)] + (java/lang/AutoCloseable::close stream)))))] + + [over-write #0] + [append #1] + )) + + (def: content + (..can-query + (function (content _) + (do (error.with io.monad) + [#let [file (java/io/File::new path)] + size (java/io/File::length file) + #let [data (binary.create (.nat size))] + stream (FileInputStream::new file) + bytes-read (InputStream::read data stream) + _ (java/lang/AutoCloseable::close stream)] + (if (i/= size bytes-read) + (wrap data) + (io.io (exception.throw cannot-read-all-data path))))))) + + (def: size + (..can-query + (function (size _) + (|> path + java/io/File::new + java/io/File::length + (:: (error.with io.monad) map .nat))))) + + (def: last-modified + (..can-query + (function (last-modified _) + (|> path + java/io/File::new + (java/io/File::lastModified) + (:: (error.with io.monad) map (|>> duration.from-millis instant.absolute)))))) + + (def: can-execute? + (..can-query + (function (can-execute? _) + (|> path + java/io/File::new + java/io/File::canExecute)))) + + (def: move + (..can-open + (function (move destination) + (do io.monad + [outcome (java/io/File::renameTo (java/io/File::new destination) + (java/io/File::new path))] + (case outcome + (#error.Success #1) + (wrap (#error.Success (file destination))) + + _ + (io.io (exception.throw cannot-move [destination path]))))))) + + (def: modify + (..can-modify + (function (modify time-stamp) + (do io.monad + [outcome (java/io/File::setLastModified (|> time-stamp instant.relative duration.to-millis) + (java/io/File::new path))] + (case outcome + (#error.Success #1) + (wrap (#error.Success [])) + + _ + (io.io (exception.throw cannot-modify [time-stamp path]))))))) + + (def: delete + (..can-delete + (function (delete _) + (!delete path cannot-delete-file))))) + + (structure: (directory path) + (-> Path (Directory IO)) + + (~~ (template [ ] + [(def: + (..can-query + (function ( _) + (do (error.with io.monad) + [?children (java/io/File::listFiles (java/io/File::new path))] + (case ?children + (#.Some children) + (|> children + array.to-list + (monad.filter @ (|>> )) + (:: @ map (monad.map @ (|>> java/io/File::getAbsolutePath (:: @ map )))) + (:: @ join)) + + #.None + (io.io (exception.throw not-a-directory [path])))))))] + + [files java/io/File::isFile file] + [directories java/io/File::isDirectory directory] + )) + + (def: discard + (..can-delete + (function (discard _) + (!delete path cannot-discard-directory))))) + + (structure: #export system (System IO) + (~~ (template [ ] + [(def: + (..can-open + (function ( path) + (do io.monad + [#let [file (java/io/File::new path)] + outcome ( file)] + (case outcome + (#error.Success #1) + (wrap (#error.Success ( path))) + + _ + (wrap (exception.throw [path])))))))] + + [file java/io/File::isFile ..file cannot-find-file] + [create-file java/io/File::createNewFile ..file cannot-create-file] + [directory java/io/File::isDirectory ..directory cannot-find-directory] + [create-directory java/io/File::mkdir ..directory cannot-create-directory] + )) + + (def: separator (java/io/File::separator)) + )) + + (~~ (static @.jvm)) + (as-is (import: #long java/lang/String) + (import: #long java/lang/Boolean) + + (import: #long java/io/File + (new [java/lang/String]) + (~~ (template [] + [( [] #io #try boolean)] + + [createNewFile] [mkdir] + [exists] [delete] + [isFile] [isDirectory] + [canRead] [canWrite] [canExecute])) + + (length [] #io #try long) + (listFiles [] #io #try #? [java/io/File]) + (getAbsolutePath [] #io #try java/lang/String) + (renameTo [java/io/File] #io #try boolean) + (lastModified [] #io #try long) + (setLastModified [long] #io #try boolean) + (#static separator java/lang/String)) + + (template: (!delete path exception) + (do io.monad + [outcome (java/io/File::delete (java/io/File::new path))] + (case outcome + (#error.Success #1) + (wrap (#error.Success [])) + + _ + (io.io (exception.throw exception [path]))))) + + (import: #long java/lang/AutoCloseable + (close [] #io #try void)) + + (import: java/io/OutputStream + (write [[byte]] #io #try void) + (flush [] #io #try void)) + + (import: java/io/FileOutputStream + (new [java/io/File boolean] #io #try)) + + (import: java/io/InputStream + (read [[byte]] #io #try int)) + + (import: java/io/FileInputStream + (new [java/io/File] #io #try)) + + (def: (file path) + (-> Path (File IO)) + (structure + (~~ (template [ ] + [(def: + (..can-modify + (function ( data) + (do (error.with io.monad) + [stream (FileOutputStream::new (java/io/File::new path) ) + _ (OutputStream::write data stream) + _ (OutputStream::flush stream)] + (java/lang/AutoCloseable::close stream)))))] + + [over-write #0] + [append #1] + )) + + (def: content + (..can-query + (function (content _) + (do (error.with io.monad) + [#let [file (java/io/File::new path)] + size (java/io/File::length file) + #let [data (binary.create (.nat size))] + stream (FileInputStream::new file) + bytes-read (InputStream::read data stream) + _ (java/lang/AutoCloseable::close stream)] + (if (i/= size bytes-read) + (wrap data) + (io.io (exception.throw cannot-read-all-data path))))))) + + (def: size + (..can-query + (function (size _) + (|> (java/io/File::new path) + java/io/File::length + (:: (error.with io.monad) map .nat))))) + + (def: last-modified + (..can-query + (function (last-modified _) + (|> (java/io/File::new path) + java/io/File::lastModified + (:: (error.with io.monad) map (|>> duration.from-millis instant.absolute)))))) + + (def: can-execute? + (..can-query + (function (can-execute? _) + (java/io/File::canExecute (java/io/File::new path))))) + + (def: move + (..can-open + (function (move destination) + (do io.monad + [outcome (java/io/File::renameTo (java/io/File::new destination) + (java/io/File::new path))] + (case outcome + (#error.Success #1) + (wrap (#error.Success (file destination))) + + _ + (io.io (exception.throw cannot-move [destination path]))))))) + + (def: modify + (..can-modify + (function (modify time-stamp) + (do io.monad + [outcome (java/io/File::setLastModified (|> time-stamp instant.relative duration.to-millis) + (java/io/File::new path))] + (case outcome + (#error.Success #1) + (wrap (#error.Success [])) + + _ + (io.io (exception.throw cannot-modify [time-stamp path]))))))) + + (def: delete + (..can-delete + (function (delete _) + (!delete path cannot-delete-file)))))) + + (structure: (directory path) + (-> Path (Directory IO)) + + (~~ (template [ ] + [(def: + (..can-query + (function ( _) + (do (error.with io.monad) + [?children (java/io/File::listFiles (java/io/File::new path))] + (case ?children + (#.Some children) + (|> children + array.to-list + (monad.filter @ (|>> )) + (:: @ map (monad.map @ (|>> java/io/File::getAbsolutePath + (:: @ map )))) + (:: @ join)) + + #.None + (io.io (exception.throw not-a-directory [path])))))))] + + [files java/io/File::isFile file] + [directories java/io/File::isDirectory directory] + )) + + (def: discard + (..can-delete + (function (discard _) + (!delete path cannot-discard-directory))))) + + (structure: #export system (System IO) + (~~ (template [ ] + [(def: + (..can-open + (function ( path) + (do io.monad + [#let [file (java/io/File::new path)] + outcome ( file)] + (case outcome + (#error.Success #1) + (wrap (#error.Success ( path))) + + _ + (wrap (exception.throw [path])))))))] + + [file java/io/File::isFile ..file cannot-find-file] + [create-file java/io/File::createNewFile ..file cannot-create-file] + [directory java/io/File::isDirectory ..directory cannot-find-directory] + [create-directory java/io/File::mkdir ..directory cannot-create-directory] + )) + + (def: separator (java/io/File::separator)) + ))})) (template [ ] [(def: #export ( monad system path) @@ -379,7 +563,7 @@ (wrap (#error.Success file)) (#error.Failure error) - (if (ex.match? error) + (if (exception.match? error) (!.use (:: system ) path) (wrap (#error.Failure error))))))] -- cgit v1.2.3