diff --git a/C/scanner.c b/C/scanner.c index cdb06f1bb..b232b3816 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -1437,7 +1437,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments, ch = getchr(st); } add_ch_to_buff('\0'); - if (!isvar) { + if (!isvar || (ch == '(' && trueLocalPrologFlag(ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG) ) ) { Atom ae; /* don't do this in iso */ ae = Yap_LookupAtom(TokImage); @@ -1585,7 +1585,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments, charp = (unsigned char *)TokImage+sz; break; } - if (ch == 10 && trueGlobalPrologFlag(ISO_FLAG)) { + if (ch == 10 && (trueGlobalPrologFlag(ISO_FLAG) || + trueLocalPrologFlag(MULTILINE_QUOTED_TEXT_FLAG))) { /* in ISO a new line terminates a string */ LOCAL_ErrorMessage = "layout character \n inside quotes"; break; diff --git a/C/sort.c b/C/sort.c index bb6e60296..8381306dd 100644 --- a/C/sort.c +++ b/C/sort.c @@ -59,7 +59,7 @@ build_new_list(CELL *pt, Term t USES_REGS) pt += 2; if (pt > ASP - 4096) { if (!Yap_gcl((ASP-HR)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); + Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return(FALSE); } t = Deref(ARG1); diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index 73cc33054..631c06ca4 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -53,21 +53,6 @@ opportunity. Initial value is 10,000. May be changed. A value of 0 "allow_assert_for_static_predicates", true, booleanFlag, "true", NULL), - /**< - - boolean flag allows syntax such - as - ~~~ - Tree(Node(L,node,R)) :- - Tree(L), - Tree(R). - ~~~ - */ - YAP_FLAG(ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG, - "allow_variable_name_as_functor", false, booleanFlag, "false", - NULL), - - /**< how to present answers, default is `~p`. */ YAP_FLAG(ANSWER_FORMAT_FLAG, "answer_format", true, isatom, "~p", NULL), /**< diff --git a/H/YapLFlagInfo.h b/H/YapLFlagInfo.h index 0269c16e2..611f9a229 100644 --- a/H/YapLFlagInfo.h +++ b/H/YapLFlagInfo.h @@ -26,6 +26,13 @@ START_LOCAL_FLAGS +/**< Allow constructs such as 'Functor( V )'. Functor is parsed as an + atom. The token `V` is still understood as a variable. + +Originally a SWI-Prolog flag. + */ +YAP_FLAG(ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG, "allow_variable_name_as_functor", true, booleanFlag, "false", NULL), + /**< set the system to look for undefined procedures */ YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL), @@ -72,6 +79,11 @@ YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL), */ YAP_FLAG(LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap", NULL), + /**< If true, quoted atoms, string, lists of codes and of chars may extend over several lines, without the need to escape the new-line characters. Otherwise, unquoted line breaks cause a syntax error. + + The default was for it to be true, except if in iso mode. YAP-6.5 changed the default, in order to ensure compatibility. + */ + YAP_FLAG(MULTILINE_QUOTED_TEXT_FLAG, "multiline_quoted_text", false, booleanFlag, "false", NULL), /**< Show the execution stack in exceptions. */ YAP_FLAG(STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", false, booleanFlag, "true", NULL), diff --git a/library/matrix.yap b/library/matrix.yap index 9efefb539..cdbd51a88 100644 --- a/library/matrix.yap +++ b/library/matrix.yap @@ -29,6 +29,7 @@ (+=)/2, op(800, xfx, +=), (-=)/2, op(800, xfx, -=), op(700, xfx, in), + op(700, xfx, within), op(700, xfx, ins), op(450, xfx, ..), % should bind more tightly than \/ op(710, xfx, of), of/2, @@ -974,8 +975,6 @@ mtimes(I1, I2, V) :- V = I1*I2 ) ; V = I1 *I2. - - % % three types of matrix: integers, floats and general terms. % diff --git a/packages/gecode/clpfd.yap b/packages/gecode/clpfd.yap index a5a683113..00e3457da 100644 --- a/packages/gecode/clpfd.yap +++ b/packages/gecode/clpfd.yap @@ -72,6 +72,7 @@ Constraints supported are: (#\/)/2, (#/\)/2, in/2 , + fd_in/2 , ins/2, boolvar/1, boolvars/1, @@ -80,7 +81,7 @@ Constraints supported are: all_distinct/2, maximize/1, minimize/1, - sum/3, + sum/3, fd_sum/3, lex_chain/1, minimum/2, min/2, @@ -232,6 +233,7 @@ The product of constant _Cs_ by _Vs_ must be in relation :- reexport(library(matrix), [(<==)/2, op(800, xfx, '<=='), op(700, xfx, in), + op(700, xfx, fd_in), op(700, xfx, ins), op(450, xfx, ..), % should bind more tightly than \/ op(710, xfx, of), @@ -258,13 +260,13 @@ constraint( (_ #<==> _) ). constraint( (_ #==> _) ). constraint( (_ #<== _) ). constraint( (_ #\/ _) ). -constraint( (_ #/\ _) ). constraint( in(_, _) ). %2, constraint( ins(_, _) ). %2, constraint( all_different(_) ). %1, constraint( all_distinct(_) ). %1, constraint( all_distinct(_,_) ). %1, constraint( sum(_, _, _) ). %3, +constraint( fd_sum(_, _, _) ). %3, constraint( scalar_product(_, _, _, _) ). %4, constraint( min(_, _) ). %2, constraint( minimum(_, _) ). %2, @@ -297,12 +299,16 @@ constraint( fd_dom(_, _) ). %2 constraint( clause(_, _, _, _) ). %2 -process_constraints((B0,B1), (NB0, NB1), Env) :- - process_constraints(B0, NB0, Env), - process_constraints(B1, NB1, Env). -process_constraints(B, B, env(_Space)) :- +process_constraints(V, V, _Env, _) :- + var(V), !. +process_constraints((B0,B1), (NB0, NB1), Env, L) :- + process_constraints(B0, NB0, Env, L), + process_constraints(B1, NB1, Env,L). +process_constraints(labeling(A,B),labeling(A, B), env(_Space),true) :- + !. +process_constraints(B, B, env(_Space),_) :- constraint(B), !. -process_constraints(B, B, _Env). +process_constraints(B, B, _Env,_). % process_constraint(B, NB, Space). ( A #= B) :- @@ -385,6 +391,8 @@ sum( L, Op, V) :- check(L, NL), check(V, NV), post( rel(sum(NL), Op, NV), Env, _). +fd_sum( L, Op, V) :- + sum( L, Op, V). ( ( A #<==> VBool )) :- get_home(Space-Map), check(A, NA), @@ -444,6 +452,12 @@ sum( L, Op, V) :- check(B, NB), m(X, NX, NA, NB, Map), NX := intvar(Space, NA, NB). +( X fd_in A..B) :- + get_home(Space-Map), + check(A, NA), + check(B, NB), + m(X, NX, NA, NB, Map), + NX := intvar(Space, NA, NB). ( Xs ins A..B) :- get_home(Space-Map), check(A, NA), @@ -580,6 +594,7 @@ check(V, NV) :- V = '$matrix'(_, _, _, _, C) -> C =.. [_|L], maplist(check, L, NV) ; V = A+B -> check(A,NA), check(B, NB), NV = NB+NA ; V = A-B -> check(A,NA), check(B, NB), NV = NB-NA ; + V in Domain -> V fd_in Domain, V=NV ; arith(V, _) -> V =.. [C|L], maplist(check, L, NL), NV =.. [C|NL] ; constraint(V) -> V =.. [C|L], maplist(check, L, NL), NV =.. [C|NL] ). @@ -859,7 +874,6 @@ linearize(AC, C, [A|Bs], Bs, [C|CBs], CBs, I, I, Env) :- Env = _-Map, l(V, A, Map). -arith('/\\'(_,_), (/\)). arith('\\/'(_,_), (\/)). arith('=>'(_,_), (=>)). arith('<=>'(_,_), (<=>)). @@ -869,6 +883,7 @@ arith(min(_), min). arith(max(_), max). arith(min(_,_), min). arith(max(_,_), max). +arith((_ - _), minus). arith((_ * _), times). arith((_ / _), div). arith(sum(_), sum). @@ -1208,7 +1223,8 @@ in_c_l(Env, V, IV) :- in_c(V, IV, Env). user:term_expansion( ( H :- B), (H :- (gecode_clpfd:init_gecode(Space, Me), NB, gecode_clpfd:close_gecode(Space, Vs, Me)) ) ) :- - process_constraints(B, NB, Env), + process_constraints(B, NB, Env, Labeling), + nonvar(Labeling), term_variables(H, Vs), nonvar( Env ), !, Env = env( Space ). @@ -1266,6 +1282,11 @@ attr_unify_hook(v(IV1,_,_), Y) :- % Translate attributes from this module to residual goals + +attribute_goals(X) --> + { get_attr(X, gecode_clpfd, v(_,0,1)) }, + !, + [boolvar(X)]. attribute_goals(X) --> { get_attr(X, gecode_clpfd, v(_,A,B)) }, [X in A..B]. diff --git a/pl/boot.yap b/pl/boot.yap index 941e1c8c7..89188051e 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -267,7 +267,7 @@ initialize_prolog :- :- c_compile( 'protect.yap' ). :- ['absf.yap']. -%:- stop_low_level_trace. + :- use_module('error.yap'). :- [ diff --git a/pl/debug.yap b/pl/debug.yap index 1f3deecce..f8a0097a2 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -1,4 +1,3 @@ - /**********************************************************************a*** * * * YAP Prolog * @@ -302,7 +301,12 @@ be lost. '$trace'(Mod:G) :- '$creep_is_off'(Mod:G,_GN0), !, - '$execute_nonstop'(G,Mod). + gated_call( + true, + Mod:G, + E, + '$reenter_debugger'(E) + ). '$trace'(Mod:G) :- '$$save_by'(CP), '$trace_query'(G, Mod, CP, G, EG), @@ -314,12 +318,6 @@ be lost. ). -'$continue_debugging'(exit) :- !, '$creep'. -'$continue_debugging'(answer) :- !, '$creep'. -'$continue_debugging'(fail) :- !, '$creep'. -'$continue_debugging'(_). - - @@ -454,53 +452,55 @@ be lost. '$trace_goal'(G, M, L, H), E, '$TraceError'(E, G, M, L, H) - ))). + ))). %% @pred $trace_goal( +Goal, +Module, +CallId, +CallInfo) %% -%% Actuallb sy debugs a +%% Actually debugs a %% goal! -'$trace_goal'(G, M, GoalNumber, _H) :- - '$creep_is_off'(M:G,GoalNumber), - !, - '$execute_nonstop'(G,M). -'$trace_goal'(G, M, _GoalNumber, _H) :- - '$undefined'(G, M), - !, - '$undefp'([M|G], _ ). -% meta system '$trace_goal'(G, M, GoalNumber, H) :- '$is_metapredicate'(G, prolog), !, '$debugger_expand_meta_call'(M:G, [], G1), strip_module(G1, MF, NG), - gated_call( - '$enter_trace'(GoalNumber, G, M, H), - '$execute_nonstop'(NG,MF), - Port, - '$trace_port'(Port, GoalNumber, G, M, true, H) - ). -% system_ + '$trace_goal__'(NG,MF, GoalNumber, H). '$trace_goal'(G, M, GoalNumber, H) :- - ( - '$is_opaque_predicate'(G, M) - ; - 'strip_module'(M:G, prolog, _NG) - ), + '$trace_goal__'(G,M, GoalNumber, H). + +'$trace_goal__'(G,M, _GoalNumber, _H) :- + '$undefined'(G,M), !, + '$undefp'([M|G], _). +'$trace_goal__'(G,M, GoalNumber, H) :- + '$is_source'(G,M), + '$current_choice_point'(CP), + !, + '$enter_trace'(GoalNumber, G, M, H), gated_call( - '$enter_trace'(GoalNumber, G, M, H), - '$execute_nonstop'(G,M), - Port, - '$trace_port'(Port, GoalNumber, G, M, true, H) - ). -'$trace_goal'(G, M, GoalNumber, H) :- - gated_call( - '$enter_trace'(GoalNumber, G, M, H), - '$debug'( GoalNumber, G, M, H), + true, + ( '$creep_is_on_at_entry'(G,M) + -> + clause(M:G, B), '$trace_query'(B,M,CP,B,H) + ; + '$execute_nonstop'(G,M) + ), Port, '$trace_port'(Port, GoalNumber, G, M, true, H) ). +% system_ +'$trace_goal__'(G,M, GoalNumber, H) :- + !, + gated_call( + '$enter_trace'(GoalNumber, G, M, H), + ( '$creep_is_on_at_entry'(G,M) + -> + '$execute_nonstop'(('$creep',G),M) + ; + '$execute_nonstop'(G,M) + ), + Port, + '$trace_port'(Port, GoalNumber, G, M, true, H) + ). /** @@ -542,33 +542,6 @@ be lost. '__NB_setval__'('$spy_gn',L1). '$id_goal'(_L). -/** - * @pred '$enter_trace'(+L, 0:G, +Module, +Info) - * - * call goal: setup the diferrent cases - * - zip, just run through - * - source, call an interpreter - * - compiled code: try black magic. - * - * @parameter _Module_:_G_ - * @parameter _GoalNumber_ identifies the active goal - * @parameter _Info_ describes the goal - * - */ - -'$debug'(_, G, M, _H) :- - '__NB_getval__'('$debug_status',state(zip,_Border,Spy,_Trace), fail), - ( Spy == stop -> \+ '$pred_being_spied'(G,M) ; true ), - !, - '$execute_nonstop'( G, M ). -'$debug'(GoalNumber, G, M, Info) :- - '$is_source'(G,M), - !, - '$trace_go'(GoalNumber, G, M, Info). -'$debug'(GoalNumber, G, M, Info) :- - '$creep_step'(GoalNumber, G, M, Info). - - /** * @pred '$trace_go'(+L, 0:G, +Module, +Info) * @@ -705,7 +678,7 @@ be lost. '$port'(_P, _G, _M,GoalNumber,_Determinic, _Info ) :- %%> leap '__NB_getval__'('$debug_status',state(leap,Border,_,_), fail), - GoalNumber > Border, + GoalNumber < Border, !. '$port'(P,G,Module,L,Deterministic, Info) :- % at this point we are done with leap or skip @@ -714,7 +687,7 @@ be lost. ( '$unleashed'(P) -> '$action'('\n',P,L,G,Module,Info), - put_code(debugger_output, 10) + nl(debugger_output) ; write(debugger_output,' ? '), '$clear_input'(debugger_input), diff --git a/pl/signals.yap b/pl/signals.yap index f9b9603be..4a0cb7242 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -181,8 +181,8 @@ '$trace'(Mod:G). '$no_creep_call'('$execute_clause'(G,Mod,Ref,CP),_) :- !, - '$enable_debugging', - '$execute_clause'(G,Mod,Ref,CP). + '$enable_debugging', + '$execute_clause'(G,Mod,Ref,CP). '$no_creep_call'('$execute_nonstop'(G, M),_) :- !, '$enable_debugging', '$execute_nonstop'(G, M). diff --git a/pl/spy.yap b/pl/spy.yap index cb3149008..425dc0f51 100644 --- a/pl/spy.yap +++ b/pl/spy.yap @@ -393,7 +393,16 @@ notrace(G) :- fail ). -'$disable_debugging_on_port'(retry) :- +'$creep_at_port'(retry) :- + current_prolog_flag(debug, true), + '__NB_getval__'('$trace',Trace,fail), + Trace = on, + !, + '$enable_debugging'. +'$creep_at_port'(fail) :- + current_prolog_flag(debug, true), + '__NB_getval__'('$trace',Trace,fail), + Trace = on, !, '$enable_debugging'. '$disable_debugging_on_port'(_Port) :- @@ -401,19 +410,52 @@ notrace(G) :- -% enable creeping -'$enable_debugging':- - current_prolog_flag(debug, false), !. -'$enable_debugging' :- - '__NB_getval__'('$trace',Trace,fail), - nb_setval('$debug_status', state(creep, 0, stop,Trace)), - Trace = on, !, - '$creep'. -'$enable_debugging'. +%% @pred $enter_debugging(G,Mod,CP,G0,NG) +%% +%% Internal predicate called by top-level; +%% enable creeping on a goal by just switching execution to debugger. +%% +'$enter_debugging'(G,Mod,CP,G0,NG) :- + '$creep_is_on_at_entry'(G,Mod), + !, + '$trace_query'(G,Mod,CP,G0,NG). +'$enter_debugging'(G,_Mod,_CP,_G0,G). +%% we're coming back from external code to a debugger call. +%% +'$reenter_debugger'(retry) :- + '$re_enter_creep_mode'. +'$reenter_debugger'(_) :- + set_current_flag(debug, false). + +%% @pred $re_enter_creep_mode1 +%% +%% Internal predicate called when exiting through a port; +%% enable creeping on the next goal. +%% +'$re_enter_creep_mode' :- + '$creep_is_on', + !, + '$creep'. +'$re_enter_creep_mode'. + +'$continue_debugging'(exit) :- + !, + '$re_enter_creep_mode'. +'$continue_debugging'(answer) :- + !, + '$re_enter_creep_mode'. +'$continue_debugging'(fail) :- + !, + '$re_enter_creep_mode', +'$continue_debugging'(_). + +'$enable_debugging' :- + '$re_enter_creep_mode'. + '$trace_on' :- '__NB_getval__'('$debug_status', state(_Creep, GN, Spy,_), fail), - '__NB_setval__'('$trace',on), + nb_setval('$trace',on), nb_setval('$debug_status', state(creep, GN, Spy, on)). '$trace_off' :- @@ -438,6 +480,22 @@ notrace(G) :- GN > GN0 ). +%% +% +'$creep_is_on' :- + current_prolog_flag(debug, true), + '__NB_getval__'('$debug_status',state(Step, _GN, _Spy,_), fail), + Step \= zip. + +'$creep_is_on_at_entry'(G,M) :- + current_prolog_flag(debug, true), + '__NB_getval__'('$debug_status',state(Step, _GN, Spy,_), fail), + ( + Step \= zip + ; + Spy == stop, + '$pred_being_spied'(G,M) + ). /* diff --git a/pl/top.yap b/pl/top.yap index 0367deaea..8abf13d29 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -444,10 +444,12 @@ write_query_answer( Bindings ) :- '$purge_dontcares'([],[]). '$purge_dontcares'([Name=_|Vs],NVs) :- - atom_codes(Name, [C|_]), C is "_", !, - '$purge_dontcares'(Vs,NVs). + atom_codes(Name, [C|_]), + C is "_", + !, + '$purge_dontcares'(Vs,NVs). '$purge_dontcares'([V|Vs],[V|NVs]) :- - '$purge_dontcares'(Vs,NVs). + '$purge_dontcares'(Vs,NVs). '$prep_answer_var_by_var'([], L, L). @@ -577,10 +579,10 @@ write_query_answer( Bindings ) :- '$user_call'(G, CP, G0, M) :- gated_call( - '$enable_debugging', - '$call'(G, CP, G0, M), - Port, - '$disable_debugging_on_port'(Port) + '$enable_debugging', + '$call'(G, CP, G0, M), + Port, + '$disable_debugging_on_port'(Port) ). @@ -773,8 +775,6 @@ Command = (H --> B) -> '$boot_clause'( Command, _ ) :- format(user_error, ' ~w failed.~n', [Command]). - - '$enter_command'(Stream, Mod, Status) :- prompt1(': '), prompt(_,' '), Options = [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)],