root/tags/lgt293/compiler/logtalk.pl

Revision 71, 149.7 KB (checked in by pmoura, 7 years ago)

Added exception to set_logtalk_flag/2 on invalid flag value.
  • 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.3
6%
7%  Copyright (c) 1998-2002 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:- dynamic(lgt_flag_/2).                    % lgt_flag_(Option, Value)
125
126:- dynamic(lgt_referenced_object_/1).       % lgt_referenced_object_(Object)
127:- dynamic(lgt_referenced_protocol_/1).     % lgt_referenced_protocol_(Protocol)
128:- dynamic(lgt_referenced_category_/1).     % lgt_referenced_object_(Category)
129
130
131
132
133%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
134%
135%  top level runtime predicate for message sending: ::/2
136%
137%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
138
139
140
141Obj::Pred :-
142    var(Obj),
143    throw(error(instantiation_error, Obj::Pred, user)).
144
145Obj::Pred :-
146    var(Pred),
147    throw(error(instantiation_error, Obj::Pred, user)).
148
149Obj::Pred :-
150    lgt_sender(Context, user),
151    lgt_this(Context, user),
152    lgt_self(Context, Obj),
153    lgt_tr_msg(Obj, Pred, Call, Context),
154    call(Call).
155
156
157
158
159%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
160%
161%  built-in predicates
162%
163%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
164
165
166
167% current_object(?object_identifier)
168
169current_object(Obj) :-
170    nonvar(Obj),
171    \+ lgt_valid_object_id(Obj),
172    throw(error(type_error(object_identifier, Obj), current_object(Obj))).
173
174current_object(Obj) :-
175    lgt_current_object_(Obj, _, _, _, _).
176
177
178
179% current_protocol(?protocol_identifier)
180
181current_protocol(Ptc) :-
182    nonvar(Ptc),
183    \+ lgt_valid_protocol_id(Ptc),
184    throw(error(type_error(protocol_identifier, Ptc), current_protocol(Ptc))).
185
186current_protocol(Ptc) :-
187    lgt_current_protocol_(Ptc, _).
188
189
190
191% current_category(?category_identifier)
192
193current_category(Ctg) :-
194    nonvar(Ctg),
195    \+ lgt_valid_category_id(Ctg),
196    throw(error(type_error(category_identifier, Ctg), current_category(Ctg))).
197
198current_category(Ctg) :-
199    lgt_current_category_(Ctg, _).
200
201
202
203% object_property(?object_identifier, ?object_property)
204
205object_property(Obj, Prop) :-
206    nonvar(Obj),
207    \+ lgt_valid_object_id(Obj),
208    throw(error(type_error(object_identifier, Obj), object_property(Obj, Prop))).
209
210object_property(Obj, Prop) :-
211    nonvar(Prop),
212    \+ lgt_member(Prop, [(dynamic), static, built_in]),
213    throw(error(domain_error(object_property, Prop), object_property(Obj, Prop))).
214
215object_property(user, built_in).
216
217object_property(Obj, Prop) :-
218    lgt_current_object_(Obj, Prefix, _, _, _),
219    functor(Pred, Prefix, 7),
220    (lgt_predicate_property(Pred, (dynamic)) ->
221        Prop = (dynamic)
222        ;
223        Prop = static).
224
225
226
227% category_property(?category_identifier, ?category_property)
228
229category_property(Ctg, Prop) :-
230    nonvar(Ctg),
231    \+ lgt_valid_category_id(Ctg),
232    throw(error(type_error(category_identifier, Ctg), category_property(Ctg, Prop))).
233
234category_property(Ctg, Prop) :-
235    nonvar(Prop),
236    \+ lgt_member(Prop, [(dynamic), static, built_in]),
237    throw(error(domain_error(category_property, Prop), category_property(Ctg, Prop))).
238
239category_property(Ctg, Prop) :-
240    lgt_current_category_(Ctg, Prefix),
241    functor(Pred, Prefix, 2),
242    (lgt_predicate_property(Pred, (dynamic)) ->
243        Prop = (dynamic)
244        ;
245        Prop = static).
246
247
248
249% protocol_property(?protocol_identifier, ?protocol_property)
250
251protocol_property(Ptc, Prop) :-
252    nonvar(Ptc),
253    \+ lgt_valid_protocol_id(Ptc),
254    throw(error(type_error(protocol_identifier, Ptc), protocol_property(Ptc, Prop))).
255
256protocol_property(Ptc, Prop) :-
257    nonvar(Prop),
258    \+ lgt_member(Prop, [(dynamic), static, built_in]),
259    throw(error(domain_error(protocol_property, Prop), protocol_property(Ptc, Prop))).
260
261protocol_property(Ptc, Prop) :-
262    lgt_current_protocol_(Ptc, Prefix),
263    functor(Pred, Prefix, 1),
264    (lgt_predicate_property(Pred, (dynamic)) ->
265        Prop = (dynamic)
266        ;
267        Prop = static).
268
269
270
271% create_object(+object_identifier, +list, +list, +list)
272
273create_object(Obj, Rels, Dirs, Clauses) :-
274    var(Obj),
275    throw(error(instantiation_error, create_object(Obj, Rels, Dirs, Clauses))).
276
277create_object(Obj, Rels, Dirs, Clauses) :-
278    \+ lgt_valid_object_id(Obj),
279    throw(error(type_error(object_identifier, Obj), create_object(Obj, Rels, Dirs, Clauses))).
280
281create_object(Obj, Rels, Dirs, Clauses) :-
282    lgt_current_object_(Obj, _, _, _, _),
283    throw(error(permission_error(replace, object, Obj), create_object(Obj, Rels, Dirs, Clauses))).
284
285create_object(Obj, Rels, Dirs, Clauses) :-
286    lgt_current_category_(Obj, _),
287    throw(error(permission_error(replace, category, Obj), create_object(Obj, Rels, Dirs, Clauses))).
288
289create_object(Obj, Rels, Dirs, Clauses) :-
290    lgt_current_protocol_(Obj, _),
291    throw(error(permission_error(replace, protocol, Obj), create_object(Obj, Rels, Dirs, Clauses))).
292
293create_object(Obj, Rels, Dirs, Clauses) :-
294    (var(Rels); \+ lgt_proper_list(Rels)),
295    throw(error(type_error(list, Rels), create_object(Obj, Rels, Dirs, Clauses))).
296
297create_object(Obj, Rels, Dirs, Clauses) :-
298    (var(Dirs); \+ lgt_proper_list(Dirs)),
299    throw(error(type_error(list, Dirs), create_object(Obj, Rels, Dirs, Clauses))).
300
301create_object(Obj, Rels, Dirs, Clauses) :-
302    (var(Clauses); \+ lgt_proper_list(Clauses)),
303    throw(error(type_error(list, Clauses), create_object(Obj, Rels, Dirs, Clauses))).
304
305create_object(Obj, Rels, Dirs, Clauses) :-
306    lgt_clean_up,
307    lgt_tr_directive(object, [Obj| Rels]),
308    lgt_tr_directives(Dirs),
309    lgt_tr_clauses(Clauses),
310    lgt_fix_redef_built_ins,
311    lgt_gen_object_clauses,
312    lgt_gen_object_directives,
313    lgt_assert_tr_entity,
314    lgt_report_unknown_entities.
315
316
317
318% create_category(+category_identifier, +list, +list, +list)
319
320create_category(Ctg, Rels, Dirs, Clauses) :-
321    var(Ctg),
322    throw(error(instantiation_error, create_category(Ctg, Rels, Dirs, Clauses))).
323
324create_category(Ctg, Rels, Dirs, Clauses) :-
325    \+ lgt_valid_category_id(Ctg),
326    throw(error(type_error(category_identifier, Ctg), create_category(Ctg, Rels, Dirs, Clauses))).
327
328create_category(Ctg, Rels, Dirs, Clauses) :-
329    lgt_current_category_(Ctg, _),
330    throw(error(permission_error(replace, category, Ctg), create_category(Ctg, Rels, Dirs, Clauses))).
331
332create_category(Ctg, Rels, Dirs, Clauses) :-
333    lgt_current_object_(Ctg, _, _, _, _),
334    throw(error(permission_error(replace, object, Ctg), create_category(Ctg, Rels, Dirs, Clauses))).
335
336create_category(Ctg, Rels, Dirs, Clauses) :-
337    lgt_current_protocol_(Ctg, _),
338    throw(error(permission_error(replace, protocol, Ctg), create_category(Ctg, Rels, Dirs, Clauses))).
339
340create_category(Ctg, Rels, Dirs, Clauses) :-
341    (var(Rels); \+ lgt_proper_list(Rels)),
342    throw(error(type_error(list, Rels), create_category(Ctg, Rels, Dirs, Clauses))).
343
344create_category(Ctg, Rels, Dirs, Clauses) :-
345    (var(Dirs); \+ lgt_proper_list(Dirs)),
346    throw(error(type_error(list, Dirs), create_category(Ctg, Rels, Dirs, Clauses))).
347
348create_category(Ctg, Rels, Dirs, Clauses) :-
349    (var(Clauses); \+ lgt_proper_list(Clauses)),
350    throw(error(type_error(list, Clauses), create_category(Ctg, Rels, Dirs, Clauses))).
351
352create_category(Ctg, Rels, Dirs, Clauses) :-
353    lgt_clean_up,
354    lgt_tr_directive(category, [Ctg| Rels]),
355    lgt_tr_directives(Dirs),
356    lgt_tr_clauses(Clauses),
357    lgt_fix_redef_built_ins,
358    lgt_gen_category_clauses,
359    lgt_gen_category_directives,
360    lgt_assert_tr_entity,
361    lgt_report_unknown_entities.
362
363
364
365% create_protocol(+protocol_identifier, +list, +list)
366
367create_protocol(Ptc, Rels, Dirs) :-
368    var(Ptc),
369    throw(error(instantiation_error, create_protocol(Ptc, Rels, Dirs))).
370
371create_protocol(Ptc, Rels, Dirs) :-
372    \+ lgt_valid_protocol_id(Ptc),
373    throw(error(type_error(protocol_identifier, Ptc), create_protocol(Ptc, Rels, Dirs))).
374
375create_protocol(Ptc, Rels, Dirs) :-
376    lgt_current_protocol_(Ptc, _),
377    throw(error(permission_error(replace, protocol, Ptc), create_protocol(Ptc, Rels, Dirs))).
378
379create_protocol(Ptc, Rels, Dirs) :-
380    lgt_current_object_(Ptc, _, _, _, _),
381    throw(error(permission_error(replace, object, Ptc), create_protocol(Ptc, Rels, Dirs))).
382
383create_protocol(Ptc, Rels, Dirs) :-
384    lgt_current_category_(Ptc, _),
385    throw(error(permission_error(replace, category, Ptc), create_protocol(Ptc, Rels, Dirs))).
386
387create_protocol(Ptc, Rels, Dirs) :-
388    (var(Rels); \+ lgt_proper_list(Rels)),
389    throw(error(type_error(list, Rels), create_protocol(Ptc, Rels, Dirs))).
390
391create_protocol(Ptc, Rels, Dirs) :-
392    (var(Dirs); \+ lgt_proper_list(Dirs)),
393    throw(error(type_error(list, Dirs), create_protocol(Ptc, Rels, Dirs))).
394
395create_protocol(Ptc, Rels, Dirs) :-
396    lgt_clean_up,
397    lgt_tr_directive(protocol, [Ptc| Rels]),
398    lgt_tr_directives(Dirs),
399    lgt_gen_protocol_clauses,
400    lgt_gen_protocol_directives,
401    lgt_assert_tr_entity,
402    lgt_report_unknown_entities.
403
404
405
406% abolish_object(@object_identifier)
407
408abolish_object(Obj) :-
409    var(Obj),
410    throw(error(instantiation_error, abolish_object(Obj))).
411
412abolish_object(Obj) :-
413    \+ lgt_valid_object_id(Obj),
414    throw(error(type_error(object_identifier, Obj), abolish_object(Obj))).
415
416abolish_object(Obj) :-
417    lgt_current_object_(Obj, Prefix, _, _, _) ->
418        (object_property(Obj, (dynamic)) ->
419            lgt_once(Prefix, Dcl, Def, Super, IDcl, IDef, DDcl, DDef),
420            forall(
421                lgt_call(Def, _, _, _, _, Pred),
422                (functor(Pred, Functor, Arity),
423                 abolish(Functor/Arity))),
424            forall(
425                lgt_call(DDef, _, _, _, _, Pred),
426                (functor(Pred, Functor, Arity),
427                 abolish(Functor/Arity))),
428            abolish(Dcl/4),
429            abolish(Dcl/6),
430            abolish(Def/5),
431            abolish(Def/6),
432            abolish(Super/6),
433            abolish(IDcl/6),
434            abolish(IDef/6),
435            abolish(DDcl/4),
436            abolish(DDef/5),
437            abolish(Prefix/7),
438            retractall(lgt_current_object_(Obj, _, _, _, _)),
439            retractall(lgt_extends_object_(Obj, _, _)),
440            retractall(lgt_instantiates_class_(Obj, _, _)),
441            retractall(lgt_specializes_class_(Obj, _, _)),
442            retractall(lgt_implements_protocol_(Obj, _, _)),
443            retractall(lgt_imports_category_(Obj, _, _))           
444            ;
445            throw(error(permission_error(modify, static_object, Obj), abolish_object(Obj))))
446        ;
447        throw(error(existence_error(object, Obj), abolish_object(Obj))).
448
449
450
451% abolish_category(@category_identifier)
452
453abolish_category(Ctg) :-
454    var(Ctg),
455    throw(error(instantiation_error, abolish_category(Ctg))).
456
457abolish_category(Ctg) :-
458    \+ lgt_valid_category_id(Ctg),
459    throw(error(type_error(category_identifier, Ctg), abolish_category(Ctg))).
460
461abolish_category(Ctg) :-
462    lgt_current_category_(Ctg, Prefix) ->
463        (category_property(Ctg, (dynamic)) ->
464            lgt_once(Prefix, Dcl, Def),
465            forall(
466                lgt_call(Def, _, _, _, _, Pred),
467                (functor(Pred, Functor, Arity),
468                 abolish(Functor/Arity))),
469            abolish(Dcl/4),
470            abolish(Dcl/5),
471            abolish(Def/5),
472            abolish(Prefix/2),
473            retractall(lgt_current_category_(Ctg, _)),
474            retractall(lgt_implements_protocol_(Ctg, _, _))
475            ;
476            throw(error(permission_error(modify, static_category, Ctg), abolish_category(Ctg))))
477        ;
478        throw(error(existence_error(category, Ctg), abolish_category(Ctg))).
479
480
481
482% abolish_protocol(@protocol_identifier)
483
484abolish_protocol(Ptc) :-
485    var(Ptc),
486    throw(error(instantiation_error, abolish_protocol(Ptc))).
487
488abolish_protocol(Ptc) :-
489    \+ lgt_valid_protocol_id(Ptc),
490    throw(error(type_error(protocol_identifier, Ptc), abolish_protocol(Ptc))).
491
492abolish_protocol(Ptc) :-
493    lgt_current_protocol_(Ptc, Prefix) ->
494        (protocol_property(Ptc, (dynamic)) ->
495            lgt_once(Prefix, Dcl),
496            abolish(Dcl/4),
497            abolish(Dcl/5),
498            abolish(Prefix/1),
499            retractall(lgt_current_protocol_(Ptc, _)),
500            retractall(lgt_extends_protocol_(Ptc, _, _))
501            ;
502            throw(error(permission_error(modify, static_protocol, Ptc), abolish_protocol(Ptc))))
503        ;
504        throw(error(existence_error(protocol, Ptc), abolish_protocol(Ptc))).
505
506
507
508% implements_protocol(?term, ?atom)
509
510implements_protocol(Entity, Ptc) :-
511    catch(
512        implements_protocol(Entity, Ptc, _),
513        error(Error, _),
514        throw(error(Error, implements_protocol(Entity, Ptc)))).
515
516
517
518% implements_protocol(?term, ?atom, ?atom)
519
520implements_protocol(Entity, Ptc, Scope) :-
521    nonvar(Entity),
522    \+ lgt_valid_object_id(Entity),
523    throw(error(type_error(object_identifier, Entity), implements_protocol(Entity, Ptc, Scope))).
524
525implements_protocol(Entity, Ptc, Scope) :-
526    nonvar(Ptc),
527    \+ lgt_valid_protocol_id(Ptc),
528    throw(error(type_error(protocol_identifier, Ptc), implements_protocol(Entity, Ptc, Scope))).
529
530implements_protocol(Entity, Ptc, Scope) :-
531    nonvar(Scope),
532    \+ lgt_member(Scope, [(public), protected, private]),
533    throw(error(type_error(scope, Scope), implements_protocol(Entity, Ptc, Scope))).
534
535implements_protocol(Entity, Ptc, Scope) :-
536    lgt_implements_protocol_(Entity, Ptc, Scope).
537
538
539
540% imports_category(?term, ?term)
541
542imports_category(Obj, Ctg) :-
543    catch(
544        imports_category(Obj, Ctg, _),
545        error(Error, _),
546        throw(error(Error, imports_category(Obj, Ctg)))).
547
548
549
550% imports_category(?term, ?term, ?atom)
551
552imports_category(Obj, Ctg, Scope) :-
553    nonvar(Obj),
554    \+ lgt_valid_object_id(Obj),
555    throw(error(type_error(object_identifier, Obj), imports_category(Obj, Ctg, Scope))).
556
557imports_category(Obj, Ctg, Scope) :-
558    nonvar(Ctg),
559    \+ lgt_valid_category_id(Ctg),
560    throw(error(type_error(category_identifier, Ctg), imports_category(Obj, Ctg, Scope))).
561
562imports_category(Obj, Ctg, Scope) :-
563    nonvar(Scope),
564    \+ lgt_member(Scope, [(public), protected, private]),
565    throw(error(type_error(scope, Scope), imports_category(Obj, Ctg, Scope))).
566
567imports_category(Obj, Ctg, Scope) :-
568    lgt_imports_category_(Obj, Ctg, Scope).
569
570
571
572% instantiates_class(?term, ?term)
573
574instantiates_class(Obj, Class) :-
575    catch(
576        instantiates_class(Obj, Class, _),
577        error(Error, _),
578        throw(error(Error, instantiates_class(Obj, Class)))).
579
580
581
582% instantiates_class(?term, ?term, ?atom)
583
584instantiates_class(Obj, Class, Scope) :-
585    nonvar(Obj),
586    \+ lgt_valid_object_id(Obj),
587    throw(error(type_error(object_identifier, Obj), instantiates_class(Obj, Class, Scope))).
588
589instantiates_class(Obj, Class, Scope) :-
590    nonvar(Class),
591    \+ lgt_valid_object_id(Class),
592    throw(error(type_error(object_identifier, Class), instantiates_class(Obj, Class, Scope))).
593
594instantiates_class(Obj, Class, Scope) :-
595    nonvar(Scope),
596    \+ lgt_member(Scope, [(public), protected, private]),
597    throw(error(type_error(scope, Scope), instantiates_class(Obj, Class, Scope))).
598
599instantiates_class(Obj, Class, Scope) :-
600    lgt_instantiates_class_(Obj, Class, Scope).
601
602
603
604% specializes_class(?term, ?term)
605
606specializes_class(Class, Superclass) :-
607    catch(
608        specializes_class(Class, Superclass, _),
609        error(Error, _),
610        throw(error(Error, specializes_class(Class, Superclass)))).
611
612
613
614% specializes_class(?term, ?term, ?atom)
615
616specializes_class(Class, Superclass, Scope) :-
617    nonvar(Class),
618    \+ lgt_valid_object_id(Class),
619    throw(error(type_error(object_identifier, Class), specializes_class(Class, Superclass, Scope))).
620
621specializes_class(Class, Superclass, Scope) :-
622    nonvar(Superclass),
623    \+ lgt_valid_object_id(Superclass),
624    throw(error(type_error(object_identifier, Superclass), specializes_class(Class, Superclass, Scope))).
625
626specializes_class(Class, Superclass, Scope) :-
627    nonvar(Scope),
628    \+ lgt_member(Scope, [(public), protected, private]),
629    throw(error(type_error(scope, Scope), specializes_class(Class, Superclass, Scope))).
630
631specializes_class(Class, Superclass, Scope) :-
632    lgt_specializes_class_(Class, Superclass, Scope).
633
634
635
636% extends_protocol(?atom, ?atom)
637
638extends_protocol(Ptc1, Ptc2) :-
639    catch(
640        extends_protocol(Ptc1, Ptc2, _),
641        error(Error, _),
642        throw(error(Error, extends_protocol(Ptc1, Ptc2)))).
643
644
645
646% extends_protocol(?atom, ?atom, ?atom)
647
648extends_protocol(Ptc1, Ptc2, Scope) :-
649    nonvar(Ptc1),
650    \+ lgt_valid_protocol_id(Ptc1),
651    throw(error(type_error(protocol_identifier, Ptc1), extends_protocol(Ptc1, Ptc2, Scope))).
652
653extends_protocol(Ptc1, Ptc2, Scope) :-
654    nonvar(Ptc2),
655    \+ lgt_valid_protocol_id(Ptc2),
656    throw(error(type_error(protocol_identifier, Ptc2), extends_protocol(Ptc1, Ptc2, Scope))).
657
658extends_protocol(Ptc1, Ptc2, Scope) :-
659    nonvar(Scope),
660    \+ lgt_member(Scope, [(public), protected, private]),
661    throw(error(type_error(scope, Scope), extends_protocol(Ptc1, Ptc2, Scope))).
662
663extends_protocol(Ptc1, Ptc2, Scope) :-
664    lgt_extends_protocol_(Ptc1, Ptc2, Scope).
665
666
667
668% extends_object(?term, ?term)
669
670extends_object(Prototype, Parent) :-
671    catch(
672        extends_object(Prototype, Parent, _),
673        error(Error, _),
674        throw(error(Error, extends_object(Prototype, Parent)))).
675
676
677
678% extends_object(?term, ?term, ?atom)
679
680extends_object(Prototype, Parent, Scope) :-
681    nonvar(Prototype),
682    \+ lgt_valid_object_id(Prototype),
683    throw(error(type_error(object_identifier, Prototype), extends_object(Prototype, Parent, Scope))).
684
685extends_object(Prototype, Parent, Scope) :-
686    nonvar(Parent),
687    \+ lgt_valid_object_id(Parent),
688    throw(error(type_error(object_identifier, Parent), extends_object(Prototype, Parent, Scope))).
689
690extends_object(Prototype, Parent, Scope) :-
691    nonvar(Scope),
692    \+ lgt_member(Scope, [(public), protected, private]),
693    throw(error(type_error(scope, Scope), extends_object(Prototype, Parent, Scope))).
694
695extends_object(Prototype, Parent, Scope) :-
696    lgt_extends_object_(Prototype, Parent, Scope).
697
698
699
700% current_event(?event, ?object_identifier, ?callable, ?object_identifier, ?object_identifier)
701
702current_event(Event, Obj, Msg, Sender, Monitor) :-
703    nonvar(Event),
704    Event \= before,
705    Event \= after,
706    throw(error(type_error(event, Event), current_event(Event, Obj, Msg, Sender, Monitor))).
707
708current_event(Event, Obj, Msg, Sender, Monitor) :-
709    nonvar(Obj),
710    \+ lgt_valid_object_id(Obj),
711    throw(error(type_error(object_identifier, Obj), current_event(Event, Obj, Msg, Sender, Monitor))).
712
713current_event(Event, Obj, Msg, Sender, Monitor) :-
714    nonvar(Msg),
715    \+ lgt_callable(Msg),
716    throw(error(type_error(callable, Msg), current_event(Event, Obj, Msg, Sender, Monitor))).
717
718current_event(Event, Obj, Msg, Sender, Monitor) :-
719    nonvar(Sender),
720    \+ lgt_valid_object_id(Sender),
721    throw(error(type_error(object_identifier, Sender), current_event(Event, Obj, Msg, Sender, Monitor))).
722
723current_event(Event, Obj, Msg, Sender, Monitor) :-
724    nonvar(Monitor),
725    \+ lgt_valid_object_id(Monitor),
726    throw(error(type_error(object_identifier, Monitor), current_event(Event, Obj, Msg, Sender, Monitor))).
727
728current_event(before, Obj, Msg, Sender, Monitor) :-
729    lgt_before_(Obj, Msg, Sender, Monitor, _).
730
731current_event(after, Obj, Msg, Sender, Monitor) :-
732    lgt_after_(Obj, Msg, Sender, Monitor, _).
733
734
735
736%define_events(@event, @object_identifier, @callable, @object_identifier, +object_identifier)
737
738define_events(Event, Obj, Msg, Sender, Monitor) :-
739    nonvar(Event),
740    Event \= before,
741    Event \= after,
742    throw(error(type_error(event, Event), define_events(Event, Obj, Msg, Sender, Monitor))).
743
744define_events(Event, Obj, Msg, Sender, Monitor) :-
745    nonvar(Obj),
746    \+ lgt_valid_object_id(Obj),
747    throw(error(type_error(object_identifier, Obj), define_events(Event, Obj, Msg, Sender, Monitor))).
748
749define_events(Event, Obj, Msg, Sender, Monitor) :-
750    nonvar(Msg),
751    \+ lgt_callable(Msg),
752    throw(error(type_error(callable, Msg), define_events(Event, Obj, Msg, Sender, Monitor))).
753
754define_events(Event, Obj, Msg, Sender, Monitor) :-
755    nonvar(Sender),
756    \+ lgt_valid_object_id(Sender),
757    throw(error(type_error(object_identifier, Sender), define_events(Event, Obj, Msg, Sender, Monitor))).
758
759define_events(Event, Obj, Msg, Sender, Monitor) :-
760    var(Monitor),
761    throw(error(instantiation_error, define_events(Event, Obj, Msg, Sender, Monitor))).
762
763define_events(Event, Obj, Msg, Sender, Monitor) :-