1/*
2   Highlighting test case for Logtalk
3
4   Copied from the Logtalk distribution by the Logtalk copright holder
5   and contributed using the Apache License 2.0
6*/
7
8:- encoding(Encoding).	% this is a single-line comment
9
10/*
11this is
12a block
13comment
14*/
15
16
17:- if(Goal).
18	% conditional
19:- elif(Goal).
20	% compilation
21:- else.
22	% directives
23:- endif.
24
25
26:- initialization(Goal).
27:- op(Precedence, Associativity, Operator).
28:- ensure_loaded(File).
29:- include(File).
30:- set_prolog_flag(Flag, Value).
31:- set_logtalk_flag(Flag, Value).
32
33
34:- object(prototype,
35	implements(protocol),
36	imports(category),
37	extends(parent)).
38
39	:- info([
40		version is 1:47:0,
41		author is 'Paulo Moura',
42		date is 2019-09-18,
43		comment is 'Sample prototype for testing syntax coloring.'
44	]).
45
46	:- built_in.
47	:- threaded.
48	:- dynamic.
49
50	:- initialization(some_goal(X, Y)).
51
52	:- uses([
53		foobar as fb
54	]).
55
56	:- alias(set, [member/2 as set_member/2]).
57	:- alias(words, [singular//0 as peculiar//0]).
58
59	:- uses(list, [append/3, member/2]).
60	:- uses(queues, [new/1 as new_queue/1]).
61
62	:- use_module(module).
63	:- use_module(module, [append/3, member/2]).
64
65	:- multifile(zzz/1).
66	:- multifile(module:zzz/1).
67	:- multifile(object::zzz/1).
68
69	:- coinductive(comember/1).
70
71	:- use_module(module, [xxx/1, yyy/2, zzz/3]).
72	:- export(bbb/3).
73	:- reexport(cccc/4).
74
75	:- public(aaa/2).
76	:- meta_predicate(aaa(::, *)).
77	:- discontiguous(aaa/2).
78	:- mode(aaa(+callable, ?integer), zero_or_one).
79	:- info(position/2, [
80		comment is 'Predicate brief description.',
81		arguments is ['Arg1'-'Arg1 description', 'Arg2'-'Arg2 description']
82	]).
83
84	:- public(nt//2).
85	:- meta_non_terminal(nt(1, *)).
86
87	:- protected(bbb/2).
88	:- synchronized(bbb/2).
89	:- mode(bbb(+integer, -float), one).
90	:- info(bbb/2, [
91		comment is 'Predicate brief description.',
92		argnames is ['Arg1', 'Arg2']
93	]).
94
95	:- private(ccc/2).
96	:- dynamic(ccc/2).
97	:- mode(ccc(@atom, ?atom, ++list, --ground), one_or_more).
98	:- info(ccc/2, [
99		comment is 'Predicate brief description.',
100		argnames is ['Arg1', 'Arg2']
101	]).
102
103	enumerating_entities(Object, Protocol, Category) :-
104		current_category(Category),
105		current_object(Object),
106		current_protocol(Protocol).
107
108	enumerating_properties :-
109		category_property(Category, Property),
110		object_property(Object, Property),
111		protocol_property(Protocol, Property).
112
113	creating_entities(Object, Protocol, Category) :-
114		create_category(Category, Relations, Directives, Clauses),
115		create_object(Object, Relations, Directives, Clauses),
116		create_protocol(Protocol, Relations, Directives).
117
118	abolishing_entities(Object, Protocol, Category) :-
119		abolish_category(Category),
120		abolish_object(Object),
121		abolish_protocol(Protocol).
122
123	entity_relations :-
124		extends_object(Prototype, Parent, Scope),
125		extends_protocol(Protocol1, Protocol2, Scope),
126		extends_category(Category1, Category2, Scope),
127		implements_protocol(Object, Protocol, Scope),
128		imports_category(Object, Category, Scope),
129		instantiates_class(Instance, Class, Scope),
130		specializes_class(Class, Superclass, Scope),
131		complements_object(Category, Object),
132		conforms_to_protocol(ObjOrCtg, Protocol, Scope).
133
134	event_handling :-
135		abolish_events(Event, Object, Message, Sender, Monitor),
136		current_event(Event, Object, Message, Sender, Monitor),
137		define_events(Event, Object, Message, Sender, Monitor).
138
139	multi_threading :-
140		threaded(Goals),
141		threaded_call(Goal),
142		threaded_call(Goal, Tag),
143		threaded_once(Goal),
144		threaded_once(Goal, Tag),
145		threaded_ignore(Goal),
146		threaded_exit(Goal),
147		threaded_exit(Goal, Tag),
148		threaded_peek(Goal),
149		threaded_peek(Goal, Tag),
150		threaded_cancel(Tag),
151		threaded_wait(Notification),
152		threaded_notify(Notification).
153
154	engines :-
155		threaded_engine(Engine),
156		threaded_engine_create(AnswerTemplate, Goal, Engine),
157		threaded_engine_destroy(Engine),
158		threaded_engine_self(Engine),
159		threaded_engine_next(Engine, Answer),
160		threaded_engine_next_reified(Engine, Answer),
161		threaded_engine_yield(Answer),
162		threaded_engine_post(Engine, Term),
163		threaded_engine_fetch(Term).
164
165	compiling_and_loading :-
166		logtalk_compile(File, Options),
167		logtalk_load(File, Options),
168		logtalk_library_path(Library, Path),
169		logtalk_load_context(Key, Value),
170		logtalk_make(Action),
171		logtalk_make,
172		logtalk_make_target_action(Target).
173
174	flags :-
175		current_logtalk_flag(Flag, Value),
176		set_logtalk_flag(Flag, Value),
177		create_logtalk_flag(Flag, Value, Options).
178
179	execution_context_methods :-
180		context(Context),
181		parameter(N, Parameter),
182		self(Self),
183		sender(Sender),
184		this(This).
185
186	reflection_methods :-
187		current_predicate(Predicate),
188		predicate_property(Predicate, Property).
189
190	database_methods :-
191		abolish(Name/Arity),
192		asserta(Clause),
193		assertz(Clause),
194		clause(Head, Body),
195		retract(Clause),
196		retractall(Head).
197
198	exception_methods :-
199		catch(Goal, Error, Catcher),
200		throw(Error),
201		instantiation_error,
202		type_error(Type, Culprit),
203		domain_error(Domain, Culprit),
204		existence_error(Thing, Culprit),
205		permission_error(Operation, Permission, Culprit),
206		representation_error(Flag),
207		evaluation_error(Exception),
208		resource_error(Resource),
209		syntax_error(Description),
210		system_error.
211
212	all_solutions_methods :-
213		bagof(Term, Goal, List),
214		bagof(Term, Var^Goal, List),
215		findall(Term, Goal, List),
216		forall(Generate, Test),
217		setof(Term, Goal, List),
218		setof(Term, Var1^Var2^Goal, List).
219
220	event_handler_methods :-
221		before(Object, Message, Sender),
222		after(Object, Message, Sender).
223
224	message_forwarding_method :-
225		forward(Message).
226
227	dcg_rules_parsing_methods :-
228		phrase(NonTerminal, Input, Rest).
229
230	term_expansion_methods :-
231		expand_term(Term, Expanded),
232		expand_goal(Goal, Expanded),
233		term_expansion(Term, Expanded),
234		goal_expansion(Goal, Expanded).
235
236	message_sending :-
237		Object::Message,
238		::Message,
239		^^Message.
240
241	calling_external_code :-
242		{goal1, goal2, goal3}.
243
244	context_switching_calls :-
245		Object<<Goal.
246
247	lambda_expressions :-
248		{X,Y,Z}/[P,Q]>>Goal.
249
250	explicitly_qualified_module_calls :-
251		Module:Goal.
252
253	if_then_else :-
254		(	If ->
255			Then
256		;	Else
257		).
258
259	numbers :-
260		X1 is 13, X2 is -13, X3 is +13,
261		Y1 is 13.13, Y2 is -13.13, Y3 is +13.13,
262		Z1 is 13.13e-23, Z2 is -13.13e-23, Z3 is +13.13e-23,
263		C1 is 0'A, C2 is 0'', C3 is 0'", C4 is 0'%,
264		C5 is 0'\n, C6 is 0'\\, C7 is 0'\', C8 is 0'\", C9 is 0'\`,
265		B1 is 0b1011101,
266		O1 is 0o1234560,
267		H1 is 0x1234567890abcDEF.
268
269	functions :-
270		A is atan(3.14) + atan2(1, 0) + acos(0.5) + asin(0.5) + sin(0.77) - cos(123.23) - tan(0.33),
271		B is sign(-12) * abs(35/78),
272		C is truncate(3.14) + round(-7.8) - ceiling(111.88),
273		D is exp(3.8) - log(123.98) / sqrt(33) * 23 ** 4 + 12345^2,
274		E is rem(3, 2) + mod(5, 3) - div(8, 4) * 2 rem 2 // 5 mod 3 - 8 div 4 + pi * e,
275		F is float_fractional_part(3.14) + float_integer_part(3.14),
276		G is float(33) + floor(99.99),
277		I is min(3,4) + max(4,5).
278
279	bitwise :-
280		A is 16 >> 2,
281		B is 16 << 2,
282		C is 10 /\ 12,
283		D is 10 \/ 12,
284		E is \ 10,
285		F is xor(13, 7).
286
287	term_unification :-
288		Term1 = Term2,
289		Term1 \= Term2,
290		unify_with_occurs_check(Term1, Term2),
291		subsumes_term(General, Specific).
292
293	term_testing :-
294		atom(Atom),
295		atomic(Atomic),
296		integer(Integer),
297		float(Float),
298		callable(Term),
299		compound(Term),
300		nonvar(Term),
301		var(Term),
302		number(Number),
303		ground(Term),
304		acyclic_term(Term).
305
306	term_comparison :-
307		compare(Order, Term1, Term2),
308		Term1 == Term2,
309		Term1 \== Term2,
310		Term1 @< Term2,
311		Term1 @=< Term2,
312		Term1 @>= Term2,
313		Term1 @> Term2.
314
315	term_creation_and_decomposition :-
316		functor(Term, Name, Arity),
317		arg(N, Term, Arg),
318		Term =.. [Functor| Args],
319		copy_term(Term, Copy),
320		numbervars(Term, Start, End),
321		term_variables(Term, Variables).
322
323	arithmetic_evaluation :-
324		X is Expression.
325
326	arithmetic_comparison :-
327		Exp1 =:= Exp2,
328		Exp1 =\= Exp2,
329		Exp1 < Exp2,
330		Exp1 =< Exp2,
331		Exp1 > Exp2,
332		Exp1 >= Exp2.
333
334	stream_selection_and_control :-
335		current_input(Stream),
336		current_output(Stream),
337		set_input(Stream),
338		set_output(Stream),
339		open(Source, Mode, Stream, Options),
340		close(Stream),
341		flush_output(Stream),
342		stream_property(Stream, Property),
343		at_end_of_stream(Stream),
344		set_stream_position(Stream, Position),
345		flush_output,
346		at_end_of_stream.
347
348	character_input_output :-
349		get_char(Char),
350		get_code(Code),
351		peek_char(Char),
352		peek_code(Code),
353		put_char(Char),
354		put_code(Code),
355		nl(Stream),
356		nl.
357
358	byte_input_output :-
359		get_byte(Byte),
360		peek_byte(Byte),
361		put_byte(Byte).
362
363	term_input_output :-
364		read(Term),
365		read_term(Stream, Term, Options),
366		write(Term),
367		write(Term),
368		write_canonical(Term),
369		write_term(Stream, Term, Options),
370		current_op(Precedence, Associativity, Operator),
371		op(Precedence, Associativity, Operator),
372		current_char_conversion(InChar, OutChar),
373		char_conversion(InChar, OutChar).
374
375	logic_and_control :-
376		\+ Goal,
377		call(Goal),
378		once(Goal),
379		ignore(Goal),
380		true,
381		fail,
382		false,
383		repeat,
384		!.
385
386	atomic_term_processing :-
387		atom_length(Atom, Length),
388		atom_chars(Atom, Chars),
389		atom_codes(Atom, Codes),
390		atom_concat(Atom1, Atom2, Atom),
391		sub_atom(Atom, Before, Length, After, SubAtom),
392		char_code(Char, Code),
393		number_chars(Number, Chars),
394		number_codes(Number, Codes).
395
396	implementation_defined_hooks :-
397		current_prolog_flag(Flag, Value),
398		set_prolog_flag(Flag, Value),
399		halt(ExitCode),
400		halt.
401
402	sorting :-
403		keysort(List, Sorted),
404		sort(List, Sorted).
405
406	number(C) --> "+", number(C).
407	number(C) --> "-", number(X), {C is -X}.
408	number(X) --> [C], {0'0 =< C, C =< 0'9, X is C - 0'0}.
409
410	escape_sequences :-
411		write('Quoted atom with a quote ('') inside.'),
412		write('Quoted atom with a quote (\') inside using a control escape sequence.'),
413		write('Quoted atom with a backslash (\\) inside.'),
414		write('Quoted atom with control escape sequences: \a \b \r \f \t \n \v'),
415		write('Quoted atom with an octal escape sequence: \123\.'),
416		write('Quoted atom with an hexadecimal escape sequence: \x123f\.').
417
418	% nothing in the following predicate definition should be highlighted
419	sort :-
420		forall,
421		object,
422		write,
423		number.
424
425:- end_object.
426
427
428:- object(class,
429	implements(protected::protocol),
430	imports(private::category),
431	instantiates(metaclass),
432	specializes(superclass)).
433
434:- end_object.
435
436
437:- object(parametric(Parameter, "String", 33.78),
438	implements(protocol),
439	imports(category),
440	extends(parent(Parameter))).
441
442:- end_object.
443
444
445:- category(category,
446	implements(protocol),
447	extends(other_category)).
448
449:- end_category.
450
451
452:- protocol(extended,
453	extends(minimal)).
454
455:- end_protocol.
456
457
458:- module(module, [foo/1, bar/2]).
459
460:- use_module(library).
461:- use_module(library, [baz/3]).
462
463:- reexport(library).
464:- reexport(library, [qux/4]).
465
466:- export(quux/5).
467