add char streams

Author: [email protected]

build/instructions_template.rs

@@ -247,6 +247,8 @@ enum SystemClauseType {
     CurrentHostname,
     #[strum_discriminants(strum(props(Arity = "1", Name = "$current_input")))]
     CurrentInput,
+    #[strum_discriminants(strum(props(Arity = "1", Name = "$memory_stream")))]
+    MemoryStream,
     #[strum_discriminants(strum(props(Arity = "1", Name = "$current_output")))]
     CurrentOutput,
     #[strum_discriminants(strum(props(Arity = "2", Name = "$directory_files")))]
@@ -1672,6 +1674,7 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::CallCreatePartialString |
                     &Instruction::CallCurrentHostname |
                     &Instruction::CallCurrentInput |
+                    &Instruction::CallMemoryStream |
                     &Instruction::CallCurrentOutput |
                     &Instruction::CallDirectoryFiles |
                     &Instruction::CallFileSize |
@@ -1915,6 +1918,7 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::ExecuteCreatePartialString |
                     &Instruction::ExecuteCurrentHostname |
                     &Instruction::ExecuteCurrentInput |
+                    &Instruction::ExecuteMemoryStream |
                     &Instruction::ExecuteCurrentOutput |
                     &Instruction::ExecuteDirectoryFiles |
                     &Instruction::ExecuteFileSize |

src/lib/charsio.pl

@@ -14,14 +14,18 @@
                     read_from_chars/2,
                     read_term_from_chars/3,
                     write_term_to_chars/3,
-                    chars_base64/3]).
+                    chars_base64/3,
+                    chars_stream/1,
+                    chars_to_stream/2,
+                    chars_to_stream/3]).
 
 :- use_module(library(dcgs)).
 :- use_module(library(iso_ext)).
 :- use_module(library(error)).
 :- use_module(library(lists)).
 :- use_module(library(between)).
 :- use_module(library(iso_ext), [partial_string/1,partial_string/3]).
+:- use_module(library(charsio/memory_stream_utils)).
 
 fabricate_var_name(VarType, VarName, N) :-
     char_code('A', AC),
@@ -305,7 +309,7 @@
 
 % invalid continuation byte
 % each remaining continuation byte (if any) will raise 0xFFFD too
-continuation(_, ['\xFFFD\'|T], _) --> [_], decode_utf8(T).
+continuation(_, ['\xFFFD\'|T], _) --> [_], decode_utf8(T). %'
 
 %% get_line_to_chars(+Stream, -Chars, +InitialChars).
 %
@@ -393,3 +397,40 @@
             ;   '$chars_base64'(Cs, Bs, Padding, Charset)
             )
         ).
+
+%% chars_stream(-Stream)
+% Stream is a character stream.
+
+chars_stream(Stream) :-
+        '$memory_stream'(Stream).
+
+%% chars_to_stream(+Chars, -Stream) :-
+% Convert a list of characters into a character stream.
+
+chars_to_stream(Chars, Stream) :-
+        chars_to_stream(Chars, Stream, []).
+
+%% chars_to_stream(+Chars, -Stream, +Options) :-
+% Creates a character stream from a list of characters.
+%
+% Chars is the list of characters to write to the stream.
+% Stream is the created character stream (a memory stream).
+% Options are currently ignored.
+%
+% Example:
+%
+% ```
+% ?- chars_to_stream("hello", Stream, []).
+%    Stream = stream('$memory_stream'(2048)).
+% ```
+
+chars_to_stream(Chars, Stream, StreamOpts) :-
+        parse_stream_options_list(StreamOpts, [Alias, EOFAction, Reposition, Type]),
+        validate_chars(Chars, Type),
+        '$memory_stream'(Stream),
+        '$set_stream_options'(Stream, Alias ,EOFAction, Reposition, Type),
+        (   Type=binary
+        ->  maplist(put_byte(Stream), Chars)
+        ;   maplist(put_char(Stream), Chars)
+        ).
+

src/lib/charsio/memory_stream_utils.pl

@@ -0,0 +1,77 @@
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   Internal utilities supporting charsio:chars_to_stream/3.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+:- module(memory_stream_utils, [parse_stream_options_list/2, validate_chars/2]).
+
+:- use_module(library(lists)).
+:- use_module(library(error)).
+
+
+option_default(type, text).
+option_default(reposition, false).
+option_default(alias, []).
+option_default(eof_action, eof_code).
+
+parse_stream_options_list(Options, [Alias, EOFAction, Reposition, Type]) :-
+        maplist(parse_option, Options),
+        option_default(type, Type, Options),
+        option_default(reposition, Reposition, Options),
+        option_default(alias, Alias, Options),
+        option_default(eof_action, EOFAction, Options).
+
+option_default(Option, Resolved, Options) :-
+        option_default(Option, Default),
+        MaybeOption =.. [Option,Answer],
+        (   member(MaybeOption, Options) ->
+            Resolved=Answer
+        ;   Resolved=Default
+        ).
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   ?- option_default(type, Resolved, []).
+   ?- option_default(type, Resolved, [type(binary)]).
+   ?- option_default(type, Resolved, [type(text)]).
+   ?- option_default(type, Resolved, [alias]).
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+parse_option(type(Type)) :-
+        (   memberchk(Type, [binary, text]), !
+        ;   throw(error(instantiation_error, choose_for(type, one_of(binary, text))))
+        ).
+
+parse_option(reposition(Bool)) :-
+           catch(must_be(boolean, Bool),
+                 error(_,_),
+                 throw(error(instantiation_error, choose_for(binary, one_of(true,false))))
+                ).
+
+parse_option(alias(A)) :-
+        (   var(A)
+        ->  throw(error(instantiation_error, must_satisfy(alias, var)))
+        ;   true
+        ),
+        (   atom(A), dif(A, []), !
+        ;   throw(error(instantiation_error, must_satisfy(alias, (atom, dif([])))))
+        )
+        .
+
+
+parse_option(eof_action(Action)) :-
+        (   nonvar(Action), memberchk(Action, [eof_code, error, reset]), !
+        ;   throw(error(domain_error(stream_option), choose_one(eof_action, [eof_code, error, reset])))
+        ).
+
+validate_chars(Chars, Type) :-
+        validate_chars_(Chars, Type).
+
+valid_byte_(Byte) :-
+        must_be(integer, Byte),
+        Byte >= 0,
+        Byte < 256.
+
+validate_chars_(Chars, binary) :-
+        maplist(valid_byte_, Chars).
+
+validate_chars_(Chars, text) :-
+        must_be(chars, Chars).

src/machine/dispatch.rs

@@ -3521,6 +3521,14 @@ impl Machine {
                         try_or_throw!(self.machine_st, self.current_input());
                         step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
                     }
+                    &Instruction::CallMemoryStream => {
+                        try_or_throw!(self.machine_st, self.memory_stream());
+                        step_or_fail!(self, self.machine_st.p += 1);
+                    }
+                    &Instruction::ExecuteMemoryStream => {
+                        try_or_throw!(self.machine_st, self.memory_stream());
+                        step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
+                    }
                     &Instruction::CallCurrentOutput => {
                         try_or_throw!(self.machine_st, self.current_output());
                         step_or_fail!(self, self.machine_st.p += 1);

src/machine/system_calls.rs

@@ -14,7 +14,7 @@ use crate::heap_print::*;
 #[cfg(feature = "http")]
 use crate::http::{HttpListener, HttpRequest, HttpRequestData, HttpResponse};
 use crate::instructions::*;
-use crate::machine;
+use crate::{machine};
 use crate::machine::code_walker::*;
 use crate::machine::copier::*;
 use crate::machine::heap::*;
@@ -1952,6 +1952,41 @@ impl Machine {
         Ok(())
     }
 
+    #[inline(always)]
+    pub(crate) fn memory_stream(&mut self) -> CallResult {
+        let addr = self.deref_register(1);
+        let stream = Stream::from_owned_string("".to_string(), &mut self.machine_st.arena);
+
+        if let Some(var) = addr.as_var() {
+            self.machine_st.bind(var, stream.into());
+            return Ok(());
+        }
+
+        read_heap_cell!(addr,
+            (HeapCellValueTag::Cons, cons_ptr) => {
+                match_untyped_arena_ptr!(cons_ptr,
+                    (ArenaHeaderTag::Stream, other_stream) => {
+                        self.machine_st.fail = stream != other_stream;
+                    }
+                    _ => {
+                        let stub = functor_stub(atom!("memory_stream"), 1);
+                        let err = self.machine_st.domain_error(DomainErrorType::Stream, addr);
+
+                        return Err(self.machine_st.error_form(err, stub));
+                    }
+                );
+            }
+            _ => {
+                let stub = functor_stub(atom!("memory_stream"), 1);
+                let err = self.machine_st.domain_error(DomainErrorType::Stream, addr);
+
+                return Err(self.machine_st.error_form(err, stub));
+            }
+        );
+
+        Ok(())
+    }
+
     #[inline(always)]
     pub(crate) fn current_output(&mut self) -> CallResult {
         let addr = self.deref_register(1);

src/tests/charsio.pl

@@ -0,0 +1,80 @@
+:- module(charsio_tests, []).
+:- use_module(library(lists)).
+:- use_module(library(charsio)).
+
+:- use_module(test_framework).
+
+
+
+test("can create string char stream",
+        (   chars_stream(Stream),
+            put_char(Stream, a),
+            get_char(Stream, C),
+            C=a
+        )).
+
+
+test("can spell simple word with char stream",
+     (
+      chars_stream(Stream),
+      put_char(Stream, c),
+      put_char(Stream, a),
+      put_char(Stream, t),
+      get_n_chars(Stream, 3, Chars),
+      Chars=[c,a,t]
+     )).
+
+test("can read from and write to char stream",
+     (
+      chars_stream(Stream),
+      put_char(Stream, c),
+      put_char(Stream, a),
+      get_char(Stream, _C),
+      put_char(Stream, b),
+      get_n_chars(Stream, 2, Chars),
+      Chars=[a,b]
+     )
+    ).
+
+
+test("can convert string to char stream",
+     (
+      Phrase="can convert string to char stream",
+      length(Phrase, N),
+      chars_to_stream(Phrase, Stream),
+      get_n_chars(Stream, N, Chars),
+      Phrase=Chars
+     )
+    ).
+
+test("can convert string to char stream with options",
+     (
+      Phrase="can convert string to char stream",
+      length(Phrase, N),
+      chars_to_stream(Phrase, Stream, []),
+      get_n_chars(Stream, N, Chars),
+      Phrase=Chars
+     )).
+
+
+test("can read/write bytes",
+     (
+      A=97,
+      B=98,
+      C=99,
+      chars_to_stream([A,B,C], Stream, [type(binary)]),
+      get_byte(Stream, A),
+      get_byte(Stream, B),
+      get_byte(Stream, C),
+      put_byte(Stream, A),
+      put_byte(Stream, B),
+      put_byte(Stream, C),
+      get_byte(Stream, A),
+      get_byte(Stream, B),
+      get_byte(Stream, C)
+      )).
+
+
+
+% ?- test_framework:main(charsio_tests). 
+

tests/scryer/cli/src_tests/charsio_tests.toml

@@ -0,0 +1 @@
+args = ["-f", "--no-add-history", "src/tests/charsio.pl", "-f", "-g", "use_module(library(charsio_tests)), charsio_tests:main_quiet(charsio_tests)"]