root/tags/lgt290/compiler/logtalk.pl

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%Â  Logtalk - Object oriented extension to Prolog
%Â  Release 2.9.0
%
%  Copyright (c) 1998-2001 Paulo Moura.  All Rights Reserved.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%Â  operators
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%



% message sending operators

:- op(600, xfy, ::).                        % send to object
:- op(600,  fy, ::).                        % send to self

:- op(600,  fx, ^^).                        % super call


% mode operators

:- op(200, fy, +).                          % input argument (instantiated)
:- op(200, fy, ?).                          % input/output argument
:- op(200, fy, @).                          % input argument (not modified by the call)
:- op(200, fy, -).                          % output argument (not instantiated)




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%Â  runtime directives
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%



% tables of defined events and monitors

:- dynamic(lgt_before_/5).                  % lgt_before_(Obj, Msg, Sender, Monitor, Call)
:- dynamic(lgt_after_/5).                   % lgt_after_(Obj, Msg, Sender, Monitor, Call)



% tables of loaded entities and respective relationships

:- dynamic(lgt_current_protocol_/2).        % lgt_current_protocol_(Ptc, Prefix)
:- dynamic(lgt_current_category_/2).        % lgt_current_category_(Ctg, Prefix)
:- dynamic(lgt_current_object_/5).          % lgt_current_object_(Obj, Prefix, Dcl, Def, Super)

:- dynamic(lgt_implements_protocol_/3).     % lgt_implements_protocol_(ObjOrCtg, Ptc, Scope)
:- dynamic(lgt_imports_category_/3).        % lgt_imports_category_(Obj, Ctg, Scope)
:- dynamic(lgt_instantiates_class_/3).      % lgt_instantiates_class_(Instance, Class, Scope)
:- dynamic(lgt_specializes_class_/3).       % lgt_specializes_class_(Class, Superclass, Scope)
:- dynamic(lgt_extends_protocol_/3).        % lgt_extends_protocol_(Ptc1, Ptc2, Scope)
:- dynamic(lgt_extends_object_/3).          % lgt_extends_object_(Prototype, Parent, Scope)




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%Â  pre-processor directives
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%



:- dynamic(lgt_dcl_/1).                     % lgt_dcl_(Clause)
:- dynamic(lgt_def_/1).                     % lgt_def_(Clause)
:- dynamic(lgt_super_/1).                   % lgt_super_(Clause)

:- dynamic(lgt_dynamic_/1).                 % lgt_dynamic_(Functor/Arity)
:- dynamic(lgt_discontiguous_/1).           % lgt_discontiguous_(Functor/Arity)
:- dynamic(lgt_mode_/2).                    % lgt_mode_(Mode, Determinism)
:- dynamic(lgt_public_/1).                  % lgt_public_(Functor/Arity)
:- dynamic(lgt_protected_/1).               % lgt_protected_(Functor/Arity)
:- dynamic(lgt_private_/1).                 % lgt_private_(Functor/Arity)
:- dynamic(lgt_metapredicate_/1).           % lgt_metapredicate_(Pred)

:- dynamic(lgt_object_/9).                  % lgt_object_(Obj, Prefix, Dcl, Def, Super, IDcl, IDef, DDcl, DDef)
:- dynamic(lgt_category_/4).                % lgt_category_(Ctg, Prefix, Dcl, Def)
:- dynamic(lgt_protocol_/3).                % lgt_protocol_(Ptc, Prefix, Dcl)

:- dynamic(lgt_uses_/1).                    % lgt_uses_(Entity)
:- dynamic(lgt_calls_/1).                   % lgt_calls_(Entity)
:- dynamic(lgt_info_/1).                    % lgt_info_(List)
:- dynamic(lgt_info_/2).                    % lgt_info_(Functor/Arity, List)

:- dynamic(lgt_implemented_protocol_/4).    % lgt_implemented_protocol_(Ptc, Prefix, Dcl, Scope)
:- dynamic(lgt_imported_category_/5).       % lgt_imported_category_(Ctg, Prefix, Dcl, Def, Scope)
:- dynamic(lgt_extended_object_/10).        % lgt_extended_object_(Parent, Prefix, Dcl, Def, Super, IDcl, IDef, DDcl, DDef, Scope)
:- dynamic(lgt_instantiated_class_/10).     % lgt_instantiated_class_(Class, Prefix, Dcl, Def, Super, IDcl, IDef, DDcl, DDef, Scope)
:- dynamic(lgt_specialized_class_/10).      % lgt_specialized_class_(Superclass, Prefix, Dcl, Def, Super, IDcl, IDef, DDcl, DDef, Scope)
:- dynamic(lgt_extended_protocol_/4).       % lgt_extended_protocol_(Ptc2, Prefix, Dcl, Scope)

:- dynamic(lgt_entity_/4).                  % lgt_entity_(Type, Entity, Prefix, Dcl)
:- dynamic(lgt_entity_functors_/1).         % lgt_entity_functors_(Clause)
:- dynamic(lgt_entity_init_/1).             % lgt_entity_init_(Goal)
:- dynamic(lgt_fentity_init_/1).            % lgt_fentity_init_(Goal)
:- dynamic(lgt_entity_comp_mode_/1).        % lgt_entity_comp_mode_(Type)

:- dynamic(lgt_redefined_built_in_/3).      % lgt_redefined_built_in_(Head, Context, THead)

:- dynamic(lgt_directive_/1).               % lgt_directive_(Dir)
:- dynamic(lgt_rclause_/1).                 % lgt_rclause_(Clause)
:- dynamic(lgt_eclause_/1).                 % lgt_eclause_(Clause)
:- dynamic(lgt_feclause_/1).                % lgt_feclause_(Clause)

:- dynamic(lgt_defs_pred_/1).               % lgt_defs_pred_(Functor/Arity)
:- dynamic(lgt_calls_pred_/1).              % lgt_calls_pred_(Functor/Arity)

:- dynamic(lgt_current_compiler_option_/2). % lgt_current_compiler_option_(Option, Value)

:- dynamic(lgt_referenced_object_/1).       % lgt_referenced_object_(Object)
:- dynamic(lgt_referenced_protocol_/1).     % lgt_referenced_protocol_(Protocol)
:- dynamic(lgt_referenced_category_/1).     % lgt_referenced_object_(Category)




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%Â  top level runtime predicate for message sending: ::/2
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%



Obj::Pred :-
    var(Obj),
    throw(error(instantiation_error, Obj::Pred, user)).

Obj::Pred :-
    var(Pred),
    throw(error(instantiation_error, Obj::Pred, user)).

Obj::Pred :-
    lgt_sender(Context, user),
    lgt_this(Context, user),
    lgt_self(Context, Obj),
    lgt_tr_msg(Obj, Pred, Call, Context),
    call(Call).




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%Â  built-in predicates
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%



% current_object(?object_identifier)

current_object(Obj) :-
    nonvar(Obj),
    \+ lgt_valid_object_id(Obj),
    throw(error(type_error(object_identifier, Obj), current_object(Obj))).

current_object(Obj) :-
    lgt_current_object_(Obj, _, _, _, _).



% current_protocol(?protocol_identifier)

current_protocol(Ptc) :-
    nonvar(Ptc),
    \+ lgt_valid_protocol_id(Ptc),
    throw(error(type_error(protocol_identifier, Ptc), current_protocol(Ptc))).

current_protocol(Ptc) :-
    lgt_current_protocol_(Ptc, _).



% current_category(?category_identifier)

current_category(Ctg) :-
    nonvar(Ctg),
    \+ lgt_valid_category_id(Ctg),
    throw(error(type_error(category_identifier, Ctg), current_category(Ctg))).

current_category(Ctg) :-
    lgt_current_category_(Ctg, _).



% object_property(?object_identifier, ?object_property)

object_property(Obj, Prop) :-
    nonvar(Obj),
    \+ lgt_valid_object_id(Obj),
    throw(error(type_error(object_identifier, Obj), object_property(Obj, Prop))).

object_property(Obj, Prop) :-
    nonvar(Prop),
    \+ lgt_member(Prop, [(dynamic), static, built_in]),
    throw(error(domain_error(object_property, Prop), object_property(Obj, Prop))).

object_property(user, built_in).

object_property(Obj, Prop) :-
    lgt_current_object_(Obj, Prefix, _, _, _),
    functor(Pred, Prefix, 7),
    (lgt_predicate_property(Pred, (dynamic)) ->
        Prop = (dynamic)
        ;
        Prop = static).



% category_property(?category_identifier, ?category_property)

category_property(Ctg, Prop) :-
    nonvar(Ctg),
    \+ lgt_valid_category_id(Ctg),
    throw(error(type_error(category_identifier, Ctg), category_property(Ctg, Prop))).

category_property(Ctg, Prop) :-
    nonvar(Prop),
    \+ lgt_member(Prop, [(dynamic), static, built_in]),
    throw(error(domain_error(category_property, Prop), category_property(Ctg, Prop))).

category_property(Ctg, Prop) :-
    lgt_current_category_(Ctg, Prefix),
    functor(Pred, Prefix, 2),
    (lgt_predicate_property(Pred, (dynamic)) ->
        Prop = (dynamic)
        ;
        Prop = static).



% protocol_property(?protocol_identifier, ?protocol_property)

protocol_property(Ptc, Prop) :-
    nonvar(Ptc),
    \+ lgt_valid_protocol_id(Ptc),
    throw(error(type_error(protocol_identifier, Ptc), protocol_property(Ptc, Prop))).

protocol_property(Ptc, Prop) :-
    nonvar(Prop),
    \+ lgt_member(Prop, [(dynamic), static, built_in]),
    throw(error(domain_error(protocol_property, Prop), protocol_property(Ptc, Prop))).

protocol_property(Ptc, Prop) :-
    lgt_current_protocol_(Ptc, Prefix),
    functor(Pred, Prefix, 1),
    (lgt_predicate_property(Pred, (dynamic)) ->
        Prop = (dynamic)
        ;
        Prop = static).



% create_object(+object_identifier, +list, +list, +list)

create_object(Obj, Rels, Dirs, Clauses) :-
    var(Obj),
    throw(error(instantiation_error, create_object(Obj, Rels, Dirs, Clauses))).

create_object(Obj, Rels, Dirs, Clauses) :-
    \+ lgt_valid_object_id(Obj),
    throw(error(type_error(object_identifier, Obj), create_object(Obj, Rels, Dirs, Clauses))).

create_object(Obj, Rels, Dirs, Clauses) :-
    lgt_current_object_(Obj, _, _, _, _),
    throw(error(permission_error(replace, object, Obj), create_object(Obj, Rels, Dirs, Clauses))).

create_object(Obj, Rels, Dirs, Clauses) :-
    lgt_current_category_(Obj, _),
    throw(error(permission_error(replace, category, Obj), create_object(Obj, Rels, Dirs, Clauses))).

create_object(Obj, Rels, Dirs, Clauses) :-
    lgt_current_protocol_(Obj, _),
    throw(error(permission_error(replace, protocol, Obj), create_object(Obj, Rels, Dirs, Clauses))).

create_object(Obj, Rels, Dirs, Clauses) :-
    (var(Rels); \+ lgt_proper_list(Rels)),
    throw(error(type_error(list, Rels), create_object(Obj, Rels, Dirs, Clauses))).

create_object(Obj, Rels, Dirs, Clauses) :-
    (var(Dirs); \+ lgt_proper_list(Dirs)),
    throw(error(type_error(list, Dirs), create_object(Obj, Rels, Dirs, Clauses))).

create_object(Obj, Rels, Dirs, Clauses) :-
    (var(Clauses); \+ lgt_proper_list(Clauses)),
    throw(error(type_error(list, Clauses), create_object(Obj, Rels, Dirs, Clauses))).

create_object(Obj, Rels, Dirs, Clauses) :-
    lgt_clean_up,
    lgt_tr_directive(object, [Obj| Rels]),
    lgt_tr_directives(Dirs),
    lgt_tr_clauses(Clauses),
    lgt_fix_redef_built_ins,
    lgt_gen_object_clauses,
    lgt_gen_object_directives,
    lgt_assert_tr_entity,
    lgt_report_unknown_entities.



% create_category(+category_identifier, +list, +list, +list)

create_category(Ctg, Rels, Dirs, Clauses) :-
    var(Ctg),
    throw(error(instantiation_error, create_category(Ctg, Rels, Dirs, Clauses))).

create_category(Ctg, Rels, Dirs, Clauses) :-
    \+ lgt_valid_category_id(Ctg),
    throw(error(type_error(category_identifier, Ctg), create_category(Ctg, Rels, Dirs, Clauses))).

create_category(Ctg, Rels, Dirs, Clauses) :-
    lgt_current_category_(Ctg, _),
    throw(error(permission_error(replace, category, Ctg), create_category(Ctg, Rels, Dirs, Clauses))).

create_category(Ctg, Rels, Dirs, Clauses) :-
    lgt_current_object_(Ctg, _, _, _, _),
    throw(error(permission_error(replace, object, Ctg), create_category(Ctg, Rels, Dirs, Clauses))).

create_category(Ctg, Rels, Dirs, Clauses) :-
    lgt_current_protocol_(Ctg, _),
    throw(error(permission_error(replace, protocol, Ctg), create_category(Ctg, Rels, Dirs, Clauses))).

create_category(Ctg, Rels, Dirs, Clauses) :-
    (var(Rels); \+ lgt_proper_list(Rels)),
    throw(error(type_error(list, Rels), create_category(Ctg, Rels, Dirs, Clauses))).

create_category(Ctg, Rels, Dirs, Clauses) :-
    (var(Dirs); \+ lgt_proper_list(Dirs)),
    throw(error(type_error(list, Dirs), create_category(Ctg, Rels, Dirs, Clauses))).

create_category(Ctg, Rels, Dirs, Clauses) :-
    (var(Clauses); \+ lgt_proper_list(Clauses)),
    throw(error(type_error(list, Clauses), create_category(Ctg, Rels, Dirs, Clauses))).

create_category(Ctg, Rels, Dirs, Clauses) :-
    lgt_clean_up,
    lgt_tr_directive(category, [Ctg| Rels]),
    lgt_tr_directives(Dirs),
    lgt_tr_clauses(Clauses),
    lgt_fix_redef_built_ins,
    lgt_gen_category_clauses,
    lgt_gen_category_directives,
    lgt_assert_tr_entity,
    lgt_report_unknown_entities.



% create_protocol(+protocol_identifier, +list, +list)

create_protocol(Ptc, Rels, Dirs) :-
    var(Ptc),
    throw(error(instantiation_error, create_protocol(Ptc, Rels, Dirs))).

create_protocol(Ptc, Rels, Dirs) :-
    \+ lgt_valid_protocol_id(Ptc),
    throw(error(type_error(protocol_identifier, Ptc), create_protocol(Ptc, Rels, Dirs))).

create_protocol(Ptc, Rels, Dirs) :-
    lgt_current_protocol_(Ptc, _),
    throw(error(permission_error(replace, protocol, Ptc), create_protocol(Ptc, Rels, Dirs))).

create_protocol(Ptc, Rels, Dirs) :-
    lgt_current_object_(Ptc, _, _, _, _),
    throw(error(permission_error(replace, object, Ptc), create_protocol(Ptc, Rels, Dirs))).

create_protocol(Ptc, Rels, Dirs) :-
    lgt_current_category_(Ptc, _),
    throw(error(permission_error(replace, category, Ptc), create_protocol(Ptc, Rels, Dirs))).

create_protocol(Ptc, Rels, Dirs) :-
    (var(Rels); \+ lgt_proper_list(Rels)),
    throw(error(type_error(list, Rels), create_protocol(Ptc, Rels, Dirs))).

create_protocol(Ptc, Rels, Dirs) :-
    (var(Dirs); \+ lgt_proper_list(Dirs)),
    throw(error(type_error(list, Dirs), create_protocol(Ptc, Rels, Dirs))).

create_protocol(Ptc, Rels, Dirs) :-
    lgt_clean_up,
    lgt_tr_directive(protocol, [Ptc| Rels]),
    lgt_tr_directives(Dirs),
    lgt_gen_protocol_clauses,
    lgt_gen_protocol_directives,
    lgt_assert_tr_entity,
    lgt_report_unknown_entities.



% abolish_object(@object_identifier)

abolish_object(Obj) :-
    var(Obj),
    throw(error(instantiation_error, abolish_object(Obj))).

abolish_object(Obj) :-
    \+ lgt_valid_object_id(Obj),
    throw(error(type_error(object_identifier, Obj), abolish_object(Obj))).

abolish_object(Obj) :-
    lgt_current_object_(Obj, Prefix, _, _, _) ->
        (object_property(Obj, (dynamic)) ->
            lgt_once(Prefix, Dcl, Def, Super, IDcl, IDef, DDcl, DDef),
            forall(
                lgt_call(Def, _, _, _, _, Pred),
                (functor(Pred, Functor, Arity),
                 abolish(Functor/Arity))),
            forall(
                lgt_call(DDef, _, _, _, _, Pred),
                (functor(Pred, Functor, Arity),
                 abolish(Functor/Arity))),
            abolish(Dcl/4),
            abolish(Dcl/6),
            abolish(Def/5),
            abolish(Def/6),
            abolish(Super/6),
            abolish(IDcl/6),
            abolish(IDef/6),
            abolish(DDcl/4),
            abolish(DDef/5),
            abolish(Prefix/7),
            retractall(lgt_current_object_(Obj, _, _, _, _)),
            retractall(lgt_extends_object_(Obj, _, _)),
            retractall(lgt_instantiates_class_(Obj, _, _)),
            retractall(lgt_specializes_class_(Obj, _, _)),
            retractall(lgt_implements_protocol_(Obj, _, _)),
            retractall(lgt_imports_category_(Obj, _, _))            
            ;
            throw(error(permission_error(modify, static_object, Obj), abolish_object(Obj))))
        ;
        throw(error(existence_error(object, Obj), abolish_object(Obj))).



% abolish_category(@category_identifier)

abolish_category(Ctg) :-
    var(Ctg),
    throw(error(instantiation_error, abolish_category(Ctg))).

abolish_category(Ctg) :-
    \+ lgt_valid_category_id(Ctg),
    throw(error(type_error(category_identifier, Ctg), abolish_category(Ctg))).

abolish_category(Ctg) :-
    lgt_current_category_(Ctg, Prefix) ->
        (category_property(Ctg, (dynamic)) ->
            lgt_once(Prefix, Dcl, Def),
            forall(
                lgt_call(Def, _, _, _, _, Pred),
                (functor(Pred, Functor, Arity),
                 abolish(Functor/Arity))),
            abolish(Dcl/4),
            abolish(Dcl/5),
            abolish(Def/5),
            abolish(Prefix/2),
            retractall(lgt_current_category_(Ctg, _)),
            retractall(lgt_implements_protocol_(Ctg, _, _))
            ;
            throw(error(permission_error(modify, static_category, Ctg), abolish_category(Ctg))))
        ;
        throw(error(existence_error(category, Ctg), abolish_category(Ctg))).



% abolish_protocol(@protocol_identifier)

abolish_protocol(Ptc) :-
    var(Ptc),
    throw(error(instantiation_error, abolish_protocol(Ptc))).

abolish_protocol(Ptc) :-
    \+ lgt_valid_protocol_id(Ptc),
    throw(error(type_error(protocol_identifier, Ptc), abolish_protocol(Ptc))).

abolish_protocol(Ptc) :-
    lgt_current_protocol_(Ptc, Prefix) ->
        (protocol_property(Ptc, (dynamic)) ->
            lgt_once(Prefix, Dcl),
            abolish(Dcl/4),
            abolish(Dcl/5),
            abolish(Prefix/1),
            retractall(lgt_current_protocol_(Ptc, _)),
            retractall(lgt_extends_protocol_(Ptc, _, _))
            ;
            throw(error(permission_error(modify, static_protocol, Ptc), abolish_protocol(Ptc))))
        ;
        throw(error(existence_error(protocol, Ptc), abolish_protocol(Ptc))).



% implements_protocol(?term, ?atom)

implements_protocol(Entity, Ptc) :-
    catch(
        implements_protocol(Entity, Ptc, _),
        error(Error, _),
        throw(error(Error, implements_protocol(Entity, Ptc)))).



% implements_protocol(?term, ?atom, ?atom)

implements_protocol(Entity, Ptc, Scope) :-
    nonvar(Entity),
    \+ lgt_valid_object_id(Entity),
    throw(error(type_error(object_identifier, Entity), implements_protocol(Entity, Ptc, Scope))).

implements_protocol(Entity, Ptc, Scope) :-
    nonvar(Ptc),
    \+ lgt_valid_protocol_id(Ptc),
    throw(error(type_error(protocol_identifier, Ptc), implements_protocol(Entity, Ptc, Scope))).

implements_protocol(Entity, Ptc, Scope) :-
    nonvar(Scope),
    \+ lgt_member(Scope, [(public), protected, private]),
    throw(error(type_error(scope, Scope), implements_protocol(Entity, Ptc, Scope))).

implements_protocol(Entity, Ptc, Scope) :-
    lgt_implements_protocol_(Entity, Ptc, Scope).



% imports_category(?term, ?term)

imports_category(Obj, Ctg) :-
    catch(
        imports_category(Obj, Ctg, _),
        error(Error, _),
        throw(error(Error, imports_category(Obj, Ctg)))).



% imports_category(?term, ?term, ?atom)

imports_category(Obj, Ctg, Scope) :-
    nonvar(Obj),
    \+ lgt_valid_object_id(Obj),
    throw(error(type_error(object_identifier, Obj), imports_category(Obj, Ctg, Scope))).

imports_category(Obj, Ctg, Scope) :-
    nonvar(Ctg),
    \+ lgt_valid_category_id(Ctg),
    throw(error(type_error(category_identifier, Ctg), imports_category(Obj, Ctg, Scope))).

imports_category(Obj, Ctg, Scope) :-
    nonvar(Scope),
    \+ lgt_member(Scope, [(public), protected, private]),
    throw(error(type_error(scope, Scope), imports_category(Obj, Ctg, Scope))).

imports_category(Obj, Ctg, Scope) :-
    lgt_imports_category_(Obj, Ctg, Scope).



% instantiates_class(?term, ?term)

instantiates_class(Obj, Class) :-
    catch(
        instantiates_class(Obj, Class, _),
        error(Error, _),
        throw(error(Error, instantiates_class(Obj, Class)))).



% instantiates_class(?term, ?term, ?atom)

instantiates_class(Obj, Class, Scope) :-
    nonvar(Obj),
    \+ lgt_valid_object_id(Obj),
    throw(error(type_error(object_identifier, Obj), instantiates_class(Obj, Class, Scope))).

instantiates_class(Obj, Class, Scope) :-
    nonvar(Class),
    \+ lgt_valid_object_id(Class),
    throw(error(type_error(object_identifier, Class), instantiates_class(Obj, Class, Scope))).

instantiates_class(Obj, Class, Scope) :-
    nonvar(Scope),
    \+ lgt_member(Scope, [(public), protected, private]),
    throw(error(type_error(scope, Scope), instantiates_class(Obj, Class, Scope))).

instantiates_class(Obj, Class, Scope) :-
    lgt_instantiates_class_(Obj, Class, Scope).



% specializes_class(?term, ?term)

specializes_class(Class, Superclass) :-
    catch(
        specializes_class(Class, Superclass, _),
        error(Error, _),
        throw(error(Error, specializes_class(Class, Superclass)))).



% specializes_class(?term, ?term, ?atom)

specializes_class(Class, Superclass, Scope) :-
    nonvar(Class),
    \+ lgt_valid_object_id(Class),
    throw(error(type_error(object_identifier, Class), specializes_class(Class, Superclass, Scope))).

specializes_class(Class, Superclass, Scope) :-
    nonvar(Superclass),
    \+ lgt_valid_object_id(Superclass),
    throw(error(type_error(object_identifier, Superclass), specializes_class(Class, Superclass, Scope))).

specializes_class(Class, Superclass, Scope) :-
    nonvar(Scope),
    \+ lgt_member(Scope, [(public), protected, private]),
    throw(error(type_error(scope, Scope), specializes_class(Class, Superclass, Scope))).

specializes_class(Class, Superclass, Scope) :-
    lgt_specializes_class_(Class, Superclass, Scope).



% extends_protocol(?atom, ?atom)

extends_protocol(Ptc1, Ptc2) :-
    catch(
        extends_protocol(Ptc1, Ptc2, _),
        error(Error, _),
        throw(error(Error, extends_protocol(Ptc1, Ptc2)))).



% extends_protocol(?atom, ?atom, ?atom)

extends_protocol(Ptc1, Ptc2, Scope) :-
    nonvar(Ptc1),
    \+ lgt_valid_protocol_id(Ptc1),
    throw(error(type_error(protocol_identifier, Ptc1), extends_protocol(Ptc1, Ptc2, Scope))).

extends_protocol(Ptc1, Ptc2, Scope) :-
    nonvar(Ptc2),
    \+ lgt_valid_protocol_id(Ptc2),
    throw(error(type_error(protocol_identifier, Ptc2), extends_protocol(Ptc1, Ptc2, Scope))).

extends_protocol(Ptc1, Ptc2, Scope) :-
    nonvar(Scope),
    \+ lgt_member(Scope, [(public), protected, private]),
    throw(error(type_error(scope, Scope), extends_protocol(Ptc1, Ptc2, Scope))).

extends_protocol(Ptc1, Ptc2, Scope) :-
    lgt_extends_protocol_(Ptc1, Ptc2, Scope).



% extends_object(?term, ?term)

extends_object(Prototype, Parent) :-
    catch(
        extends_object(Prototype, Parent, _),
        error(Error, _),
        throw(error(Error, extends_object(Prototype, Parent)))).



% extends_object(?term, ?term, ?atom)

extends_object(Prototype, Parent, Scope) :-
    nonvar(Prototype),
    \+ lgt_valid_object_id(Prototype),
    throw(error(type_error(object_identifier, Prototype), extends_object(Prototype, Parent, Scope))).

extends_object(Prototype, Parent, Scope) :-
    nonvar(Parent),
    \+ lgt_valid_object_id(Parent),
    throw(error(type_error(object_identifier, Parent), extends_object(Prototype, Parent, Scope))).

extends_object(Prototype, Parent, Scope) :-
    nonvar(Scope),
    \+ lgt_member(Scope, [(public), protected, private]),
    throw(error(type_error(scope, Scope), extends_object(Prototype, Parent, Scope))).

extends_object(Prototype, Parent, Scope) :-
    lgt_extends_object_(Prototype, Parent, Scope).



% current_event(?event, ?object_identifier, ?callable, ?object_identifier, ?object_identifier)

current_event(Event, Obj, Msg, Sender, Monitor) :-
    nonvar(Event),
    Event \= before,
    Event \= after,
    throw(error(type_error(event, Event), current_event(Event, Obj, Msg, Sender, Monitor))).

current_event(Event, Obj, Msg, Sender, Monitor) :-
    nonvar(Obj),
    \+ lgt_valid_object_id(Obj),
    throw(error(type_error(object_identifier, Obj), current_event(Event, Obj, Msg, Sender, Monitor))).

current_event(Event, Obj, Msg, Sender, Monitor) :-
    nonvar(Msg),
    \+ lgt_callable(Msg),
    throw(error(type_error(callable, Msg), current_event(Event, Obj, Msg, Sender, Monitor))).

current_event(Event, Obj, Msg, Sender, Monitor) :-
    nonvar(Sender),
    \+ lgt_valid_object_id(Sender),
    throw(error(type_error(object_identifier, Sender), current_event(Event, Obj, Msg, Sender, Monitor))).

current_event(Event, Obj, Msg, Sender, Monitor) :-
    nonvar(Monitor),
    \+ lgt_valid_object_id(Monitor),
    throw(error(type_error(object_identifier, Monitor), current_event(Event, Obj, Msg, Sender, Monitor))).

current_event(before, Obj, Msg, Sender, Monitor) :-
    lgt_before_(Obj, Msg, Sender, Monitor, _).

current_event(after, Obj, Msg, Sender, Monitor) :-
    lgt_after_(Obj, Msg, Sender, Monitor, _).



%define_events(@event, @object_identifier, @callable, @object_identifier, +object_identifier)

define_events(Event, Obj, Msg, Sender, Monitor) :-
    nonvar(Event),
    Event \= before,
    Event \= after,
    throw(error(type_error(event, Event), define_events(Event, Obj, Msg, Sender, Monitor))).

define_events(Event, Obj, Msg, Sender, Monitor) :-
    nonvar(Obj),
    \+ lgt_valid_object_id(Obj),
    throw(error(type_error(object_identifier, Obj), define_events(Event, Obj, Msg, Sender, Monitor))).

define_events(Event, Obj, Msg, Sender, Monitor) :-
    nonvar(Msg),
    \+ lgt_callable(Msg),
    throw(error(type_error(callable, Msg), define_events(Event, Obj, Msg, Sender, Monitor))).

define_events(Event, Obj, Msg, Sender, Monitor) :-
    nonvar(Sender),
    \+ lgt_valid_object_id(Sender),
    throw(error(type_error(object_identifier, Sender), define_events(Event, Obj, Msg, Sender, Monitor))).

define_events(Event, Obj, Msg, Sender, Monitor) :-
    var(Monitor),
    throw(error(instantiation_error, define_events(Event, Obj, Msg, Sender, Monitor))).

define_events(Event, Obj, Msg, Sender, Monitor) :-
    nonvar(Monitor),
    \+ lgt_valid_object_id(Monitor),
  Â