root/tags/lgt291/compiler/logtalk.pl

Revision 16, 142.7 KB (checked in by pmoura, 7 years ago)

Print a warning when redefining or replacing an existing entity.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1
2%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3%
4%  Logtalk - Object oriented extension to Prolog
5%  Release 2.9.1
6%
7%  Copyright (c) 1998-2001 Paulo Moura.  All Rights Reserved.
8%
9%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10
11
12
13
14%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
15%
16%  operators
17%
18%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
19
20
21
22% message sending operators
23
24:- op(600, xfy, ::).                        % send to object
25:- op(600,  fy, ::).                        % send to self
26
27:- op(600,  fx, ^^).                        % super call
28
29
30% mode operators
31
32:- op(200, fy, +).                          % input argument (instantiated)
33:- op(200, fy, ?).                          % input/output argument
34:- op(200, fy, @).                          % input argument (not modified by the call)
35:- op(200, fy, -).                          % output argument (not instantiated)
36
37
38
39
40%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
41%
42%  runtime directives
43%
44%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
45
46
47
48% tables of defined events and monitors
49
50:- dynamic(lgt_before_/5).                  % lgt_before_(Obj, Msg, Sender, Monitor, Call)
51:- dynamic(lgt_after_/5).                   % lgt_after_(Obj, Msg, Sender, Monitor, Call)
52
53
54
55% tables of loaded entities and respective relationships
56
57:- dynamic(lgt_current_protocol_/2).        % lgt_current_protocol_(Ptc, Prefix)
58:- dynamic(lgt_current_category_/2).        % lgt_current_category_(Ctg, Prefix)
59:- dynamic(lgt_current_object_/5).          % lgt_current_object_(Obj, Prefix, Dcl, Def, Super)
60
61:- dynamic(lgt_implements_protocol_/3).     % lgt_implements_protocol_(ObjOrCtg, Ptc, Scope)
62:- dynamic(lgt_imports_category_/3).        % lgt_imports_category_(Obj, Ctg, Scope)
63:- dynamic(lgt_instantiates_class_/3).      % lgt_instantiates_class_(Instance, Class, Scope)
64:- dynamic(lgt_specializes_class_/3).       % lgt_specializes_class_(Class, Superclass, Scope)
65:- dynamic(lgt_extends_protocol_/3).        % lgt_extends_protocol_(Ptc1, Ptc2, Scope)
66:- dynamic(lgt_extends_object_/3).          % lgt_extends_object_(Prototype, Parent, Scope)
67
68
69
70
71%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
72%
73%  pre-processor directives
74%
75%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
76
77
78
79:- dynamic(lgt_dcl_/1).                     % lgt_dcl_(Clause)
80:- dynamic(lgt_def_/1).                     % lgt_def_(Clause)
81:- dynamic(lgt_super_/1).                   % lgt_super_(Clause)
82
83:- dynamic(lgt_dynamic_/1).                 % lgt_dynamic_(Functor/Arity)
84:- dynamic(lgt_discontiguous_/1).           % lgt_discontiguous_(Functor/Arity)
85:- dynamic(lgt_mode_/2).                    % lgt_mode_(Mode, Determinism)
86:- dynamic(lgt_public_/1).                  % lgt_public_(Functor/Arity)
87:- dynamic(lgt_protected_/1).               % lgt_protected_(Functor/Arity)
88:- dynamic(lgt_private_/1).                 % lgt_private_(Functor/Arity)
89:- dynamic(lgt_metapredicate_/1).           % lgt_metapredicate_(Pred)
90
91:- dynamic(lgt_object_/9).                  % lgt_object_(Obj, Prefix, Dcl, Def, Super, IDcl, IDef, DDcl, DDef)
92:- dynamic(lgt_category_/4).                % lgt_category_(Ctg, Prefix, Dcl, Def)
93:- dynamic(lgt_protocol_/3).                % lgt_protocol_(Ptc, Prefix, Dcl)
94
95:- dynamic(lgt_uses_/1).                    % lgt_uses_(Entity)
96:- dynamic(lgt_calls_/1).                   % lgt_calls_(Entity)
97:- dynamic(lgt_info_/1).                    % lgt_info_(List)
98:- dynamic(lgt_info_/2).                    % lgt_info_(Functor/Arity, List)
99
100:- dynamic(lgt_implemented_protocol_/4).    % lgt_implemented_protocol_(Ptc, Prefix, Dcl, Scope)
101:- dynamic(lgt_imported_category_/5).       % lgt_imported_category_(Ctg, Prefix, Dcl, Def, Scope)
102:- dynamic(lgt_extended_object_/10).        % lgt_extended_object_(Parent, Prefix, Dcl, Def, Super, IDcl, IDef, DDcl, DDef, Scope)
103:- dynamic(lgt_instantiated_class_/10).     % lgt_instantiated_class_(Class, Prefix, Dcl, Def, Super, IDcl, IDef, DDcl, DDef, Scope)
104:- dynamic(lgt_specialized_class_/10).      % lgt_specialized_class_(Superclass, Prefix, Dcl, Def, Super, IDcl, IDef, DDcl, DDef, Scope)
105:- dynamic(lgt_extended_protocol_/4).       % lgt_extended_protocol_(Ptc2, Prefix, Dcl, Scope)
106
107:- dynamic(lgt_entity_/4).                  % lgt_entity_(Type, Entity, Prefix, Dcl)
108:- dynamic(lgt_entity_functors_/1).         % lgt_entity_functors_(Clause)
109:- dynamic(lgt_entity_init_/1).             % lgt_entity_init_(Goal)
110:- dynamic(lgt_fentity_init_/1).            % lgt_fentity_init_(Goal)
111:- dynamic(lgt_entity_comp_mode_/1).        % lgt_entity_comp_mode_(Type)
112
113:- dynamic(lgt_redefined_built_in_/3).      % lgt_redefined_built_in_(Head, Context, THead)
114
115:- dynamic(lgt_directive_/1).               % lgt_directive_(Dir)
116:- dynamic(lgt_rclause_/1).                 % lgt_rclause_(Clause)
117:- dynamic(lgt_eclause_/1).                 % lgt_eclause_(Clause)
118:- dynamic(lgt_feclause_/1).                % lgt_feclause_(Clause)
119
120:- dynamic(lgt_defs_pred_/1).               % lgt_defs_pred_(Functor/Arity)
121:- dynamic(lgt_calls_pred_/1).              % lgt_calls_pred_(Functor/Arity)
122
123:- dynamic(lgt_current_compiler_option_/2). % lgt_current_compiler_option_(Option, Value)
124
125:- dynamic(lgt_referenced_object_/1).       % lgt_referenced_object_(Object)
126:- dynamic(lgt_referenced_protocol_/1).     % lgt_referenced_protocol_(Protocol)
127:- dynamic(lgt_referenced_category_/1).     % lgt_referenced_object_(Category)
128
129
130
131
132%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
133%
134%  top level runtime predicate for message sending: ::/2
135%
136%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
137
138
139
140Obj::Pred :-
141    var(Obj),
142    throw(error(instantiation_error, Obj::Pred, user)).
143
144Obj::Pred :-
145    var(Pred),
146    throw(error(instantiation_error, Obj::Pred, user)).
147
148Obj::Pred :-
149    lgt_sender(Context, user),
150    lgt_this(Context, user),
151    lgt_self(Context, Obj),
152    lgt_tr_msg(Obj, Pred, Call, Context),
153    call(Call).
154
155
156
157
158%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
159%
160%  built-in predicates
161%
162%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
163
164
165
166% current_object(?object_identifier)
167
168current_object(Obj) :-
169    nonvar(Obj),
170    \+ lgt_valid_object_id(Obj),
171    throw(error(type_error(object_identifier, Obj), current_object(Obj))).
172
173current_object(Obj) :-
174    lgt_current_object_(Obj, _, _, _, _).
175
176
177
178% current_protocol(?protocol_identifier)
179
180current_protocol(Ptc) :-
181    nonvar(Ptc),
182    \+ lgt_valid_protocol_id(Ptc),
183    throw(error(type_error(protocol_identifier, Ptc), current_protocol(Ptc))).
184
185current_protocol(Ptc) :-
186    lgt_current_protocol_(Ptc, _).
187
188
189
190% current_category(?category_identifier)
191
192current_category(Ctg) :-
193    nonvar(Ctg),
194    \+ lgt_valid_category_id(Ctg),
195    throw(error(type_error(category_identifier, Ctg), current_category(Ctg))).
196
197current_category(Ctg) :-
198    lgt_current_category_(Ctg, _).
199
200
201
202% object_property(?object_identifier, ?object_property)
203
204object_property(Obj, Prop) :-
205    nonvar(Obj),
206    \+ lgt_valid_object_id(Obj),
207    throw(error(type_error(object_identifier, Obj), object_property(Obj, Prop))).
208
209object_property(Obj, Prop) :-
210    nonvar(Prop),
211    \+ lgt_member(Prop, [(dynamic), static, built_in]),
212    throw(error(domain_error(object_property, Prop), object_property(Obj, Prop))).
213
214object_property(user, built_in).
215
216object_property(Obj, Prop) :-
217    lgt_current_object_(Obj, Prefix, _, _, _),
218    functor(Pred, Prefix, 7),
219    (lgt_predicate_property(Pred, (dynamic)) ->
220        Prop = (dynamic)
221        ;
222        Prop = static).
223
224
225
226% category_property(?category_identifier, ?category_property)
227
228category_property(Ctg, Prop) :-
229    nonvar(Ctg),
230    \+ lgt_valid_category_id(Ctg),
231    throw(error(type_error(category_identifier, Ctg), category_property(Ctg, Prop))).
232
233category_property(Ctg, Prop) :-
234    nonvar(Prop),
235    \+ lgt_member(Prop, [(dynamic), static, built_in]),
236    throw(error(domain_error(category_property, Prop), category_property(Ctg, Prop))).
237
238category_property(Ctg, Prop) :-
239    lgt_current_category_(Ctg, Prefix),
240    functor(Pred, Prefix, 2),
241    (lgt_predicate_property(Pred, (dynamic)) ->
242        Prop = (dynamic)
243        ;
244        Prop = static).
245
246
247
248% protocol_property(?protocol_identifier, ?protocol_property)
249
250protocol_property(Ptc, Prop) :-
251    nonvar(Ptc),
252    \+ lgt_valid_protocol_id(Ptc),
253    throw(error(type_error(protocol_identifier, Ptc), protocol_property(Ptc, Prop))).
254
255protocol_property(Ptc, Prop) :-
256    nonvar(Prop),
257    \+ lgt_member(Prop, [(dynamic), static, built_in]),
258    throw(error(domain_error(protocol_property, Prop), protocol_property(Ptc, Prop))).
259
260protocol_property(Ptc, Prop) :-
261    lgt_current_protocol_(Ptc, Prefix),
262    functor(Pred, Prefix, 1),
263    (lgt_predicate_property(Pred, (dynamic)) ->
264        Prop = (dynamic)
265        ;
266        Prop = static).
267
268
269
270% create_object(+object_identifier, +list, +list, +list)
271
272create_object(Obj, Rels, Dirs, Clauses) :-
273    var(Obj),
274    throw(error(instantiation_error, create_object(Obj, Rels, Dirs, Clauses))).
275
276create_object(Obj, Rels, Dirs, Clauses) :-
277    \+ lgt_valid_object_id(Obj),
278    throw(error(type_error(object_identifier, Obj), create_object(Obj, Rels, Dirs, Clauses))).
279
280create_object(Obj, Rels, Dirs, Clauses) :-
281    lgt_current_object_(Obj, _, _, _, _),
282    throw(error(permission_error(replace, object, Obj), create_object(Obj, Rels, Dirs, Clauses))).
283
284create_object(Obj, Rels, Dirs, Clauses) :-
285    lgt_current_category_(Obj, _),
286    throw(error(permission_error(replace, category, Obj), create_object(Obj, Rels, Dirs, Clauses))).
287
288create_object(Obj, Rels, Dirs, Clauses) :-
289    lgt_current_protocol_(Obj, _),
290    throw(error(permission_error(replace, protocol, Obj), create_object(Obj, Rels, Dirs, Clauses))).
291
292create_object(Obj, Rels, Dirs, Clauses) :-
293    (var(Rels); \+ lgt_proper_list(Rels)),
294    throw(error(type_error(list, Rels), create_object(Obj, Rels, Dirs, Clauses))).
295
296create_object(Obj, Rels, Dirs, Clauses) :-
297    (var(Dirs); \+ lgt_proper_list(Dirs)),
298    throw(error(type_error(list, Dirs), create_object(Obj, Rels, Dirs, Clauses))).
299
300create_object(Obj, Rels, Dirs, Clauses) :-
301    (var(Clauses); \+ lgt_proper_list(Clauses)),
302    throw(error(type_error(list, Clauses), create_object(Obj, Rels, Dirs, Clauses))).
303
304create_object(Obj, Rels, Dirs, Clauses) :-
305    lgt_clean_up,
306    lgt_tr_directive(object, [Obj| Rels]),
307    lgt_tr_directives(Dirs),
308    lgt_tr_clauses(Clauses),
309    lgt_fix_redef_built_ins,
310    lgt_gen_object_clauses,
311    lgt_gen_object_directives,
312    lgt_assert_tr_entity,
313    lgt_report_unknown_entities.
314
315
316
317% create_category(+category_identifier, +list, +list, +list)
318
319create_category(Ctg, Rels, Dirs, Clauses) :-
320    var(Ctg),
321    throw(error(instantiation_error, create_category(Ctg, Rels, Dirs, Clauses))).
322
323create_category(Ctg, Rels, Dirs, Clauses) :-
324    \+ lgt_valid_category_id(Ctg),
325    throw(error(type_error(category_identifier, Ctg), create_category(Ctg, Rels, Dirs, Clauses))).
326
327create_category(Ctg, Rels, Dirs, Clauses) :-
328    lgt_current_category_(Ctg, _),
329    throw(error(permission_error(replace, category, Ctg), create_category(Ctg, Rels, Dirs, Clauses))).
330
331create_category(Ctg, Rels, Dirs, Clauses) :-
332    lgt_current_object_(Ctg, _, _, _, _),
333    throw(error(permission_error(replace, object, Ctg), create_category(Ctg, Rels, Dirs, Clauses))).
334
335create_category(Ctg, Rels, Dirs, Clauses) :-
336    lgt_current_protocol_(Ctg, _),
337    throw(error(permission_error(replace, protocol, Ctg), create_category(Ctg, Rels, Dirs, Clauses))).
338
339create_category(Ctg, Rels, Dirs, Clauses) :-
340    (var(Rels); \+ lgt_proper_list(Rels)),
341    throw(error(type_error(list, Rels), create_category(Ctg, Rels, Dirs, Clauses))).
342
343create_category(Ctg, Rels, Dirs, Clauses) :-
344    (var(Dirs); \+ lgt_proper_list(Dirs)),
345    throw(error(type_error(list, Dirs), create_category(Ctg, Rels, Dirs, Clauses))).
346
347create_category(Ctg, Rels, Dirs, Clauses) :-
348    (var(Clauses); \+ lgt_proper_list(Clauses)),
349    throw(error(type_error(list, Clauses), create_category(Ctg, Rels, Dirs, Clauses))).
350
351create_category(Ctg, Rels, Dirs, Clauses) :-
352    lgt_clean_up,
353    lgt_tr_directive(category, [Ctg| Rels]),
354    lgt_tr_directives(Dirs),
355    lgt_tr_clauses(Clauses),
356    lgt_fix_redef_built_ins,
357    lgt_gen_category_clauses,
358    lgt_gen_category_directives,
359    lgt_assert_tr_entity,
360    lgt_report_unknown_entities.
361
362
363
364% create_protocol(+protocol_identifier, +list, +list)
365
366create_protocol(Ptc, Rels, Dirs) :-
367    var(Ptc),
368    throw(error(instantiation_error, create_protocol(Ptc, Rels, Dirs))).
369
370create_protocol(Ptc, Rels, Dirs) :-
371    \+ lgt_valid_protocol_id(Ptc),
372    throw(error(type_error(protocol_identifier, Ptc), create_protocol(Ptc, Rels, Dirs))).
373
374create_protocol(Ptc, Rels, Dirs) :-
375    lgt_current_protocol_(Ptc, _),
376    throw(error(permission_error(replace, protocol, Ptc), create_protocol(Ptc, Rels, Dirs))).
377
378create_protocol(Ptc, Rels, Dirs) :-
379    lgt_current_object_(Ptc, _, _, _, _),
380    throw(error(permission_error(replace, object, Ptc), create_protocol(Ptc, Rels, Dirs))).
381
382create_protocol(Ptc, Rels, Dirs) :-
383    lgt_current_category_(Ptc, _),
384    throw(error(permission_error(replace, category, Ptc), create_protocol(Ptc, Rels, Dirs))).
385
386create_protocol(Ptc, Rels, Dirs) :-
387    (var(Rels); \+ lgt_proper_list(Rels)),
388    throw(error(type_error(list, Rels), create_protocol(Ptc, Rels, Dirs))).
389
390create_protocol(Ptc, Rels, Dirs) :-
391    (var(Dirs); \+ lgt_proper_list(Dirs)),
392    throw(error(type_error(list, Dirs), create_protocol(Ptc, Rels, Dirs))).
393
394create_protocol(Ptc, Rels, Dirs) :-
395    lgt_clean_up,
396    lgt_tr_directive(protocol, [Ptc| Rels]),
397    lgt_tr_directives(Dirs),
398    lgt_gen_protocol_clauses,
399    lgt_gen_protocol_directives,
400    lgt_assert_tr_entity,
401    lgt_report_unknown_entities.
402
403
404
405% abolish_object(@object_identifier)
406
407abolish_object(Obj) :-
408    var(Obj),
409    throw(error(instantiation_error, abolish_object(Obj))).
410
411abolish_object(Obj) :-
412    \+ lgt_valid_object_id(Obj),
413    throw(error(type_error(object_identifier, Obj), abolish_object(Obj))).
414
415abolish_object(Obj) :-
416    lgt_current_object_(Obj, Prefix, _, _, _) ->
417        (object_property(Obj, (dynamic)) ->
418            lgt_once(Prefix, Dcl, Def, Super, IDcl, IDef, DDcl, DDef),
419            forall(
420                lgt_call(Def, _, _, _, _, Pred),
421                (functor(Pred, Functor, Arity),
422                 abolish(Functor/Arity))),
423            forall(
424                lgt_call(DDef, _, _, _, _, Pred),
425                (functor(Pred, Functor, Arity),
426                 abolish(Functor/Arity))),
427            abolish(Dcl/4),
428            abolish(Dcl/6),
429            abolish(Def/5),
430            abolish(Def/6),
431            abolish(Super/6),
432            abolish(IDcl/6),
433            abolish(IDef/6),
434            abolish(DDcl/4),
435            abolish(DDef/5),
436            abolish(Prefix/7),
437            retractall(lgt_current_object_(Obj, _, _, _, _)),
438            retractall(lgt_extends_object_(Obj, _, _)),
439            retractall(lgt_instantiates_class_(Obj, _, _)),
440            retractall(lgt_specializes_class_(Obj, _, _)),
441            retractall(lgt_implements_protocol_(Obj, _, _)),
442            retractall(lgt_imports_category_(Obj, _, _))           
443            ;
444            throw(error(permission_error(modify, static_object, Obj), abolish_object(Obj))))
445        ;
446        throw(error(existence_error(object, Obj), abolish_object(Obj))).
447
448
449
450% abolish_category(@category_identifier)
451
452abolish_category(Ctg) :-
453    var(Ctg),
454    throw(error(instantiation_error, abolish_category(Ctg))).
455
456abolish_category(Ctg) :-
457    \+ lgt_valid_category_id(Ctg),
458    throw(error(type_error(category_identifier, Ctg), abolish_category(Ctg))).
459
460abolish_category(Ctg) :-
461    lgt_current_category_(Ctg, Prefix) ->
462        (category_property(Ctg, (dynamic)) ->
463            lgt_once(Prefix, Dcl, Def),
464            forall(
465                lgt_call(Def, _, _, _, _, Pred),
466                (functor(Pred, Functor, Arity),
467                 abolish(Functor/Arity))),
468            abolish(Dcl/4),
469            abolish(Dcl/5),
470            abolish(Def/5),
471            abolish(Prefix/2),
472            retractall(lgt_current_category_(Ctg, _)),
473            retractall(lgt_implements_protocol_(Ctg, _, _))
474            ;
475            throw(error(permission_error(modify, static_category, Ctg), abolish_category(Ctg))))
476        ;
477        throw(error(existence_error(category, Ctg), abolish_category(Ctg))).
478
479
480
481% abolish_protocol(@protocol_identifier)
482
483abolish_protocol(Ptc) :-
484    var(Ptc),
485    throw(error(instantiation_error, abolish_protocol(Ptc))).
486
487abolish_protocol(Ptc) :-
488    \+ lgt_valid_protocol_id(Ptc),
489    throw(error(type_error(protocol_identifier, Ptc), abolish_protocol(Ptc))).
490
491abolish_protocol(Ptc) :-
492    lgt_current_protocol_(Ptc, Prefix) ->
493        (protocol_property(Ptc, (dynamic)) ->
494            lgt_once(Prefix, Dcl),
495            abolish(Dcl/4),
496            abolish(Dcl/5),
497            abolish(Prefix/1),
498            retractall(lgt_current_protocol_(Ptc, _)),
499            retractall(lgt_extends_protocol_(Ptc, _, _))
500            ;
501            throw(error(permission_error(modify, static_protocol, Ptc), abolish_protocol(Ptc))))
502        ;
503        throw(error(existence_error(protocol, Ptc), abolish_protocol(Ptc))).
504
505
506
507% implements_protocol(?term, ?atom)
508
509implements_protocol(Entity, Ptc) :-
510    catch(
511        implements_protocol(Entity, Ptc, _),
512        error(Error, _),
513        throw(error(Error, implements_protocol(Entity, Ptc)))).
514
515
516
517% implements_protocol(?term, ?atom, ?atom)
518
519implements_protocol(Entity, Ptc, Scope) :-
520    nonvar(Entity),
521    \+ lgt_valid_object_id(Entity),
522    throw(error(type_error(object_identifier, Entity), implements_protocol(Entity, Ptc, Scope))).
523
524implements_protocol(Entity, Ptc, Scope) :-
525    nonvar(Ptc),
526    \+ lgt_valid_protocol_id(Ptc),
527    throw(error(type_error(protocol_identifier, Ptc), implements_protocol(Entity, Ptc, Scope))).
528
529implements_protocol(Entity, Ptc, Scope) :-
530    nonvar(Scope),
531    \+ lgt_member(Scope, [(public), protected, private]),
532    throw(error(type_error(scope, Scope), implements_protocol(Entity, Ptc, Scope))).
533
534implements_protocol(Entity, Ptc, Scope) :-
535    lgt_implements_protocol_(Entity, Ptc, Scope).
536
537
538
539% imports_category(?term, ?term)
540
541imports_category(Obj, Ctg) :-
542    catch(
543        imports_category(Obj, Ctg, _),
544        error(Error, _),
545        throw(error(Error, imports_category(Obj, Ctg)))).
546
547
548
549% imports_category(?term, ?term, ?atom)
550
551imports_category(Obj, Ctg, Scope) :-
552    nonvar(Obj),
553    \+ lgt_valid_object_id(Obj),
554    throw(error(type_error(object_identifier, Obj), imports_category(Obj, Ctg, Scope))).
555
556imports_category(Obj, Ctg, Scope) :-
557    nonvar(Ctg),
558    \+ lgt_valid_category_id(Ctg),
559    throw(error(type_error(category_identifier, Ctg), imports_category(Obj, Ctg, Scope))).
560
561imports_category(Obj, Ctg, Scope) :-
562    nonvar(Scope),
563    \+ lgt_member(Scope, [(public), protected, private]),
564    throw(error(type_error(scope, Scope), imports_category(Obj, Ctg, Scope))).
565
566imports_category(Obj, Ctg, Scope) :-
567    lgt_imports_category_(Obj, Ctg, Scope).
568
569
570
571% instantiates_class(?term, ?term)
572
573instantiates_class(Obj, Class) :-
574    catch(
575        instantiates_class(Obj, Class, _),
576        error(Error, _),
577        throw(error(Error, instantiates_class(Obj, Class)))).
578
579
580
581% instantiates_class(?term, ?term, ?atom)
582
583instantiates_class(Obj, Class, Scope) :-
584    nonvar(Obj),
585    \+ lgt_valid_object_id(Obj),
586    throw(error(type_error(object_identifier, Obj), instantiates_class(Obj, Class, Scope))).
587
588instantiates_class(Obj, Class, Scope) :-
589    nonvar(Class),
590    \+ lgt_valid_object_id(Class),
591    throw(error(type_error(object_identifier, Class), instantiates_class(Obj, Class, Scope))).
592
593instantiates_class(Obj, Class, Scope) :-
594    nonvar(Scope),
595    \+ lgt_member(Scope, [(public), protected, private]),
596    throw(error(type_error(scope, Scope), instantiates_class(Obj, Class, Scope))).
597
598instantiates_class(Obj, Class, Scope) :-
599    lgt_instantiates_class_(Obj, Class, Scope).
600
601
602
603% specializes_class(?term, ?term)
604
605specializes_class(Class, Superclass) :-
606    catch(
607        specializes_class(Class, Superclass, _),
608        error(Error, _),
609        throw(error(Error, specializes_class(Class, Superclass)))).
610
611
612
613% specializes_class(?term, ?term, ?atom)
614
615specializes_class(Class, Superclass, Scope) :-
616    nonvar(Class),
617    \+ lgt_valid_object_id(Class),
618    throw(error(type_error(object_identifier, Class), specializes_class(Class, Superclass, Scope))).
619
620specializes_class(Class, Superclass, Scope) :-
621    nonvar(Superclass),
622    \+ lgt_valid_object_id(Superclass),
623    throw(error(type_error(object_identifier, Superclass), specializes_class(Class, Superclass, Scope))).
624
625specializes_class(Class, Superclass, Scope) :-
626    nonvar(Scope),
627    \+ lgt_member(Scope, [(public), protected, private]),
628    throw(error(type_error(scope, Scope), specializes_class(Class, Superclass, Scope))).
629
630specializes_class(Class, Superclass, Scope) :-
631    lgt_specializes_class_(Class, Superclass, Scope).
632
633
634
635% extends_protocol(?atom, ?atom)
636
637extends_protocol(Ptc1, Ptc2) :-
638    catch(
639        extends_protocol(Ptc1, Ptc2, _),
640        error(Error, _),
641        throw(error(Error, extends_protocol(Ptc1, Ptc2)))).
642
643
644
645% extends_protocol(?atom, ?atom, ?atom)
646
647extends_protocol(Ptc1, Ptc2, Scope) :-
648    nonvar(Ptc1),
649    \+ lgt_valid_protocol_id(Ptc1),
650    throw(error(type_error(protocol_identifier, Ptc1), extends_protocol(Ptc1, Ptc2, Scope))).
651
652extends_protocol(Ptc1, Ptc2, Scope) :-
653    nonvar(Ptc2),
654    \+ lgt_valid_protocol_id(Ptc2),
655    throw(error(type_error(protocol_identifier, Ptc2), extends_protocol(Ptc1, Ptc2, Scope))).
656
657extends_protocol(Ptc1, Ptc2, Scope) :-
658    nonvar(Scope),
659    \+ lgt_member(Scope, [(public), protected, private]),
660    throw(error(type_error(scope, Scope), extends_protocol(Ptc1, Ptc2, Scope))).
661
662extends_protocol(Ptc1, Ptc2, Scope) :-
663    lgt_extends_protocol_(Ptc1, Ptc2, Scope).
664
665
666
667% extends_object(?term, ?term)
668
669extends_object(Prototype, Parent) :-
670    catch(
671        extends_object(Prototype, Parent, _),
672        error(Error, _),
673        throw(error(Error, extends_object(Prototype, Parent)))).
674
675
676
677% extends_object(?term, ?term, ?atom)
678
679extends_object(Prototype, Parent, Scope) :-
680    nonvar(Prototype),
681    \+ lgt_valid_object_id(Prototype),
682    throw(error(type_error(object_identifier, Prototype), extends_object(Prototype, Parent, Scope))).
683
684extends_object(Prototype, Parent, Scope) :-
685    nonvar(Parent),
686    \+ lgt_valid_object_id(Parent),
687    throw(error(type_error(object_identifier, Parent), extends_object(Prototype, Parent, Scope))).
688
689extends_object(Prototype, Parent, Scope) :-
690    nonvar(Scope),
691    \+ lgt_member(Scope, [(public), protected, private]),
692    throw(error(type_error(scope, Scope), extends_object(Prototype, Parent, Scope))).
693
694extends_object(Prototype, Parent, Scope) :-
695    lgt_extends_object_(Prototype, Parent, Scope).
696
697
698
699% current_event(?event, ?object_identifier, ?callable, ?object_identifier, ?object_identifier)
700
701current_event(Event, Obj, Msg, Sender, Monitor) :-
702    nonvar(Event),
703    Event \= before,
704    Event \= after,
705    throw(error(type_error(event, Event), current_event(Event, Obj, Msg, Sender, Monitor))).
706
707current_event(Event, Obj, Msg, Sender, Monitor) :-
708    nonvar(Obj),
709    \+ lgt_valid_object_id(Obj),
710    throw(error(type_error(object_identifier, Obj), current_event(Event, Obj, Msg, Sender, Monitor))).
711
712current_event(Event, Obj, Msg, Sender, Monitor) :-
713    nonvar(Msg),
714    \+ lgt_callable(Msg),
715    throw(error(type_error(callable, Msg), current_event(Event, Obj, Msg, Sender, Monitor))).
716
717current_event(Event, Obj, Msg, Sender, Monitor) :-
718    nonvar(Sender),
719    \+ lgt_valid_object_id(Sender),
720    throw(error(type_error(object_identifier, Sender), current_event(Event, Obj, Msg, Sender, Monitor))).
721
722current_event(Event, Obj, Msg, Sender, Monitor) :-
723    nonvar(Monitor),
724    \+ lgt_valid_object_id(Monitor),
725    throw(error(type_error(object_identifier, Monitor), current_event(Event, Obj, Msg, Sender, Monitor))).
726
727current_event(before, Obj, Msg, Sender, Monitor) :-
728    lgt_before_(Obj, Msg, Sender, Monitor, _).
729
730current_event(after, Obj, Msg, Sender, Monitor) :-
731    lgt_after_(Obj, Msg, Sender, Monitor, _).
732
733
734
735%define_events(@event, @object_identifier, @callable, @object_identifier, +object_identifier)
736
737define_events(Event, Obj, Msg, Sender, Monitor) :-
738    nonvar(Event),
739    Event \= before,
740    Event \= after,
741    throw(error(type_error(event, Event), define_events(Event, Obj, Msg, Sender, Monitor))).
742
743define_events(Event, Obj, Msg, Sender, Monitor) :-
744    nonvar(Obj),
745    \+ lgt_valid_object_id(Obj),
746    throw(error(type_error(object_identifier, Obj), define_events(Event, Obj, Msg, Sender, Monitor))).
747
748define_events(Event, Obj, Msg, Sender, Monitor) :-
749    nonvar(Msg),
750    \+ lgt_callable(Msg),
751    throw(error(type_error(callable, Msg), define_events(Event, Obj, Msg, Sender, Monitor))).
752
753define_events(Event, Obj, Msg, Sender, Monitor) :-
754    nonvar(Sender),
755    \+ lgt_valid_object_id(Sender),
756    throw(error(type_error(object_identifier, Sender), define_events(Event, Obj, Msg, Sender, Monitor))).
757
758define_events(Event, Obj, Msg, Sender, Monitor) :-
759    var(Monitor),
760    throw(error(instantiation_error, define_events(Event, Obj, Msg, Sender, Monitor))).
761
762define_events(Event, Obj, Msg, Sender, Monitor) :-
763    nonvar(Monitor),
764    \+ lgt_valid_object_id(Monitor),