From: LeonardoBizzoni Date: Sun, 24 Dec 2023 17:59:46 +0000 (+0100) Subject: Aggiunti wrapper per `def_class` e `make` e rinominato titoli X-Git-Url: http://git.leonardobizzoni.com/?a=commitdiff_plain;h=048b8aa6690f543f05e70f4414637c976eb92ed6;p=ObjectOriented-Prolog-Lisp Aggiunti wrapper per `def_class` e `make` e rinominato titoli Prima chiamando `def_class(name, ...)` se si verificava un errore `name` rimaneva un nome valido di classe e non era possibile riprovare a creare la classe con lo stesso nome. Idem per `make(name, ...)` se si verificava un errore `name` rimaneva un nome valido di istanza. --- diff --git a/Prolog/README.org b/Prolog/README.org index 1b42bbf..d4f15bd 100644 --- a/Prolog/README.org +++ b/Prolog/README.org @@ -12,43 +12,29 @@ *** Definizione Definisce la struttura di una classe. - *** Implementazione #+begin_src prolog :tangle oop.pl %%%% %%%% -def_class(ClassName, []) :- - nonvar(ClassName), +def_class(ClassName, Parents) :- def_class(ClassName, Parents, []), !. +def_class(ClassName, Parents, Parts) :- \+ is_class(ClassName), - asserta(is_class(ClassName)), + is_list(Parents), + is_list(Parts), + wrapped_def_class(ClassName, Parents, Parts), !. -def_class(ClassName, [Parent | OtherParents]) :- - nonvar(ClassName), - nonvar(Parent), - nonvar(OtherParents), - \+ is_class(ClassName), - is_class(Parent), - asserta(is_child_of(Parent, ClassName)), - def_class(ClassName, OtherParents), - - findall(Part, - is_member(Part, Parent), - ParentParts), - add_part(ClassName, ParentParts). -def_class(ClassName, [], []) :- - nonvar(ClassName), - \+ is_class(ClassName), - def_class(ClassName, []), - !. def_class(ClassName, Parents, Parts) :- - nonvar(ClassName), - nonvar(Parents), - nonvar(Parts), \+ is_class(ClassName), - def_class(ClassName, Parents), - add_part(ClassName, Parts). + is_list(Parents), + is_list(Parts), + \+ wrapped_def_class(ClassName, Parents, Parts), + retractall(is_class(ClassName)), + retractall(is_class(ClassName, _)), + retractall(is_child_of(_, ClassName)), + retractall(is_member(_, ClassName)), + fail(). #+end_src *** Esempio pratico @@ -134,50 +120,37 @@ Definisce una nuova istanza della classe *** Implementazione #+begin_src prolog :tangle oop.pl -make(InstanceName, ClassName) :- - atom(InstanceName), - nonvar(ClassName), - !, - make(InstanceName, ClassName, []). - make(InstanceName, ClassName) :- var(InstanceName), nonvar(ClassName), + is_class(ClassName), !, - is_instance(InstanceName, ClassName). -#+end_src + search_instance(InstanceName, ClassName, []). - -#+begin_src prolog :tangle oop.pl -make(InstanceName, ClassName, []) :- +make(InstanceName, ClassName) :- atom(InstanceName), nonvar(ClassName), is_class(ClassName), - \+ is_instance(InstanceName), !, - asserta(is_instance(InstanceName)), - asserta(is_instance(InstanceName, ClassName)), + make(InstanceName, ClassName, []). - findall([Name, Value, Type], - is_member(field(Name, Value, Type), ClassName), - Fields), - set_default_fields_for(InstanceName, ClassName, Fields). +make(InstanceName, ClassName, Fields) :- + nonvar(InstanceName), + wrapped_make(InstanceName, ClassName, Fields), + !. -make(InstanceName, ClassName, [Field | Other]) :- - atom(InstanceName), - nonvar(ClassName), - [Field | Other] = Fields, +make(InstanceName, ClassName, Fields) :- + nonvar(InstanceName), + \+ wrapped_make(InstanceName, ClassName, Fields), !, - make(InstanceName, ClassName, []), - set_fields_for(InstanceName, ClassName, Fields). + retractall(is_instance(InstanceName)), + retractall(is_instance(InstanceName, _)), + retractall(field(InstanceName, _, _)), + fail(). make(InstanceName, ClassName, Fields) :- var(InstanceName), - nonvar(ClassName), - is_list(Fields), - Fields \= [], - is_instance(InstanceName, ClassName), - check_fields(InstanceName, Fields). + search_instance(InstanceName, ClassName, Fields). #+end_src *** Esempio pratico @@ -192,10 +165,12 @@ make(Instance, foobar). %% Instance = fb. make(Instance, bar, [bar = "69"]). %% Instance = b; false. #+end_src - ** field *** Definizione +<<<<<<< Updated upstream Estrae il valore di una classe da un campo +======= +>>>>>>> Stashed changes *** Implementazione #+begin_src prolog :tangle oop.pl @@ -247,18 +222,14 @@ fieldx(fb, [foo,bar,foobar], Result). :- dynamic is_instance/2. #+end_src -** add_part +** Aggiunta di `field` e `metodi` #+begin_src prolog :tangle oop.pl add_part(ClassName, []) :- is_class(ClassName), !. - add_part(ClassName, [field(Name, Value) | OtherParts]) :- is_class(ClassName), is_member(field(Name, _, _), ClassName), !, - - %% Se è già definito questo member viene cancellalo retractall(is_member(field(Name, _, _), ClassName)), - asserta(is_member((field(Name, Value, nil)), ClassName)), add_part(ClassName, OtherParts). @@ -266,7 +237,6 @@ add_part(ClassName, [field(Name, Value) | OtherParts]) :- is_class(ClassName), \+ is_member(field(Name, _, _), ClassName), !, - asserta(is_member((field(Name, Value, nil)), ClassName)), add_part(ClassName, OtherParts). @@ -274,11 +244,8 @@ add_part(ClassName, [field(Name, Value, Type) | OtherParts]) :- is_class(ClassName), is_member(field(Name, _, _), ClassName), !, - - %% Se è già definito questo member cancellalo retractall(is_member(field(Name, _, _), ClassName)), - - check_value_type(Type, Value), + type_check(Type, Value), asserta(is_member(field(Name, Value, Type), ClassName)), add_part(ClassName, OtherParts). @@ -286,20 +253,15 @@ add_part(ClassName, [field(Name, Value, Type) | OtherParts]) :- is_class(ClassName), \+ is_member(field(Name, _, _), ClassName), !, - - %% Se è già definito questo member cancellalo retractall(is_member(field(Name, _, _), ClassName)), - - check_value_type(Type, Value), + type_check(Type, Value), asserta(is_member(field(Name, Value, Type), ClassName)), add_part(ClassName, OtherParts). add_part(ClassName, [method(Name, ArgList, Body) | OtherParts]) :- is_list(ArgList), is_class(ClassName), - asserta(is_member(method(Name, ArgList, Body), ClassName)), - Head =.. [Name, InstanceName | ArgList], !, replace(this,InstanceName,Body,NewBody), @@ -307,34 +269,32 @@ add_part(ClassName, [method(Name, ArgList, Body) | OtherParts]) :- add_part(ClassName, OtherParts). #+end_src -** set_default_fields_for +** Impostazione dei field ereditati #+begin_src prolog :tangle oop.pl -set_default_fields_for(_InstanceName, _ClassName, []) :- !. -set_default_fields_for(InstanceName, +set_superclass_fields(_InstanceName, _ClassName, []) :- !. +set_superclass_fields(InstanceName, ClassName, - [[Name, Value, _Type] | OtherFields]) :- - % Controlli sul tipo - - % Aggingi i field + [[Name, Value, Type] | OtherFields]) :- + type_check(Type, Value), assertz(field(InstanceName, Name, Value)), - set_default_fields_for(InstanceName, ClassName, OtherFields). + set_superclass_fields(InstanceName, ClassName, OtherFields). #+end_src -** set_fields_for +** Costruzione di un'istanza #+begin_src prolog :tangle oop.pl -set_fields_for(_InstanceName, _ClassName, []) :- !. -set_fields_for(InstanceName, +set_fields(_InstanceName, _ClassName, []) :- !. +set_fields(InstanceName, ClassName, [=(Name, Value) | OtherFields]) :- field(InstanceName, Name, OldValue), is_member(field(Name, _Value, Type), ClassName), - check_value_type(Type, Value), + type_check(Type, Value), retractall(field(InstanceName, Name, OldValue)), !, asserta(field(InstanceName, Name, Value)), - set_fields_for(InstanceName, ClassName, OtherFields). + set_fields(InstanceName, ClassName, OtherFields). -set_fields_for(InstanceName, _ClassName, _Fields) :- +set_fields(InstanceName, _ClassName, _Fields) :- retractall(is_instance(InstanceName)), retractall(is_instance(InstanceName, _)), retractall(field(InstanceName, _, _)), @@ -342,15 +302,7 @@ set_fields_for(InstanceName, _ClassName, _Fields) :- fail(). #+end_src -** check_fields -#+begin_src prolog :tangle oop.pl -check_fields(_InstanceName, []). -check_fields(InstanceName, [=(Field, Value) | Other]) :- - field(InstanceName, Field, Value), - check_fields(InstanceName, Other). -#+end_src - -** replace +** Sostituzione di termine #+begin_src prolog :tangle oop.pl replace(Subterm0, Subterm, Term0, Term) :- Term0 == Subterm0, @@ -366,34 +318,104 @@ replace(Subterm0, Subterm, Term0, Term) :- Term =.. [F | Args]. #+end_src -** check_value_type +** Controllo dei tipi #+begin_src prolog :tangle oop.pl -check_value_type(_X, nil) :- !. -check_value_type(nil, _X) :- !. -check_value_type(var, X) :- var(X), !. -check_value_type(nonvar, X) :- nonvar(X), !. -check_value_type(integer, X) :- integer(X), !. -check_value_type(float, X) :- float(X), !. -check_value_type(rational, X) :- rational(X), !. -check_value_type(number, X) :- number(X), !. -check_value_type(atom, X) :- atom(X), !. -check_value_type(string, X) :- string(X), !. -check_value_type(atomic, X) :- atomic(X), !. -check_value_type(compound, X) :- compound(X), !. -check_value_type(callable, X) :- callable(X), !. -check_value_type(ground, X) :- ground(X), !. - -check_value_type(ClassName, Instance) :- +type_check(_X, nil) :- !. +type_check(nil, _X) :- !. +type_check(var, X) :- var(X), !. +type_check(nonvar, X) :- nonvar(X), !. +type_check(integer, X) :- integer(X), !. +type_check(float, X) :- float(X), !. +type_check(rational, X) :- rational(X), !. +type_check(number, X) :- number(X), !. +type_check(atom, X) :- atom(X), !. +type_check(string, X) :- string(X), !. +type_check(atomic, X) :- atomic(X), !. +type_check(compound, X) :- compound(X), !. +type_check(callable, X) :- callable(X), !. +type_check(ground, X) :- ground(X), !. + +type_check(ClassName, Instance) :- is_class(ClassName), is_instance(Instance, ClassName), !. -check_value_type(ClassName, Instance) :- +type_check(ClassName, Instance) :- is_child_of(ClassName, ChildClass), is_instance(Instance, ChildClass), !. -check_value_type(ClassName, Instance) :- +type_check(ClassName, Instance) :- is_child_of(ClassName, ChildClass), - check_value_type(ChildClass, Instance). + type_check(ChildClass, Instance). +#+end_src + +** Definizione di una classe +*** Effettivo predicato `def_class` +#+begin_src prolog :tangle oop.pl +wrapped_def_class(ClassName, Parents, Parts) :- + nonvar(ClassName), + nonvar(Parents), + nonvar(Parts), + \+ is_class(ClassName), + + set_superclass(ClassName, Parents), + asserta(is_class(ClassName)), + add_part(ClassName, Parts). +#+end_src + +*** Ereditazione di field da superclass +#+begin_src prolog :tangle oop.pl +set_superclass(_ClassName, []) :- !. +set_superclass(ClassName, [Parent | OtherParents]) :- + nonvar(ClassName), + nonvar(Parent), + nonvar(OtherParents), + \+ is_class(ClassName), + is_class(Parent), + asserta(is_child_of(Parent, ClassName)), + def_class(ClassName, OtherParents), + + findall(Part, + is_member(Part, Parent), + ParentParts), + add_part(ClassName, ParentParts). +#+end_src + +** Istanziazione di una classe +*** Effettivo predicato `make` +#+begin_src prolog :tangle oop.pl +wrapped_make(InstanceName, ClassName, Fields) :- + is_list(Fields), + !, + instanciate_superclass(InstanceName, ClassName), + set_fields(InstanceName, ClassName, Fields). +#+end_src + +*** Assegnamento dei valori ereditati dalla superclass all'istanza +#+begin_src prolog :tangle oop.pl +instanciate_superclass(InstanceName, ClassName) :- + atom(InstanceName), + nonvar(ClassName), + is_class(ClassName), + \+ is_instance(InstanceName), + !, + asserta(is_instance(InstanceName)), + asserta(is_instance(InstanceName, ClassName)), + + findall([Name, Value, Type], + is_member(field(Name, Value, Type), ClassName), + Fields), + set_superclass_fields(InstanceName, ClassName, Fields). +#+end_src + +** Ricerca di un'istanza +#+begin_src prolog :tangle oop.pl +search_instance(InstanceName, ClassName, [=(Field,Value) | Other]) :- + is_instance(InstanceName, ClassName), + field(InstanceName, Field, Value), + search_instance(InstanceName, ClassName, Other). + +search_instance(InstanceName, ClassName, []) :- + is_instance(InstanceName, ClassName). #+end_src diff --git a/Prolog/oop.pl b/Prolog/oop.pl index 985e975..1d00590 100644 --- a/Prolog/oop.pl +++ b/Prolog/oop.pl @@ -1,79 +1,56 @@ %%%% %%%% -def_class(ClassName, []) :- - nonvar(ClassName), +def_class(ClassName, Parents) :- def_class(ClassName, Parents, []), !. +def_class(ClassName, Parents, Parts) :- \+ is_class(ClassName), - asserta(is_class(ClassName)), + is_list(Parents), + is_list(Parts), + wrapped_def_class(ClassName, Parents, Parts), !. -def_class(ClassName, [Parent | OtherParents]) :- - nonvar(ClassName), - nonvar(Parent), - nonvar(OtherParents), - \+ is_class(ClassName), - is_class(Parent), - asserta(is_child_of(Parent, ClassName)), - def_class(ClassName, OtherParents), - findall(Part, - is_member(Part, Parent), - ParentParts), - add_part(ClassName, ParentParts). - -def_class(ClassName, [], []) :- - nonvar(ClassName), - \+ is_class(ClassName), - def_class(ClassName, []), - !. def_class(ClassName, Parents, Parts) :- - nonvar(ClassName), - nonvar(Parents), - nonvar(Parts), \+ is_class(ClassName), - def_class(ClassName, Parents), - add_part(ClassName, Parts). - -make(InstanceName, ClassName) :- - atom(InstanceName), - nonvar(ClassName), - !, - make(InstanceName, ClassName, []). + is_list(Parents), + is_list(Parts), + \+ wrapped_def_class(ClassName, Parents, Parts), + retractall(is_class(ClassName)), + retractall(is_class(ClassName, _)), + retractall(is_child_of(_, ClassName)), + retractall(is_member(_, ClassName)), + fail(). make(InstanceName, ClassName) :- var(InstanceName), nonvar(ClassName), + is_class(ClassName), !, - is_instance(InstanceName, ClassName). + search_instance(InstanceName, ClassName, []). -make(InstanceName, ClassName, []) :- +make(InstanceName, ClassName) :- atom(InstanceName), nonvar(ClassName), is_class(ClassName), - \+ is_instance(InstanceName), !, - asserta(is_instance(InstanceName)), - asserta(is_instance(InstanceName, ClassName)), + make(InstanceName, ClassName, []). - findall([Name, Value, Type], - is_member(field(Name, Value, Type), ClassName), - Fields), - set_default_fields_for(InstanceName, ClassName, Fields). +make(InstanceName, ClassName, Fields) :- + nonvar(InstanceName), + wrapped_make(InstanceName, ClassName, Fields), + !. -make(InstanceName, ClassName, [Field | Other]) :- - atom(InstanceName), - nonvar(ClassName), - [Field | Other] = Fields, +make(InstanceName, ClassName, Fields) :- + nonvar(InstanceName), + \+ wrapped_make(InstanceName, ClassName, Fields), !, - make(InstanceName, ClassName, []), - set_fields_for(InstanceName, ClassName, Fields). + retractall(is_instance(InstanceName)), + retractall(is_instance(InstanceName, _)), + retractall(field(InstanceName, _, _)), + fail(). make(InstanceName, ClassName, Fields) :- var(InstanceName), - nonvar(ClassName), - is_list(Fields), - Fields \= [], - is_instance(InstanceName, ClassName), - check_fields(InstanceName, Fields). + search_instance(InstanceName, ClassName, Fields). :- dynamic field/3. @@ -92,15 +69,11 @@ fieldx(Instance, [FieldName | Others], Res) :- :- dynamic is_instance/2. add_part(ClassName, []) :- is_class(ClassName), !. - add_part(ClassName, [field(Name, Value) | OtherParts]) :- is_class(ClassName), is_member(field(Name, _, _), ClassName), !, - - %% Se è già definito questo member viene cancellalo retractall(is_member(field(Name, _, _), ClassName)), - asserta(is_member((field(Name, Value, nil)), ClassName)), add_part(ClassName, OtherParts). @@ -108,7 +81,6 @@ add_part(ClassName, [field(Name, Value) | OtherParts]) :- is_class(ClassName), \+ is_member(field(Name, _, _), ClassName), !, - asserta(is_member((field(Name, Value, nil)), ClassName)), add_part(ClassName, OtherParts). @@ -116,11 +88,8 @@ add_part(ClassName, [field(Name, Value, Type) | OtherParts]) :- is_class(ClassName), is_member(field(Name, _, _), ClassName), !, - - %% Se è già definito questo member cancellalo retractall(is_member(field(Name, _, _), ClassName)), - - check_value_type(Type, Value), + type_check(Type, Value), asserta(is_member(field(Name, Value, Type), ClassName)), add_part(ClassName, OtherParts). @@ -128,60 +97,48 @@ add_part(ClassName, [field(Name, Value, Type) | OtherParts]) :- is_class(ClassName), \+ is_member(field(Name, _, _), ClassName), !, - - %% Se è già definito questo member cancellalo retractall(is_member(field(Name, _, _), ClassName)), - - check_value_type(Type, Value), + type_check(Type, Value), asserta(is_member(field(Name, Value, Type), ClassName)), add_part(ClassName, OtherParts). add_part(ClassName, [method(Name, ArgList, Body) | OtherParts]) :- is_list(ArgList), is_class(ClassName), - asserta(is_member(method(Name, ArgList, Body), ClassName)), - Head =.. [Name, InstanceName | ArgList], !, replace(this,InstanceName,Body,NewBody), asserta(Head :- (is_instance(InstanceName, ClassName), NewBody, !)), add_part(ClassName, OtherParts). -set_default_fields_for(_InstanceName, _ClassName, []) :- !. -set_default_fields_for(InstanceName, +set_superclass_fields(_InstanceName, _ClassName, []) :- !. +set_superclass_fields(InstanceName, ClassName, - [[Name, Value, _Type] | OtherFields]) :- - % Controlli sul tipo - - % Aggingi i field + [[Name, Value, Type] | OtherFields]) :- + type_check(Type, Value), assertz(field(InstanceName, Name, Value)), - set_default_fields_for(InstanceName, ClassName, OtherFields). + set_superclass_fields(InstanceName, ClassName, OtherFields). -set_fields_for(_InstanceName, _ClassName, []) :- !. -set_fields_for(InstanceName, +set_fields(_InstanceName, _ClassName, []) :- !. +set_fields(InstanceName, ClassName, [=(Name, Value) | OtherFields]) :- field(InstanceName, Name, OldValue), is_member(field(Name, _Value, Type), ClassName), - check_value_type(Type, Value), + type_check(Type, Value), retractall(field(InstanceName, Name, OldValue)), !, asserta(field(InstanceName, Name, Value)), - set_fields_for(InstanceName, ClassName, OtherFields). + set_fields(InstanceName, ClassName, OtherFields). -set_fields_for(InstanceName, _ClassName, _Fields) :- +set_fields(InstanceName, _ClassName, _Fields) :- retractall(is_instance(InstanceName)), retractall(is_instance(InstanceName, _)), retractall(field(InstanceName, _, _)), !, fail(). -check_fields(_InstanceName, []). -check_fields(InstanceName, [=(Field, Value) | Other]) :- - field(InstanceName, Field, Value), - check_fields(InstanceName, Other). - replace(Subterm0, Subterm, Term0, Term) :- Term0 == Subterm0, !, @@ -195,31 +152,84 @@ replace(Subterm0, Subterm, Term0, Term) :- maplist(replace(Subterm0,Subterm), Args0, Args), Term =.. [F | Args]. -check_value_type(_X, nil) :- !. -check_value_type(nil, _X) :- !. -check_value_type(var, X) :- var(X), !. -check_value_type(nonvar, X) :- nonvar(X), !. -check_value_type(integer, X) :- integer(X), !. -check_value_type(float, X) :- float(X), !. -check_value_type(rational, X) :- rational(X), !. -check_value_type(number, X) :- number(X), !. -check_value_type(atom, X) :- atom(X), !. -check_value_type(string, X) :- string(X), !. -check_value_type(atomic, X) :- atomic(X), !. -check_value_type(compound, X) :- compound(X), !. -check_value_type(callable, X) :- callable(X), !. -check_value_type(ground, X) :- ground(X), !. - -check_value_type(ClassName, Instance) :- +type_check(_X, nil) :- !. +type_check(nil, _X) :- !. +type_check(var, X) :- var(X), !. +type_check(nonvar, X) :- nonvar(X), !. +type_check(integer, X) :- integer(X), !. +type_check(float, X) :- float(X), !. +type_check(rational, X) :- rational(X), !. +type_check(number, X) :- number(X), !. +type_check(atom, X) :- atom(X), !. +type_check(string, X) :- string(X), !. +type_check(atomic, X) :- atomic(X), !. +type_check(compound, X) :- compound(X), !. +type_check(callable, X) :- callable(X), !. +type_check(ground, X) :- ground(X), !. + +type_check(ClassName, Instance) :- is_class(ClassName), is_instance(Instance, ClassName), !. -check_value_type(ClassName, Instance) :- +type_check(ClassName, Instance) :- is_child_of(ClassName, ChildClass), is_instance(Instance, ChildClass), !. -check_value_type(ClassName, Instance) :- +type_check(ClassName, Instance) :- is_child_of(ClassName, ChildClass), - check_value_type(ChildClass, Instance). + type_check(ChildClass, Instance). + +wrapped_def_class(ClassName, Parents, Parts) :- + nonvar(ClassName), + nonvar(Parents), + nonvar(Parts), + \+ is_class(ClassName), + + set_superclass(ClassName, Parents), + asserta(is_class(ClassName)), + add_part(ClassName, Parts). + +set_superclass(_ClassName, []) :- !. +set_superclass(ClassName, [Parent | OtherParents]) :- + nonvar(ClassName), + nonvar(Parent), + nonvar(OtherParents), + \+ is_class(ClassName), + is_class(Parent), + asserta(is_child_of(Parent, ClassName)), + def_class(ClassName, OtherParents), + + findall(Part, + is_member(Part, Parent), + ParentParts), + add_part(ClassName, ParentParts). + +wrapped_make(InstanceName, ClassName, Fields) :- + is_list(Fields), + !, + instanciate_superclass(InstanceName, ClassName), + set_fields(InstanceName, ClassName, Fields). + +instanciate_superclass(InstanceName, ClassName) :- + atom(InstanceName), + nonvar(ClassName), + is_class(ClassName), + \+ is_instance(InstanceName), + !, + asserta(is_instance(InstanceName)), + asserta(is_instance(InstanceName, ClassName)), + + findall([Name, Value, Type], + is_member(field(Name, Value, Type), ClassName), + Fields), + set_superclass_fields(InstanceName, ClassName, Fields). + +search_instance(InstanceName, ClassName, [=(Field,Value) | Other]) :- + is_instance(InstanceName, ClassName), + field(InstanceName, Field, Value), + search_instance(InstanceName, ClassName, Other). + +search_instance(InstanceName, ClassName, []) :- + is_instance(InstanceName, ClassName).