]> Repositorios git - scryer-prolog.git/commitdiff
ADDED: New Prolog flag, answer_write_options.
authorMarkus Triska <[email protected]>
Sun, 3 Sep 2023 07:33:16 +0000 (09:33 +0200)
committerMarkus Triska <[email protected]>
Sun, 3 Sep 2023 08:49:07 +0000 (10:49 +0200)
This lets us specify additional write options used by the top level
for writing answers.

src/lib/builtins.pl
src/toplevel.pl

index 81f63dddf1e6e50efa7bcf76e6942390f1eb1742..4625cfb216d6578dd3d77855a955ea7f21470f82 100644 (file)
@@ -143,6 +143,7 @@ call(_, _, _, _, _, _, _, _, _).
 %    enabled) and `error` which throws an exception when a cylic term is created. Read and write.
 %  * `unknown`: How undefined predicates are handled when called. Possible values are `error` (the default, an error is thrown),
 %    `fail` (the call silently fails) and `warn` (the call fails and a warning about the undefined predicate is printed).
+%  * `answer_write_options`: Additional write options used by the top level for writing answers.
 %
 current_prolog_flag(Flag, Value) :- Flag == max_arity, !, Value = 1023.
 current_prolog_flag(max_arity, 1023).
@@ -160,6 +161,12 @@ current_prolog_flag(Flag, OccursCheckEnabled) :-
     Flag == occurs_check,
     !,
     '$is_sto_enabled'(OccursCheckEnabled).
+current_prolog_flag(Flag, Value) :-
+    Flag == answer_write_options,
+    !,
+    (   iso_ext:bb_get('$answer_write_options', Value) -> true
+    ;   Value = []
+    ).
 current_prolog_flag(Flag, _) :-
     atom(Flag),
     throw(error(domain_error(prolog_flag, Flag), current_prolog_flag/2)). % 8.17.2.3 b
@@ -207,14 +214,25 @@ set_prolog_flag(occurs_check, false) :-
 set_prolog_flag(occurs_check, error) :-
     !, '$set_sto_with_error_as_unify'.
 set_prolog_flag(double_quotes, Value) :-
-    throw(error(domain_error(flag_value, double_quotes + Value),
-                set_prolog_flag/2)). % 8.17.1.3 e
+    flag_domain_error(double_quotes, Value).
+set_prolog_flag(answer_write_options, Options) :-
+    !,
+    catch(catch(builtins:parse_write_options(Options, _, set_prolog_flag/2),
+                error(domain_error(_,_), _),
+                throw(error(type_error(_,_), _))), % convert domain error to type error ....
+          error(type_error(_,_), _),               % ... to catch type and domain errors.
+          flag_domain_error(answer_write_options, Options)),
+    iso_ext:bb_put('$answer_write_options', Options).
 set_prolog_flag(Flag, _) :-
     atom(Flag),
     throw(error(domain_error(prolog_flag, Flag), set_prolog_flag/2)). % 8.17.1.3 d
 set_prolog_flag(Flag, _) :-
     throw(error(type_error(atom, Flag), set_prolog_flag/2)). % 8.17.1.3 c
 
+flag_domain_error(Flag, Value) :-
+    % domain error via 8.17.1.3 e: Value is inappropriate for Flag
+    throw(error(domain_error(flag_value, Flag + Value), set_prolog_flag/2)).
+
 % control operators.
 
 %% fail.
index 5431bad187c2604b80687c08d7894187e6de3f86..b804401b795787c30640dcfdf6fc1e0941d0ae25 100644 (file)
@@ -235,8 +235,12 @@ double_quotes_option(DQ) :-
     ;   DQ = false
     ).
 
+answer_write_options(Os) :-
+    current_prolog_flag(answer_write_options, Os).
+
 write_goal(G, VarList, MaxDepth) :-
     double_quotes_option(DQ),
+    answer_write_options(Os),
     (  G = (Var = Value) ->
        (  var(Value) ->
           select((Var = _), VarList, NewVarList)
@@ -246,17 +250,18 @@ write_goal(G, VarList, MaxDepth) :-
        write(' = '),
        (  needs_bracketing(Value, =) ->
           write('('),
-          write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth), double_quotes(DQ)]),
+          write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth), double_quotes(DQ)|Os]),
           write(')')
-       ;  write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth), double_quotes(DQ)])
+       ;  write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth), double_quotes(DQ)|Os])
        )
     ;  G == [] ->
        write('true')
-    ;  write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth), double_quotes(DQ)])
+    ;  write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth), double_quotes(DQ)|Os])
     ).
 
 write_last_goal(G, VarList, MaxDepth) :-
     double_quotes_option(DQ),
+    answer_write_options(Os),
     (  G = (Var = Value) ->
        (  var(Value) ->
           select((Var = _), VarList, NewVarList)
@@ -266,9 +271,9 @@ write_last_goal(G, VarList, MaxDepth) :-
        write(' = '),
        (  needs_bracketing(Value, =) ->
           write('('),
-          write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth), double_quotes(DQ)]),
+          write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth), double_quotes(DQ)|Os]),
           write(')')
-       ;  write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth), double_quotes(DQ)]),
+       ;  write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth), double_quotes(DQ)|Os]),
           (  trailing_period_is_ambiguous(Value) ->
              write(' ')
           ;  true
@@ -276,7 +281,7 @@ write_last_goal(G, VarList, MaxDepth) :-
        )
     ;  G == [] ->
        write('true')
-    ;  write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth), double_quotes(DQ)])
+    ;  write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth), double_quotes(DQ)|Os])
     ).
 
 write_eq((G1, G2), VarList, MaxDepth) :-