35
36:- module('$messages',
37 [ print_message/2, 38 print_message_lines/3, 39 message_to_string/2 40 ]). 41
42:- multifile
43 prolog:message//1, 44 prolog:error_message//1, 45 prolog:message_context//1, 46 prolog:message_location//1, 47 prolog:message_line_element/2. 48:- discontiguous
49 prolog_message/3. 50
51:- public
52 translate_message//1. 53
54:- create_prolog_flag(message_context, [thread], []). 55
72
73translate_message(Term) -->
74 translate_message2(Term),
75 !.
76translate_message(Term) -->
77 { Term = error(_, _) },
78 [ 'Unknown exception: ~p'-[Term] ].
79translate_message(Term) -->
80 [ 'Unknown message: ~p'-[Term] ].
81
82translate_message2(Term) -->
83 {var(Term)},
84 !,
85 [ 'Unknown message: ~p'-[Term] ].
86translate_message2(Term) -->
87 prolog:message(Term).
88translate_message2(Term) -->
89 prolog_message(Term).
90translate_message2(error(resource_error(stack), Context)) -->
91 out_of_stack(Context).
92translate_message2(error(resource_error(Missing), _)) -->
93 [ 'Not enough resources: ~w'-[Missing] ].
94translate_message2(error(ISO, SWI)) -->
95 swi_location(SWI),
96 term_message(ISO),
97 swi_extra(SWI).
98translate_message2('$aborted') -->
99 [ 'Execution Aborted' ].
100translate_message2(message_lines(Lines), L, T) :- 101 make_message_lines(Lines, L, T).
102translate_message2(format(Fmt, Args)) -->
103 [ Fmt-Args ].
104
105make_message_lines([], T, T) :- !.
106make_message_lines([Last], ['~w'-[Last]|T], T) :- !.
107make_message_lines([L0|LT], ['~w'-[L0],nl|T0], T) :-
108 make_message_lines(LT, T0, T).
109
110term_message(Term) -->
111 {var(Term)},
112 !,
113 [ 'Unknown error term: ~p'-[Term] ].
114term_message(Term) -->
115 prolog:error_message(Term).
116term_message(Term) -->
117 iso_message(Term).
118term_message(Term) -->
119 swi_message(Term).
120term_message(Term) -->
121 [ 'Unknown error term: ~p'-[Term] ].
122
123iso_message(type_error(evaluable, Actual)) -->
124 { callable(Actual) },
125 [ 'Arithmetic: `~p'' is not a function'-[Actual] ].
126iso_message(type_error(free_of_attvar, Actual)) -->
127 [ 'Type error: `~W'' contains attributed variables'-
128 [Actual,[portray(true), attributes(portray)]] ].
129iso_message(type_error(Expected, Actual)) -->
130 [ 'Type error: `~w'' expected, found `~p'''-[Expected, Actual] ],
131 type_error_comment(Expected, Actual).
132iso_message(domain_error(Domain, Actual)) -->
133 [ 'Domain error: '-[] ], domain(Domain),
134 [ ' expected, found `~p'''-[Actual] ].
135iso_message(instantiation_error) -->
136 [ 'Arguments are not sufficiently instantiated' ].
137iso_message(uninstantiation_error(Var)) -->
138 [ 'Uninstantiated argument expected, found ~p'-[Var] ].
139iso_message(representation_error(What)) -->
140 [ 'Cannot represent due to `~w'''-[What] ].
141iso_message(permission_error(Action, Type, Object)) -->
142 permission_error(Action, Type, Object).
143iso_message(evaluation_error(Which)) -->
144 [ 'Arithmetic: evaluation error: `~p'''-[Which] ].
145iso_message(existence_error(procedure, Proc)) -->
146 [ 'Undefined procedure: ~q'-[Proc] ],
147 undefined_proc_msg(Proc).
148iso_message(existence_error(answer_variable, Var)) -->
149 [ '$~w was not bound by a previous query'-[Var] ].
150iso_message(existence_error(Type, Object)) -->
151 [ '~w `~p'' does not exist'-[Type, Object] ].
152iso_message(existence_error(Type, Object, In)) --> 153 [ '~w `~p'' does not exist in ~p'-[Type, Object, In] ].
154iso_message(busy(Type, Object)) -->
155 [ '~w `~p'' is busy'-[Type, Object] ].
156iso_message(syntax_error(swi_backslash_newline)) -->
157 [ 'Deprecated ... \\<newline><white>*. Use \\c' ].
158iso_message(syntax_error(Id)) -->
159 [ 'Syntax error: ' ],
160 syntax_error(Id).
161iso_message(occurs_check(Var, In)) -->
162 [ 'Cannot unify ~p with ~p: would create an infinite tree'-[Var, In] ].
163
168
169permission_error(Action, built_in_procedure, Pred) -->
170 { user_predicate_indicator(Pred, PI)
171 },
172 [ 'No permission to ~w built-in predicate `~p'''-[Action, PI] ],
173 ( {Action \== export}
174 -> [ nl,
175 'Use :- redefine_system_predicate(+Head) if redefinition is intended'
176 ]
177 ; []
178 ).
179permission_error(import_into(Dest), procedure, Pred) -->
180 [ 'No permission to import ~p into ~w'-[Pred, Dest] ].
181permission_error(Action, static_procedure, Proc) -->
182 [ 'No permission to ~w static procedure `~p'''-[Action, Proc] ],
183 defined_definition('Defined', Proc).
184permission_error(input, stream, Stream) -->
185 [ 'No permission to read from output stream `~p'''-[Stream] ].
186permission_error(output, stream, Stream) -->
187 [ 'No permission to write to input stream `~p'''-[Stream] ].
188permission_error(input, text_stream, Stream) -->
189 [ 'No permission to read bytes from TEXT stream `~p'''-[Stream] ].
190permission_error(output, text_stream, Stream) -->
191 [ 'No permission to write bytes to TEXT stream `~p'''-[Stream] ].
192permission_error(input, binary_stream, Stream) -->
193 [ 'No permission to read characters from binary stream `~p'''-[Stream] ].
194permission_error(output, binary_stream, Stream) -->
195 [ 'No permission to write characters to binary stream `~p'''-[Stream] ].
196permission_error(open, source_sink, alias(Alias)) -->
197 [ 'No permission to reuse alias "~p": already taken'-[Alias] ].
198permission_error(Action, Type, Object) -->
199 [ 'No permission to ~w ~w `~p'''-[Action, Type, Object] ].
200
201
202undefined_proc_msg(_:(^)/2) -->
203 !,
204 undefined_proc_msg((^)/2).
205undefined_proc_msg((^)/2) -->
206 !,
207 [nl, ' ^/2 can only appear as the 2nd argument of setof/3 and bagof/3'].
208undefined_proc_msg((:-)/2) -->
209 !,
210 [nl, ' Rules must be loaded from a file'],
211 faq('ToplevelMode').
212undefined_proc_msg((:-)/1) -->
213 !,
214 [nl, ' Directives must be loaded from a file'],
215 faq('ToplevelMode').
216undefined_proc_msg((?-)/1) -->
217 !,
218 [nl, ' ?- is the Prolog prompt'],
219 faq('ToplevelMode').
220undefined_proc_msg(Proc) -->
221 { dwim_predicates(Proc, Dwims) },
222 ( {Dwims \== []}
223 -> [nl, ' However, there are definitions for:', nl],
224 dwim_message(Dwims)
225 ; []
226 ).
227
228faq(Page) -->
229 [nl, ' See FAQ at http://www.swi-prolog.org/FAQ/', Page, '.txt' ].
230
(_Expected, Actual) -->
232 { type_of(Actual, Type),
233 ( sub_atom(Type, 0, 1, _, First),
234 memberchk(First, [a,e,i,o,u])
235 -> Article = an
236 ; Article = a
237 )
238 },
239 [ ' (~w ~w)'-[Article, Type] ].
240
241type_of(Term, Type) :-
242 ( attvar(Term) -> Type = attvar
243 ; var(Term) -> Type = var
244 ; atom(Term) -> Type = atom
245 ; integer(Term) -> Type = integer
246 ; string(Term) -> Type = string
247 ; Term == [] -> Type = empty_list
248 ; blob(Term, BlobT) -> blob_type(BlobT, Type)
249 ; rational(Term) -> Type = rational
250 ; float(Term) -> Type = float
251 ; is_stream(Term) -> Type = stream
252 ; is_dict(Term) -> Type = dict
253 ; is_list(Term) -> Type = list
254 ; cyclic_term(Term) -> Type = cyclic
255 ; compound(Term) -> Type = compound
256 ; Type = unknown
257 ).
258
259blob_type(BlobT, Type) :-
260 atom_concat(BlobT, '_reference', Type).
261
262syntax_error(end_of_clause) -->
263 [ 'Unexpected end of clause' ].
264syntax_error(end_of_clause_expected) -->
265 [ 'End of clause expected' ].
266syntax_error(end_of_file) -->
267 [ 'Unexpected end of file' ].
268syntax_error(end_of_file_in_block_comment) -->
269 [ 'End of file in /* ... */ comment' ].
270syntax_error(end_of_file_in_quoted(Quote)) -->
271 [ 'End of file in quoted ' ],
272 quoted_type(Quote).
273syntax_error(illegal_number) -->
274 [ 'Illegal number' ].
275syntax_error(long_atom) -->
276 [ 'Atom too long (see style_check/1)' ].
277syntax_error(long_string) -->
278 [ 'String too long (see style_check/1)' ].
279syntax_error(operator_clash) -->
280 [ 'Operator priority clash' ].
281syntax_error(operator_expected) -->
282 [ 'Operator expected' ].
283syntax_error(operator_balance) -->
284 [ 'Unbalanced operator' ].
285syntax_error(quoted_punctuation) -->
286 [ 'Operand expected, unquoted comma or bar found' ].
287syntax_error(list_rest) -->
288 [ 'Unexpected comma or bar in rest of list' ].
289syntax_error(cannot_start_term) -->
290 [ 'Illegal start of term' ].
291syntax_error(punct(Punct, End)) -->
292 [ 'Unexpected `~w\' before `~w\''-[Punct, End] ].
293syntax_error(undefined_char_escape(C)) -->
294 [ 'Undefined character escape in quoted atom or string: `\\~w\''-[C] ].
295syntax_error(void_not_allowed) -->
296 [ 'Empty argument list "()"' ].
297syntax_error(Message) -->
298 [ '~w'-[Message] ].
299
300quoted_type('\'') --> [atom].
301quoted_type('\"') --> { current_prolog_flag(double_quotes, Type) }, [Type-[]].
302quoted_type('\`') --> { current_prolog_flag(back_quotes, Type) }, [Type-[]].
303
304domain(range(Low,High)) -->
305 !,
306 ['[~q..~q]'-[Low,High] ].
307domain(Domain) -->
308 ['`~w\''-[Domain] ].
309
310dwim_predicates(Module:Name/_Arity, Dwims) :-
311 !,
312 findall(Dwim, dwim_predicate(Module:Name, Dwim), Dwims).
313dwim_predicates(Name/_Arity, Dwims) :-
314 findall(Dwim, dwim_predicate(user:Name, Dwim), Dwims).
315
316dwim_message([]) --> [].
317dwim_message([M:Head|T]) -->
318 { hidden_module(M),
319 !,
320 functor(Head, Name, Arity)
321 },
322 [ ' ~q'-[Name/Arity], nl ],
323 dwim_message(T).
324dwim_message([Module:Head|T]) -->
325 !,
326 { functor(Head, Name, Arity)
327 },
328 [ ' ~q'-[Module:Name/Arity], nl],
329 dwim_message(T).
330dwim_message([Head|T]) -->
331 {functor(Head, Name, Arity)},
332 [ ' ~q'-[Name/Arity], nl],
333 dwim_message(T).
334
335
336swi_message(io_error(Op, Stream)) -->
337 [ 'I/O error in ~w on stream ~p'-[Op, Stream] ].
338swi_message(shell(execute, Cmd)) -->
339 [ 'Could not execute `~w'''-[Cmd] ].
340swi_message(shell(signal(Sig), Cmd)) -->
341 [ 'Caught signal ~d on `~w'''-[Sig, Cmd] ].
342swi_message(format(Fmt, Args)) -->
343 [ Fmt-Args ].
344swi_message(signal(Name, Num)) -->
345 [ 'Caught signal ~d (~w)'-[Num, Name] ].
346swi_message(limit_exceeded(Limit, MaxVal)) -->
347 [ 'Exceeded ~w limit (~w)'-[Limit, MaxVal] ].
348swi_message(goal_failed(Goal)) -->
349 [ 'goal unexpectedly failed: ~p'-[Goal] ].
350swi_message(shared_object(_Action, Message)) --> 351 [ '~w'-[Message] ].
352swi_message(system_error(Error)) -->
353 [ 'error in system call: ~w'-[Error]
354 ].
355swi_message(system_error) -->
356 [ 'error in system call'
357 ].
358swi_message(failure_error(Goal)) -->
359 [ 'Goal failed: ~p'-[Goal] ].
360swi_message(timeout_error(Op, Stream)) -->
361 [ 'Timeout in ~w from ~p'-[Op, Stream] ].
362swi_message(not_implemented(Type, What)) -->
363 [ '~w `~p\' is not implemented in this version'-[Type, What] ].
364swi_message(context_error(nodirective, Goal)) -->
365 { goal_to_predicate_indicator(Goal, PI) },
366 [ 'Wrong context: ~p can only be used in a directive'-[PI] ].
367swi_message(context_error(edit, no_default_file)) -->
368 ( { current_prolog_flag(windows, true) }
369 -> [ 'Edit/0 can only be used after opening a \c
370 Prolog file by double-clicking it' ]
371 ; [ 'Edit/0 can only be used with the "-s file" commandline option'
372 ]
373 ),
374 [ nl, 'Use "?- edit(Topic)." or "?- emacs."' ].
375swi_message(context_error(function, meta_arg(S))) -->
376 [ 'Functions are not (yet) supported for meta-arguments of type ~q'-[S] ].
377swi_message(format_argument_type(Fmt, Arg)) -->
378 [ 'Illegal argument to format sequence ~~~w: ~p'-[Fmt, Arg] ].
379swi_message(format(Msg)) -->
380 [ 'Format error: ~w'-[Msg] ].
381swi_message(conditional_compilation_error(unterminated, Where)) -->
382 [ 'Unterminated conditional compilation from '-[] ],
383 cond_location(Where).
384swi_message(conditional_compilation_error(no_if, What)) -->
385 [ ':- ~w without :- if'-[What] ].
386swi_message(duplicate_key(Key)) -->
387 [ 'Duplicate key: ~p'-[Key] ].
388swi_message(initialization_error(failed, Goal, File:Line)) -->
389 !,
390 [ '~w:~w: ~p: false'-[File, Line, Goal] ].
391swi_message(initialization_error(Error, Goal, File:Line)) -->
392 [ '~w:~w: ~p '-[File, Line, Goal] ],
393 translate_message(Error).
394swi_message(qlf_format_error(File, Message)) -->
395 [ '~w: Invalid QLF file: ~w'-[File, Message] ].
396
397cond_location(File:Line) -->
398 { file_base_name(File, Base) },
399 [ '~w:~d'-[Base, Line] ].
400
401swi_location(X) -->
402 { var(X)
403 },
404 !,
405 [].
406swi_location(Context) -->
407 prolog:message_location(Context),
408 !.
409swi_location(context(Caller, _Msg)) -->
410 { ground(Caller)
411 },
412 !,
413 caller(Caller).
414swi_location(file(Path, Line, -1, _CharNo)) -->
415 !,
416 [ '~w:~d: '-[Path, Line] ].
417swi_location(file(Path, Line, LinePos, _CharNo)) -->
418 [ '~w:~d:~d: '-[Path, Line, LinePos] ].
419swi_location(stream(Stream, Line, LinePos, CharNo)) -->
420 ( { is_stream(Stream),
421 stream_property(Stream, file_name(File))
422 }
423 -> swi_location(file(File, Line, LinePos, CharNo))
424 ; [ 'Stream ~w:~d:~d '-[Stream, Line, LinePos] ]
425 ).
426swi_location(_) -->
427 [].
428
429caller(system:'$record_clause'/3) -->
430 !,
431 [].
432caller(Module:Name/Arity) -->
433 !,
434 ( { \+ hidden_module(Module) }
435 -> [ '~q:~q/~w: '-[Module, Name, Arity] ]
436 ; [ '~q/~w: '-[Name, Arity] ]
437 ).
438caller(Name/Arity) -->
439 [ '~q/~w: '-[Name, Arity] ].
440caller(Caller) -->
441 [ '~p: '-[Caller] ].
442
443
(X) -->
445 { var(X)
446 },
447 !,
448 [].
449swi_extra(Context) -->
450 prolog:message_context(Context).
451swi_extra(context(_, Msg)) -->
452 { nonvar(Msg),
453 Msg \== ''
454 },
455 !,
456 swi_comment(Msg).
457swi_extra(string(String, CharPos)) -->
458 { sub_string(String, 0, CharPos, _, Before),
459 sub_string(String, CharPos, _, 0, After)
460 },
461 [ nl, '~w'-[Before], nl, '** here **', nl, '~w'-[After] ].
462swi_extra(_) -->
463 [].
464
(already_from(Module)) -->
466 !,
467 [ ' (already imported from ~q)'-[Module] ].
468swi_comment(directory(_Dir)) -->
469 !,
470 [ ' (is a directory)' ].
471swi_comment(not_a_directory(_Dir)) -->
472 !,
473 [ ' (is not a directory)' ].
474swi_comment(Msg) -->
475 [ ' (~w)'-[Msg] ].
476
477
478thread_context -->
479 { thread_self(Me), Me \== main, thread_property(Me, id(Id)) },
480 !,
481 ['[Thread ~w] '-[Id]].
482thread_context -->
483 [].
484
485 488
489prolog_message(initialization_error(_, E, File:Line)) -->
490 !,
491 [ '~w:~d: '-[File, Line],
492 'Initialization goal raised exception:', nl
493 ],
494 translate_message(E).
495prolog_message(initialization_error(Goal, E, _)) -->
496 [ 'Initialization goal ~p raised exception:'-[Goal], nl ],
497 translate_message(E).
498prolog_message(initialization_failure(_Goal, File:Line)) -->
499 !,
500 [ '~w:~d: '-[File, Line],
501 'Initialization goal failed'-[]
502 ].
503prolog_message(initialization_failure(Goal, _)) -->
504 [ 'Initialization goal failed: ~p'-[Goal]
505 ].
506prolog_message(initialization_exception(E)) -->
507 [ 'Prolog initialisation failed:', nl ],
508 translate_message(E).
509prolog_message(init_goal_syntax(Error, Text)) -->
510 !,
511 [ '-g ~w: '-[Text] ],
512 translate_message(Error).
513prolog_message(init_goal_failed(failed, @(Goal,File:Line))) -->
514 !,
515 [ '~w:~w: ~p: false'-[File, Line, Goal] ].
516prolog_message(init_goal_failed(Error, @(Goal,File:Line))) -->
517 !,
518 [ '~w:~w: ~p '-[File, Line, Goal] ],
519 translate_message(Error).
520prolog_message(init_goal_failed(failed, Text)) -->
521 !,
522 [ '-g ~w: false'-[Text] ].
523prolog_message(init_goal_failed(Error, Text)) -->
524 !,
525 [ '-g ~w: '-[Text] ],
526 translate_message(Error).
527prolog_message(unhandled_exception(E)) -->
528 [ 'Unhandled exception: ' ],
529 ( translate_message2(E)
530 -> []
531 ; [ '~p'-[E] ]
532 ).
533prolog_message(goal_failed(Context, Goal)) -->
534 [ 'Goal (~w) failed: ~p'-[Context, Goal] ].
535prolog_message(no_current_module(Module)) -->
536 [ '~w is not a current module (created)'-[Module] ].
537prolog_message(commandline_arg_type(Flag, Arg)) -->
538 [ 'Bad argument to commandline option -~w: ~w'-[Flag, Arg] ].
539prolog_message(missing_feature(Name)) -->
540 [ 'This version of SWI-Prolog does not support ~w'-[Name] ].
541prolog_message(singletons(_Term, List)) -->
542 [ 'Singleton variables: ~w'-[List] ].
543prolog_message(multitons(_Term, List)) -->
544 [ 'Singleton-marked variables appearing more than once: ~w'-[List] ].
545prolog_message(profile_no_cpu_time) -->
546 [ 'No CPU-time info. Check the SWI-Prolog manual for details' ].
547prolog_message(non_ascii(Text, Type)) -->
548 [ 'Unquoted ~w with non-portable characters: ~w'-[Type, Text] ].
549prolog_message(io_warning(Stream, Message)) -->
550 { stream_property(Stream, position(Position)),
551 !,
552 stream_position_data(line_count, Position, LineNo),
553 stream_position_data(line_position, Position, LinePos),
554 ( stream_property(Stream, file_name(File))
555 -> Obj = File
556 ; Obj = Stream
557 )
558 },
559 [ '~p:~d:~d: ~w'-[Obj, LineNo, LinePos, Message] ].
560prolog_message(io_warning(Stream, Message)) -->
561 [ 'stream ~p: ~w'-[Stream, Message] ].
562prolog_message(option_usage(pldoc)) -->
563 [ 'Usage: --pldoc[=port]' ].
564prolog_message(interrupt(begin)) -->
565 [ 'Action (h for help) ? ', flush ].
566prolog_message(interrupt(end)) -->
567 [ 'continue' ].
568prolog_message(interrupt(trace)) -->
569 [ 'continue (trace mode)' ].
570prolog_message(unknown_in_module_user) -->
571 [ 'Using a non-error value for unknown in the global module', nl,
572 'causes most of the development environment to stop working.', nl,
573 'Please use :- dynamic or limit usage of unknown to a module.', nl,
574 'See http://www.swi-prolog.org/howto/database.html'
575 ].
576prolog_message(deprecated(What)) -->
577 deprecated(What).
578
579
580 583
584prolog_message(modify_active_procedure(Who, What)) -->
585 [ '~p: modified active procedure ~p'-[Who, What] ].
586prolog_message(load_file(failed(user:File))) -->
587 [ 'Failed to load ~p'-[File] ].
588prolog_message(load_file(failed(Module:File))) -->
589 [ 'Failed to load ~p into module ~p'-[File, Module] ].
590prolog_message(load_file(failed(File))) -->
591 [ 'Failed to load ~p'-[File] ].
592prolog_message(mixed_directive(Goal)) -->
593 [ 'Cannot pre-compile mixed load/call directive: ~p'-[Goal] ].
594prolog_message(cannot_redefine_comma) -->
595 [ 'Full stop in clause-body? Cannot redefine ,/2' ].
596prolog_message(illegal_autoload_index(Dir, Term)) -->
597 [ 'Illegal term in INDEX file of directory ~w: ~w'-[Dir, Term] ].
598prolog_message(redefined_procedure(Type, Proc)) -->
599 [ 'Redefined ~w procedure ~p'-[Type, Proc] ],
600 defined_definition('Previously defined', Proc).
601prolog_message(declare_module(Module, abolish(Predicates))) -->
602 [ 'Loading module ~w abolished: ~p'-[Module, Predicates] ].
603prolog_message(import_private(Module, Private)) -->
604 [ 'import/1: ~p is not exported (still imported into ~q)'-
605 [Private, Module]
606 ].
607prolog_message(ignored_weak_import(Into, From:PI)) -->
608 [ 'Local definition of ~p overrides weak import from ~q'-
609 [Into:PI, From]
610 ].
611prolog_message(undefined_export(Module, PI)) -->
612 [ 'Exported procedure ~q:~q is not defined'-[Module, PI] ].
613prolog_message(no_exported_op(Module, Op)) -->
614 [ 'Operator ~q:~q is not exported (still defined)'-[Module, Op] ].
615prolog_message(discontiguous((-)/2,_)) -->
616 prolog_message(minus_in_identifier).
617prolog_message(discontiguous(Proc,Current)) -->
618 [ 'Clauses of ~p are not together in the source-file'-[Proc], nl ],
619 current_definition(Proc, ' Earlier definition at '),
620 [ ' Current predicate: ~p'-[Current], nl,
621 ' Use :- discontiguous ~p. to suppress this message'-[Proc]
622 ].
623prolog_message(decl_no_effect(Goal)) -->
624 [ 'Deprecated declaration has no effect: ~p'-[Goal] ].
625prolog_message(load_file(start(Level, File))) -->
626 [ '~|~t~*+Loading '-[Level] ],
627 load_file(File),
628 [ ' ...' ].
629prolog_message(include_file(start(Level, File))) -->
630 [ '~|~t~*+include '-[Level] ],
631 load_file(File),
632 [ ' ...' ].
633prolog_message(include_file(done(Level, File))) -->
634 [ '~|~t~*+included '-[Level] ],
635 load_file(File).
636prolog_message(load_file(done(Level, File, Action, Module, Time, Clauses))) -->
637 [ '~|~t~*+'-[Level] ],
638 load_file(File),
639 [ ' ~w'-[Action] ],
640 load_module(Module),
641 [ ' ~2f sec, ~D clauses'-[Time, Clauses] ].
642prolog_message(dwim_undefined(Goal, Alternatives)) -->
643 { goal_to_predicate_indicator(Goal, Pred)
644 },
645 [ 'Undefined procedure: ~q'-[Pred], nl,
646 ' However, there are definitions for:', nl
647 ],
648 dwim_message(Alternatives).
649prolog_message(dwim_correct(Into)) -->
650 [ 'Correct to: ~q? '-[Into], flush ].
651prolog_message(error(loop_error(Spec), file_search(Used))) -->
652 [ 'File search: too many levels of indirections on: ~p'-[Spec], nl,
653 ' Used alias expansions:', nl
654 ],
655 used_search(Used).
656prolog_message(minus_in_identifier) -->
657 [ 'The "-" character should not be used to seperate words in an', nl,
658 'identifier. Check the SWI-Prolog FAQ for details.'
659 ].
660prolog_message(qlf(removed_after_error(File))) -->
661 [ 'Removed incomplete QLF file ~w'-[File] ].
662prolog_message(qlf(recompile(Spec,_Pl,_Qlf,Reason))) -->
663 [ '~p: recompiling QLF file'-[Spec] ],
664 qlf_recompile_reason(Reason).
665prolog_message(qlf(can_not_recompile(Spec,QlfFile,_Reason))) -->
666 [ '~p: can not recompile "~w" (access denied)'-[Spec, QlfFile], nl,
667 '\tLoading from source'-[]
668 ].
669prolog_message(redefine_module(Module, OldFile, File)) -->
670 [ 'Module "~q" already loaded from ~w.'-[Module, OldFile], nl,
671 'Wipe and reload from ~w? '-[File], flush
672 ].
673prolog_message(redefine_module_reply) -->
674 [ 'Please answer y(es), n(o) or a(bort)' ].
675prolog_message(reloaded_in_module(Absolute, OldContext, LM)) -->
676 [ '~w was previously loaded in module ~w'-[Absolute, OldContext], nl,
677 '\tnow it is reloaded into module ~w'-[LM] ].
678prolog_message(expected_layout(Expected, Pos)) -->
679 [ 'Layout data: expected ~w, found: ~p'-[Expected, Pos] ].
680
681defined_definition(Message, Spec) -->
682 { strip_module(user:Spec, M, Name/Arity),
683 functor(Head, Name, Arity),
684 predicate_property(M:Head, file(File)),
685 predicate_property(M:Head, line_count(Line))
686 },
687 !,
688 [ nl, '~w at ~w:~d'-[Message, File,Line] ].
689defined_definition(_, _) --> [].
690
691used_search([]) -->
692 [].
693used_search([Alias=Expanded|T]) -->
694 [ ' file_search_path(~p, ~p)'-[Alias, Expanded], nl ],
695 used_search(T).
696
697load_file(file(Spec, _Path)) -->
698 ( {atomic(Spec)}
699 -> [ '~w'-[Spec] ]
700 ; [ '~p'-[Spec] ]
701 ).
704
705load_module(user) --> !.
706load_module(system) --> !.
707load_module(Module) -->
708 [ ' into ~w'-[Module] ].
709
710goal_to_predicate_indicator(Goal, PI) :-
711 strip_module(Goal, Module, Head),
712 callable_name_arity(Head, Name, Arity),
713 user_predicate_indicator(Module:Name/Arity, PI).
714
715callable_name_arity(Goal, Name, Arity) :-
716 compound(Goal),
717 !,
718 compound_name_arity(Goal, Name, Arity).
719callable_name_arity(Goal, Goal, 0) :-
720 atom(Goal).
721
722user_predicate_indicator(Module:PI, PI) :-
723 hidden_module(Module),
724 !.
725user_predicate_indicator(PI, PI).
726
727hidden_module(user) :- !.
728hidden_module(system) :- !.
729hidden_module(M) :-
730 sub_atom(M, 0, _, _, $).
731
732current_definition(Proc, Prefix) -->
733 { pi_head(Proc, Head),
734 predicate_property(Head, file(File)),
735 predicate_property(Head, line_count(Line))
736 },
737 [ '~w'-[Prefix], '~w:~d'-[File,Line], nl ].
738current_definition(_, _) --> [].
739
740pi_head(Module:Name/Arity, Module:Head) :-
741 !,
742 atom(Module), atom(Name), integer(Arity),
743 functor(Head, Name, Arity).
744pi_head(Name/Arity, user:Head) :-
745 atom(Name), integer(Arity),
746 functor(Head, Name, Arity).
747
748qlf_recompile_reason(old) -->
749 !,
750 [ ' (out of date)'-[] ].
751qlf_recompile_reason(_) -->
752 [ ' (incompatible with current Prolog version)'-[] ].
753
754prolog_message(file_search(cache(Spec, _Cond), Path)) -->
755 [ 'File search: ~p --> ~p (cache)'-[Spec, Path] ].
756prolog_message(file_search(found(Spec, Cond), Path)) -->
757 [ 'File search: ~p --> ~p OK ~p'-[Spec, Path, Cond] ].
758prolog_message(file_search(tried(Spec, Cond), Path)) -->
759 [ 'File search: ~p --> ~p NO ~p'-[Spec, Path, Cond] ].
760
761 764
765prolog_message(agc(start)) -->
766 thread_context,
767 [ 'AGC: ', flush ].
768prolog_message(agc(done(Collected, Remaining, Time))) -->
769 [ at_same_line,
770 'reclaimed ~D atoms in ~3f sec. (remaining: ~D)'-
771 [Collected, Time, Remaining]
772 ].
773prolog_message(cgc(start)) -->
774 thread_context,
775 [ 'CGC: ', flush ].
776prolog_message(cgc(done(CollectedClauses, _CollectedBytes,
777 RemainingBytes, Time))) -->
778 [ at_same_line,
779 'reclaimed ~D clauses in ~3f sec. (pending: ~D bytes)'-
780 [CollectedClauses, Time, RemainingBytes]
781 ].
782
783 786
787out_of_stack(Context) -->
788 { human_stack_size(Context.localused, Local),
789 human_stack_size(Context.globalused, Global),
790 human_stack_size(Context.trailused, Trail),
791 human_stack_size(Context.stack_limit, Limit),
792 LCO is (100*(Context.depth - Context.environments))/Context.depth
793 },
794 [ 'Stack limit (~s) exceeded'-[Limit], nl,
795 ' Stack sizes: local: ~s, global: ~s, trail: ~s'-[Local,Global,Trail], nl,
796 ' Stack depth: ~D, last-call: ~0f%, Choice points: ~D'-
797 [Context.depth, LCO, Context.choicepoints], nl
798 ],
799 overflow_reason(Context, Resolve),
800 resolve_overflow(Resolve).
801
802human_stack_size(Size, String) :-
803 Size < 100,
804 format(string(String), '~dKb', [Size]).
805human_stack_size(Size, String) :-
806 Size < 100 000,
807 Value is Size / 1024,
808 format(string(String), '~1fMb', [Value]).
809human_stack_size(Size, String) :-
810 Value is Size / (1024*1024),
811 format(string(String), '~1fGb', [Value]).
812
813overflow_reason(Context, fix) -->
814 show_non_termination(Context),
815 !.
816overflow_reason(Context, enlarge) -->
817 { Stack = Context.get(stack) },
818 !,
819 [ ' In:'-[], nl ],
820 stack(Stack).
821overflow_reason(_Context, enlarge) -->
822 [ ' Insufficient global stack'-[] ].
823
824show_non_termination(Context) -->
825 ( { Stack = Context.get(cycle) }
826 -> [ ' Probable infinite recursion (cycle):'-[], nl ]
827 ; { Stack = Context.get(non_terminating) }
828 -> [ ' Possible non-terminating recursion:'-[], nl ]
829 ),
830 stack(Stack).
831
832stack([]) --> [].
833stack([frame(Depth, M:Goal, _)|T]) -->
834 [ ' [~D] ~q:'-[Depth, M] ],
835 stack_goal(Goal),
836 [ nl ],
837 stack(T).
838
839stack_goal(Goal) -->
840 { compound(Goal),
841 !,
842 compound_name_arity(Goal, Name, Arity)
843 },
844 [ '~q('-[Name] ],
845 stack_goal_args(1, Arity, Goal),
846 [ ')'-[] ].
847stack_goal(Goal) -->
848 [ '~q'-[Goal] ].
849
850stack_goal_args(I, Arity, Goal) -->
851 { I =< Arity,
852 !,
853 arg(I, Goal, A),
854 I2 is I + 1
855 },
856 stack_goal_arg(A),
857 ( { I2 =< Arity }
858 -> [ ', '-[] ],
859 stack_goal_args(I2, Arity, Goal)
860 ; []
861 ).
862stack_goal_args(_, _, _) -->
863 [].
864
865stack_goal_arg(A) -->
866 { nonvar(A),
867 A = [Len|T],
868 !
869 },
870 ( {Len == cyclic_term}
871 -> [ '[cyclic list]'-[] ]
872 ; {T == []}
873 -> [ '[length:~D]'-[Len] ]
874 ; [ '[length:~D|~p]'-[Len, T] ]
875 ).
876stack_goal_arg(A) -->
877 { nonvar(A),
878 A = _/_,
879 !
880 },
881 [ '<compound ~p>'-[A] ].
882stack_goal_arg(A) -->
883 [ '~p'-[A] ].
884
885resolve_overflow(fix) -->
886 [].
887resolve_overflow(enlarge) -->
888 { current_prolog_flag(stack_limit, LimitBytes),
889 NewLimit is LimitBytes * 2
890 },
891 [ nl,
892 'Use the --stack_limit=size[KMG] command line option or'-[], nl,
893 '?- set_prolog_flag(stack_limit, ~I). to double the limit.'-[NewLimit]
894 ].
895
896
897 900
901prolog_message(make(reload(Files))) -->
902 { length(Files, N)
903 },
904 [ 'Make: reloading ~D files'-[N] ].
905prolog_message(make(done(_Files))) -->
906 [ 'Make: finished' ].
907prolog_message(make(library_index(Dir))) -->
908 [ 'Updating index for library ~w'-[Dir] ].
909prolog_message(autoload(Pred, File)) -->
910 thread_context,
911 [ 'autoloading ~p from ~w'-[Pred, File] ].
912prolog_message(autoload(read_index(Dir))) -->
913 [ 'Loading autoload index for ~w'-[Dir] ].
914
915
916 919
922
923prolog_message(compiler_warnings(Clause, Warnings0)) -->
924 { print_goal_options(DefOptions),
925 ( prolog_load_context(variable_names, VarNames)
926 -> warnings_with_named_vars(Warnings0, VarNames, Warnings),
927 Options = [variable_names(VarNames)|DefOptions]
928 ; Options = DefOptions,
929 Warnings = Warnings0
930 )
931 },
932 compiler_warnings(Warnings, Clause, Options).
933
934warnings_with_named_vars([], _, []).
935warnings_with_named_vars([H|T0], VarNames, [H|T]) :-
936 term_variables(H, Vars),
937 '$member'(V1, Vars),
938 '$member'(_=V2, VarNames),
939 V1 == V2,
940 !,
941 warnings_with_named_vars(T0, VarNames, T).
942warnings_with_named_vars([_|T0], VarNames, T) :-
943 warnings_with_named_vars(T0, VarNames, T).
944
945
946compiler_warnings([], _, _) --> [].
947compiler_warnings([H|T], Clause, Options) -->
948 ( compiler_warning(H, Clause, Options)
949 -> []
950 ; [ 'Unknown compiler warning: ~W'-[H,Options] ]
951 ),
952 ( {T==[]}
953 -> []
954 ; [nl]
955 ),
956 compiler_warnings(T, Clause, Options).
957
958compiler_warning(eq_vv(A,B), _Clause, Options) -->
959 ( { A == B }
960 -> [ 'Test is always true: ~W'-[A==B, Options] ]
961 ; [ 'Test is always false: ~W'-[A==B, Options] ]
962 ).
963compiler_warning(eq_singleton(A,B), _Clause, Options) -->
964 [ 'Test is always false: ~W'-[A==B, Options] ].
965compiler_warning(neq_vv(A,B), _Clause, Options) -->
966 ( { A \== B }
967 -> [ 'Test is always true: ~W'-[A\==B, Options] ]
968 ; [ 'Test is always false: ~W'-[A\==B, Options] ]
969 ).
970compiler_warning(neq_singleton(A,B), _Clause, Options) -->
971 [ 'Test is always true: ~W'-[A\==B, Options] ].
972compiler_warning(unify_singleton(A,B), _Clause, Options) -->
973 [ 'Unified variable is not used: ~W'-[A=B, Options] ].
974compiler_warning(always(Bool, Pred, Arg), _Clause, Options) -->
975 { Goal =.. [Pred,Arg] },
976 [ 'Test is always ~w: ~W'-[Bool, Goal, Options] ].
977compiler_warning(unbalanced_var(V), _Clause, Options) -->
978 [ 'Variable not introduced in all branches: ~W'-[V, Options] ].
979compiler_warning(branch_singleton(V), _Clause, Options) -->
980 [ 'Singleton variable in branch: ~W'-[V, Options] ].
981compiler_warning(negation_singleton(V), _Clause, Options) -->
982 [ 'Singleton variable in \\+: ~W'-[V, Options] ].
983compiler_warning(multiton(V), _Clause, Options) -->
984 [ 'Singleton-marked variable appears more than once: ~W'-[V, Options] ].
985
986print_goal_options(
987 [ quoted(true),
988 portray(true)
989 ]).
990
991
992 995
996prolog_message(version) -->
997 { current_prolog_flag(version_git, Version) },
998 !,
999 [ '~w'-[Version] ].
1000prolog_message(version) -->
1001 { current_prolog_flag(version_data, swi(Major,Minor,Patch,Options))
1002 },
1003 ( { memberchk(tag(Tag), Options) }
1004 -> [ '~w.~w.~w-~w'-[Major, Minor, Patch, Tag] ]
1005 ; [ '~w.~w.~w'-[Major, Minor, Patch] ]
1006 ).
1007prolog_message(address_bits) -->
1008 { current_prolog_flag(address_bits, Bits)
1009 },
1010 !,
1011 [ '~d bits, '-[Bits] ].
1012prolog_message(threads) -->
1013 { current_prolog_flag(threads, true)
1014 },
1015 !,
1016 [ 'threaded, ' ].
1017prolog_message(threads) -->
1018 [].
1019prolog_message(copyright) -->
1020 [ 'SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software.', nl,
1021 'Please run ?- license. for legal details.'
1022 ].
1023prolog_message(user_versions) -->
1024 ( { findall(Msg, prolog:version_msg(Msg), Msgs),
1025 Msgs \== []
1026 }
1027 -> [nl],
1028 user_version_messages(Msgs)
1029 ; []
1030 ).
1031prolog_message(documentaton) -->
1032 [ 'For online help and background, visit http://www.swi-prolog.org', nl,
1033 'For built-in help, use ?- help(Topic). or ?- apropos(Word).'
1034 ].
1035prolog_message(welcome) -->
1036 [ 'Welcome to SWI-Prolog (' ],
1037 prolog_message(threads),
1038 prolog_message(address_bits),
1039 ['version ' ],
1040 prolog_message(version),
1041 [ ')', nl ],
1042 prolog_message(copyright),
1043 [ nl ],
1044 prolog_message(user_versions),
1045 [ nl ],
1046 prolog_message(documentaton),
1047 [ nl, nl ].
1048prolog_message(about) -->
1049 [ 'SWI-Prolog version (' ],
1050 prolog_message(threads),
1051 prolog_message(address_bits),
1052 ['version ' ],
1053 prolog_message(version),
1054 [ ')', nl ],
1055 prolog_message(copyright).
1056prolog_message(halt) -->
1057 [ 'halt' ].
1058prolog_message(break(begin, Level)) -->
1059 [ 'Break level ~d'-[Level] ].
1060prolog_message(break(end, Level)) -->
1061 [ 'Exit break level ~d'-[Level] ].
1062prolog_message(var_query(_)) -->
1063 [ '... 1,000,000 ............ 10,000,000 years later', nl, nl,
1064 '~t~8|>> 42 << (last release gives the question)'
1065 ].
1066prolog_message(close_on_abort(Stream)) -->
1067 [ 'Abort: closed stream ~p'-[Stream] ].
1068prolog_message(cancel_halt(Reason)) -->
1069 [ 'Halt cancelled: ~p'-[Reason] ].
1070
1071prolog_message(query(QueryResult)) -->
1072 query_result(QueryResult).
1073
1074query_result(no) --> 1075 [ ansi([bold,fg(red)], 'false.', []) ],
1076 extra_line.
1077query_result(yes([])) --> 1078 !,
1079 [ ansi(bold, 'true.', []) ],
1080 extra_line.
1081query_result(yes(Residuals)) -->
1082 result([], Residuals),
1083 extra_line.
1084query_result(done) --> 1085 extra_line.
1086query_result(yes(Bindings, Residuals)) -->
1087 result(Bindings, Residuals),
1088 prompt(yes, Bindings, Residuals).
1089query_result(more(Bindings, Residuals)) -->
1090 result(Bindings, Residuals),
1091 prompt(more, Bindings, Residuals).
1092query_result(help) -->
1093 [ nl, 'Actions:'-[], nl, nl,
1094 '; (n, r, space, TAB): redo t: trace & redo'-[], nl,
1095 'b: break c (a, RET): exit'-[], nl,
1096 'w: write p print'-[], nl,
1097 'h (?): help'-[],
1098 nl, nl
1099 ].
1100query_result(action) -->
1101 [ 'Action? '-[], flush ].
1102query_result(confirm) -->
1103 [ 'Please answer \'y\' or \'n\'? '-[], flush ].
1104query_result(eof) -->
1105 [ nl ].
1106query_result(toplevel_open_line) -->
1107 [].
1108
1109prompt(Answer, [], []-[]) -->
1110 !,
1111 prompt(Answer, empty).
1112prompt(Answer, _, _) -->
1113 !,
1114 prompt(Answer, non_empty).
1115
1116prompt(yes, empty) -->
1117 !,
1118 [ ansi(bold, 'true.', []) ],
1119 extra_line.
1120prompt(yes, _) -->
1121 !,
1122 [ full_stop ],
1123 extra_line.
1124prompt(more, empty) -->
1125 !,
1126 [ ansi(bold, 'true ', []), flush ].
1127prompt(more, _) -->
1128 !,
1129 [ ' '-[], flush ].
1130
1131result(Bindings, Residuals) -->
1132 { current_prolog_flag(answer_write_options, Options0),
1133 Options = [partial(true)|Options0]
1134 },
1135 bindings(Bindings, [priority(699)|Options]),
1136 bind_res_sep(Bindings, Residuals),
1137 residuals(Residuals, [priority(999)|Options]).
1138
1139bindings([], _) -->
1140 [].
1141bindings([binding(Names,Skel,Subst)|T], Options) -->
1142 { '$last'(Names, Name) },
1143 var_names(Names), value(Name, Skel, Subst, Options),
1144 ( { T \== [] }
1145 -> [ ','-[], nl ],
1146 bindings(T, Options)
1147 ; []
1148 ).
1149
1150var_names([Name]) -->
1151 !,
1152 [ '~w = '-[Name] ].
1153var_names([Name1,Name2|T]) -->
1154 !,
1155 [ '~w = ~w, '-[Name1, Name2] ],
1156 var_names([Name2|T]).
1157
1158
1159value(Name, Skel, Subst, Options) -->
1160 ( { var(Skel), Subst = [Skel=S] }
1161 -> { Skel = '$VAR'(Name) },
1162 [ '~W'-[S, Options] ]
1163 ; [ '~W'-[Skel, Options] ],
1164 substitution(Subst, Options)
1165 ).
1166
1167substitution([], _) --> !.
1168substitution([N=V|T], Options) -->
1169 [ ', ', ansi(fg(green), '% where', []), nl,
1170 ' ~w = ~W'-[N,V,Options] ],
1171 substitutions(T, Options).
1172
1173substitutions([], _) --> [].
1174substitutions([N=V|T], Options) -->
1175 [ ','-[], nl, ' ~w = ~W'-[N,V,Options] ],
1176 substitutions(T, Options).
1177
1178
1179residuals(Normal-Hidden, Options) -->
1180 residuals1(Normal, Options),
1181 bind_res_sep(Normal, Hidden),
1182 ( {Hidden == []}
1183 -> []
1184 ; [ansi(fg(green), '% with pending residual goals', []), nl]
1185 ),
1186 residuals1(Hidden, Options).
1187
1188residuals1([], _) -->
1189 [].
1190residuals1([G|Gs], Options) -->
1191 ( { Gs \== [] }
1192 -> [ '~W,'-[G, Options], nl ],
1193 residuals1(Gs, Options)
1194 ; [ '~W'-[G, Options] ]
1195 ).
1196
1197bind_res_sep(_, []) --> !.
1198bind_res_sep(_, []-[]) --> !.
1199bind_res_sep([], _) --> !.
1200bind_res_sep(_, _) --> [','-[], nl].
1201
-->
1203 { current_prolog_flag(toplevel_extra_white_line, true) },
1204 !,
1205 ['~N'-[]].
1206extra_line -->
1207 [].
1208
1209prolog_message(if_tty(Message)) -->
1210 ( {current_prolog_flag(tty_control, true)}
1211 -> [ at_same_line | Message ]
1212 ; []
1213 ).
1214prolog_message(halt(Reason)) -->
1215 [ '~w: halt'-[Reason] ].
1216prolog_message(no_action(Char)) -->
1217 [ 'Unknown action: ~c (h for help)'-[Char], nl ].
1218
1219prolog_message(history(help(Show, Help))) -->
1220 [ 'History Commands:', nl,
1221 ' !!. Repeat last query', nl,
1222 ' !nr. Repeat query numbered <nr>', nl,
1223 ' !str. Repeat last query starting with <str>', nl,
1224 ' !?str. Repeat last query holding <str>', nl,
1225 ' ^old^new. Substitute <old> into <new> of last query', nl,
1226 ' !nr^old^new. Substitute in query numbered <nr>', nl,
1227 ' !str^old^new. Substitute in query starting with <str>', nl,
1228 ' !?str^old^new. Substitute in query holding <str>', nl,
1229 ' ~w.~21|Show history list'-[Show], nl,
1230 ' ~w.~21|Show this list'-[Help], nl, nl
1231 ].
1232prolog_message(history(no_event)) -->
1233 [ '! No such event' ].
1234prolog_message(history(bad_substitution)) -->
1235 [ '! Bad substitution' ].
1236prolog_message(history(expanded(Event))) -->
1237 [ '~w.'-[Event] ].
1238prolog_message(history(history(Events))) -->
1239 history_events(Events).
1240
1241history_events([]) -->
1242 [].
1243history_events([Nr/Event|T]) -->
1244 [ '~t~w ~8|~W~W'-[ Nr,
1245 Event, [partial(true)],
1246 '.', [partial(true)]
1247 ],
1248 nl
1249 ],
1250 history_events(T).
1251
1252
1253user_version_messages([]) --> [].
1254user_version_messages([H|T]) -->
1255 user_version_message(H),
1256 user_version_messages(T).
1257
1259
1260user_version_message(Term) -->
1261 translate_message2(Term), !, [nl].
1262user_version_message(Atom) -->
1263 [ '~w'-[Atom], nl ].
1264
1265
1266 1269
1270prolog_message(spy(Head)) -->
1271 { goal_to_predicate_indicator(Head, Pred)
1272 },
1273 [ 'Spy point on ~p'-[Pred] ].
1274prolog_message(nospy(Head)) -->
1275 { goal_to_predicate_indicator(Head, Pred)
1276 },
1277 [ 'Spy point removed from ~p'-[Pred] ].
1278prolog_message(trace_mode(Bool)) -->
1279 [ 'Trace mode switched to ~w'-[Bool] ].
1280prolog_message(debug_mode(Bool)) -->
1281 [ 'Debug mode switched to ~w'-[Bool] ].
1282prolog_message(debugging(Bool)) -->
1283 [ 'Debug mode is ~w'-[Bool] ].
1284prolog_message(spying([])) -->
1285 !,
1286 [ 'No spy points' ].
1287prolog_message(spying(Heads)) -->
1288 [ 'Spy points (see spy/1) on:', nl ],
1289 predicate_list(Heads).
1290prolog_message(trace(Head, [])) -->
1291 !,
1292 { goal_to_predicate_indicator(Head, Pred)
1293 },
1294 [ ' ~p: Not tracing'-[Pred], nl].
1295prolog_message(trace(Head, Ports)) -->
1296 { goal_to_predicate_indicator(Head, Pred)
1297 },
1298 [ ' ~p: ~w'-[Pred, Ports], nl].
1299prolog_message(tracing([])) -->
1300 !,
1301 [ 'No traced predicates (see trace/1)' ].
1302prolog_message(tracing(Heads)) -->
1303 [ 'Trace points (see trace/1) on:', nl ],
1304 tracing_list(Heads).
1305
1306predicate_list([]) --> 1307 [].
1308predicate_list([H|T]) -->
1309 { goal_to_predicate_indicator(H, Pred)
1310 },
1311 [ ' ~p'-[Pred], nl],
1312 predicate_list(T).
1313
1314tracing_list([]) -->
1315 [].
1316tracing_list([trace(Head, Ports)|T]) -->
1317 translate_message(trace(Head, Ports)),
1318 tracing_list(T).
1319
1320prolog_message(frame(Frame, backtrace, _PC)) -->
1321 !,
1322 { prolog_frame_attribute(Frame, level, Level)
1323 },
1324 [ ansi(bold, '~t[~D] ~10|', [Level]) ],
1325 frame_context(Frame),
1326 frame_goal(Frame).
1327prolog_message(frame(Frame, choice, PC)) -->
1328 !,
1329 prolog_message(frame(Frame, backtrace, PC)).
1330prolog_message(frame(_, cut_call, _)) --> !, [].
1331prolog_message(frame(Frame, trace(Port), _PC)) -->
1332 !,
1333 [ ' T ' ],
1334 port(Port),
1335 frame_level(Frame),
1336 frame_context(Frame),
1337 frame_goal(Frame).
1338prolog_message(frame(Frame, Port, _PC)) -->
1339 frame_flags(Frame),
1340 port(Port),
1341 frame_level(Frame),
1342 frame_context(Frame),
1343 frame_depth_limit(Port, Frame),
1344 frame_goal(Frame),
1345 [ flush ].
1346
1347frame_goal(Frame) -->
1348 { prolog_frame_attribute(Frame, goal, Goal0),
1349 clean_goal(Goal0, Goal),
1350 current_prolog_flag(debugger_write_options, Options)
1351 },
1352 [ '~W'-[Goal, Options] ].
1353
1354frame_level(Frame) -->
1355 { prolog_frame_attribute(Frame, level, Level)
1356 },
1357 [ '(~D) '-[Level] ].
1358
1359frame_context(Frame) -->
1360 ( { current_prolog_flag(debugger_show_context, true),
1361 prolog_frame_attribute(Frame, context_module, Context)
1362 }
1363 -> [ '[~w] '-[Context] ]
1364 ; []
1365 ).
1366
1367frame_depth_limit(fail, Frame) -->
1368 { prolog_frame_attribute(Frame, depth_limit_exceeded, true)
1369 },
1370 !,
1371 [ '[depth-limit exceeded] ' ].
1372frame_depth_limit(_, _) -->
1373 [].
1374
1375frame_flags(Frame) -->
1376 { prolog_frame_attribute(Frame, goal, Goal),
1377 ( predicate_property(Goal, transparent)
1378 -> T = '^'
1379 ; T = ' '
1380 ),
1381 ( predicate_property(Goal, spying)
1382 -> S = '*'
1383 ; S = ' '
1384 )
1385 },
1386 [ '~w~w '-[T, S] ].
1387
1388port(Port) -->
1389 { port_name(Port, Colour, Name)
1390 },
1391 !,
1392 [ ansi([bold,fg(Colour)], '~w: ', [Name]) ].
1393
1394port_name(call, green, 'Call').
1395port_name(exit, green, 'Exit').
1396port_name(fail, red, 'Fail').
1397port_name(redo, yellow, 'Redo').
1398port_name(unify, blue, 'Unify').
1399port_name(exception, magenta, 'Exception').
1400
1401clean_goal(M:Goal, Goal) :-
1402 hidden_module(M),
1403 !.
1404clean_goal(M:Goal, Goal) :-
1405 predicate_property(M:Goal, built_in),
1406 !.
1407clean_goal(Goal, Goal).
1408
1409
1410 1413
1414prolog_message(compatibility(renamed(Old, New))) -->
1415 [ 'The predicate ~p has been renamed to ~p.'-[Old, New], nl,
1416 'Please update your sources for compatibility with future versions.'
1417 ].
1418
1419
1420 1423
1424prolog_message(abnormal_thread_completion(Goal, exception(Ex))) -->
1425 !,
1426 [ 'Thread running "~p" died on exception: '-[Goal] ],
1427 translate_message(Ex).
1428prolog_message(abnormal_thread_completion(Goal, fail)) -->
1429 [ 'Thread running "~p" died due to failure'-[Goal] ].
1430prolog_message(threads_not_died(Running)) -->
1431 [ 'The following threads wouldn\'t die: ~p'-[Running] ].
1432
1433
1434 1437
1438prolog_message(pack(attached(Pack, BaseDir))) -->
1439 [ 'Attached package ~w at ~q'-[Pack, BaseDir] ].
1440prolog_message(pack(duplicate(Entry, OldDir, Dir))) -->
1441 [ 'Package ~w already attached at ~q.'-[Entry,OldDir], nl,
1442 '\tIgnoring version from ~q'- [Entry, OldDir, Dir]
1443 ].
1444prolog_message(pack(no_arch(Entry, Arch))) -->
1445 [ 'Package ~w: no binary for architecture ~w'-[Entry, Arch] ].
1446
1447 1450
1451prolog_message(null_byte_in_path(Component)) -->
1452 [ '0-byte in PATH component: ~p (skipped directory)'-[Component] ].
1453prolog_message(invalid_tmp_dir(Dir, Reason)) -->
1454 [ 'Cannot use ~p as temporary file directory: ~w'-[Dir, Reason] ].
1455prolog_message(ambiguous_stream_pair(Pair)) -->
1456 [ 'Ambiguous operation on stream pair ~p'-[Pair] ].
1457
1458env(Name) -->
1459 { current_prolog_flag(windows, true) },
1460 [ '%~w%'-[Name] ].
1461env(Name) -->
1462 [ '$~w'-[Name] ].
1463
1464 1467
1468deprecated(set_prolog_stack(_Stack,limit)) -->
1469 [ 'set_prolog_stack/2: limit(Size) sets the combined limit.'-[], nl,
1470 'See http://www.swi-prolog.org/changes/stack-limit.html'
1471 ].
1472
1473
1474 1477
1478:- multifile
1479 user:message_hook/3,
1480 prolog:message_prefix_hook/2. 1481:- dynamic
1482 user:message_hook/3,
1483 prolog:message_prefix_hook/2. 1484:- thread_local
1485 user:thread_message_hook/3. 1486
1491
1492print_message(Level, Term) :-
1493 ( must_print(Level, Term)
1494 -> ( translate_message(Term, Lines, [])
1495 -> ( nonvar(Term),
1496 ( notrace(user:thread_message_hook(Term, Level, Lines))
1497 -> true
1498 ; notrace(user:message_hook(Term, Level, Lines))
1499 )
1500 -> true
1501 ; print_system_message(Term, Level, Lines)
1502 )
1503 )
1504 ; true
1505 ).
1506
1513
1514print_system_message(_, silent, _) :- !.
1515print_system_message(_, informational, _) :-
1516 current_prolog_flag(verbose, silent),
1517 !.
1518print_system_message(_, banner, _) :-
1519 current_prolog_flag(verbose, silent),
1520 !.
1521print_system_message(_, _, []) :- !.
1522print_system_message(Term, Kind, Lines) :-
1523 catch(flush_output(user_output), _, true), 1524 source_location(File, Line),
1525 Term \= error(syntax_error(_), _),
1526 msg_property(Kind, location_prefix(File:Line, LocPrefix, LinePrefix)),
1527 !,
1528 insert_prefix(Lines, LinePrefix, Ctx, PrefixLines),
1529 '$append'([ begin(Kind, Ctx),
1530 LocPrefix,
1531 nl
1532 | PrefixLines
1533 ],
1534 [ end(Ctx)
1535 ],
1536 AllLines),
1537 msg_property(Kind, stream(Stream)),
1538 ignore(stream_property(Stream, position(Pos))),
1539 print_message_lines(Stream, AllLines),
1540 ( \+ stream_property(Stream, position(Pos)),
1541 msg_property(Kind, wait(Wait)),
1542 Wait > 0
1543 -> sleep(Wait)
1544 ; true
1545 ).
1546print_system_message(_, Kind, Lines) :-
1547 msg_property(Kind, stream(Stream)),
1548 print_message_lines(Stream, kind(Kind), Lines).
1549
1550:- multifile
1551 user:message_property/2. 1552
1553msg_property(Kind, Property) :-
1554 user:message_property(Kind, Property),
1555 !.
1556msg_property(Kind, prefix(Prefix)) :-
1557 msg_prefix(Kind, Prefix),
1558 !.
1559msg_property(_, prefix('~N')) :- !.
1560msg_property(query, stream(user_output)) :- !.
1561msg_property(_, stream(user_error)) :- !.
1562msg_property(error,
1563 location_prefix(File:Line,
1564 '~NERROR: ~w:~d:'-[File,Line], '~N\t')) :- !.
1565msg_property(warning,
1566 location_prefix(File:Line,
1567 '~NWarning: ~w:~d:'-[File,Line], '~N\t')) :- !.
1568msg_property(error, wait(0.1)) :- !.
1569
1570msg_prefix(debug(_), Prefix) :-
1571 msg_context('~N% ', Prefix).
1572msg_prefix(warning, Prefix) :-
1573 msg_context('~NWarning: ', Prefix).
1574msg_prefix(error, Prefix) :-
1575 msg_context('~NERROR: ', Prefix).
1576msg_prefix(informational, '~N% ').
1577msg_prefix(information, '~N% ').
1578
1590
1591msg_context(Prefix0, Prefix) :-
1592 current_prolog_flag(message_context, Context),
1593 is_list(Context),
1594 !,
1595 add_message_context(Context, Prefix0, Prefix).
1596msg_context(Prefix, Prefix).
1597
1598add_message_context([], Prefix, Prefix).
1599add_message_context([H|T], Prefix0, Prefix) :-
1600 ( add_message_context1(H, Prefix0, Prefix1)
1601 -> true
1602 ; Prefix1 = Prefix0
1603 ),
1604 add_message_context(T, Prefix1, Prefix).
1605
1606add_message_context1(Context, Prefix0, Prefix) :-
1607 prolog:message_prefix_hook(Context, Extra),
1608 atomics_to_string([Prefix0, Extra, ' '], Prefix).
1609add_message_context1(time, Prefix0, Prefix) :-
1610 get_time(Now),
1611 format_time(string(S), '%T.%3f ', Now),
1612 string_concat(Prefix0, S, Prefix).
1613add_message_context1(time(Format), Prefix0, Prefix) :-
1614 get_time(Now),
1615 format_time(string(S), Format, Now),
1616 atomics_to_string([Prefix0, S, ' '], Prefix).
1617add_message_context1(thread, Prefix0, Prefix) :-
1618 thread_self(Id0),
1619 Id0 \== main,
1620 !,
1621 ( atom(Id0)
1622 -> Id = Id0
1623 ; thread_property(Id0, id(Id))
1624 ),
1625 format(string(Prefix), '~w[Thread ~w] ', [Prefix0, Id]).
1626
1631
1632print_message_lines(Stream, kind(Kind), Lines) :-
1633 !,
1634 msg_property(Kind, prefix(Prefix)),
1635 insert_prefix(Lines, Prefix, Ctx, PrefixLines),
1636 '$append'([ begin(Kind, Ctx)
1637 | PrefixLines
1638 ],
1639 [ end(Ctx)
1640 ],
1641 AllLines),
1642 print_message_lines(Stream, AllLines).
1643print_message_lines(Stream, Prefix, Lines) :-
1644 insert_prefix(Lines, Prefix, _, PrefixLines),
1645 print_message_lines(Stream, PrefixLines).
1646
1648
1649insert_prefix([at_same_line|Lines0], Prefix, Ctx, Lines) :-
1650 !,
1651 prefix_nl(Lines0, Prefix, Ctx, Lines).
1652insert_prefix(Lines0, Prefix, Ctx, [prefix(Prefix)|Lines]) :-
1653 prefix_nl(Lines0, Prefix, Ctx, Lines).
1654
1655prefix_nl([], _, _, [nl]).
1656prefix_nl([nl], _, _, [nl]) :- !.
1657prefix_nl([flush], _, _, [flush]) :- !.
1658prefix_nl([nl|T0], Prefix, Ctx, [nl, prefix(Prefix)|T]) :-
1659 !,
1660 prefix_nl(T0, Prefix, Ctx, T).
1661prefix_nl([ansi(Attrs,Fmt,Args)|T0], Prefix, Ctx,
1662 [ansi(Attrs,Fmt,Args,Ctx)|T]) :-
1663 !,
1664 prefix_nl(T0, Prefix, Ctx, T).
1665prefix_nl([H|T0], Prefix, Ctx, [H|T]) :-
1666 prefix_nl(T0, Prefix, Ctx, T).
1667
1669
1670print_message_lines(Stream, Lines) :-
1671 with_output_to(
1672 Stream,
1673 notrace(print_message_lines_guarded(current_output, Lines))).
1674
1675print_message_lines_guarded(_, []) :- !.
1676print_message_lines_guarded(S, [H|T]) :-
1677 line_element(S, H),
1678 print_message_lines_guarded(S, T).
1679
1680line_element(S, E) :-
1681 prolog:message_line_element(S, E),
1682 !.
1683line_element(S, full_stop) :-
1684 !,
1685 '$put_token'(S, '.'). 1686line_element(S, nl) :-
1687 !,
1688 nl(S).
1689line_element(S, prefix(Fmt-Args)) :-
1690 !,
1691 safe_format(S, Fmt, Args).
1692line_element(S, prefix(Fmt)) :-
1693 !,
1694 safe_format(S, Fmt, []).
1695line_element(S, flush) :-
1696 !,
1697 flush_output(S).
1698line_element(S, Fmt-Args) :-
1699 !,
1700 safe_format(S, Fmt, Args).
1701line_element(S, ansi(_, Fmt, Args)) :-
1702 !,
1703 safe_format(S, Fmt, Args).
1704line_element(S, ansi(_, Fmt, Args, _Ctx)) :-
1705 !,
1706 safe_format(S, Fmt, Args).
1707line_element(_, begin(_Level, _Ctx)) :- !.
1708line_element(_, end(_Ctx)) :- !.
1709line_element(S, Fmt) :-
1710 safe_format(S, Fmt, []).
1711
1713
1714safe_format(S, Fmt, Args) :-
1715 E = error(_,_),
1716 catch(format(S,Fmt,Args), E,
1717 format_failed(S,Fmt,Args,E)).
1718
1719format_failed(S, _Fmt, _Args, E) :-
1720 E = error(io_error(_,S),_),
1721 !,
1722 throw(E).
1723format_failed(S, Fmt, Args, error(E,_)) :-
1724 format(S, '~N [[ EXCEPTION while printing message ~q~n\c
1725 ~7|with arguments ~W:~n\c
1726 ~7|raised: ~W~n~4|]]~n',
1727 [ Fmt,
1728 Args, [quoted(true), max_depth(10)],
1729 E, [quoted(true), max_depth(10)]
1730 ]).
1731
1735
1736message_to_string(Term, Str) :-
1737 translate_message(Term, Actions, []),
1738 !,
1739 actions_to_format(Actions, Fmt, Args),
1740 format(string(Str), Fmt, Args).
1741
1742actions_to_format([], '', []) :- !.
1743actions_to_format([nl], '', []) :- !.
1744actions_to_format([Term, nl], Fmt, Args) :-
1745 !,
1746 actions_to_format([Term], Fmt, Args).
1747actions_to_format([nl|T], Fmt, Args) :-
1748 !,
1749 actions_to_format(T, Fmt0, Args),
1750 atom_concat('~n', Fmt0, Fmt).
1751actions_to_format([Skip|T], Fmt, Args) :-
1752 action_skip(Skip),
1753 !,
1754 actions_to_format(T, Fmt, Args).
1755actions_to_format([Fmt0-Args0|Tail], Fmt, Args) :-
1756 !,
1757 actions_to_format(Tail, Fmt1, Args1),
1758 atom_concat(Fmt0, Fmt1, Fmt),
1759 append_args(Args0, Args1, Args).
1760actions_to_format([Term|Tail], Fmt, Args) :-
1761 atomic(Term),
1762 !,
1763 actions_to_format(Tail, Fmt1, Args),
1764 atom_concat(Term, Fmt1, Fmt).
1765actions_to_format([Term|Tail], Fmt, Args) :-
1766 actions_to_format(Tail, Fmt1, Args1),
1767 atom_concat('~w', Fmt1, Fmt),
1768 append_args([Term], Args1, Args).
1769
1770action_skip(at_same_line).
1771action_skip(flush).
1772action_skip(ansi(_Attrs, _Fmt, _Args)).
1773action_skip(begin(_Level, _Ctx)).
1774action_skip(end(_Ctx)).
1775
1776append_args(M:Args0, Args1, M:Args) :-
1777 !,
1778 strip_module(Args1, _, A1),
1779 '$append'(Args0, A1, Args).
1780append_args(Args0, Args1, Args) :-
1781 strip_module(Args1, _, A1),
1782 '$append'(Args0, A1, Args).
1783
1784
1785 1788
1789:- dynamic
1790 printed/2. 1791
1795
1796print_once(compatibility(_), _).
1797print_once(null_byte_in_path(_), _).
1798print_once(deprecated(_), _).
1799
1803
1804must_print(Level, Message) :-
1805 nonvar(Message),
1806 print_once(Message, Level),
1807 !,
1808 \+ printed(Message, Level),
1809 assert(printed(Message, Level)).
1810must_print(_, _)