cleanup parser, add validation logic

Author: [email protected]

src/lib/charsio.pl

@@ -25,6 +25,7 @@
 :- 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),
@@ -424,7 +425,7 @@
 % ```
 
 chars_to_stream(Chars, Stream, StreamOpts) :-
-        parse_stream_options(StreamOpts, [Alias, EOFAction, Reposition, Type]),
+        parse_stream_options_list(StreamOpts, [Alias, EOFAction, Reposition, Type]),
         validate_chars(Chars, Type),
         '$memory_stream'(Stream),
         '$set_stream_options'(Stream, Alias ,EOFAction, Reposition, Type),
@@ -433,88 +434,3 @@
         ;   maplist(put_char(Stream), Chars)
         ).
 
-%% ugly ripoff of parser from library(builtins).
-
-:- meta_predicate parse_options_list(?, 2, ?, ?, ?).
-
-parse_options_list(Options, Selector, DefaultPairs, OptionValues, Stub) :-
-    '$skip_max_list'(_, _, Options, Tail),
-    (  Tail == [] ->
-       true
-    ;  var(Tail) ->
-       throw(error(instantiation_error, Stub))       % 8.11.5.3c)
-    ;  Tail \== [] ->
-       throw(error(type_error(list, Options), Stub)) % 8.11.5.3e)
-    ),
-    (  lists:maplist('$call'(nonvar), Options), % need '$call' because
-                                                % maplist isn't
-                                                % declared as a
-                                                % meta-predicate yet
-       catch(lists:maplist(Selector, Options, OptionPairs0),
-             error(E, _),
-             builtins:throw(error(E, Stub))) ->
-       lists:append(DefaultPairs, OptionPairs0, OptionPairs1),
-       keysort(OptionPairs1, OptionPairs),
-       select_rightmost_options(OptionPairs, OptionValues)
-    ;
-       throw(error(instantiation_error, Stub))       % 8.11.5.3c)
-    ).
-
-parse_stream_options_(type(Type), type-Type) :-
-    (  var(Type) ->
-       throw(error(instantiation_error, open/4)) % 8.1.3 7)
-    ;
-       lists:member(Type, [text, binary]), !
-    ;
-       throw(error(domain_error(stream_option, type(Type)), _))
-    ).
-parse_stream_options_(reposition(Bool), reposition-Bool) :-
-    (  nonvar(Bool), lists:member(Bool, [true, false]), !
-    ;
-       throw(error(domain_error(stream_option, reposition(Bool)), _))
-    ).
-
-parse_stream_options_(alias(A), alias-A) :-
-
-    (  var(A) ->
-       throw(error(instantiation_error, open/4)) % 8.1.3 7)
-    ;
-       atom(A), A \== [] -> true
-    ;
-       throw(error(domain_error(stream_option, alias(A)), _))
-    ).
-parse_stream_options_(eof_action(Action), eof_action-Action) :-
-    (  nonvar(Action), lists:member(Action, [eof_code, error, reset]), !
-    ;
-       throw(error(domain_error(stream_option, eof_action(Action)), _))
-    ).
-parse_stream_options_(E, _) :-
-        throw(error(domain_error(stream_option, E), _)). % 8.11.5.3i) %
-
-parse_stream_options(Options, OptionValues) :-
-    DefaultOptions = [alias-[], eof_action-eof_code, reposition-false, type-text],
-    parse_options_list(Options, parse_stream_options_, DefaultOptions, OptionValues, chars_to_stream/3).
-
-
-select_rightmost_options([Option-Value | OptionPairs], OptionValues) :-
-    (  pairs:same_key(Option, OptionPairs, OtherValues, _),
-       OtherValues == []  ->
-       OptionValues = [Value | OptionValues0],
-       select_rightmost_options(OptionPairs, OptionValues0)
-    ;
-       select_rightmost_options(OptionPairs, OptionValues)
-    ).
-
-select_rightmost_options([], []).
-
-
-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/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).