<commit_before>% -*- fill-column: 65; -*-
%
%  This file is a part of Uranium, a general-purpose functional
%  test platform.
%
%  Copyright (C) 2012, Kogorta OOO Ltd
%
%  This library is free software; you can redistribute it and/or
%  modify it under the terms of the GNU Lesser General Public
%  License as published by the Free Software Foundation; either
%  version 2.1 of the License, or (at your option) any later
%  version.
%
%  This library is distributed in the hope that it will be
%  useful, but WITHOUT ANY WARRANTY; without even the implied
%  warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
%  PURPOSE.  See the GNU Lesser General Public License for more
%  details.
%
%  You should have received a copy of the GNU Lesser General
%  Public License along with this library; if not, write to the
%  Free Software Foundation, Inc., 51 Franklin Street, Fifth
%  Floor, Boston, MA 02110-1301 USA
%
%  e-mail: <EMAIL>
%  post:   49017 Ukraine, Dnepropetrovsk per. Kamenski, 6

:- module(objects_i,
          [
           class_all_fields/2,  % +Class_Id, -Fields
                                % nonevals only
           class_arity/2,

           % @Pattern, +Class_Id, ?Native, ?Eval, ?Fields
           class_fields/5,

           class_id/2,          % ?Class_Id, ?Class_Name
           class_new_fields/2,  % +Class_Id, -Fields
           class_primary_id/2,  % +Class, ?Class_Id
           common_parent/3,
           fields_names_types/3,
           gen_class_id/2,
           gen_new_class_id/1,
           get_key/2,
           get_keymaster/2,     % +Class_Id, -Keymaster_Id
           is_rebased_class/1,  % +Class_Id
           no_rebased_class/2,  % ?Class_Id, ?No_Rebased
           list_inheritance/2,
           list_inheritance/3,
           list_inheritance_names/2, % +Class_Id, -List
           list_inheritance_names/3,
           nearest_common_keymaster_int/3, % +Id1, +Id2, -Keymaster_Id
           obj_class_id/2,
           obj_construct_int/5,
           obj_field_int/7,
           obj_reset_fields_int/6,
           obj_rewrite_int/8,   % +Class_Id, +Object0, +Weak, +Fields,
                                % ?Old_Vals, +New_Vals, -Object,
                                % +Ctx

           obj_unify_int/6,     % +Class_Id, +Fields, +Weak,
                                % +Term, ?Value, +Ctx

           parent/2,            % ?Id, ?Parent_Id
	   descendant_class/2,  % ?Desc_Id, ?Ancestor_Id
           descendant_class/3,  %+Desc_Id, ?No_Rebased, ?Anc_Class_Name
           same_class/3,        %+Class1_Id, ?No_Rebased, ?Class_Name
           same_or_descendant/2,%?Desc_Id, ?Ancestor_Id
           same_or_descendant/3,%+Desc_Id, ?No_Rebased, ?Anc_Class_Name
           u_class/1,
           u_object/1,
           unbounded_fields/2  % +Obj, -Field_Names
           ]).

/** <module> Internal operations with objects.

  This module should not be used in user programs, only by
  Uranium itself.
*/

:- use_module(u(internal/objects)).
:- use_module(library(lists)).
:- use_module(library(error)).
:- use_module(library(pairs)).
:- use_module(u(ur_lists)).
:- use_module(u(internal/decode_arg)).

class_all_fields(Class_Id, Fields) :-

   class_fields(_, Class_Id, _, false, Fields).


% class_arity(+Class_Id, -Arity)

class_arity(Class_Id, Arity) :-

   integer(Class_Id),
   (  objects:arity(Class_Id, Arity) -> true
   ;  throw(class_system_bad_state(
            'no objects:arity/2 for class id ~d' - Class_Id))
   ).


% class_fields(@Pattern, +Class_Id, ?Native, ?Eval, ?Fields)
% Get list of fields/types
% Native == true means no field from parent
% Native == false - only parent fields
% Native unbound - both
%
% Eval == true - only eval fields
% Eval == false - only non-eval fields
% Eval unbound - both
%
% It returns ordset (coz it uses setof)

class_fields(Pattern, Class_Id, Native, Eval, Fields) :-

   var(Pattern), !,

   class_fields(_-_, Class_Id, Native, Eval, Fields0),
   pairs_keys(Fields0, Fields).

class_fields(_-_, Class_Id, Native, Eval, Fields) :- !,

   class_fields2(Class_Id, Native, Eval, Fields).

class_fields(Pattern, Class_Id, Native, Eval, Fields) :-

   functor(Pattern, Symbol, 2),
   class_fields(_-_, Class_Id, Native, Eval, Fields0),
   pairs_replace_functor(Symbol, Fields0, Fields).

class_fields2(Class_Id, Native, Eval, Fields) :-

   (  setof(Field_Name-Field_Type,
        Native^Eval^(objects:field_info(Class_Id, Field_Name,
                                        Field_Type, Native, Eval)
                    ),
        Fields0
      )
   -> predsort(compare_obj_fields, Fields0, Fields)
   ;  Fields = []
   ).

compare_obj_fields(Delta, E1-_, E2-_) :-

   compare(Delta, E1, E2).

%% class_id(?Class_Id, ?Class_Name) is nondet.
%
%  It is the most general case of a Class_Id <-> Class_Name
%  conversion (which includes all existing rebasing cases). The
%  predicate is semidet if Class_Id is ground (because Class_Id
%  -> Class_Name is a functional relation). Do not use it for get
%  a single id for a not rebased class.
%
%  @see class_primary_id/2

class_id(Class_Id, Class) :-

   nonvar(Class_Id), !,
   objects:class_id(Class_Id, _, Class), !. % ensure no BT

class_id(Class_Id, Class) :-

   objects:class_id(Class_Id, _, Class).


class_new_fields(Class_Id, Fields) :-

   class_fields(_, Class_Id, true, false, Fields).

%% class_primary_id(+Class, ?Class_Id) is semidet.
%
%  Found a primary class id by a class name.
%
%  @see class_id/2

class_primary_id(Class, Class_Id) :-

   must_be(atom, Class),
   objects:class_id(Class_Id, true, Class), !.


%% common_parent(+Class1_Id, +Class2_Id, -Cmn_Parent_Id) is det.
%
% Find the common parent's id.

common_parent(Class1_Id, Class2_Id, Cmn_Parent_Id) :-

   list_inheritance(Class1_Id, List1),
   list_inheritance(Class2_Id, List2),
   common_head_rev(List1, List2, [Cmn_Parent_Id|_]).


%% list_inheritance(+Class_Id, -List)
%
% Represent inheritance as [class_id|...]
% e.g. list_inheritance(1, [0, 1]).
%
% @see list_inheritance/3

list_inheritance(Class_Id, List) :-

   list_inheritance(0, Class_Id, [], List).


%% list_inheritance(+From_Id, +To_Id, -List)
%
%  It is like list_inheritance/2 but return only [From_Id
%  .. To_Id] part. I.e. list_inheritance(Class_Id, List)
%  === list_inheritance(0, Class_Id, List).
%
% @see list_inheritance/2, class_path/4

list_inheritance(From_Id, To_Id, List) :-

   list_inheritance(From_Id, To_Id, [], List).


list_inheritance(Id, Id, List, [Id|List]) :- !.

list_inheritance(From_Id, To_Id, List0, List) :-

   objects:parent_(To_Id, Parent_Id),
   list_inheritance(From_Id, Parent_Id, [To_Id|List0], List).


%% list_inheritance_names(+Class_Id, -List)
%
% The same as list_inheritance/2 but return a list of class names.
% @see class_path/4

list_inheritance_names(Class_Id, List) :-

   list_inheritance(0, Class_Id, [], Id_List),
   maplist(class_id, Id_List, List).

list_inheritance_names(From_Id, To_Id, List) :-

   list_inheritance(From_Id, To_Id, [], Id_List),
   maplist(class_id, Id_List, List).



% fields_names_types(?Fields_Def, ?Names, ?Types)

fields_names_types([], [], []).

fields_names_types([Name:Type|FT], [Name|NT], [Type|TT]) :-

   nonvar(Type), !,
   (  var(Name) -> throw(error(instantiation_error, _))
   ; true ),<commit_msg>Cosmetic<commit_after>% -*- fill-column: 65; -*-
%
%  This file is a part of Uranium, a general-purpose functional
%  test platform.
%
%  Copyright (C) 2012, Kogorta OOO Ltd
%
%  This library is free software; you can redistribute it and/or
%  modify it under the terms of the GNU Lesser General Public
%  License as published by the Free Software Foundation; either
%  version 2.1 of the License, or (at your option) any later
%  version.
%
%  This library is distributed in the hope that it will be
%  useful, but WITHOUT ANY WARRANTY; without even the implied
%  warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
%  PURPOSE.  See the GNU Lesser General Public License for more
%  details.
%
%  You should have received a copy of the GNU Lesser General
%  Public License along with this library; if not, write to the
%  Free Software Foundation, Inc., 51 Franklin Street, Fifth
%  Floor, Boston, MA 02110-1301 USA
%
%  e-mail: <EMAIL>
%  post:   49017 Ukraine, Dnepropetrovsk per. Kamenski, 6

:- module(objects_i,
          [
           class_all_fields/2,  % +Class_Id, -Fields
                                % nonevals only
           class_arity/2,

           % @Pattern, +Class_Id, ?Native, ?Eval, ?Fields
           class_fields/5,

           class_id/2,          % ?Class_Id, ?Class_Name
           class_new_fields/2,  % +Class_Id, -Fields
           class_primary_id/2,  % +Class, ?Class_Id
           common_parent/3,
           fields_names_types/3,
           gen_class_id/2,
           gen_new_class_id/1,
           get_key/2,
           get_keymaster/2,     % +Class_Id, -Keymaster_Id
           is_rebased_class/1,  % +Class_Id
           no_rebased_class/2,  % ?Class_Id, ?No_Rebased
           list_inheritance/2,       % +Class_Id, -List
           list_inheritance/3,       % +From_Id, +To_Id, -List
           list_inheritance/4,       % +From_Id, +To_Id, List0, List
           list_inheritance_names/2, % +Class_Id, -List
           list_inheritance_names/3, % +From_Id, +To_Id, -List
           nearest_common_keymaster_int/3, % +Id1, +Id2, -Keymaster_Id
           obj_class_id/2,
           obj_construct_int/5,
           obj_field_int/7,
           obj_reset_fields_int/6,
           obj_rewrite_int/8,   % +Class_Id, +Object0, +Weak, +Fields,
                                % ?Old_Vals, +New_Vals, -Object,
                                % +Ctx

           obj_unify_int/6,     % +Class_Id, +Fields, +Weak,
                                % +Term, ?Value, +Ctx

           parent/2,            % ?Id, ?Parent_Id
	   descendant_class/2,  % ?Desc_Id, ?Ancestor_Id
           descendant_class/3,  %+Desc_Id, ?No_Rebased, ?Anc_Class_Name
           same_class/3,        %+Class1_Id, ?No_Rebased, ?Class_Name
           same_or_descendant/2,%?Desc_Id, ?Ancestor_Id
           same_or_descendant/3,%+Desc_Id, ?No_Rebased, ?Anc_Class_Name
           u_class/1,
           u_object/1,
           unbounded_fields/2  % +Obj, -Field_Names
           ]).

/** <module> Internal operations with objects.

  This module should not be used in user programs, only by
  Uranium itself.
*/

:- use_module(u(internal/objects)).
:- use_module(library(lists)).
:- use_module(library(error)).
:- use_module(library(pairs)).
:- use_module(u(ur_lists)).
:- use_module(u(internal/decode_arg)).

class_all_fields(Class_Id, Fields) :-

   class_fields(_, Class_Id, _, false, Fields).


% class_arity(+Class_Id, -Arity)

class_arity(Class_Id, Arity) :-

   integer(Class_Id),
   (  objects:arity(Class_Id, Arity) -> true
   ;  throw(class_system_bad_state(
            'no objects:arity/2 for class id ~d' - Class_Id))
   ).


% class_fields(@Pattern, +Class_Id, ?Native, ?Eval, ?Fields)
% Get list of fields/types
% Native == true means no field from parent
% Native == false - only parent fields
% Native unbound - both
%
% Eval == true - only eval fields
% Eval == false - only non-eval fields
% Eval unbound - both
%
% It returns ordset (coz it uses setof)

class_fields(Pattern, Class_Id, Native, Eval, Fields) :-

   var(Pattern), !,

   class_fields(_-_, Class_Id, Native, Eval, Fields0),
   pairs_keys(Fields0, Fields).

class_fields(_-_, Class_Id, Native, Eval, Fields) :- !,

   class_fields2(Class_Id, Native, Eval, Fields).

class_fields(Pattern, Class_Id, Native, Eval, Fields) :-

   functor(Pattern, Symbol, 2),
   class_fields(_-_, Class_Id, Native, Eval, Fields0),
   pairs_replace_functor(Symbol, Fields0, Fields).

class_fields2(Class_Id, Native, Eval, Fields) :-

   (  setof(Field_Name-Field_Type,
        Native^Eval^(objects:field_info(Class_Id, Field_Name,
                                        Field_Type, Native, Eval)
                    ),
        Fields0
      )
   -> predsort(compare_obj_fields, Fields0, Fields)
   ;  Fields = []
   ).

compare_obj_fields(Delta, E1-_, E2-_) :-

   compare(Delta, E1, E2).

%% class_id(?Class_Id, ?Class_Name) is nondet.
%
%  It is the most general case of a Class_Id <-> Class_Name
%  conversion (which includes all existing rebasing cases). The
%  predicate is semidet if Class_Id is ground (because Class_Id
%  -> Class_Name is a functional relation). Do not use it for get
%  a single id for a not rebased class.
%
%  @see class_primary_id/2

class_id(Class_Id, Class) :-

   nonvar(Class_Id), !,
   objects:class_id(Class_Id, _, Class), !. % ensure no BT

class_id(Class_Id, Class) :-

   objects:class_id(Class_Id, _, Class).


class_new_fields(Class_Id, Fields) :-

   class_fields(_, Class_Id, true, false, Fields).

%% class_primary_id(+Class, ?Class_Id) is semidet.
%
%  Found a primary class id by a class name.
%
%  @see class_id/2

class_primary_id(Class, Class_Id) :-

   must_be(atom, Class),
   objects:class_id(Class_Id, true, Class), !.


%% common_parent(+Class1_Id, +Class2_Id, -Cmn_Parent_Id) is det.
%
% Find the common parent's id.

common_parent(Class1_Id, Class2_Id, Cmn_Parent_Id) :-

   list_inheritance(Class1_Id, List1),
   list_inheritance(Class2_Id, List2),
   common_head_rev(List1, List2, [Cmn_Parent_Id|_]).


%% list_inheritance(+Class_Id, -List) is det.
%
% Represent inheritance as [class_id|...]
% e.g. list_inheritance(1, [0, 1]).
%
% @see list_inheritance/3

list_inheritance(Class_Id, List) :-

   list_inheritance(0, Class_Id, [], List).


%% list_inheritance(+From_Id, +To_Id, -List) is det.
%
%  It is like list_inheritance/2 but return only [From_Id
%  .. To_Id] part. I.e. list_inheritance(Class_Id, List)
%  === list_inheritance(0, Class_Id, List).
%
% @see list_inheritance/2, class_path/4

list_inheritance(From_Id, To_Id, List) :-
   list_inheritance(From_Id, To_Id, [], List).

%% list_inheritance(+From_Id, +To_Id, List0, List) is det.
%
% A diff-list version.
list_inheritance(Id, Id, List, [Id|List]) :- !.
list_inheritance(From_Id, To_Id, List0, List) :-
   objects:parent_(To_Id, Parent_Id),
   list_inheritance(From_Id, Parent_Id, [To_Id|List0], List).

%% list_inheritance_names(+Class_Id, -List)
%
% The same as list_inheritance/2 but return a list of class names.
% @see class_path/4
list_inheritance_names(Class_Id, List) :-
   list_inheritance(0, Class_Id, [], Id_List),
   maplist(class_id, Id_List, List).

%% list_inheritance_names(+From_Class_Id, +To_Class_Id, -List)
list_inheritance_names(From_Id, To_Id, List) :-
   list_inheritance(From_Id, To_Id, [], Id_List),
   maplist(class_id, Id_List, List).

% fields_names_types(?Fields_Def, ?Names, ?Types)

fields_names_types([], [], []).

fields_names_types([Name:Type|FT], [Name|NT], [Type|TT]) :-

   nonvar(Type), !,
   (  var(Name) -> throw(error(instantiation_error, _))
   ; true ),
{'fraction_non_alphanumeric': 0.12259583053127102, 'fraction_numerical': 0.014055144586415602, 'mean_word_length': 3.0051171559385943, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 17, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 10, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4413458', 'n_tokens_mistral': 5391, 'n_tokens_neox': 5178, 'n_words': 1227}