Merge pull request #1069 from triska/crypto_improvements

Performance improvements for library(crypto)

src/clause_types.rs

@@ -296,6 +296,7 @@ pub(crate) enum SystemClauseType {
     Ed25519NewKeyPair,
     Ed25519KeyPairPublicKey,
     Curve25519ScalarMult,
+    FirstNonOctet,
     LoadHTML,
     LoadXML,
     GetEnv,
@@ -588,6 +589,7 @@ impl SystemClauseType {
                 clause_name!("$ed25519_keypair_public_key")
             }
             &SystemClauseType::Curve25519ScalarMult => clause_name!("$curve25519_scalar_mult"),
+            &SystemClauseType::FirstNonOctet => clause_name!("$first_non_octet"),
             &SystemClauseType::LoadHTML => clause_name!("$load_html"),
             &SystemClauseType::LoadXML => clause_name!("$load_xml"),
             &SystemClauseType::GetEnv => clause_name!("$getenv"),
@@ -810,6 +812,7 @@ impl SystemClauseType {
             ("$ed25519_new_keypair", 1) => Some(SystemClauseType::Ed25519NewKeyPair),
             ("$ed25519_keypair_public_key", 2) => Some(SystemClauseType::Ed25519KeyPairPublicKey),
             ("$curve25519_scalar_mult", 3) => Some(SystemClauseType::Curve25519ScalarMult),
+            ("$first_non_octet", 2) => Some(SystemClauseType::FirstNonOctet),
             ("$load_html", 3) => Some(SystemClauseType::LoadHTML),
             ("$load_xml", 3) => Some(SystemClauseType::LoadXML),
             ("$getenv", 2) => Some(SystemClauseType::GetEnv),

src/lib/charsio.pl

@@ -10,6 +10,7 @@
 :- use_module(library(iso_ext)).
 :- use_module(library(error)).
 :- use_module(library(lists)).
+:- use_module(library(iso_ext), [partial_string/1,partial_string/3]).
 
 fabricate_var_name(VarType, VarName, N) :-
     char_code('A', AC),
@@ -235,10 +236,18 @@ chars_base64(Cs, Bs, Options) :-
         ;   domain_error(charset, Charset, chars_base64/3)
         ),
         (   var(Cs) ->
-            must_be(list, Bs),
+            must_be_characters(Bs),
-            maplist(must_be(character), Bs),
-            '$chars_base64'(Cs, Bs, Padding, Charset)
-        ;   must_be(list, Cs),
-            maplist(must_be(character), Cs),
             '$chars_base64'(Cs, Bs, Padding, Charset)
+        ;   must_be_characters(Cs),
+            (   '$first_non_octet'(Cs, N) ->
+                domain_error(byte_char, N, chars_base64/3)
+            ;   '$chars_base64'(Cs, Bs, Padding, Charset)
+            )
+        ).
+
+must_be_characters(Cs) :-
+        (   partial_string(Cs) ->
+            true
+        ;   must_be(list, Cs),
+            maplist(must_be(character), Cs)
         ).

src/lib/crypto.pl

@@ -46,6 +46,7 @@
 :- use_module(library(format)).
 :- use_module(library(charsio)).
 :- use_module(library(si)).
+:- use_module(library(iso_ext), [partial_string/1]).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    hex_bytes(?Hex, ?Bytes) is det.
@@ -104,12 +105,18 @@ must_be_bytes(Bytes, Context) :-
 
 
 must_be_byte_chars(Chars, Context) :-
-        must_be(list, Chars),
+        (   partial_string(Chars) ->
-        (   member(Char, Chars),
+            (   '$first_non_octet'(Chars, F) ->
-            char_code(Char, Code),
+                domain_error(byte_char, F, Context)
-            \+ between(0, 255, Code) ->
+            ;   true
-            domain_error(byte_char, Char, Context)
+            )
-        ;   true
+        ;   must_be(list, Chars),
+            (   member(Char, Chars),
+                char_code(Char, Code),
+                \+ between(0, 255, Code) ->
+                domain_error(byte_char, Char, Context)
+            ;   true
+            )
         ).
 
 
@@ -613,8 +620,11 @@ encoding_chars(octet, Bs, Cs) :-
         ),
         must_be_byte_chars(Cs, crypto_encoding).
 encoding_chars(utf8, Cs, Cs) :-
-        must_be(list, Cs),
+        (   partial_string(Cs) ->
-        maplist(must_be(character), Cs).
+            true
+        ;   must_be(list, Cs),
+            maplist(must_be(character), Cs)
+        ).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Digital signatures with Ed25519

src/lib/format.pl

@@ -390,6 +390,13 @@ format(Fs, Args) :-
 
 format(Stream, Fs, Args) :-
         phrase(format_(Fs, Args), Cs),
+        (   stream_property(Stream, type(binary)) ->
+            (   '$first_non_octet'(Cs, N) ->
+                domain_error(byte_char, N, format/3)
+            ;   true
+            )
+        ;   true
+        ),
         % we use a specialised internal predicate that uses only a
         % single "write" operation for efficiency. It is equivalent to
         % maplist(put_char(Stream), Cs). It also works for binary streams.

src/machine/system_calls.rs

@@ -2042,18 +2042,6 @@ impl MachineState {
 
                 if stream.options().stream_type == StreamType::Binary {
                     for c in string.chars() {
-                        if c as u32 > 255 {
-                            let stub = MachineError::functor_stub(clause_name!("$put_chars"), 2);
-
-                            let err = MachineError::type_error(
-                                self.heap.h(),
-                                ValidType::Byte,
-                                Addr::Char(c),
-                            );
-
-                            return Err(self.error_form(err, stub));
-                        }
-
                         bytes.push(c as u8);
                     }
                 } else {
@@ -5340,6 +5328,18 @@ impl MachineState {
                 let cstr = self.heap.put_complete_string(&string);
                 (self.unify_fn)(self, self[temp_v!(3)], cstr);
             }
+            &SystemClauseType::FirstNonOctet => {
+                for c in self.heap_pstr_iter(self[temp_v!(1)]).to_string().chars() {
+                    if c as u32 > 255 {
+                        let chars = clause_name!(String::from(c.to_string()), self.atom_tbl);
+                        let non_octet = self.heap.to_unifiable(HeapCellValue::Atom(chars, None));
+                        (self.unify_fn)(self, self[temp_v!(2)], non_octet);
+                        return return_from_clause!(self.last_call, self);
+                    }
+                }
+                self.fail = true;
+                return Ok(());
+            }
             &SystemClauseType::LoadHTML => {
                 let string = self.heap_pstr_iter(self[temp_v!(1)]).to_string();
                 let doc = select::document::Document::from_read(string.as_bytes()).unwrap();
@@ -5474,18 +5474,6 @@ impl MachineState {
                 } else {
                     let mut bytes = vec![];
                     for c in self.heap_pstr_iter(self[temp_v!(1)]).to_string().chars() {
-                        if c as u32 > 255 {
-                            let stub = MachineError::functor_stub(clause_name!("chars_base64"), 3);
-
-                            let err = MachineError::type_error(
-                                self.heap.h(),
-                                ValidType::Byte,
-                                Addr::Char(c),
-                            );
-
-                            return Err(self.error_form(err, stub));
-                        }
-
                         bytes.push(c as u8);
                     }
                     let b64 = base64::encode_config(bytes, config);