Merge pull request #1988 from triska/answer_write_options
ADDED: New Prolog flag, answer_write_options.
This commit is contained in:
@@ -143,6 +143,7 @@ call(_, _, _, _, _, _, _, _, _).
|
|||||||
% enabled) and `error` which throws an exception when a cylic term is created. Read and write.
|
% 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),
|
% * `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).
|
% `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(Flag, Value) :- Flag == max_arity, !, Value = 1023.
|
||||||
current_prolog_flag(max_arity, 1023).
|
current_prolog_flag(max_arity, 1023).
|
||||||
@@ -160,6 +161,12 @@ current_prolog_flag(Flag, OccursCheckEnabled) :-
|
|||||||
Flag == occurs_check,
|
Flag == occurs_check,
|
||||||
!,
|
!,
|
||||||
'$is_sto_enabled'(OccursCheckEnabled).
|
'$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, _) :-
|
current_prolog_flag(Flag, _) :-
|
||||||
atom(Flag),
|
atom(Flag),
|
||||||
throw(error(domain_error(prolog_flag, Flag), current_prolog_flag/2)). % 8.17.2.3 b
|
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_prolog_flag(occurs_check, error) :-
|
||||||
!, '$set_sto_with_error_as_unify'.
|
!, '$set_sto_with_error_as_unify'.
|
||||||
set_prolog_flag(double_quotes, Value) :-
|
set_prolog_flag(double_quotes, Value) :-
|
||||||
throw(error(domain_error(flag_value, double_quotes + Value),
|
flag_domain_error(double_quotes, Value).
|
||||||
set_prolog_flag/2)). % 8.17.1.3 e
|
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, _) :-
|
set_prolog_flag(Flag, _) :-
|
||||||
atom(Flag),
|
atom(Flag),
|
||||||
throw(error(domain_error(prolog_flag, Flag), set_prolog_flag/2)). % 8.17.1.3 d
|
throw(error(domain_error(prolog_flag, Flag), set_prolog_flag/2)). % 8.17.1.3 d
|
||||||
set_prolog_flag(Flag, _) :-
|
set_prolog_flag(Flag, _) :-
|
||||||
throw(error(type_error(atom, Flag), set_prolog_flag/2)). % 8.17.1.3 c
|
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.
|
% control operators.
|
||||||
|
|
||||||
%% fail.
|
%% fail.
|
||||||
|
|||||||
@@ -235,8 +235,12 @@ double_quotes_option(DQ) :-
|
|||||||
; DQ = false
|
; DQ = false
|
||||||
).
|
).
|
||||||
|
|
||||||
|
answer_write_options(Os) :-
|
||||||
|
current_prolog_flag(answer_write_options, Os).
|
||||||
|
|
||||||
write_goal(G, VarList, MaxDepth) :-
|
write_goal(G, VarList, MaxDepth) :-
|
||||||
double_quotes_option(DQ),
|
double_quotes_option(DQ),
|
||||||
|
answer_write_options(Os),
|
||||||
( G = (Var = Value) ->
|
( G = (Var = Value) ->
|
||||||
( var(Value) ->
|
( var(Value) ->
|
||||||
select((Var = _), VarList, NewVarList)
|
select((Var = _), VarList, NewVarList)
|
||||||
@@ -246,17 +250,18 @@ write_goal(G, VarList, MaxDepth) :-
|
|||||||
write(' = '),
|
write(' = '),
|
||||||
( needs_bracketing(Value, =) ->
|
( needs_bracketing(Value, =) ->
|
||||||
write('('),
|
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(')')
|
||||||
; 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 == [] ->
|
; G == [] ->
|
||||||
write('true')
|
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) :-
|
write_last_goal(G, VarList, MaxDepth) :-
|
||||||
double_quotes_option(DQ),
|
double_quotes_option(DQ),
|
||||||
|
answer_write_options(Os),
|
||||||
( G = (Var = Value) ->
|
( G = (Var = Value) ->
|
||||||
( var(Value) ->
|
( var(Value) ->
|
||||||
select((Var = _), VarList, NewVarList)
|
select((Var = _), VarList, NewVarList)
|
||||||
@@ -266,9 +271,9 @@ write_last_goal(G, VarList, MaxDepth) :-
|
|||||||
write(' = '),
|
write(' = '),
|
||||||
( needs_bracketing(Value, =) ->
|
( needs_bracketing(Value, =) ->
|
||||||
write('('),
|
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(')')
|
||||||
; 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) ->
|
( trailing_period_is_ambiguous(Value) ->
|
||||||
write(' ')
|
write(' ')
|
||||||
; true
|
; true
|
||||||
@@ -276,7 +281,7 @@ write_last_goal(G, VarList, MaxDepth) :-
|
|||||||
)
|
)
|
||||||
; G == [] ->
|
; G == [] ->
|
||||||
write('true')
|
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) :-
|
write_eq((G1, G2), VarList, MaxDepth) :-
|
||||||
|
|||||||
Reference in New Issue
Block a user