Faking OOP features, Prolog

Faking OOP features

%commands to the interpreter are submitted from stdin input ('show input' box below)
%'halt.' will be automatically appended to stdin input.
%swi-prolog 7.6.4

%Basic utilities for fake OOP.
% OBJECT CREATION:
% If class(Thing,Class) is true, then all terms that unify with Thing have class Class.
% new(Class,X) unifies X with some term, and assert that term to be of class Class.
%              new/2 never uses the same term twice for this purpose in the same run.
% with_object(Class,X,Q) creates a new term of class X, unifies it to X, then calls the goal Q.
%              It also tries to clean after itself, by calling the new object's destroy 'method'
%              if defined and then cleaning the database of anything pertaining to that object.
% with_objects([Class1,X1,Class2,X2,...],Q) is the same as nesting multiple with_object/3.
%
% SETTERS AND GETTERS:
% The operators ::, ::= are used. They both are yfx with priority 500.
% Obj::Attr::=Value sets the attribute Attr of object Obj to Value.
% Obj::Attr::Value checks if the attribute Attr of object Obj is Value.
%
% METHODS:
% The operator := is yfx with priority 1100.
% If (foo(X)::bar(Y1,Y2,...) := Q(X,Y1,Y2,...)) is true -- where the
% goal Q may contain the variables X and Y1,... --, then the class
% foo will have a method named bar defined by that clause.
% X::baz(Y1,...) will check if X is of a class that has a method named baz
% so that baz(Y1,...) is true.
%
% INHERITANCE:
% If isa(Child,Parent) is true, then the class Child inherits from Parent.
% Inherited classes can see methods of their parents, unless shadowed.
% Multiple inheritance is allowed.
%
% DESTRUCTION:
% Objects created inside a with_object/3 or with_objects/2 are automatically
% purged from the database. While doing so, the objects' destroy/0 method is 
% called, provided that it exists.
%
% N.B.: all methods are public. You can set any attribute on any object.
% This is obviously not meant for any serious use.

use_module(library(gensym)).

:- op(500, yfx, '::').
:- op(500, yfx, '::='). 
:- op(1100, yfx, ':=').

inherit(X,Y) :- isa(X,Y).
inherit(X,Y) :- isa(X,Z), X\=Z, inherit(Z,Y).
:- dynamic isa/2.
:- multifile isa/2.
:- dynamic class/2.
:- multifile class/2.

:- dynamic call_method/3.
:- multifile call_method/3.
:- multifile user:term_expansion/2.
user:term_expansion(:=(Class::Method, Q), (call_method(Cl,X,Method) :- Q))
    :- functor(Class,Cl,1),
       arg(1,Class,X).
Obj::Attr::=Value :- asserta(
    (Obj::Attr1::Value1 :- Attr1=Attr, !,
                           Value1=Value) ).

:- dynamic (::)/2.
:- multifile (::)/2.
allow_method_calling :- assert(
    (Obj::Method :- class(Obj,Cl), !,
                    call_method(Cl,Obj,Method)) ),
  assert(
    (Obj::Method :- class(Obj,Cl1), inherit(Cl1,Cl),
                    call_method(Cl,Obj,Method)) ).
:- allow_method_calling.

genterm(X) :- nonvar(X), functor(X,_,0), !.
genterm(X) :- var(X), !, gensym(obj,X).
genterm(F) :- functor(F,_,N), genterm(F,N).
genterm(_,0).
genterm(F,N) :- arg(N,F,X), genterm(X),
                M is N-1, genterm(F,M).
new(Class,X) :- genterm(X), assert(class(X,Class)).
destroy(X) :- class(X,_), ((X::destroy, !); true),
              retractall(X::_::_),
              allow_method_calling,
              retractall(class(X,_)).
with_object(Class,X,Q) :- new(Class,X),
                          ((call(Q), !); true),
                          ((destroy(X), !); true).
with_objects([],Q) :- Q.
with_objects([Class,X|T],Q) :- with_object(Class,X,with_objects(T,Q)).

%% EXAMPLE %%
person(X)::can_vote := X::age::Age, Age>=18.
person(X)::older_than(Y) := X::age::Ax, Y::age::Ay, Ax>Ay.
person(X)::destroy := X::name::Name, write(Name), writeln(' retired.').
child(X)::destroy := X::name::Name, write(Name), writeln(' ran away.').
isa(child,person).

main :- with_objects([person, John, child, Mary], (
    John::age::=25, John::name::='John',
    Mary::age::=10, Mary::name::='Mary',
    (((John::can_vote, writeln('John can vote.')),!);
                       writeln('John can\'t vote.')),
    (((Mary::can_vote, writeln('Mary can vote.')),!);
                       writeln('Mary can\'t vote.')),
    (((John::older_than(Mary), writeln('John is older than Mary.')),!);
                               writeln('John isn\'t older than Mary.')) )).

:- main.
%% prints:  John can vote
%%          Mary can't vote
%%          John is older than Mary
%%          Mary ran away.
%%          John retired.


run \| edit \| history \| help	1