37
38:- module('$messages',
39 [ print_message/2, 40 print_message_lines/3, 41 message_to_string/2 42 ]). 43
44:- multifile
45 prolog:message//1, 46 prolog:error_message//1, 47 prolog:message_context//1, 48 prolog:deprecated//1, 49 prolog:message_location//1, 50 prolog:message_line_element/2. 51:- '$hide'((
52 prolog:message//1,
53 prolog:error_message//1,
54 prolog:message_context//1,
55 prolog:deprecated//1,
56 prolog:message_location//1,
57 prolog:message_line_element/2)). 59:- multifile
60 prolog:message//2, 61 prolog:error_message//2, 62 prolog:message_context//2, 63 prolog:message_location//2, 64 prolog:deprecated//2. 65:- '$hide'((
66 prolog:message//2,
67 prolog:error_message//2,
68 prolog:message_context//2,
69 prolog:deprecated//2,
70 prolog:message_location//2)). 71
72:- discontiguous
73 prolog_message/3. 74
75:- public
76 translate_message//1, 77 prolog:translate_message//1. 78
79:- create_prolog_flag(message_context, [thread], []). 80
102
103prolog:translate_message(Term) -->
104 translate_message(Term).
105
110
111translate_message(Term) -->
112 { nonvar(Term) },
113 ( { message_lang(Lang) },
114 prolog:message(Lang, Term)
115 ; prolog:message(Term)
116 ),
117 !.
118translate_message(Term) -->
119 { nonvar(Term) },
120 translate_message2(Term),
121 !.
122translate_message(Term) -->
123 { nonvar(Term),
124 Term = error(_, _)
125 },
126 [ 'Unknown exception: ~p'-[Term] ].
127translate_message(Term) -->
128 [ 'Unknown message: ~p'-[Term] ].
129
130translate_message2(Term) -->
131 prolog_message(Term).
132translate_message2(error(resource_error(stack), Context)) -->
133 !,
134 out_of_stack(Context).
135translate_message2(error(resource_error(tripwire(Wire, Context)), _)) -->
136 !,
137 tripwire_message(Wire, Context).
138translate_message2(error(existence_error(reset, Ball), SWI)) -->
139 swi_location(SWI),
140 tabling_existence_error(Ball, SWI).
141translate_message2(error(ISO, SWI)) -->
142 swi_location(SWI),
143 term_message(ISO),
144 swi_extra(SWI).
145translate_message2(unwind(Term)) -->
146 unwind_message(Term).
147translate_message2(message_lines(Lines), L, T) :- 148 make_message_lines(Lines, L, T).
149translate_message2(format(Fmt, Args)) -->
150 [ Fmt-Args ].
151
152make_message_lines([], T, T) :- !.
153make_message_lines([Last], ['~w'-[Last]|T], T) :- !.
154make_message_lines([L0|LT], ['~w'-[L0],nl|T0], T) :-
155 make_message_lines(LT, T0, T).
156
162
163:- public term_message//1. 164term_message(Term) -->
165 {var(Term)},
166 !,
167 [ 'Unknown error term: ~p'-[Term] ].
168term_message(Term) -->
169 { message_lang(Lang) },
170 prolog:error_message(Lang, Term),
171 !.
172term_message(Term) -->
173 prolog:error_message(Term),
174 !.
175term_message(Term) -->
176 iso_message(Term).
177term_message(Term) -->
178 swi_message(Term).
179term_message(Term) -->
180 [ 'Unknown error term: ~p'-[Term] ].
181
182iso_message(resource_error(c_stack)) -->
183 out_of_c_stack.
184iso_message(resource_error(Missing)) -->
185 [ 'Not enough resources: ~w'-[Missing] ].
186iso_message(type_error(evaluable, Actual)) -->
187 { callable(Actual) },
188 [ 'Arithmetic: `~p'' is not a function'-[Actual] ].
189iso_message(type_error(free_of_attvar, Actual)) -->
190 [ 'Type error: `~W'' contains attributed variables'-
191 [Actual,[portray(true), attributes(portray)]] ].
192iso_message(type_error(Expected, Actual)) -->
193 [ 'Type error: `~w'' expected, found `~p'''-[Expected, Actual] ],
194 type_error_comment(Expected, Actual).
195iso_message(domain_error(Domain, Actual)) -->
196 [ 'Domain error: '-[] ], domain(Domain),
197 [ ' expected, found `~p'''-[Actual] ].
198iso_message(instantiation_error) -->
199 [ 'Arguments are not sufficiently instantiated' ].
200iso_message(uninstantiation_error(Var)) -->
201 [ 'Uninstantiated argument expected, found ~p'-[Var] ].
202iso_message(representation_error(What)) -->
203 [ 'Cannot represent due to `~w'''-[What] ].
204iso_message(permission_error(Action, Type, Object)) -->
205 permission_error(Action, Type, Object).
206iso_message(evaluation_error(Which)) -->
207 [ 'Arithmetic: evaluation error: `~p'''-[Which] ].
208iso_message(existence_error(procedure, Proc)) -->
209 [ 'Unknown procedure: ~q'-[Proc] ],
210 unknown_proc_msg(Proc).
211iso_message(existence_error(answer_variable, Var)) -->
212 [ '$~w was not bound by a previous query'-[Var] ].
213iso_message(existence_error(matching_rule, Goal)) -->
214 [ 'No rule matches ~p'-[Goal] ].
215iso_message(existence_error(Type, Object)) -->
216 [ '~w `~p'' does not exist'-[Type, Object] ].
217iso_message(existence_error(export, PI, module(M))) --> 218 [ 'Module ', ansi(code, '~q', [M]), ' does not export ',
219 ansi(code, '~q', [PI]) ].
220iso_message(existence_error(Type, Object, In)) --> 221 [ '~w `~p'' does not exist in ~p'-[Type, Object, In] ].
222iso_message(busy(Type, Object)) -->
223 [ '~w `~p'' is busy'-[Type, Object] ].
224iso_message(syntax_error(swi_backslash_newline)) -->
225 [ 'Deprecated: ... \\<newline><white>*. Use \\c' ].
226iso_message(syntax_error(warning_var_tag)) -->
227 [ 'Deprecated: dict with unbound tag (_{...}). Mapped to #{...}.' ].
228iso_message(syntax_error(var_tag)) -->
229 [ 'Syntax error: dict syntax with unbound tag (_{...}).' ].
230iso_message(syntax_error(Id)) -->
231 [ 'Syntax error: ' ],
232 syntax_error(Id).
233iso_message(occurs_check(Var, In)) -->
234 [ 'Cannot unify ~p with ~p: would create an infinite tree'-[Var, In] ].
235
240
241permission_error(Action, built_in_procedure, Pred) -->
242 { user_predicate_indicator(Pred, PI)
243 },
244 [ 'No permission to ~w built-in predicate `~p'''-[Action, PI] ],
245 ( {Action \== export}
246 -> [ nl,
247 'Use :- redefine_system_predicate(+Head) if redefinition is intended'
248 ]
249 ; []
250 ).
251permission_error(import_into(Dest), procedure, Pred) -->
252 [ 'No permission to import ~p into ~w'-[Pred, Dest] ].
253permission_error(Action, static_procedure, Proc) -->
254 [ 'No permission to ~w static procedure `~p'''-[Action, Proc] ],
255 defined_definition('Defined', Proc).
256permission_error(input, stream, Stream) -->
257 [ 'No permission to read from output stream `~p'''-[Stream] ].
258permission_error(output, stream, Stream) -->
259 [ 'No permission to write to input stream `~p'''-[Stream] ].
260permission_error(input, text_stream, Stream) -->
261 [ 'No permission to read bytes from TEXT stream `~p'''-[Stream] ].
262permission_error(output, text_stream, Stream) -->
263 [ 'No permission to write bytes to TEXT stream `~p'''-[Stream] ].
264permission_error(input, binary_stream, Stream) -->
265 [ 'No permission to read characters from binary stream `~p'''-[Stream] ].
266permission_error(output, binary_stream, Stream) -->
267 [ 'No permission to write characters to binary stream `~p'''-[Stream] ].
268permission_error(open, source_sink, alias(Alias)) -->
269 [ 'No permission to reuse alias "~p": already taken'-[Alias] ].
270permission_error(tnot, non_tabled_procedure, Pred) -->
271 [ 'The argument of tnot/1 is not tabled: ~p'-[Pred] ].
272permission_error(assert, procedure, Pred) -->
273 { '$pi_head'(Pred, Head),
274 predicate_property(Head, ssu)
275 },
276 [ '~p: an SSU (Head => Body) predicate cannot have normal Prolog clauses'-
277 [Pred] ].
278permission_error(Action, Type, Object) -->
279 [ 'No permission to ~w ~w `~p'''-[Action, Type, Object] ].
280
281
282unknown_proc_msg(_:(^)/2) -->
283 !,
284 unknown_proc_msg((^)/2).
285unknown_proc_msg((^)/2) -->
286 !,
287 [nl, ' ^/2 can only appear as the 2nd argument of setof/3 and bagof/3'].
288unknown_proc_msg((:-)/2) -->
289 !,
290 [nl, ' Rules must be loaded from a file'],
291 faq('ToplevelMode').
292unknown_proc_msg((=>)/2) -->
293 !,
294 [nl, ' Rules must be loaded from a file'],
295 faq('ToplevelMode').
296unknown_proc_msg((:-)/1) -->
297 !,
298 [nl, ' Directives must be loaded from a file'],
299 faq('ToplevelMode').
300unknown_proc_msg((?-)/1) -->
301 !,
302 [nl, ' ?- is the Prolog prompt'],
303 faq('ToplevelMode').
304unknown_proc_msg(Proc) -->
305 { dwim_predicates(Proc, Dwims) },
306 ( {Dwims \== []}
307 -> [nl, ' However, there are definitions for:', nl],
308 dwim_message(Dwims)
309 ; []
310 ).
311
312dependency_error(shared(Shared), private(Private)) -->
313 [ 'Shared table for ~p may not depend on private ~p'-[Shared, Private] ].
314dependency_error(Dep, monotonic(On)) -->
315 { '$pi_head'(PI, Dep),
316 '$pi_head'(MPI, On)
317 },
318 [ 'Dependent ~p on monotonic predicate ~p is not monotonic or incremental'-
319 [PI, MPI]
320 ].
321
322faq(Page) -->
323 [nl, ' See FAQ at https://www.swi-prolog.org/FAQ/', Page, '.html' ].
324
(_Expected, Actual) -->
326 { type_of(Actual, Type),
327 ( sub_atom(Type, 0, 1, _, First),
328 memberchk(First, [a,e,i,o,u])
329 -> Article = an
330 ; Article = a
331 )
332 },
333 [ ' (~w ~w)'-[Article, Type] ].
334
335type_of(Term, Type) :-
336 ( attvar(Term) -> Type = attvar
337 ; var(Term) -> Type = var
338 ; atom(Term) -> Type = atom
339 ; integer(Term) -> Type = integer
340 ; string(Term) -> Type = string
341 ; Term == [] -> Type = empty_list
342 ; blob(Term, BlobT) -> blob_type(BlobT, Type)
343 ; rational(Term) -> Type = rational
344 ; float(Term) -> Type = float
345 ; is_stream(Term) -> Type = stream
346 ; is_dict(Term) -> Type = dict
347 ; is_list(Term) -> Type = list
348 ; cyclic_term(Term) -> Type = cyclic
349 ; compound(Term) -> Type = compound
350 ; Type = unknown
351 ).
352
353blob_type(BlobT, Type) :-
354 atom_concat(BlobT, '_reference', Type).
355
356syntax_error(end_of_clause) -->
357 [ 'Unexpected end of clause' ].
358syntax_error(end_of_clause_expected) -->
359 [ 'End of clause expected' ].
360syntax_error(end_of_file) -->
361 [ 'Unexpected end of file' ].
362syntax_error(end_of_file_in_block_comment) -->
363 [ 'End of file in /* ... */ comment' ].
364syntax_error(end_of_file_in_quoted(Quote)) -->
365 [ 'End of file in quoted ' ],
366 quoted_type(Quote).
367syntax_error(illegal_number) -->
368 [ 'Illegal number' ].
369syntax_error(long_atom) -->
370 [ 'Atom too long (see style_check/1)' ].
371syntax_error(long_string) -->
372 [ 'String too long (see style_check/1)' ].
373syntax_error(operator_clash) -->
374 [ 'Operator priority clash' ].
375syntax_error(operator_expected) -->
376 [ 'Operator expected' ].
377syntax_error(operator_balance) -->
378 [ 'Unbalanced operator' ].
379syntax_error(quoted_punctuation) -->
380 [ 'Operand expected, unquoted comma or bar found' ].
381syntax_error(list_rest) -->
382 [ 'Unexpected comma or bar in rest of list' ].
383syntax_error(cannot_start_term) -->
384 [ 'Illegal start of term' ].
385syntax_error(punct(Punct, End)) -->
386 [ 'Unexpected `~w\' before `~w\''-[Punct, End] ].
387syntax_error(undefined_char_escape(C)) -->
388 [ 'Unknown character escape in quoted atom or string: `\\~w\''-[C] ].
389syntax_error(void_not_allowed) -->
390 [ 'Empty argument list "()"' ].
391syntax_error(Term) -->
392 { compound(Term),
393 compound_name_arguments(Term, Syntax, [Text])
394 }, !,
395 [ '~w expected, found '-[Syntax], ansi(code, '"~w"', [Text]) ].
396syntax_error(Message) -->
397 [ '~w'-[Message] ].
398
399quoted_type('\'') --> [atom].
400quoted_type('\"') --> { current_prolog_flag(double_quotes, Type) }, [Type-[]].
401quoted_type('\`') --> { current_prolog_flag(back_quotes, Type) }, [Type-[]].
402
403domain(range(Low,High)) -->
404 !,
405 ['[~q..~q]'-[Low,High] ].
406domain(Domain) -->
407 ['`~w\''-[Domain] ].
408
413
414tabling_existence_error(Ball, Context) -->
415 { table_shift_ball(Ball) },
416 [ 'Tabling dependency error' ],
417 swi_extra(Context).
418
419table_shift_ball(dependency(_Head)).
420table_shift_ball(dependency(_Skeleton, _Trie, _Mono)).
421table_shift_ball(call_info(_Skeleton, _Status)).
422table_shift_ball(call_info(_GenSkeleton, _Skeleton, _Status)).
423
427
428dwim_predicates(Module:Name/_Arity, Dwims) :-
429 !,
430 findall(Dwim, dwim_predicate(Module:Name, Dwim), Dwims).
431dwim_predicates(Name/_Arity, Dwims) :-
432 findall(Dwim, dwim_predicate(user:Name, Dwim), Dwims).
433
434dwim_message([]) --> [].
435dwim_message([M:Head|T]) -->
436 { hidden_module(M),
437 !,
438 functor(Head, Name, Arity)
439 },
440 [ ' ~q'-[Name/Arity], nl ],
441 dwim_message(T).
442dwim_message([Module:Head|T]) -->
443 !,
444 { functor(Head, Name, Arity)
445 },
446 [ ' ~q'-[Module:Name/Arity], nl],
447 dwim_message(T).
448dwim_message([Head|T]) -->
449 {functor(Head, Name, Arity)},
450 [ ' ~q'-[Name/Arity], nl],
451 dwim_message(T).
452
453
454swi_message(io_error(Op, Stream)) -->
455 [ 'I/O error in ~w on stream ~p'-[Op, Stream] ].
456swi_message(thread_error(TID, false)) -->
457 [ 'Thread ~p died due to failure:'-[TID] ].
458swi_message(thread_error(TID, exception(Error))) -->
459 [ 'Thread ~p died abnormally:'-[TID], nl ],
460 translate_message(Error).
461swi_message(dependency_error(Tabled, DependsOn)) -->
462 dependency_error(Tabled, DependsOn).
463swi_message(shell(execute, Cmd)) -->
464 [ 'Could not execute `~w'''-[Cmd] ].
465swi_message(shell(signal(Sig), Cmd)) -->
466 [ 'Caught signal ~d on `~w'''-[Sig, Cmd] ].
467swi_message(format(Fmt, Args)) -->
468 [ Fmt-Args ].
469swi_message(signal(Name, Num)) -->
470 [ 'Caught signal ~d (~w)'-[Num, Name] ].
471swi_message(limit_exceeded(Limit, MaxVal)) -->
472 [ 'Exceeded ~w limit (~w)'-[Limit, MaxVal] ].
473swi_message(goal_failed(Goal)) -->
474 [ 'goal unexpectedly failed: ~p'-[Goal] ].
475swi_message(shared_object(_Action, Message)) --> 476 [ '~w'-[Message] ].
477swi_message(system_error(Error)) -->
478 [ 'error in system call: ~w'-[Error]
479 ].
480swi_message(system_error) -->
481 [ 'error in system call'
482 ].
483swi_message(failure_error(Goal)) -->
484 [ 'Goal failed: ~p'-[Goal] ].
485swi_message(timeout_error(Op, Stream)) -->
486 [ 'Timeout in ~w from ~p'-[Op, Stream] ].
487swi_message(not_implemented(Type, What)) -->
488 [ '~w `~p\' is not implemented in this version'-[Type, What] ].
489swi_message(context_error(nodirective, Goal)) -->
490 { goal_to_predicate_indicator(Goal, PI) },
491 [ 'Wrong context: ~p can only be used in a directive'-[PI] ].
492swi_message(context_error(edit, no_default_file)) -->
493 ( { current_prolog_flag(windows, true) }
494 -> [ 'Edit/0 can only be used after opening a \c
495 Prolog file by double-clicking it' ]
496 ; [ 'Edit/0 can only be used with the "-s file" commandline option'
497 ]
498 ),
499 [ nl, 'Use "?- edit(Topic)." or "?- emacs."' ].
500swi_message(context_error(function, meta_arg(S))) -->
501 [ 'Functions are not (yet) supported for meta-arguments of type ~q'-[S] ].
502swi_message(format_argument_type(Fmt, Arg)) -->
503 [ 'Illegal argument to format sequence ~~~w: ~p'-[Fmt, Arg] ].
504swi_message(format(Msg)) -->
505 [ 'Format error: ~w'-[Msg] ].
506swi_message(conditional_compilation_error(unterminated, File:Line)) -->
507 [ 'Unterminated conditional compilation from '-[], url(File:Line) ].
508swi_message(conditional_compilation_error(no_if, What)) -->
509 [ ':- ~w without :- if'-[What] ].
510swi_message(duplicate_key(Key)) -->
511 [ 'Duplicate key: ~p'-[Key] ].
512swi_message(initialization_error(failed, Goal, File:Line)) -->
513 !,
514 [ url(File:Line), ': ~p: false'-[Goal] ].
515swi_message(initialization_error(Error, Goal, File:Line)) -->
516 [ url(File:Line), ': ~p '-[Goal] ],
517 translate_message(Error).
518swi_message(determinism_error(PI, det, Found, property)) -->
519 ( { '$pi_head'(user:PI, Head),
520 predicate_property(Head, det)
521 }
522 -> [ 'Deterministic procedure ~p'-[PI] ]
523 ; [ 'Procedure ~p called from a deterministic procedure'-[PI] ]
524 ),
525 det_error(Found).
526swi_message(determinism_error(PI, det, fail, guard)) -->
527 [ 'Procedure ~p failed after $-guard'-[PI] ].
528swi_message(determinism_error(PI, det, fail, guard_in_caller)) -->
529 [ 'Procedure ~p failed after $-guard in caller'-[PI] ].
530swi_message(determinism_error(Goal, det, fail, goal)) -->
531 [ 'Goal ~p failed'-[Goal] ].
532swi_message(determinism_error(Goal, det, nondet, goal)) -->
533 [ 'Goal ~p succeeded with a choice point'-[Goal] ].
534swi_message(qlf_format_error(File, Message)) -->
535 [ '~w: Invalid QLF file: ~w'-[File, Message] ].
536swi_message(goal_expansion_error(bound, Term)) -->
537 [ 'Goal expansion bound a variable to ~p'-[Term] ].
538
539det_error(nondet) -->
540 [ ' succeeded with a choicepoint'- [] ].
541det_error(fail) -->
542 [ ' failed'- [] ].
543
544
549
550:- public swi_location//1. 551swi_location(X) -->
552 { var(X) },
553 !.
554swi_location(Context) -->
555 { message_lang(Lang) },
556 prolog:message_location(Lang, Context),
557 !.
558swi_location(Context) -->
559 prolog:message_location(Context),
560 !.
561swi_location(context(Caller, _Msg)) -->
562 { ground(Caller) },
563 !,
564 caller(Caller).
565swi_location(file(Path, Line, -1, _CharNo)) -->
566 !,
567 [ url(Path:Line), ': ' ].
568swi_location(file(Path, Line, LinePos, _CharNo)) -->
569 [ url(Path:Line:LinePos), ': ' ].
570swi_location(stream(Stream, Line, LinePos, CharNo)) -->
571 ( { is_stream(Stream),
572 stream_property(Stream, file_name(File))
573 }
574 -> swi_location(file(File, Line, LinePos, CharNo))
575 ; [ 'Stream ~w:~d:~d '-[Stream, Line, LinePos] ]
576 ).
577swi_location(autoload(File:Line)) -->
578 [ url(File:Line), ': ' ].
579swi_location(_) -->
580 [].
581
582caller(system:'$record_clause'/3) -->
583 !,
584 [].
585caller(Module:Name/Arity) -->
586 !,
587 ( { \+ hidden_module(Module) }
588 -> [ '~q:~q/~w: '-[Module, Name, Arity] ]
589 ; [ '~q/~w: '-[Name, Arity] ]
590 ).
591caller(Name/Arity) -->
592 [ '~q/~w: '-[Name, Arity] ].
593caller(Caller) -->
594 [ '~p: '-[Caller] ].
595
596
604
(X) -->
606 { var(X) },
607 !,
608 [].
609swi_extra(Context) -->
610 { message_lang(Lang) },
611 prolog:message_context(Lang, Context),
612 !.
613swi_extra(Context) -->
614 prolog:message_context(Context).
615swi_extra(context(_, Msg)) -->
616 { nonvar(Msg),
617 Msg \== ''
618 },
619 !,
620 swi_comment(Msg).
621swi_extra(string(String, CharPos)) -->
622 { sub_string(String, 0, CharPos, _, Before),
623 sub_string(String, CharPos, _, 0, After)
624 },
625 [ nl, '~w'-[Before], nl, '** here **', nl, '~w'-[After] ].
626swi_extra(_) -->
627 [].
628
(already_from(Module)) -->
630 !,
631 [ ' (already imported from ~q)'-[Module] ].
632swi_comment(directory(_Dir)) -->
633 !,
634 [ ' (is a directory)' ].
635swi_comment(not_a_directory(_Dir)) -->
636 !,
637 [ ' (is not a directory)' ].
638swi_comment(Msg) -->
639 [ ' (~w)'-[Msg] ].
640
641
642thread_context -->
643 { \+ current_prolog_flag(toplevel_thread, true),
644 thread_self(Id)
645 },
646 !,
647 ['[Thread ~w] '-[Id]].
648thread_context -->
649 [].
650
651 654
655unwind_message(Var) -->
656 { var(Var) }, !,
657 [ 'Unknown unwind message: ~p'-[Var] ].
658unwind_message(abort) -->
659 [ 'Execution Aborted' ].
660unwind_message(halt(_)) -->
661 [].
662unwind_message(thread_exit(Term)) -->
663 [ 'Invalid thread_exit/1. Payload: ~p'-[Term] ].
664unwind_message(Term) -->
665 [ 'Unknown "unwind" exception: ~p'-[Term] ].
666
667
668 671
672:- dynamic prolog:version_msg/1. 673:- multifile prolog:version_msg/1. 674
675prolog_message(welcome) -->
676 [ 'Welcome to SWI-Prolog (' ],
677 prolog_message(threads),
678 prolog_message(address_bits),
679 ['version ' ],
680 prolog_message(version),
681 [ ')', nl ],
682 prolog_message(copyright),
683 [ nl ],
684 translate_message(user_versions),
685 [ nl ],
686 prolog_message(documentaton),
687 [ nl, nl ].
688prolog_message(user_versions) -->
689 ( { findall(Msg, prolog:version_msg(Msg), Msgs),
690 Msgs \== []
691 }
692 -> [nl],
693 user_version_messages(Msgs)
694 ; []
695 ).
696prolog_message(deprecated(Term)) -->
697 { nonvar(Term) },
698 ( { message_lang(Lang) },
699 prolog:deprecated(Lang, Term)
700 -> []
701 ; prolog:deprecated(Term)
702 -> []
703 ; deprecated(Term)
704 ).
705prolog_message(unhandled_exception(E)) -->
706 { nonvar(E) },
707 [ 'Unhandled exception: ' ],
708 ( translate_message(E)
709 -> []
710 ; [ '~p'-[E] ]
711 ).
712
714
715prolog_message(initialization_error(_, E, File:Line)) -->
716 !,
717 [ url(File:Line),
718 ': Initialization goal raised exception:', nl
719 ],
720 translate_message(E).
721prolog_message(initialization_error(Goal, E, _)) -->
722 [ 'Initialization goal ~p raised exception:'-[Goal], nl ],
723 translate_message(E).
724prolog_message(initialization_failure(_Goal, File:Line)) -->
725 !,
726 [ url(File:Line),
727 ': Initialization goal failed'-[]
728 ].
729prolog_message(initialization_failure(Goal, _)) -->
730 [ 'Initialization goal failed: ~p'-[Goal]
731 ].
732prolog_message(initialization_exception(E)) -->
733 [ 'Prolog initialisation failed:', nl ],
734 translate_message(E).
735prolog_message(init_goal_syntax(Error, Text)) -->
736 !,
737 [ '-g ~w: '-[Text] ],
738 translate_message(Error).
739prolog_message(init_goal_failed(failed, @(Goal,File:Line))) -->
740 !,
741 [ url(File:Line), ': ~p: false'-[Goal] ].
742prolog_message(init_goal_failed(Error, @(Goal,File:Line))) -->
743 !,
744 [ url(File:Line), ': ~p '-[Goal] ],
745 translate_message(Error).
746prolog_message(init_goal_failed(failed, Text)) -->
747 !,
748 [ '-g ~w: false'-[Text] ].
749prolog_message(init_goal_failed(Error, Text)) -->
750 !,
751 [ '-g ~w: '-[Text] ],
752 translate_message(Error).
753prolog_message(goal_failed(Context, Goal)) -->
754 [ 'Goal (~w) failed: ~p'-[Context, Goal] ].
755prolog_message(no_current_module(Module)) -->
756 [ '~w is not a current module (created)'-[Module] ].
757prolog_message(commandline_arg_type(Flag, Arg)) -->
758 [ 'Bad argument to commandline option -~w: ~w'-[Flag, Arg] ].
759prolog_message(missing_feature(Name)) -->
760 [ 'This version of SWI-Prolog does not support ~w'-[Name] ].
761prolog_message(singletons(_Term, List)) -->
762 [ 'Singleton variables: ~w'-[List] ].
763prolog_message(multitons(_Term, List)) -->
764 [ 'Singleton-marked variables appearing more than once: ~w'-[List] ].
765prolog_message(profile_no_cpu_time) -->
766 [ 'No CPU-time info. Check the SWI-Prolog manual for details' ].
767prolog_message(non_ascii(Text, Type)) -->
768 [ 'Unquoted ~w with non-portable characters: ~w'-[Type, Text] ].
769prolog_message(io_warning(Stream, Message)) -->
770 { stream_property(Stream, position(Position)),
771 !,
772 stream_position_data(line_count, Position, LineNo),
773 stream_position_data(line_position, Position, LinePos),
774 ( stream_property(Stream, file_name(File))
775 -> Obj = File
776 ; Obj = Stream
777 )
778 },
779 [ '~p:~d:~d: ~w'-[Obj, LineNo, LinePos, Message] ].
780prolog_message(io_warning(Stream, Message)) -->
781 [ 'stream ~p: ~w'-[Stream, Message] ].
782prolog_message(option_usage(pldoc)) -->
783 [ 'Usage: --pldoc[=port]' ].
784prolog_message(interrupt(begin)) -->
785 [ 'Action (h for help) ? ', flush ].
786prolog_message(interrupt(end)) -->
787 [ 'continue' ].
788prolog_message(interrupt(trace)) -->
789 [ 'continue (trace mode)' ].
790prolog_message(unknown_in_module_user) -->
791 [ 'Using a non-error value for unknown in the global module', nl,
792 'causes most of the development environment to stop working.', nl,
793 'Please use :- dynamic or limit usage of unknown to a module.', nl,
794 'See https://www.swi-prolog.org/howto/database.html'
795 ].
796prolog_message(untable(PI)) -->
797 [ 'Reconsult: removed tabling for ~p'-[PI] ].
798prolog_message(unknown_option(Set, Opt)) -->
799 [ 'Unknown ~w option: ~p'-[Set, Opt] ].
800
801
802 805
806prolog_message(modify_active_procedure(Who, What)) -->
807 [ '~p: modified active procedure ~p'-[Who, What] ].
808prolog_message(load_file(failed(user:File))) -->
809 [ 'Failed to load ~p'-[File] ].
810prolog_message(load_file(failed(Module:File))) -->
811 [ 'Failed to load ~p into module ~p'-[File, Module] ].
812prolog_message(load_file(failed(File))) -->
813 [ 'Failed to load ~p'-[File] ].
814prolog_message(mixed_directive(Goal)) -->
815 [ 'Cannot pre-compile mixed load/call directive: ~p'-[Goal] ].
816prolog_message(cannot_redefine_comma) -->
817 [ 'Full stop in clause-body? Cannot redefine ,/2' ].
818prolog_message(illegal_autoload_index(Dir, Term)) -->
819 [ 'Illegal term in INDEX file of directory ~w: ~w'-[Dir, Term] ].
820prolog_message(redefined_procedure(Type, Proc)) -->
821 [ 'Redefined ~w procedure ~p'-[Type, Proc] ],
822 defined_definition('Previously defined', Proc).
823prolog_message(declare_module(Module, abolish(Predicates))) -->
824 [ 'Loading module ~w abolished: ~p'-[Module, Predicates] ].
825prolog_message(import_private(Module, Private)) -->
826 [ 'import/1: ~p is not exported (still imported into ~q)'-
827 [Private, Module]
828 ].
829prolog_message(ignored_weak_import(Into, From:PI)) -->
830 [ 'Local definition of ~p overrides weak import from ~q'-
831 [Into:PI, From]
832 ].
833prolog_message(undefined_export(Module, PI)) -->
834 [ 'Exported procedure ~q:~q is not defined'-[Module, PI] ].
835prolog_message(no_exported_op(Module, Op)) -->
836 [ 'Operator ~q:~q is not exported (still defined)'-[Module, Op] ].
837prolog_message(discontiguous((-)/2,_)) -->
838 prolog_message(minus_in_identifier).
839prolog_message(discontiguous(Proc,Current)) -->
840 [ 'Clauses of ', ansi(code, '~p', [Proc]),
841 ' are not together in the source-file', nl ],
842 current_definition(Proc, 'Earlier definition at '),
843 [ 'Current predicate: ', ansi(code, '~p', [Current]), nl,
844 'Use ', ansi(code, ':- discontiguous ~p.', [Proc]),
845 ' to suppress this message'
846 ].
847prolog_message(decl_no_effect(Goal)) -->
848 [ 'Deprecated declaration has no effect: ~p'-[Goal] ].
849prolog_message(load_file(start(Level, File))) -->
850 [ '~|~t~*+Loading '-[Level] ],
851 load_file(File),
852 [ ' ...' ].
853prolog_message(include_file(start(Level, File))) -->
854 [ '~|~t~*+include '-[Level] ],
855 load_file(File),
856 [ ' ...' ].
857prolog_message(include_file(done(Level, File))) -->
858 [ '~|~t~*+included '-[Level] ],
859 load_file(File).
860prolog_message(load_file(done(Level, File, Action, Module, Time, Clauses))) -->
861 [ '~|~t~*+'-[Level] ],
862 load_file(File),
863 [ ' ~w'-[Action] ],
864 load_module(Module),
865 [ ' ~2f sec, ~D clauses'-[Time, Clauses] ].
866prolog_message(dwim_undefined(Goal, Alternatives)) -->
867 { goal_to_predicate_indicator(Goal, Pred)
868 },
869 [ 'Unknown procedure: ~q'-[Pred], nl,
870 ' However, there are definitions for:', nl
871 ],
872 dwim_message(Alternatives).
873prolog_message(dwim_correct(Into)) -->
874 [ 'Correct to: ~q? '-[Into], flush ].
875prolog_message(error(loop_error(Spec), file_search(Used))) -->
876 [ 'File search: too many levels of indirections on: ~p'-[Spec], nl,
877 ' Used alias expansions:', nl
878 ],
879 used_search(Used).
880prolog_message(minus_in_identifier) -->
881 [ 'The "-" character should not be used to separate words in an', nl,
882 'identifier. Check the SWI-Prolog FAQ for details.'
883 ].
884prolog_message(qlf(removed_after_error(File))) -->
885 [ 'Removed incomplete QLF file ~w'-[File] ].
886prolog_message(qlf(recompile(Spec,_Pl,_Qlf,Reason))) -->
887 [ '~p: recompiling QLF file'-[Spec] ],
888 qlf_recompile_reason(Reason).
889prolog_message(qlf(can_not_recompile(Spec,QlfFile,_Reason))) -->
890 [ '~p: can not recompile "~w" (access denied)'-[Spec, QlfFile], nl,
891 '\tLoading from source'-[]
892 ].
893prolog_message(qlf(system_lib_out_of_date(Spec,QlfFile))) -->
894 [ '~p: can not recompile "~w" (access denied)'-[Spec, QlfFile], nl,
895 '\tLoading QlfFile'-[]
896 ].
897prolog_message(redefine_module(Module, OldFile, File)) -->
898 [ 'Module "~q" already loaded from ~w.'-[Module, OldFile], nl,
899 'Wipe and reload from ~w? '-[File], flush
900 ].
901prolog_message(redefine_module_reply) -->
902 [ 'Please answer y(es), n(o) or a(bort)' ].
903prolog_message(reloaded_in_module(Absolute, OldContext, LM)) -->
904 [ '~w was previously loaded in module ~w'-[Absolute, OldContext], nl,
905 '\tnow it is reloaded into module ~w'-[LM] ].
906prolog_message(expected_layout(Expected, Pos)) -->
907 [ 'Layout data: expected ~w, found: ~p'-[Expected, Pos] ].
908
909defined_definition(Message, Spec) -->
910 { strip_module(user:Spec, M, Name/Arity),
911 functor(Head, Name, Arity),
912 predicate_property(M:Head, file(File)),
913 predicate_property(M:Head, line_count(Line))
914 },
915 !,
916 [ nl, '~w at '-[Message], url(File:Line) ].
917defined_definition(_, _) --> [].
918
919used_search([]) -->
920 [].
921used_search([Alias=Expanded|T]) -->
922 [ ' file_search_path(~p, ~p)'-[Alias, Expanded], nl ],
923 used_search(T).
924
925load_file(file(Spec, _Path)) -->
926 ( {atomic(Spec)}
927 -> [ '~w'-[Spec] ]
928 ; [ '~p'-[Spec] ]
929 ).
932
933load_module(user) --> !.
934load_module(system) --> !.
935load_module(Module) -->
936 [ ' into ~w'-[Module] ].
937
938goal_to_predicate_indicator(Goal, PI) :-
939 strip_module(Goal, Module, Head),
940 callable_name_arity(Head, Name, Arity),
941 user_predicate_indicator(Module:Name/Arity, PI).
942
943callable_name_arity(Goal, Name, Arity) :-
944 compound(Goal),
945 !,
946 compound_name_arity(Goal, Name, Arity).
947callable_name_arity(Goal, Goal, 0) :-
948 atom(Goal).
949
950user_predicate_indicator(Module:PI, PI) :-
951 hidden_module(Module),
952 !.
953user_predicate_indicator(PI, PI).
954
955hidden_module(user) :- !.
956hidden_module(system) :- !.
957hidden_module(M) :-
958 sub_atom(M, 0, _, _, $).
959
960current_definition(Proc, Prefix) -->
961 { pi_uhead(Proc, Head),
962 predicate_property(Head, file(File)),
963 predicate_property(Head, line_count(Line))
964 },
965 [ '~w'-[Prefix], url(File:Line), nl ].
966current_definition(_, _) --> [].
967
968pi_uhead(Module:Name/Arity, Module:Head) :-
969 !,
970 atom(Module), atom(Name), integer(Arity),
971 functor(Head, Name, Arity).
972pi_uhead(Name/Arity, user:Head) :-
973 atom(Name), integer(Arity),
974 functor(Head, Name, Arity).
975
976qlf_recompile_reason(old) -->
977 !,
978 [ ' (out of date)'-[] ].
979qlf_recompile_reason(_) -->
980 [ ' (incompatible with current Prolog version)'-[] ].
981
982prolog_message(file_search(cache(Spec, _Cond), Path)) -->
983 [ 'File search: ~p --> ~p (cache)'-[Spec, Path] ].
984prolog_message(file_search(found(Spec, Cond), Path)) -->
985 [ 'File search: ~p --> ~p OK ~p'-[Spec, Path, Cond] ].
986prolog_message(file_search(tried(Spec, Cond), Path)) -->
987 [ 'File search: ~p --> ~p NO ~p'-[Spec, Path, Cond] ].
988
989 992
993prolog_message(agc(start)) -->
994 thread_context,
995 [ 'AGC: ', flush ].
996prolog_message(agc(done(Collected, Remaining, Time))) -->
997 [ at_same_line,
998 'reclaimed ~D atoms in ~3f sec. (remaining: ~D)'-
999 [Collected, Time, Remaining]
1000 ].
1001prolog_message(cgc(start)) -->
1002 thread_context,
1003 [ 'CGC: ', flush ].
1004prolog_message(cgc(done(CollectedClauses, _CollectedBytes,
1005 RemainingBytes, Time))) -->
1006 [ at_same_line,
1007 'reclaimed ~D clauses in ~3f sec. (pending: ~D bytes)'-
1008 [CollectedClauses, Time, RemainingBytes]
1009 ].
1010
1011 1014
1015out_of_stack(Context) -->
1016 { human_stack_size(Context.localused, Local),
1017 human_stack_size(Context.globalused, Global),
1018 human_stack_size(Context.trailused, Trail),
1019 human_stack_size(Context.stack_limit, Limit),
1020 LCO is (100*(Context.depth - Context.environments))/Context.depth
1021 },
1022 [ 'Stack limit (~s) exceeded'-[Limit], nl,
1023 ' Stack sizes: local: ~s, global: ~s, trail: ~s'-[Local,Global,Trail], nl,
1024 ' Stack depth: ~D, last-call: ~0f%, Choice points: ~D'-
1025 [Context.depth, LCO, Context.choicepoints], nl
1026 ],
1027 overflow_reason(Context, Resolve),
1028 resolve_overflow(Resolve).
1029
1030human_stack_size(Size, String) :-
1031 Size < 100,
1032 format(string(String), '~dKb', [Size]).
1033human_stack_size(Size, String) :-
1034 Size < 100 000,
1035 Value is Size / 1024,
1036 format(string(String), '~1fMb', [Value]).
1037human_stack_size(Size, String) :-
1038 Value is Size / (1024*1024),
1039 format(string(String), '~1fGb', [Value]).
1040
1041overflow_reason(Context, fix) -->
1042 show_non_termination(Context),
1043 !.
1044overflow_reason(Context, enlarge) -->
1045 { Stack = Context.get(stack) },
1046 !,
1047 [ ' In:'-[], nl ],
1048 stack(Stack).
1049overflow_reason(_Context, enlarge) -->
1050 [ ' Insufficient global stack'-[] ].
1051
1052show_non_termination(Context) -->
1053 ( { Stack = Context.get(cycle) }
1054 -> [ ' Probable infinite recursion (cycle):'-[], nl ]
1055 ; { Stack = Context.get(non_terminating) }
1056 -> [ ' Possible non-terminating recursion:'-[], nl ]
1057 ),
1058 stack(Stack).
1059
1060stack([]) --> [].
1061stack([frame(Depth, M:Goal, _)|T]) -->
1062 [ ' [~D] ~q:'-[Depth, M] ],
1063 stack_goal(Goal),
1064 [ nl ],
1065 stack(T).
1066
1067stack_goal(Goal) -->
1068 { compound(Goal),
1069 !,
1070 compound_name_arity(Goal, Name, Arity)
1071 },
1072 [ '~q('-[Name] ],
1073 stack_goal_args(1, Arity, Goal),
1074 [ ')'-[] ].
1075stack_goal(Goal) -->
1076 [ '~q'-[Goal] ].
1077
1078stack_goal_args(I, Arity, Goal) -->
1079 { I =< Arity,
1080 !,
1081 arg(I, Goal, A),
1082 I2 is I + 1
1083 },
1084 stack_goal_arg(A),
1085 ( { I2 =< Arity }
1086 -> [ ', '-[] ],
1087 stack_goal_args(I2, Arity, Goal)
1088 ; []
1089 ).
1090stack_goal_args(_, _, _) -->
1091 [].
1092
1093stack_goal_arg(A) -->
1094 { nonvar(A),
1095 A = [Len|T],
1096 !
1097 },
1098 ( {Len == cyclic_term}
1099 -> [ '[cyclic list]'-[] ]
1100 ; {T == []}
1101 -> [ '[length:~D]'-[Len] ]
1102 ; [ '[length:~D|~p]'-[Len, T] ]
1103 ).
1104stack_goal_arg(A) -->
1105 { nonvar(A),
1106 A = _/_,
1107 !
1108 },
1109 [ '<compound ~p>'-[A] ].
1110stack_goal_arg(A) -->
1111 [ '~p'-[A] ].
1112
1113resolve_overflow(fix) -->
1114 [].
1115resolve_overflow(enlarge) -->
1116 { current_prolog_flag(stack_limit, LimitBytes),
1117 NewLimit is LimitBytes * 2
1118 },
1119 [ nl,
1120 'Use the --stack_limit=size[KMG] command line option or'-[], nl,
1121 '?- set_prolog_flag(stack_limit, ~I). to double the limit.'-[NewLimit]
1122 ].
1123
1128
1129out_of_c_stack -->
1130 { statistics(c_stack, Limit), Limit > 0 },
1131 !,
1132 [ 'C-stack limit (~D bytes) exceeded.'-[Limit], nl ],
1133 resolve_c_stack_overflow(Limit).
1134out_of_c_stack -->
1135 { statistics(c_stack, Limit), Limit > 0 },
1136 [ 'C-stack limit exceeded.'-[Limit], nl ],
1137 resolve_c_stack_overflow(Limit).
1138
1139resolve_c_stack_overflow(_Limit) -->
1140 { thread_self(main) },
1141 [ 'Use the shell command ' ], code('~w', 'ulimit -s size'),
1142 [ ' to enlarge the limit.' ].
1143resolve_c_stack_overflow(_Limit) -->
1144 [ 'Use the ' ], code('~w', 'c_stack(KBytes)'),
1145 [ ' option of '], code(thread_create/3), [' to enlarge the limit.' ].
1146
1147
1148 1151
1152prolog_message(make(reload(Files))) -->
1153 { length(Files, N)
1154 },
1155 [ 'Make: reloading ~D files'-[N] ].
1156prolog_message(make(done(_Files))) -->
1157 [ 'Make: finished' ].
1158prolog_message(make(library_index(Dir))) -->
1159 [ 'Updating index for library ~w'-[Dir] ].
1160prolog_message(autoload(Pred, File)) -->
1161 thread_context,
1162 [ 'autoloading ~p from ~w'-[Pred, File] ].
1163prolog_message(autoload(read_index(Dir))) -->
1164 [ 'Loading autoload index for ~w'-[Dir] ].
1165prolog_message(autoload(disabled(Loaded))) -->
1166 [ 'Disabled autoloading (loaded ~D files)'-[Loaded] ].
1167prolog_message(autoload(already_defined(PI, From))) -->
1168 code(PI),
1169 ( { '$pi_head'(PI, Head),
1170 predicate_property(Head, built_in)
1171 }
1172 -> [' is a built-in predicate']
1173 ; [ ' is already imported from module ' ],
1174 code(From)
1175 ).
1176
1177swi_message(autoload(Msg)) -->
1178 [ nl, ' ' ],
1179 autoload_message(Msg).
1180
1181autoload_message(not_exported(PI, Spec, _FullFile, _Exports)) -->
1182 [ ansi(code, '~w', [Spec]),
1183 ' does not export ',
1184 ansi(code, '~p', [PI])
1185 ].
1186autoload_message(no_file(Spec)) -->
1187 [ ansi(code, '~p', [Spec]), ': No such file' ].
1188
1189
1190 1193
1196
1197prolog_message(compiler_warnings(Clause, Warnings0)) -->
1198 { print_goal_options(DefOptions),
1199 ( prolog_load_context(variable_names, VarNames)
1200 -> warnings_with_named_vars(Warnings0, VarNames, Warnings),
1201 Options = [variable_names(VarNames)|DefOptions]
1202 ; Options = DefOptions,
1203 Warnings = Warnings0
1204 )
1205 },
1206 compiler_warnings(Warnings, Clause, Options).
1207
1208warnings_with_named_vars([], _, []).
1209warnings_with_named_vars([H|T0], VarNames, [H|T]) :-
1210 term_variables(H, Vars),
1211 '$member'(V1, Vars),
1212 '$member'(_=V2, VarNames),
1213 V1 == V2,
1214 !,
1215 warnings_with_named_vars(T0, VarNames, T).
1216warnings_with_named_vars([_|T0], VarNames, T) :-
1217 warnings_with_named_vars(T0, VarNames, T).
1218
1219
1220compiler_warnings([], _, _) --> [].
1221compiler_warnings([H|T], Clause, Options) -->
1222 ( compiler_warning(H, Clause, Options)
1223 -> []
1224 ; [ 'Unknown compiler warning: ~W'-[H,Options] ]
1225 ),
1226 ( {T==[]}
1227 -> []
1228 ; [nl]
1229 ),
1230 compiler_warnings(T, Clause, Options).
1231
1232compiler_warning(eq_vv(A,B), _Clause, Options) -->
1233 ( { A == B }
1234 -> [ 'Test is always true: ~W'-[A==B, Options] ]
1235 ; [ 'Test is always false: ~W'-[A==B, Options] ]
1236 ).
1237compiler_warning(eq_singleton(A,B), _Clause, Options) -->
1238 [ 'Test is always false: ~W'-[A==B, Options] ].
1239compiler_warning(neq_vv(A,B), _Clause, Options) -->
1240 ( { A \== B }
1241 -> [ 'Test is always true: ~W'-[A\==B, Options] ]
1242 ; [ 'Test is always false: ~W'-[A\==B, Options] ]
1243 ).
1244compiler_warning(neq_singleton(A,B), _Clause, Options) -->
1245 [ 'Test is always true: ~W'-[A\==B, Options] ].
1246compiler_warning(unify_singleton(A,B), _Clause, Options) -->
1247 [ 'Unified variable is not used: ~W'-[A=B, Options] ].
1248compiler_warning(always(Bool, Pred, Arg), _Clause, Options) -->
1249 { Goal =.. [Pred,Arg] },
1250 [ 'Test is always ~w: ~W'-[Bool, Goal, Options] ].
1251compiler_warning(unbalanced_var(V), _Clause, Options) -->
1252 [ 'Variable not introduced in all branches: ~W'-[V, Options] ].
1253compiler_warning(branch_singleton(V), _Clause, Options) -->
1254 [ 'Singleton variable in branch: ~W'-[V, Options] ].
1255compiler_warning(negation_singleton(V), _Clause, Options) -->
1256 [ 'Singleton variable in \\+: ~W'-[V, Options] ].
1257compiler_warning(multiton(V), _Clause, Options) -->
1258 [ 'Singleton-marked variable appears more than once: ~W'-[V, Options] ].
1259
1260print_goal_options(
1261 [ quoted(true),
1262 portray(true)
1263 ]).
1264
1265
1266 1269
1270prolog_message(version) -->
1271 { current_prolog_flag(version_git, Version) },
1272 !,
1273 [ '~w'-[Version] ].
1274prolog_message(version) -->
1275 { current_prolog_flag(version_data, swi(Major,Minor,Patch,Options))
1276 },
1277 ( { memberchk(tag(Tag), Options) }
1278 -> [ '~w.~w.~w-~w'-[Major, Minor, Patch, Tag] ]
1279 ; [ '~w.~w.~w'-[Major, Minor, Patch] ]
1280 ).
1281prolog_message(address_bits) -->
1282 { current_prolog_flag(address_bits, Bits)
1283 },
1284 !,
1285 [ '~d bits, '-[Bits] ].
1286prolog_message(threads) -->
1287 { current_prolog_flag(threads, true)
1288 },
1289 !,
1290 [ 'threaded, ' ].
1291prolog_message(threads) -->
1292 [].
1293prolog_message(copyright) -->
1294 [ 'SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software.', nl,
1295 'Please run ', ansi(code, '?- license.', []), ' for legal details.'
1296 ].
1297prolog_message(documentaton) -->
1298 [ 'For online help and background, visit ', url('https://www.swi-prolog.org') ],
1299 ( { exists_source(library(help)) }
1300 -> [ nl,
1301 'For built-in help, use ', ansi(code, '?- help(Topic).', []),
1302 ' or ', ansi(code, '?- apropos(Word).', [])
1303 ]
1304 ; []
1305 ).
1306prolog_message(about) -->
1307 [ 'SWI-Prolog version (' ],
1308 prolog_message(threads),
1309 prolog_message(address_bits),
1310 ['version ' ],
1311 prolog_message(version),
1312 [ ')', nl ],
1313 prolog_message(copyright).
1314prolog_message(halt) -->
1315 [ 'halt' ].
1316prolog_message(break(begin, Level)) -->
1317 [ 'Break level ~d'-[Level] ].
1318prolog_message(break(end, Level)) -->
1319 [ 'Exit break level ~d'-[Level] ].
1320prolog_message(var_query(_)) -->
1321 [ '... 1,000,000 ............ 10,000,000 years later', nl, nl,
1322 '~t~8|>> 42 << (last release gives the question)'
1323 ].
1324prolog_message(close_on_abort(Stream)) -->
1325 [ 'Abort: closed stream ~p'-[Stream] ].
1326prolog_message(cancel_halt(Reason)) -->
1327 [ 'Halt cancelled: ~p'-[Reason] ].
1328prolog_message(on_error(halt(Status))) -->
1329 { statistics(errors, Errors),
1330 statistics(warnings, Warnings)
1331 },
1332 [ 'Halting with status ~w due to ~D errors and ~D warnings'-
1333 [Status, Errors, Warnings] ].
1334
1335prolog_message(query(QueryResult)) -->
1336 query_result(QueryResult).
1337
1338query_result(no) --> 1339 [ ansi(truth(false), 'false.', []) ],
1340 extra_line.
1341query_result(yes(true, [])) --> 1342 !,
1343 [ ansi(truth(true), 'true.', []) ],
1344 extra_line.
1345query_result(yes(Delays, Residuals)) -->
1346 result([], Delays, Residuals),
1347 extra_line.
1348query_result(done) --> 1349 extra_line.
1350query_result(yes(Bindings, Delays, Residuals)) -->
1351 result(Bindings, Delays, Residuals),
1352 prompt(yes, Bindings, Delays, Residuals).
1353query_result(more(Bindings, Delays, Residuals)) -->
1354 result(Bindings, Delays, Residuals),
1355 prompt(more, Bindings, Delays, Residuals).
1356:- if(current_prolog_flag(emscripten, true)). 1357query_result(help) -->
1358 [ ansi(bold, ' Possible actions:', []), nl,
1359 ' ; (n,r,space): redo | t: trace&redo'-[], nl,
1360 ' *: show choicepoint | . (c,a): stop'-[], nl,
1361 ' w: write | p: print'-[], nl,
1362 ' +: max_depth*5 | -: max_depth//5'-[], nl,
1363 ' h (?): help'-[],
1364 nl, nl
1365 ].
1366:- else. 1367query_result(help) -->
1368 [ ansi(bold, ' Possible actions:', []), nl,
1369 ' ; (n,r,space,TAB): redo | t: trace&redo'-[], nl,
1370 ' *: show choicepoint | . (c,a,RET): stop'-[], nl,
1371 ' w: write | p: print'-[], nl,
1372 ' +: max_depth*5 | -: max_depth//5'-[], nl,
1373 ' b: break | h (?): help'-[],
1374 nl, nl
1375 ].
1376:- endif. 1377query_result(action) -->
1378 [ 'Action? '-[], flush ].
1379query_result(confirm) -->
1380 [ 'Please answer \'y\' or \'n\'? '-[], flush ].
1381query_result(eof) -->
1382 [ nl ].
1383query_result(toplevel_open_line) -->
1384 [].
1385
1386prompt(Answer, [], true, []-[]) -->
1387 !,
1388 prompt(Answer, empty).
1389prompt(Answer, _, _, _) -->
1390 !,
1391 prompt(Answer, non_empty).
1392
1393prompt(yes, empty) -->
1394 !,
1395 [ ansi(truth(true), 'true.', []) ],
1396 extra_line.
1397prompt(yes, _) -->
1398 !,
1399 [ full_stop ],
1400 extra_line.
1401prompt(more, empty) -->
1402 !,
1403 [ ansi(truth(true), 'true ', []), flush ].
1404prompt(more, _) -->
1405 !,
1406 [ ' '-[], flush ].
1407
1408result(Bindings, Delays, Residuals) -->
1409 { current_prolog_flag(answer_write_options, Options0),
1410 Options = [partial(true)|Options0],
1411 GOptions = [priority(999)|Options0]
1412 },
1413 wfs_residual_program(Delays, GOptions),
1414 bindings(Bindings, [priority(699)|Options]),
1415 ( {Residuals == []-[]}
1416 -> bind_delays_sep(Bindings, Delays),
1417 delays(Delays, GOptions)
1418 ; bind_res_sep(Bindings, Residuals),
1419 residuals(Residuals, GOptions),
1420 ( {Delays == true}
1421 -> []
1422 ; [','-[], nl],
1423 delays(Delays, GOptions)
1424 )
1425 ).
1426
1427bindings([], _) -->
1428 [].
1429bindings([binding(Names,Skel,Subst)|T], Options) -->
1430 { '$last'(Names, Name) },
1431 var_names(Names), value(Name, Skel, Subst, Options),
1432 ( { T \== [] }
1433 -> [ ','-[], nl ],
1434 bindings(T, Options)
1435 ; []
1436 ).
1437
1438var_names([Name]) -->
1439 !,
1440 [ '~w = '-[Name] ].
1441var_names([Name1,Name2|T]) -->
1442 !,
1443 [ '~w = ~w, '-[Name1, Name2] ],
1444 var_names([Name2|T]).
1445
1446
1447value(Name, Skel, Subst, Options) -->
1448 ( { var(Skel), Subst = [Skel=S] }
1449 -> { Skel = '$VAR'(Name) },
1450 [ '~W'-[S, Options] ]
1451 ; [ '~W'-[Skel, Options] ],
1452 substitution(Subst, Options)
1453 ).
1454
1455substitution([], _) --> !.
1456substitution([N=V|T], Options) -->
1457 [ ', ', ansi(comment, '% where', []), nl,
1458 ' ~w = ~W'-[N,V,Options] ],
1459 substitutions(T, Options).
1460
1461substitutions([], _) --> [].
1462substitutions([N=V|T], Options) -->
1463 [ ','-[], nl, ' ~w = ~W'-[N,V,Options] ],
1464 substitutions(T, Options).
1465
1466
1467residuals(Normal-Hidden, Options) -->
1468 residuals1(Normal, Options),
1469 bind_res_sep(Normal, Hidden),
1470 ( {Hidden == []}
1471 -> []
1472 ; [ansi(comment, '% with pending residual goals', []), nl]
1473 ),
1474 residuals1(Hidden, Options).
1475
1476residuals1([], _) -->
1477 [].
1478residuals1([G|Gs], Options) -->
1479 ( { Gs \== [] }
1480 -> [ '~W,'-[G, Options], nl ],
1481 residuals1(Gs, Options)
1482 ; [ '~W'-[G, Options] ]
1483 ).
1484
1485wfs_residual_program(true, _Options) -->
1486 !.
1487wfs_residual_program(Goal, _Options) -->
1488 { current_prolog_flag(toplevel_list_wfs_residual_program, true),
1489 '$current_typein_module'(TypeIn),
1490 ( current_predicate(delays_residual_program/2)
1491 -> true
1492 ; use_module(library(wfs), [delays_residual_program/2])
1493 ),
1494 delays_residual_program(TypeIn:Goal, TypeIn:Program),
1495 Program \== []
1496 },
1497 !,
1498 [ ansi(comment, '% WFS residual program', []), nl ],
1499 [ ansi(wfs(residual_program), '~@', ['$messages':list_clauses(Program)]) ].
1500wfs_residual_program(_, _) --> [].
1501
1502delays(true, _Options) -->
1503 !.
1504delays(Goal, Options) -->
1505 { current_prolog_flag(toplevel_list_wfs_residual_program, true)
1506 },
1507 !,
1508 [ ansi(truth(undefined), '~W', [Goal, Options]) ].
1509delays(_, _Options) -->
1510 [ ansi(truth(undefined), undefined, []) ].
1511
1512:- public list_clauses/1. 1513
1514list_clauses([]).
1515list_clauses([H|T]) :-
1516 ( system_undefined(H)
1517 -> true
1518 ; portray_clause(user_output, H, [indent(4)])
1519 ),
1520 list_clauses(T).
1521
1522system_undefined((undefined :- tnot(undefined))).
1523system_undefined((answer_count_restraint :- tnot(answer_count_restraint))).
1524system_undefined((radial_restraint :- tnot(radial_restraint))).
1525
1526bind_res_sep(_, []) --> !.
1527bind_res_sep(_, []-[]) --> !.
1528bind_res_sep([], _) --> !.
1529bind_res_sep(_, _) --> [','-[], nl].
1530
1531bind_delays_sep([], _) --> !.
1532bind_delays_sep(_, true) --> !.
1533bind_delays_sep(_, _) --> [','-[], nl].
1534
-->
1536 { current_prolog_flag(toplevel_extra_white_line, true) },
1537 !,
1538 ['~N'-[]].
1539extra_line -->
1540 [].
1541
1542prolog_message(if_tty(Message)) -->
1543 ( {current_prolog_flag(tty_control, true)}
1544 -> [ at_same_line ], list(Message)
1545 ; []
1546 ).
1547prolog_message(halt(Reason)) -->
1548 [ '~w: halt'-[Reason] ].
1549prolog_message(no_action(Char)) -->
1550 [ 'Unknown action: ~c (h for help)'-[Char], nl ].
1551
1552prolog_message(history(help(Show, Help))) -->
1553 [ 'History Commands:', nl,
1554 ' !!. Repeat last query', nl,
1555 ' !nr. Repeat query numbered <nr>', nl,
1556 ' !str. Repeat last query starting with <str>', nl,
1557 ' !?str. Repeat last query holding <str>', nl,
1558 ' ^old^new. Substitute <old> into <new> of last query', nl,
1559 ' !nr^old^new. Substitute in query numbered <nr>', nl,
1560 ' !str^old^new. Substitute in query starting with <str>', nl,
1561 ' !?str^old^new. Substitute in query holding <str>', nl,
1562 ' ~w.~21|Show history list'-[Show], nl,
1563 ' ~w.~21|Show this list'-[Help], nl, nl
1564 ].
1565prolog_message(history(no_event)) -->
1566 [ '! No such event' ].
1567prolog_message(history(bad_substitution)) -->
1568 [ '! Bad substitution' ].
1569prolog_message(history(expanded(Event))) -->
1570 [ '~w.'-[Event] ].
1571prolog_message(history(history(Events))) -->
1572 history_events(Events).
1573
1574history_events([]) -->
1575 [].
1576history_events([Nr/Event|T]) -->
1577 [ '~t~w ~8|~W~W'-[ Nr,
1578 Event, [partial(true)],
1579 '.', [partial(true)]
1580 ],
1581 nl
1582 ],
1583 history_events(T).
1584
1585
1590
1591user_version_messages([]) --> [].
1592user_version_messages([H|T]) -->
1593 user_version_message(H),
1594 user_version_messages(T).
1595
1597
1598user_version_message(Term) -->
1599 translate_message(Term), !, [nl].
1600user_version_message(Atom) -->
1601 [ '~w'-[Atom], nl ].
1602
1603
1604 1607
1608prolog_message(spy(Head)) -->
1609 { goal_to_predicate_indicator(Head, Pred)
1610 },
1611 [ 'Spy point on ~p'-[Pred] ].
1612prolog_message(nospy(Head)) -->
1613 { goal_to_predicate_indicator(Head, Pred)
1614 },
1615 [ 'Spy point removed from ~p'-[Pred] ].
1616prolog_message(trace_mode(OnOff)) -->
1617 [ 'Trace mode switched to ~w'-[OnOff] ].
1618prolog_message(debug_mode(OnOff)) -->
1619 [ 'Debug mode switched to ~w'-[OnOff] ].
1620prolog_message(debugging(OnOff)) -->
1621 [ 'Debug mode is ~w'-[OnOff] ].
1622prolog_message(spying([])) -->
1623 !,
1624 [ 'No spy points' ].
1625prolog_message(spying(Heads)) -->
1626 [ 'Spy points (see spy/1) on:', nl ],
1627 predicate_list(Heads).
1628prolog_message(trace(Head, [])) -->
1629 !,
1630 [ ' ' ], goal_predicate(Head), [ ' Not tracing'-[], nl].
1631prolog_message(trace(Head, Ports)) -->
1632 { '$member'(Port, Ports), compound(Port),
1633 !,
1634 numbervars(Head+Ports, 0, _, [singletons(true)])
1635 },
1636 [ ' ~p: ~p'-[Head,Ports] ].
1637prolog_message(trace(Head, Ports)) -->
1638 [ ' ' ], goal_predicate(Head), [ ': ~w'-[Ports], nl].
1639prolog_message(tracing([])) -->
1640 !,
1641 [ 'No traced predicates (see trace/1,2)' ].
1642prolog_message(tracing(Heads)) -->
1643 [ 'Trace points (see trace/1,2) on:', nl ],
1644 tracing_list(Heads).
1645
1646goal_predicate(Head) -->
1647 { predicate_property(Head, file(File)),
1648 predicate_property(Head, line_count(Line)),
1649 goal_to_predicate_indicator(Head, PI),
1650 term_string(PI, PIS, [quoted(true)])
1651 },
1652 [ url(File:Line, PIS) ].
1653goal_predicate(Head) -->
1654 { goal_to_predicate_indicator(Head, PI)
1655 },
1656 [ '~p'-[PI] ].
1657
1658
1659predicate_list([]) --> 1660 [].
1661predicate_list([H|T]) -->
1662 [ ' ' ], goal_predicate(H), [nl],
1663 predicate_list(T).
1664
1665tracing_list([]) -->
1666 [].
1667tracing_list([trace(Head, Ports)|T]) -->
1668 translate_message(trace(Head, Ports)),
1669 tracing_list(T).
1670
1672prolog_message(frame(Frame, _Choice, backtrace, _PC)) -->
1673 !,
1674 { prolog_frame_attribute(Frame, level, Level)
1675 },
1676 [ ansi(frame(level), '~t[~D] ~10|', [Level]) ],
1677 frame_context(Frame),
1678 frame_goal(Frame).
1679prolog_message(frame(Frame, _Choice, choice, PC)) -->
1680 !,
1681 prolog_message(frame(Frame, backtrace, PC)).
1682prolog_message(frame(_, _Choice, cut_call(_PC), _)) --> !.
1683prolog_message(frame(Frame, _Choice, Port, _PC)) -->
1684 frame_flags(Frame),
1685 port(Port),
1686 frame_level(Frame),
1687 frame_context(Frame),
1688 frame_depth_limit(Port, Frame),
1689 frame_goal(Frame),
1690 [ flush ].
1691
1693prolog_message(frame(Goal, trace(Port))) -->
1694 !,
1695 thread_context,
1696 [ ' T ' ],
1697 port(Port),
1698 goal(Goal).
1699prolog_message(frame(Goal, trace(Port, Id))) -->
1700 !,
1701 thread_context,
1702 [ ' T ' ],
1703 port(Port, Id),
1704 goal(Goal).
1705
1706frame_goal(Frame) -->
1707 { prolog_frame_attribute(Frame, goal, Goal)
1708 },
1709 goal(Goal).
1710
1711goal(Goal0) -->
1712 { clean_goal(Goal0, Goal),
1713 current_prolog_flag(debugger_write_options, Options)
1714 },
1715 [ '~W'-[Goal, Options] ].
1716
1717frame_level(Frame) -->
1718 { prolog_frame_attribute(Frame, level, Level)
1719 },
1720 [ '(~D) '-[Level] ].
1721
1722frame_context(Frame) -->
1723 ( { current_prolog_flag(debugger_show_context, true),
1724 prolog_frame_attribute(Frame, context_module, Context)
1725 }
1726 -> [ '[~w] '-[Context] ]
1727 ; []
1728 ).
1729
1730frame_depth_limit(fail, Frame) -->
1731 { prolog_frame_attribute(Frame, depth_limit_exceeded, true)
1732 },
1733 !,
1734 [ '[depth-limit exceeded] ' ].
1735frame_depth_limit(_, _) -->
1736 [].
1737
1738frame_flags(Frame) -->
1739 { prolog_frame_attribute(Frame, goal, Goal),
1740 ( predicate_property(Goal, transparent)
1741 -> T = '^'
1742 ; T = ' '
1743 ),
1744 ( predicate_property(Goal, spying)
1745 -> S = '*'
1746 ; S = ' '
1747 )
1748 },
1749 [ '~w~w '-[T, S] ].
1750
1752port(Port, Dict) -->
1753 { _{level:Level, start:Time} :< Dict
1754 },
1755 ( { Port \== call,
1756 get_time(Now),
1757 Passed is (Now - Time)*1000.0
1758 }
1759 -> [ '[~d +~1fms] '-[Level, Passed] ]
1760 ; [ '[~d] '-[Level] ]
1761 ),
1762 port(Port).
1763port(Port, _Id-Level) -->
1764 [ '[~d] '-[Level] ],
1765 port(Port).
1766
1767port(PortTerm) -->
1768 { functor(PortTerm, Port, _),
1769 port_name(Port, Name)
1770 },
1771 !,
1772 [ ansi(port(Port), '~w: ', [Name]) ].
1773
1774port_name(call, 'Call').
1775port_name(exit, 'Exit').
1776port_name(fail, 'Fail').
1777port_name(redo, 'Redo').
1778port_name(unify, 'Unify').
1779port_name(exception, 'Exception').
1780
1781clean_goal(M:Goal, Goal) :-
1782 hidden_module(M),
1783 !.
1784clean_goal(M:Goal, Goal) :-
1785 predicate_property(M:Goal, built_in),
1786 !.
1787clean_goal(Goal, Goal).
1788
1789
1790 1793
1794prolog_message(compatibility(renamed(Old, New))) -->
1795 [ 'The predicate ~p has been renamed to ~p.'-[Old, New], nl,
1796 'Please update your sources for compatibility with future versions.'
1797 ].
1798
1799
1800 1803
1804prolog_message(abnormal_thread_completion(Goal, exception(Ex))) -->
1805 !,
1806 [ 'Thread running "~p" died on exception: '-[Goal] ],
1807 translate_message(Ex).
1808prolog_message(abnormal_thread_completion(Goal, fail)) -->
1809 [ 'Thread running "~p" died due to failure'-[Goal] ].
1810prolog_message(threads_not_died(Running)) -->
1811 [ 'The following threads wouldn\'t die: ~p'-[Running] ].
1812
1813
1814 1817
1818prolog_message(pack(attached(Pack, BaseDir))) -->
1819 [ 'Attached package ~w at ~q'-[Pack, BaseDir] ].
1820prolog_message(pack(duplicate(Entry, OldDir, Dir))) -->
1821 [ 'Package ~w already attached at ~q.'-[Entry,OldDir], nl,
1822 '\tIgnoring version from ~q'- [Dir]
1823 ].
1824prolog_message(pack(no_arch(Entry, Arch))) -->
1825 [ 'Package ~w: no binary for architecture ~w'-[Entry, Arch] ].
1826
1827 1830
1831prolog_message(null_byte_in_path(Component)) -->
1832 [ '0-byte in PATH component: ~p (skipped directory)'-[Component] ].
1833prolog_message(invalid_tmp_dir(Dir, Reason)) -->
1834 [ 'Cannot use ~p as temporary file directory: ~w'-[Dir, Reason] ].
1835prolog_message(ambiguous_stream_pair(Pair)) -->
1836 [ 'Ambiguous operation on stream pair ~p'-[Pair] ].
1837prolog_message(backcomp(init_file_moved(FoundFile))) -->
1838 { absolute_file_name(app_config('init.pl'), InitFile,
1839 [ file_errors(fail)
1840 ])
1841 },
1842 [ 'The location of the config file has moved'-[], nl,
1843 ' from "~w"'-[FoundFile], nl,
1844 ' to "~w"'-[InitFile], nl,
1845 ' See https://www.swi-prolog.org/modified/config-files.html'-[]
1846 ].
1847prolog_message(not_accessed_flags(List)) -->
1848 [ 'The following Prolog flags have been set but not used:', nl ],
1849 flags(List).
1850prolog_message(prolog_flag_invalid_preset(Flag, Preset, _Type, New)) -->
1851 [ 'Prolog flag ', ansi(code, '~q', Flag), ' has been (re-)created with a type that is \c
1852 incompatible with its value.', nl,
1853 'Value updated from ', ansi(code, '~p', [Preset]), ' to default (',
1854 ansi(code, '~p', [New]), ')'
1855 ].
1856
1857
1858flags([H|T]) -->
1859 [' ', ansi(code, '~q', [H])],
1860 ( {T == []}
1861 -> []
1862 ; [nl],
1863 flags(T)
1864 ).
1865
1866
1867 1870
1871deprecated(set_prolog_stack(_Stack,limit)) -->
1872 [ 'set_prolog_stack/2: limit(Size) sets the combined limit.'-[], nl,
1873 'See https://www.swi-prolog.org/changes/stack-limit.html'
1874 ].
1875deprecated(autoload(TargetModule, File, _M:PI, expansion)) -->
1876 !,
1877 [ 'Auto-loading ', ansi(code, '~p', [PI]), ' from ' ],
1878 load_file(File), [ ' into ' ],
1879 target_module(TargetModule),
1880 [ ' is deprecated due to term- or goal-expansion' ].
1881deprecated(source_search_working_directory(File, _FullFile)) -->
1882 [ 'Found file ', ansi(code, '~w', [File]),
1883 ' relative to the current working directory.', nl,
1884 'This behaviour is deprecated but still supported by', nl,
1885 'the Prolog flag ',
1886 ansi(code, source_search_working_directory, []), '.', nl
1887 ].
1888
1889load_file(File) -->
1890 { file_base_name(File, Base),
1891 absolute_file_name(library(Base), File, [access(read), file_errors(fail)]),
1892 file_name_extension(Clean, pl, Base)
1893 },
1894 !,
1895 [ ansi(code, '~p', [library(Clean)]) ].
1896load_file(File) -->
1897 [ url(File) ].
1898
1899target_module(Module) -->
1900 { module_property(Module, file(File)) },
1901 !,
1902 load_file(File).
1903target_module(Module) -->
1904 [ 'module ', ansi(code, '~p', [Module]) ].
1905
1906
1907
1908 1911
1912tripwire_message(max_integer_size, Bytes) -->
1913 !,
1914 [ 'Trapped tripwire max_integer_size: big integers and \c
1915 rationals are limited to ~D bytes'-[Bytes] ].
1916tripwire_message(Wire, Context) -->
1917 [ 'Trapped tripwire ~w for '-[Wire] ],
1918 tripwire_context(Wire, Context).
1919
1920tripwire_context(_, ATrie) -->
1921 { '$is_answer_trie'(ATrie, _),
1922 !,
1923 '$tabling':atrie_goal(ATrie, QGoal),
1924 user_predicate_indicator(QGoal, Goal)
1925 },
1926 [ '~p'-[Goal] ].
1927tripwire_context(_, Ctx) -->
1928 [ '~p'-[Ctx] ].
1929
1930
1931 1934
1935:- create_prolog_flag(message_language, default, []). 1936
1941
1942message_lang(Lang) :-
1943 current_message_lang(Lang0),
1944 ( Lang0 == en
1945 -> Lang = en
1946 ; sub_atom(Lang0, 0, _, _, en_)
1947 -> longest_id(Lang0, Lang)
1948 ; ( longest_id(Lang0, Lang)
1949 ; Lang = en
1950 )
1951 ).
1952
1953longest_id(Lang, Id) :-
1954 split_string(Lang, "_-", "", [H|Components]),
1955 longest_prefix(Components, Taken),
1956 atomic_list_concat([H|Taken], '_', Id).
1957
1958longest_prefix([H|T0], [H|T]) :-
1959 longest_prefix(T0, T).
1960longest_prefix(_, []).
1961
1965
1966current_message_lang(Lang) :-
1967 ( current_prolog_flag(message_language, Lang0),
1968 Lang0 \== default
1969 -> Lang = Lang0
1970 ; os_user_lang(Lang0)
1971 -> clean_encoding(Lang0, Lang1),
1972 set_prolog_flag(message_language, Lang1),
1973 Lang = Lang1
1974 ; Lang = en
1975 ).
1976
1977os_user_lang(Lang) :-
1978 current_prolog_flag(windows, true),
1979 win_get_user_preferred_ui_languages(name, [Lang|_]).
1980os_user_lang(Lang) :-
1981 catch(setlocale(messages, _, ''), _, fail),
1982 setlocale(messages, Lang, Lang).
1983os_user_lang(Lang) :-
1984 getenv('LANG', Lang).
1985
1986
1987clean_encoding(Lang0, Lang) :-
1988 ( sub_atom(Lang0, A, _, _, '.')
1989 -> sub_atom(Lang0, 0, A, _, Lang)
1990 ; Lang = Lang0
1991 ).
1992
1993 1996
1997code(Term) -->
1998 code('~p', Term).
1999
2000code(Format, Term) -->
2001 [ ansi(code, Format, [Term]) ].
2002
2003list([]) --> [].
2004list([H|T]) --> [H], list(T).
2005
2006
2007 2010
2011:- public default_theme/2. 2012
2013default_theme(var, [fg(red)]).
2014default_theme(code, [fg(blue)]).
2015default_theme(comment, [fg(green)]).
2016default_theme(warning, [fg(red)]).
2017default_theme(error, [bold, fg(red)]).
2018default_theme(truth(false), [bold, fg(red)]).
2019default_theme(truth(true), [bold]).
2020default_theme(truth(undefined), [bold, fg(cyan)]).
2021default_theme(wfs(residual_program), [fg(cyan)]).
2022default_theme(frame(level), [bold]).
2023default_theme(port(call), [bold, fg(green)]).
2024default_theme(port(exit), [bold, fg(green)]).
2025default_theme(port(fail), [bold, fg(red)]).
2026default_theme(port(redo), [bold, fg(yellow)]).
2027default_theme(port(unify), [bold, fg(blue)]).
2028default_theme(port(exception), [bold, fg(magenta)]).
2029default_theme(message(informational), [fg(green)]).
2030default_theme(message(information), [fg(green)]).
2031default_theme(message(debug(_)), [fg(blue)]).
2032default_theme(message(Level), Attrs) :-
2033 nonvar(Level),
2034 default_theme(Level, Attrs).
2035
2036
2037 2040
2041:- multifile
2042 user:message_hook/3,
2043 prolog:message_prefix_hook/2. 2044:- dynamic
2045 user:message_hook/3,
2046 prolog:message_prefix_hook/2. 2047:- thread_local
2048 user:thread_message_hook/3. 2049:- '$notransact'((user:message_hook/3,
2050 prolog:message_prefix_hook/2,
2051 user:thread_message_hook/3)). 2052
2057
2058print_message(Level, _Term) :-
2059 msg_property(Level, stream(S)),
2060 stream_property(S, error(true)),
2061 !.
2062print_message(Level, Term) :-
2063 setup_call_cleanup(
2064 notrace(push_msg(Term, Stack)),
2065 ignore(print_message_guarded(Level, Term)),
2066 notrace(pop_msg(Stack))),
2067 !.
2068print_message(Level, Term) :-
2069 ( Level \== silent
2070 -> format(user_error, 'Recursive ~w message: ~q~n', [Level, Term]),
2071 backtrace(20)
2072 ; true
2073 ).
2074
2075push_msg(Term, Messages) :-
2076 nb_current('$inprint_message', Messages),
2077 !,
2078 \+ ( '$member'(Msg, Messages),
2079 Msg =@= Term
2080 ),
2081 Stack = [Term|Messages],
2082 b_setval('$inprint_message', Stack).
2083push_msg(Term, []) :-
2084 b_setval('$inprint_message', [Term]).
2085
2086pop_msg(Stack) :-
2087 nb_delete('$inprint_message'), 2088 b_setval('$inprint_message', Stack).
2089
2090print_message_guarded(Level, Term) :-
2091 ( must_print(Level, Term)
2092 -> ( translate_message(Term, Lines, [])
2093 -> ( nonvar(Term),
2094 ( notrace(user:thread_message_hook(Term, Level, Lines))
2095 -> true
2096 ; notrace(user:message_hook(Term, Level, Lines))
2097 )
2098 -> true
2099 ; '$inc_message_count'(Level),
2100 print_system_message(Term, Level, Lines),
2101 maybe_halt_on_error(Level)
2102 )
2103 )
2104 ; true
2105 ).
2106
2107maybe_halt_on_error(error) :-
2108 current_prolog_flag(on_error, halt),
2109 !,
2110 halt(1).
2111maybe_halt_on_error(warning) :-
2112 current_prolog_flag(on_warning, halt),
2113 !,
2114 halt(1).
2115maybe_halt_on_error(_).
2116
2117
2124
2125print_system_message(_, silent, _) :- !.
2126print_system_message(_, informational, _) :-
2127 current_prolog_flag(verbose, silent),
2128 !.
2129print_system_message(_, banner, _) :-
2130 current_prolog_flag(verbose, silent),
2131 !.
2132print_system_message(_, _, []) :- !.
2133print_system_message(Term, Kind, Lines) :-
2134 catch(flush_output(user_output), _, true), 2135 source_location(File, Line),
2136 Term \= error(syntax_error(_), _),
2137 msg_property(Kind, location_prefix(File:Line, LocPrefix, LinePrefix)),
2138 !,
2139 to_list(LocPrefix, LocPrefixL),
2140 insert_prefix(Lines, LinePrefix, Ctx, PrefixLines),
2141 '$append'([ [begin(Kind, Ctx)],
2142 LocPrefixL,
2143 [nl],
2144 PrefixLines,
2145 [end(Ctx)]
2146 ],
2147 AllLines),
2148 msg_property(Kind, stream(Stream)),
2149 ignore(stream_property(Stream, position(Pos))),
2150 print_message_lines(Stream, AllLines),
2151 ( \+ stream_property(Stream, position(Pos)),
2152 msg_property(Kind, wait(Wait)),
2153 Wait > 0
2154 -> sleep(Wait)
2155 ; true
2156 ).
2157print_system_message(_, Kind, Lines) :-
2158 msg_property(Kind, stream(Stream)),
2159 print_message_lines(Stream, kind(Kind), Lines).
2160
2161to_list(ListIn, List) :-
2162 is_list(ListIn),
2163 !,
2164 List = ListIn.
2165to_list(NonList, [NonList]).
2166
2167:- multifile
2168 user:message_property/2. 2169
2170msg_property(Kind, Property) :-
2171 notrace(user:message_property(Kind, Property)),
2172 !.
2173msg_property(Kind, prefix(Prefix)) :-
2174 msg_prefix(Kind, Prefix),
2175 !.
2176msg_property(_, prefix('~N')) :- !.
2177msg_property(query, stream(user_output)) :- !.
2178msg_property(_, stream(user_error)) :- !.
2179msg_property(error, tag('ERROR')).
2180msg_property(warning, tag('Warning')).
2181msg_property(Level,
2182 location_prefix(File:Line,
2183 ['~N~w: '-[Tag], url(File:Line), ':'],
2184 '~N~w: '-[Tag])) :-
2185 include_msg_location(Level),
2186 msg_property(Level, tag(Tag)).
2187msg_property(error, wait(0.1)) :- !.
2188
2189include_msg_location(warning).
2190include_msg_location(error).
2191
2192msg_prefix(debug(_), Prefix) :-
2193 msg_context('~N% ', Prefix).
2194msg_prefix(Level, Prefix) :-
2195 msg_property(Level, tag(Tag)),
2196 atomics_to_string(['~N', Tag, ': '], Prefix0),
2197 msg_context(Prefix0, Prefix).
2198msg_prefix(informational, '~N% ').
2199msg_prefix(information, '~N% ').
2200
2212
2213msg_context(Prefix0, Prefix) :-
2214 current_prolog_flag(message_context, Context),
2215 is_list(Context),
2216 !,
2217 add_message_context(Context, Prefix0, Prefix).
2218msg_context(Prefix, Prefix).
2219
2220add_message_context([], Prefix, Prefix).
2221add_message_context([H|T], Prefix0, Prefix) :-
2222 ( add_message_context1(H, Prefix0, Prefix1)
2223 -> true
2224 ; Prefix1 = Prefix0
2225 ),
2226 add_message_context(T, Prefix1, Prefix).
2227
2228add_message_context1(Context, Prefix0, Prefix) :-
2229 prolog:message_prefix_hook(Context, Extra),
2230 atomics_to_string([Prefix0, Extra, ' '], Prefix).
2231add_message_context1(time, Prefix0, Prefix) :-
2232 get_time(Now),
2233 format_time(string(S), '%T.%3f ', Now),
2234 string_concat(Prefix0, S, Prefix).
2235add_message_context1(time(Format), Prefix0, Prefix) :-
2236 get_time(Now),
2237 format_time(string(S), Format, Now),
2238 atomics_to_string([Prefix0, S, ' '], Prefix).
2239add_message_context1(thread, Prefix0, Prefix) :-
2240 \+ current_prolog_flag(toplevel_thread, true),
2241 thread_self(Id0),
2242 !,
2243 ( atom(Id0)
2244 -> Id = Id0
2245 ; thread_property(Id0, id(Id))
2246 ),
2247 format(string(Prefix), '~w[Thread ~w] ', [Prefix0, Id]).
2248
2253
2254print_message_lines(Stream, kind(Kind), Lines) :-
2255 !,
2256 msg_property(Kind, prefix(Prefix)),
2257 insert_prefix(Lines, Prefix, Ctx, PrefixLines),
2258 '$append'([ begin(Kind, Ctx)
2259 | PrefixLines
2260 ],
2261 [ end(Ctx)
2262 ],
2263 AllLines),
2264 print_message_lines(Stream, AllLines).
2265print_message_lines(Stream, Prefix, Lines) :-
2266 insert_prefix(Lines, Prefix, _, PrefixLines),
2267 print_message_lines(Stream, PrefixLines).
2268
2270
2271insert_prefix([at_same_line|Lines0], Prefix, Ctx, Lines) :-
2272 !,
2273 prefix_nl(Lines0, Prefix, Ctx, Lines).
2274insert_prefix(Lines0, Prefix, Ctx, [prefix(Prefix)|Lines]) :-
2275 prefix_nl(Lines0, Prefix, Ctx, Lines).
2276
2277prefix_nl([], _, _, [nl]).
2278prefix_nl([nl], _, _, [nl]) :- !.
2279prefix_nl([flush], _, _, [flush]) :- !.
2280prefix_nl([nl|T0], Prefix, Ctx, [nl, prefix(Prefix)|T]) :-
2281 !,
2282 prefix_nl(T0, Prefix, Ctx, T).
2283prefix_nl([ansi(Attrs,Fmt,Args)|T0], Prefix, Ctx,
2284 [ansi(Attrs,Fmt,Args,Ctx)|T]) :-
2285 !,
2286 prefix_nl(T0, Prefix, Ctx, T).
2287prefix_nl([H|T0], Prefix, Ctx, [H|T]) :-
2288 prefix_nl(T0, Prefix, Ctx, T).
2289
2291
2292print_message_lines(Stream, Lines) :-
2293 with_output_to(
2294 Stream,
2295 notrace(print_message_lines_guarded(current_output, Lines))).
2296
2297print_message_lines_guarded(_, []) :- !.
2298print_message_lines_guarded(S, [H|T]) :-
2299 line_element(S, H),
2300 print_message_lines_guarded(S, T).
2301
2302line_element(S, E) :-
2303 prolog:message_line_element(S, E),
2304 !.
2305line_element(S, full_stop) :-
2306 !,
2307 '$put_token'(S, '.'). 2308line_element(S, nl) :-
2309 !,
2310 nl(S).
2311line_element(S, prefix(Fmt-Args)) :-
2312 !,
2313 safe_format(S, Fmt, Args).
2314line_element(S, prefix(Fmt)) :-
2315 !,
2316 safe_format(S, Fmt, []).
2317line_element(S, flush) :-
2318 !,
2319 flush_output(S).
2320line_element(S, Fmt-Args) :-
2321 !,
2322 safe_format(S, Fmt, Args).
2323line_element(S, ansi(_, Fmt, Args)) :-
2324 !,
2325 safe_format(S, Fmt, Args).
2326line_element(S, ansi(_, Fmt, Args, _Ctx)) :-
2327 !,
2328 safe_format(S, Fmt, Args).
2329line_element(S, url(URL)) :-
2330 !,
2331 print_link(S, URL).
2332line_element(S, url(_URL, Fmt-Args)) :-
2333 !,
2334 safe_format(S, Fmt, Args).
2335line_element(S, url(_URL, Fmt)) :-
2336 !,
2337 safe_format(S, Fmt, []).
2338line_element(_, begin(_Level, _Ctx)) :- !.
2339line_element(_, end(_Ctx)) :- !.
2340line_element(S, Fmt) :-
2341 safe_format(S, Fmt, []).
2342
2343print_link(S, File:Line:Column) :-
2344 !,
2345 safe_format(S, '~w:~d:~d', [File, Line, Column]).
2346print_link(S, File:Line) :-
2347 !,
2348 safe_format(S, '~w:~d', [File, Line]).
2349print_link(S, File) :-
2350 safe_format(S, '~w', [File]).
2351
2353
2354safe_format(S, Fmt, Args) :-
2355 E = error(_,_),
2356 catch(format(S,Fmt,Args), E,
2357 format_failed(S,Fmt,Args,E)).
2358
2359format_failed(S, _Fmt, _Args, E) :-
2360 stream_property(S, error(true)),
2361 !,
2362 throw(E).
2363format_failed(S, Fmt, Args, error(E,_)) :-
2364 format(S, '~N [[ EXCEPTION while printing message ~q~n\c
2365 ~7|with arguments ~W:~n\c
2366 ~7|raised: ~W~n~4|]]~n',
2367 [ Fmt,
2368 Args, [quoted(true), max_depth(10)],
2369 E, [quoted(true), max_depth(10)]
2370 ]).
2371
2375
2376message_to_string(Term, Str) :-
2377 translate_message(Term, Actions, []),
2378 !,
2379 actions_to_format(Actions, Fmt, Args),
2380 format(string(Str), Fmt, Args).
2381
2382actions_to_format([], '', []) :- !.
2383actions_to_format([nl], '', []) :- !.
2384actions_to_format([Term, nl], Fmt, Args) :-
2385 !,
2386 actions_to_format([Term], Fmt, Args).
2387actions_to_format([nl|T], Fmt, Args) :-
2388 !,
2389 actions_to_format(T, Fmt0, Args),
2390 atom_concat('~n', Fmt0, Fmt).
2391actions_to_format([ansi(_Attrs, Fmt0, Args0)|Tail], Fmt, Args) :-
2392 !,
2393 actions_to_format(Tail, Fmt1, Args1),
2394 atom_concat(Fmt0, Fmt1, Fmt),
2395 append_args(Args0, Args1, Args).
2396actions_to_format([url(Pos)|Tail], Fmt, Args) :-
2397 !,
2398 actions_to_format(Tail, Fmt1, Args1),
2399 url_actions_to_format(url(Pos), Fmt1, Args1, Fmt, Args).
2400actions_to_format([url(URL, Label)|Tail], Fmt, Args) :-
2401 !,
2402 actions_to_format(Tail, Fmt1, Args1),
2403 url_actions_to_format(url(URL, Label), Fmt1, Args1, Fmt, Args).
2404actions_to_format([Fmt0-Args0|Tail], Fmt, Args) :-
2405 !,
2406 actions_to_format(Tail, Fmt1, Args1),
2407 atom_concat(Fmt0, Fmt1, Fmt),
2408 append_args(Args0, Args1, Args).
2409actions_to_format([Skip|T], Fmt, Args) :-
2410 action_skip(Skip),
2411 !,
2412 actions_to_format(T, Fmt, Args).
2413actions_to_format([Term|Tail], Fmt, Args) :-
2414 atomic(Term),
2415 !,
2416 actions_to_format(Tail, Fmt1, Args),
2417 atom_concat(Term, Fmt1, Fmt).
2418actions_to_format([Term|Tail], Fmt, Args) :-
2419 actions_to_format(Tail, Fmt1, Args1),
2420 atom_concat('~w', Fmt1, Fmt),
2421 append_args([Term], Args1, Args).
2422
2423action_skip(at_same_line).
2424action_skip(flush).
2425action_skip(begin(_Level, _Ctx)).
2426action_skip(end(_Ctx)).
2427
2428url_actions_to_format(url(File:Line:Column), Fmt1, Args1, Fmt, Args) :-
2429 !,
2430 atom_concat('~w:~d:~d', Fmt1, Fmt),
2431 append_args([File,Line,Column], Args1, Args).
2432url_actions_to_format(url(File:Line), Fmt1, Args1, Fmt, Args) :-
2433 !,
2434 atom_concat('~w:~d', Fmt1, Fmt),
2435 append_args([File,Line], Args1, Args).
2436url_actions_to_format(url(File), Fmt1, Args1, Fmt, Args) :-
2437 !,
2438 atom_concat('~w', Fmt1, Fmt),
2439 append_args([File], Args1, Args).
2440url_actions_to_format(url(_URL, Label), Fmt1, Args1, Fmt, Args) :-
2441 !,
2442 atom_concat('~w', Fmt1, Fmt),
2443 append_args([Label], Args1, Args).
2444
2445
2446append_args(M:Args0, Args1, M:Args) :-
2447 !,
2448 strip_module(Args1, _, A1),
2449 to_list(Args0, Args01),
2450 '$append'(Args01, A1, Args).
2451append_args(Args0, Args1, Args) :-
2452 strip_module(Args1, _, A1),
2453 to_list(Args0, Args01),
2454 '$append'(Args01, A1, Args).
2455
2456 2459
2460:- dynamic
2461 printed/2. 2462
2466
2467print_once(compatibility(_), _).
2468print_once(null_byte_in_path(_), _).
2469print_once(deprecated(_), _).
2470
2474
2475must_print(Level, Message) :-
2476 nonvar(Message),
2477 print_once(Message, Level),
2478 !,
2479 \+ printed(Message, Level),
2480 assert(printed(Message, Level)).
2481must_print(_, _)