From 588addf90b0599d28e31933cc01bf74f75322c3e Mon Sep 17 00:00:00 2001 From: ARATA Mizuki Date: Sun, 15 Oct 2023 22:15:47 +0900 Subject: [PATCH] Implement part of BinIO structure --- doc/BasisLibrary.md | 39 ++- lib/lunarml/ml/basis/basis.mlb | 1 + lib/lunarml/ml/basis/lua/bin-io.sml | 115 ++++++++ lib/lunarml/ml/basis/nodejs/bin-io-async.sml | 284 +++++++++++++++++++ lib/lunarml/ml/basis/nodejs/bin-io-dummy.sml | 2 + lib/lunarml/ml/basis/sources-js-cps.mlb | 2 + lib/lunarml/ml/basis/sources-js.mlb | 2 + lib/lunarml/ml/basis/sources-lua.mlb | 2 + lib/lunarml/ml/basis/sources-luajit.mlb | 2 + 9 files changed, 448 insertions(+), 1 deletion(-) create mode 100644 lib/lunarml/ml/basis/lua/bin-io.sml create mode 100644 lib/lunarml/ml/basis/nodejs/bin-io-async.sml create mode 100644 lib/lunarml/ml/basis/nodejs/bin-io-dummy.sml diff --git a/doc/BasisLibrary.md b/doc/BasisLibrary.md index 9630cb95..40879fd5 100644 --- a/doc/BasisLibrary.md +++ b/doc/BasisLibrary.md @@ -1144,6 +1144,44 @@ structure TextIO : sig end ``` +## structure BinIO - partial + +```sml +structure BinIO :> sig + (* IMPERATIVE_IO *) + (* structure StreamIO : STREAM_IO *) + type vector = Word8Vector.vector + type elem = Word8.word + type instream + type outstream + val input : instream -> vector + val input1 : instream -> elem option + val inputN : instream * int -> vector + val inputAll : instream -> vector + (* val canInput : instream * int -> int option *) + (* val lookahead : instream -> elem option *) + val closeIn : instream -> unit + val endOfStream : instream -> bool + val output : outstream * vector -> unit + val output1 : outstream * elem -> unit + val flushOut : outstream -> unit + val closeOut : outstream -> unit + (* val mkInstream : StreamIO.instream -> instream *) + (* val getInstream : instream -> StreamIO.instream *) + (* val setInstream : instream * StreamIO.instream -> unit *) + (* val mkOutstream : StreamIO.outstream -> outstream *) + (* val getOutstream : outstream -> StreamIO.outstream *) + (* val setOutstream : outstream * StreamIO.outstream -> unit *) + (* val getPosOut : outstream -> StreamIO.out_pos *) + (* val setPosOut : outstream * StreamIO.out_pos -> unit *) + + (* BIN_IO *) + val openIn : string -> instream + val openOut : string -> outstream + val openAppend : string -> outstream +end +``` + ## structure OS - partial ```sml @@ -1350,7 +1388,6 @@ The GC time returned by this structure is always zero. ```sml signature BIN_IO -structure BinIO :> BIN_IO signature IMPERATIVE_IO signature PRIM_IO structure BinPrimIO :> PRIM_IO where ... diff --git a/lib/lunarml/ml/basis/basis.mlb b/lib/lunarml/ml/basis/basis.mlb index 5e974b4f..db3dbf09 100644 --- a/lib/lunarml/ml/basis/basis.mlb +++ b/lib/lunarml/ml/basis/basis.mlb @@ -31,6 +31,7 @@ signature VECTOR_SLICE signature WORD structure Array structure ArraySlice +structure BinIO structure Bool structure BoolArray structure BoolArraySlice diff --git a/lib/lunarml/ml/basis/lua/bin-io.sml b/lib/lunarml/ml/basis/lua/bin-io.sml new file mode 100644 index 00000000..e4c51942 --- /dev/null +++ b/lib/lunarml/ml/basis/lua/bin-io.sml @@ -0,0 +1,115 @@ +structure BinIO :> sig + type vector = Word8Vector.vector + type elem = Word8.word + type instream + type outstream + val input : instream -> vector + val input1 : instream -> elem option + val inputN : instream * int -> vector + val inputAll : instream -> vector + val closeIn : instream -> unit + val endOfStream : instream -> bool + val output : outstream * vector -> unit + val output1 : outstream * elem -> unit + val flushOut : outstream -> unit + val closeOut : outstream -> unit + val openIn : string -> instream + val openOut : string -> outstream + val openAppend : string -> outstream + end = struct +local + val io = LunarML.assumeDiscardable Lua.global "io" + val io_open = LunarML.assumeDiscardable Lua.field (io, "open") + structure Instream :> sig + type instream + type vector = Word8Vector.vector + type elem = Word8.word + val input : instream -> vector + val input1 : instream -> elem option + val inputN : instream * int -> vector + val inputAll : instream -> vector + (* val canInput *) + (* val lookahead *) + val closeIn : instream -> unit + val endOfStream : instream -> bool + val openIn : string -> instream + end = struct + type instream = Lua.value + type vector = Word8Vector.vector + type elem = Word8.word + fun input f = let val result = Vector.sub (Lua.method (f, "read") #[Lua.fromInt 1024], 0) + in if Lua.isFalsy result then + Word8Vector.fromList [] + else + Lua.unsafeFromValue result : vector + end + fun input1 f = let val result = Vector.sub (Lua.method (f, "read") #[Lua.fromInt 1], 0) + in if Lua.isNil result then + NONE + else + SOME (Word8Vector.sub (Lua.unsafeFromValue result : vector, 0)) + end + fun inputN (f, n : int) = if n < 0 then + raise Size + else + let val result = Vector.sub (Lua.method (f, "read") #[Lua.fromInt n], 0) + in if Lua.isNil result then + Word8Vector.fromList [] + else + Lua.unsafeFromValue result : vector + end + fun inputAll f = let val result = Vector.sub (Lua.method (f, "read") #[Lua.fromString "a"], 0) + in Lua.unsafeFromValue result : vector + end + fun closeIn f = (Lua.method (f, "close") #[]; ()) + fun endOfStream f = let val result = Vector.sub (Lua.method (f, "read") #[Lua.fromInt 0], 0) + in if Lua.isFalsy result then + true + else + false + end + (* BIN_IO *) + fun openIn f = let val (r0, message) = Lua.call2 io_open #[Lua.fromString f, Lua.fromString "rb"] + in if Lua.isNil r0 then + raise IO.Io { name = f, function = "BinIO.openIn", cause = Fail (Lua.unsafeFromValue message) } (* TODO: cause *) + else + r0 + end + end + structure Outstream :> sig + type outstream + type vector = Word8Vector.vector + type elem = Word8.word + val output : outstream * vector -> unit + val output1 : outstream * elem -> unit + val flushOut : outstream -> unit + val closeOut : outstream -> unit + val openOut : string -> outstream + val openAppend : string -> outstream + end = struct + type outstream = Lua.value + type vector = Word8Vector.vector + type elem = Word8.word + fun output (f, s : Word8Vector.vector) = (Lua.method (f, "write") #[Lua.unsafeToValue s]; ()) + fun output1 (f, c : Word8.word) = (Lua.method (f, "write") #[Lua.fromString (String.str (Byte.byteToChar c))]; ()) + fun flushOut f = (Lua.method (f, "flush") #[]; ()) + fun closeOut f = (Lua.method (f, "close") #[]; ()) + (* BIN_IO *) + fun openOut f = let val (r0, message) = Lua.call2 io_open #[Lua.fromString f, Lua.fromString "wb"] + in if Lua.isNil r0 then + raise IO.Io { name = f, function = "BinIO.openOut", cause = Fail (Lua.unsafeFromValue message) } (* TODO: cause *) + else + r0 + end + fun openAppend f = let val (r0, message) = Lua.call2 io_open #[Lua.fromString f, Lua.fromString "ab"] + in if Lua.isNil r0 then + raise IO.Io { name = f, function = "BinIO.openAppend", cause = Fail (Lua.unsafeFromValue message) } (* TODO: cause *) + else + r0 + end + end +in +open Instream +open Outstream +end (* local *) +end; (* structure BinIO *) diff --git a/lib/lunarml/ml/basis/nodejs/bin-io-async.sml b/lib/lunarml/ml/basis/nodejs/bin-io-async.sml new file mode 100644 index 00000000..6ca2bd5b --- /dev/null +++ b/lib/lunarml/ml/basis/nodejs/bin-io-async.sml @@ -0,0 +1,284 @@ +local + structure DelimCont = LunarML.DelimCont + structure Instream : sig + (* instream-related part of STREAM_IO *) + type instream + type elem = Word8.word + type vector = Word8Vector.vector + val input : instream -> vector * instream + val input1 : instream -> (elem * instream) option + val inputN : instream * int -> vector * instream + val inputAll : instream -> vector * instream + val canInput : instream * int -> int option + val closeIn : instream -> unit + val endOfStream : instream -> bool + (* mkInstream, getReader, filePosIn *) + val openReadable : JavaScript.value -> instream + end = struct + type elem = Word8.word + type vector = Word8Vector.vector + datatype state = TIP of JavaScript.value (* Readable / paused mode / Buffer *) + | BUFFERED of { buffer : vector, position : int, next : instream } (* invariant: 0 <= position < String.size buffer *) + | CLOSED + withtype instream = state ref + fun openReadable stream = ref (TIP stream) + fun rawRead (stream : JavaScript.value) : vector list + = DelimCont.withSubCont + (DelimCont.topLevel, fn cont : (vector list, unit) DelimCont.subcont => + let val handled = ref false + val readableHandler = JavaScript.callback (fn _ => + let fun doRead () : Word8Vector.vector list + = let val chunk = JavaScript.method (stream, "read") #[] + in if JavaScript.=== (chunk, JavaScript.null) then + nil + else + let val chunk : string = JavaScript.unsafeFromValue chunk (* Buffer as string *) + in if chunk = "" then (* can this happen? *) + doRead () + else + [Byte.stringToBytes chunk] + end + end + val chunks = doRead () + val () = handled := true + in DelimCont.pushSubCont (cont, fn () => chunks) + end + ) + val endHandler = JavaScript.callback (fn _ => + if not (!handled) then + ( handled := true + ; DelimCont.pushSubCont (cont, fn () => []) + ) + else + () + ) + in JavaScript.method (stream, "once") #[JavaScript.fromWideString "readable", readableHandler] + ; JavaScript.method (stream, "once") #[JavaScript.fromWideString "end", endHandler] + ; () + end + ) + fun rawEnded (stream : JavaScript.value) : bool = JavaScript.unsafeFromValue (JavaScript.field (stream, "readableEnded")) + fun fillBuffer (stream : JavaScript.value, f : instream) = let val chunks = rawRead stream + in f := List.foldr (fn (chunk, rest) => BUFFERED { buffer = chunk, position = 0, next = ref rest }) (TIP stream) chunks + end + fun input (f : instream) = case !f of + TIP stream => if rawEnded stream then + (Word8Vector.fromList [], f) + else + (fillBuffer (stream, f); input f) + | BUFFERED { buffer, position, next } => (Word8VectorSlice.vector (Word8VectorSlice.slice (buffer, position, NONE)), next) + | CLOSED => (Word8Vector.fromList [], f) + fun newStreamWithBufferAndPosition (buffer, position, next) = if position >= Word8Vector.length buffer then + next + else + ref (BUFFERED { buffer = buffer, position = position, next = next }) + fun input1 (f : instream) = case !f of + TIP stream => if rawEnded stream then + NONE + else + (fillBuffer (stream, f); input1 f) + | BUFFERED { buffer, position, next } => SOME (Word8Vector.sub (buffer, position), newStreamWithBufferAndPosition (buffer, position + 1, next)) + | CLOSED => NONE + fun inputN (f : instream, n) = case !f of + TIP stream => if rawEnded stream then + (Word8Vector.fromList [], f) + else + (fillBuffer (stream, f); inputN (f, n)) + | BUFFERED { buffer, position, next } => let val newPosition = position + n + in if newPosition <= Word8Vector.length buffer then + (Word8VectorSlice.vector (Word8VectorSlice.slice (buffer, position, SOME n)), newStreamWithBufferAndPosition (buffer, newPosition, next)) + else + let val buffer0 = Word8VectorSlice.vector (Word8VectorSlice.slice (buffer, position, NONE)) + val (buffer1, next) = inputN (next, n - Word8Vector.length buffer0) + in (Word8VectorSlice.concat [Word8VectorSlice.full buffer0, Word8VectorSlice.full buffer1], next) + end + end + | CLOSED => (Word8Vector.fromList [], f) + fun inputAll (f : instream) = let fun go (contentsRev, f) = let val (content, f) = input f + in if Word8Vector.length content = 0 then + (Word8Vector.concat (List.rev contentsRev), f) + else + go (content :: contentsRev, f) + end + in go ([], f) + end + fun canInput (f : instream, n) = if n < 0 then + raise Size + else + case !f of + TIP stream => if rawEnded stream then + SOME 0 + else + NONE + | BUFFERED { buffer, position, next } => SOME (Int.min (n, Word8Vector.length buffer - position)) + | CLOSED => SOME 0 + fun closeIn (f : instream) = case !f of + TIP stream => ( JavaScript.method (stream, "destroy") #[] + ; f := CLOSED + ) + | BUFFERED { buffer, position, next } => closeIn next + | CLOSED => () + fun endOfStream (f : instream) = case !f of + TIP stream => rawEnded stream + | BUFFERED { buffer, position, next } => false + | CLOSED => true + end +in +structure BinIO :> sig + type instream + type vector = Word8Vector.vector + type elem = Word8.word + val input : instream -> vector + val input1 : instream -> elem option + val inputN : instream * int -> vector + val inputAll : instream -> vector + val canInput : instream * int -> int option + val lookahead : instream -> elem option + val closeIn : instream -> unit + val endOfStream : instream -> bool + val openIn : string -> instream + (* val scanStream *) + structure StreamIO : sig + type instream + type elem = Word8.word + type vector = Word8Vector.vector + val input : instream -> vector * instream + val input1 : instream -> (elem * instream) option + val inputN : instream * int -> vector * instream + val inputAll : instream -> vector * instream + val canInput : instream * int -> int option + val closeIn : instream -> unit + val endOfStream : instream -> bool + (* mkInstream, getReader, filePosIn *) + end + val mkInstream : StreamIO.instream -> instream + val getInstream : instream -> StreamIO.instream + val setInstream : instream * StreamIO.instream -> unit + + type outstream + val output : outstream * vector -> unit + val output1 : outstream * elem -> unit + val flushOut : outstream -> unit + val closeOut : outstream -> unit + val openOut : string -> outstream + val openAppend : string -> outstream + end = struct +local + _esImport [pure] { createReadStream, createWriteStream } from "node:fs"; + structure Instream :> sig + type instream + type vector = Word8Vector.vector + type elem = Word8.word + val input : instream -> vector + val input1 : instream -> elem option + val inputN : instream * int -> vector + val inputAll : instream -> vector + val canInput : instream * int -> int option + val lookahead : instream -> elem option + val closeIn : instream -> unit + val endOfStream : instream -> bool + val openIn : string -> instream + (* val scanStream *) + structure StreamIO : sig + type instream + type elem = Word8.word + type vector = Word8Vector.vector + val input : instream -> vector * instream + val input1 : instream -> (elem * instream) option + val inputN : instream * int -> vector * instream + val inputAll : instream -> vector * instream + val canInput : instream * int -> int option + val closeIn : instream -> unit + val endOfStream : instream -> bool + (* mkInstream, getReader, filePosIn *) + end + val mkInstream : StreamIO.instream -> instream + val getInstream : instream -> StreamIO.instream + val setInstream : instream * StreamIO.instream -> unit + end = struct + type vector = Word8Vector.vector + type elem = Word8.word + structure StreamIO = Instream + type instream = Instream.instream ref + fun input stream = case StreamIO.input (!stream) of + (chunk, stream') => ( stream := stream' + ; chunk + ) + fun input1 stream = case StreamIO.input1 (!stream) of + NONE => NONE + | SOME (e, stream') => ( stream := stream' + ; SOME e + ) + fun inputN (stream, n) = case StreamIO.inputN (!stream, n) of + (chunk, stream') => ( stream := stream' + ; chunk + ) + fun inputAll stream = case StreamIO.inputAll (!stream) of + (chunk, stream') => ( stream := stream' + ; chunk + ) + fun canInput (stream, n) = StreamIO.canInput (!stream, n) + fun lookahead stream = case StreamIO.input1 (!stream) of + NONE => NONE + | SOME (e, _) => SOME e + fun closeIn stream = StreamIO.closeIn (!stream) + fun endOfStream stream = StreamIO.endOfStream (!stream) + fun mkInstream stream = ref stream + fun getInstream stream = !stream + fun setInstream (stream, stream') = stream := stream' + fun openIn path = ref (StreamIO.openReadable (JavaScript.call createReadStream #[JavaScript.unsafeToValue path (* as Buffer? *)])) + end + structure Outstream :> sig + type outstream + type vector = Word8Vector.vector + type elem = Word8.word + val output : outstream * vector -> unit + val output1 : outstream * elem -> unit + val flushOut : outstream -> unit + val closeOut : outstream -> unit + val openOut : string -> outstream + val openAppend : string -> outstream + end = struct + type outstream = JavaScript.value (* Writable *) + type vector = Word8Vector.vector + type elem = Word8.word + fun output (stream, chunk) = let val result = JavaScript.method (stream, "write") #[JavaScript.unsafeToValue chunk (* as Uint8Array *)] + in if JavaScript.isFalsy result then + DelimCont.withSubCont (DelimCont.topLevel, fn cont : (unit, unit) DelimCont.subcont => + let val onDrain = JavaScript.callback (fn _ => DelimCont.pushSubCont (cont, fn () => ())) + in JavaScript.method (stream, "once") #[JavaScript.fromWideString "drain", onDrain] + ; () + end + ) + else + () + end + fun outputAndFlush (stream, chunk) = DelimCont.withSubCont (DelimCont.topLevel, fn cont : (unit, unit) DelimCont.subcont => + let val callback = JavaScript.callback (fn _ => DelimCont.pushSubCont (cont, fn () => ())) + in JavaScript.method (stream, "write") #[JavaScript.unsafeToValue chunk (* as Uint8Array *), JavaScript.null, callback] + ; () + end + ) + fun output1 (stream, elem) = output (stream, Word8Vector.fromList [elem]) + fun flushOut stream = outputAndFlush (stream, Word8Vector.fromList []) + fun closeOut stream = DelimCont.withSubCont (DelimCont.topLevel, fn cont : (unit, unit) DelimCont.subcont => + let val callback = JavaScript.callback (fn _ => DelimCont.pushSubCont (cont, fn () => ())) + in ignore (JavaScript.method (stream, "end") #[JavaScript.unsafeToValue callback]) + end + ) + fun openOut path = JavaScript.call createWriteStream #[JavaScript.unsafeToValue path (* as Buffer? *)] + fun openAppend path = let val options = JavaScript.newObject () + val () = JavaScript.set (options, JavaScript.fromWideString "flags", JavaScript.fromWideString "a") + in JavaScript.call createWriteStream #[JavaScript.unsafeToValue path (* as Buffer? *), options] + end + end +in +open Instream +open Outstream +structure StreamIO = struct +open Instream.StreamIO +(* open Outstream.StreamIO *) +end +end (* local *) +end (* structure BinIO *) +end; (* local *) diff --git a/lib/lunarml/ml/basis/nodejs/bin-io-dummy.sml b/lib/lunarml/ml/basis/nodejs/bin-io-dummy.sml new file mode 100644 index 00000000..06351c34 --- /dev/null +++ b/lib/lunarml/ml/basis/nodejs/bin-io-dummy.sml @@ -0,0 +1,2 @@ +structure BinIO = struct +end; diff --git a/lib/lunarml/ml/basis/sources-js-cps.mlb b/lib/lunarml/ml/basis/sources-js-cps.mlb index 8ee7a7c7..15b17a5a 100644 --- a/lib/lunarml/ml/basis/sources-js-cps.mlb +++ b/lib/lunarml/ml/basis/sources-js-cps.mlb @@ -8,6 +8,7 @@ delim-cont.sml js-cps/javascript-callback.sml nodejs/timer.sml nodejs/text-io-async.sml +nodejs/bin-io-async.sml nodejs/os-async.sml nodejs/command-line.sml end @@ -46,6 +47,7 @@ structure JavaScript (* extension *) structure LunarML (* extension *) structure Array structure ArraySlice +structure BinIO structure Bool structure BoolArray structure BoolArraySlice diff --git a/lib/lunarml/ml/basis/sources-js.mlb b/lib/lunarml/ml/basis/sources-js.mlb index 60cb0f87..b9d034da 100644 --- a/lib/lunarml/ml/basis/sources-js.mlb +++ b/lib/lunarml/ml/basis/sources-js.mlb @@ -7,6 +7,7 @@ ann "sequenceNonUnit ignore" js/javascript-callback.sml nodejs/timer.sml nodejs/text-io.sml +nodejs/bin-io-dummy.sml nodejs/os.sml nodejs/command-line.sml end @@ -45,6 +46,7 @@ structure JavaScript (* extension *) structure LunarML (* extension *) structure Array structure ArraySlice +structure BinIO structure Bool structure BoolArray structure BoolArraySlice diff --git a/lib/lunarml/ml/basis/sources-lua.mlb b/lib/lunarml/ml/basis/sources-lua.mlb index 27a3972b..35b37eb3 100644 --- a/lib/lunarml/ml/basis/sources-lua.mlb +++ b/lib/lunarml/ml/basis/sources-lua.mlb @@ -65,6 +65,7 @@ widetext-8.sml lua/time.sml lua/timer.sml lua/text-io.sml +lua/bin-io.sml lua/os.sml lua/command-line.sml delim-cont-$(DELIMITED_CONTINUATIONS).sml @@ -105,6 +106,7 @@ structure Lua (* extension *) structure LunarML (* extension *) structure Array structure ArraySlice +structure BinIO structure Bool structure BoolArray structure BoolArraySlice diff --git a/lib/lunarml/ml/basis/sources-luajit.mlb b/lib/lunarml/ml/basis/sources-luajit.mlb index 6040b393..614307cf 100644 --- a/lib/lunarml/ml/basis/sources-luajit.mlb +++ b/lib/lunarml/ml/basis/sources-luajit.mlb @@ -65,6 +65,7 @@ widetext-8.sml luajit/time.sml lua/timer.sml lua/text-io.sml +lua/bin-io.sml lua/os.sml lua/command-line.sml end @@ -104,6 +105,7 @@ structure Lua (* extension *) structure LunarML (* extension *) structure Array structure ArraySlice +structure BinIO structure Bool structure BoolArray structure BoolArraySlice