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