%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Flags was developed at Katholieke Universiteit Leuven % % SPDX-FileCopyrightText: 2010 Katholieke Universiteit Leuven % SPDX-License-Identifier: Artistic-2.0 % % Contributions to this file: % Author: Theofrastos Mantadelis % Sugestions: Paulo Moura % Version: 1 % Date: 27/11/2010 % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Artistic License 2.0 % % Copyright (c) 2000-2006, The Perl Foundation. % % Everyone is permitted to copy and distribute verbatim copies of this % license document, but changing it is not allowed. Preamble % % This license establishes the terms under which a given free software % Package may be copied, modified, distributed, and/or % redistributed. The intent is that the Copyright Holder maintains some % artistic control over the development of that Package while still % keeping the Package available as open source and free software. % % You are always permitted to make arrangements wholly outside of this % license directly with the Copyright Holder of a given Package. If the % terms of this license do not permit the full use that you propose to % make of the Package, you should contact the Copyright Holder and seek % a different licensing arrangement. Definitions % % "Copyright Holder" means the individual(s) or organization(s) named in % the copyright notice for the entire Package. % % "Contributor" means any party that has contributed code or other % material to the Package, in accordance with the Copyright Holder's % procedures. % % "You" and "your" means any person who would like to copy, distribute, % or modify the Package. % % "Package" means the collection of files distributed by the Copyright % Holder, and derivatives of that collection and/or of those files. A % given Package may consist of either the Standard Version, or a % Modified Version. % % "Distribute" means providing a copy of the Package or making it % accessible to anyone else, or in the case of a company or % organization, to others outside of your company or organization. % % "Distributor Fee" means any fee that you charge for Distributing this % Package or providing support for this Package to another party. It % does not mean licensing fees. % % "Standard Version" refers to the Package if it has not been modified, % or has been modified only in ways explicitly requested by the % Copyright Holder. % % "Modified Version" means the Package, if it has been changed, and such % changes were not explicitly requested by the Copyright Holder. % % "Original License" means this Artistic License as Distributed with the % Standard Version of the Package, in its current version or as it may % be modified by The Perl Foundation in the future. % % "Source" form means the source code, documentation source, and % configuration files for the Package. % % "Compiled" form means the compiled bytecode, object code, binary, or % any other form resulting from mechanical transformation or translation % of the Source form. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Permission for Use and Modification Without Distribution % % (1) You are permitted to use the Standard Version and create and use % Modified Versions for any purpose without restriction, provided that % you do not Distribute the Modified Version. % % Permissions for Redistribution of the Standard Version % % (2) You may Distribute verbatim copies of the Source form of the % Standard Version of this Package in any medium without restriction, % either gratis or for a Distributor Fee, provided that you duplicate % all of the original copyright notices and associated disclaimers. At % your discretion, such verbatim copies may or may not include a % Compiled form of the Package. % % (3) You may apply any bug fixes, portability changes, and other % modifications made available from the Copyright Holder. The resulting % Package will still be considered the Standard Version, and as such % will be subject to the Original License. % % Distribution of Modified Versions of the Package as Source % % (4) You may Distribute your Modified Version as Source (either gratis % or for a Distributor Fee, and with or without a Compiled form of the % Modified Version) provided that you clearly document how it differs % from the Standard Version, including, but not limited to, documenting % any non-standard features, executables, or modules, and provided that % you do at least ONE of the following: % % (a) make the Modified Version available to the Copyright Holder of the % Standard Version, under the Original License, so that the Copyright % Holder may include your modifications in the Standard Version. (b) % ensure that installation of your Modified Version does not prevent the % user installing or running the Standard Version. In addition, the % modified Version must bear a name that is different from the name of % the Standard Version. (c) allow anyone who receives a copy of the % Modified Version to make the Source form of the Modified Version % available to others under (i) the Original License or (ii) a license % that permits the licensee to freely copy, modify and redistribute the % Modified Version using the same licensing terms that apply to the copy % that the licensee received, and requires that the Source form of the % Modified Version, and of any works derived from it, be made freely % available in that license fees are prohibited but Distributor Fees are % allowed. % % Distribution of Compiled Forms of the Standard Version or % Modified Versions without the Source % % (5) You may Distribute Compiled forms of the Standard Version without % the Source, provided that you include complete instructions on how to % get the Source of the Standard Version. Such instructions must be % valid at the time of your distribution. If these instructions, at any % time while you are carrying out such distribution, become invalid, you % must provide new instructions on demand or cease further % distribution. If you provide valid instructions or cease distribution % within thirty days after you become aware that the instructions are % invalid, then you do not forfeit any of your rights under this % license. % % (6) You may Distribute a Modified Version in Compiled form without the % Source, provided that you comply with Section 4 with respect to the % Source of the Modified Version. % % Aggregating or Linking the Package % % (7) You may aggregate the Package (either the Standard Version or % Modified Version) with other packages and Distribute the resulting % aggregation provided that you do not charge a licensing fee for the % Package. Distributor Fees are permitted, and licensing fees for other % components in the aggregation are permitted. The terms of this license % apply to the use and Distribution of the Standard or Modified Versions % as included in the aggregation. % % (8) You are permitted to link Modified and Standard Versions with % other works, to embed the Package in a larger work of your own, or to % build stand-alone binary or bytecode versions of applications that % include the Package, and Distribute the result without restriction, % provided the result does not expose a direct interface to the Package. % % Items That are Not Considered Part of a Modified Version % % (9) Works (including, but not limited to, modules and scripts) that % merely extend or make use of the Package, do not, by themselves, cause % the Package to be a Modified Version. In addition, such works are not % considered parts of the Package itself, and are not subject to the % terms of this license. % % General Provisions % % (10) Any use, modification, and distribution of the Standard or % Modified Versions is governed by this Artistic License. By using, % modifying or distributing the Package, you accept this license. Do not % use, modify, or distribute the Package, if you do not accept this % license. % % (11) If your Modified Version has been derived from a Modified Version % made by someone other than you, you are nevertheless required to % ensure that your Modified Version complies with the requirements of % this license. % % (12) This license does not grant you the right to use any trademark, % service mark, tradename, or logo of the Copyright Holder. % % (13) This license includes the non-exclusive, worldwide, % free-of-charge patent license to make, have made, use, offer to sell, % sell, import and otherwise transfer the Package with respect to any % patent claims licensable by the Copyright Holder that are necessarily % infringed by the Package. If you institute patent litigation % (including a cross-claim or counterclaim) against any party alleging % that the Package constitutes direct or contributory patent % infringement, then this Artistic License to you shall terminate on the % date that such litigation is filed. % % (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT % HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED % WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A % PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT % PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT % HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, % INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE % OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :- protocol(flags_validator). :- info([ version is 1:0:0, author is 'Theofrastos Mantadelis', date is 2010-11-27, comment is 'Flag validation protocol. Must be implemented by validator objects.' ]). :- public(print_flags/0). :- mode(print_flags, zero_or_one). :- info(print_flags/0, [ comment is 'Validates the validator object itself.' ]). :- public(validate/1). :- mode(validate(@term), zero_or_one). :- info(validate/1, [ comment is 'Validates a flag value.', argnames is ['Value'] ]). :- end_protocol. :- category(flags). :- info([ version is 1:0:0, author is 'Theofrastos Mantadelis', date is 2010-11-27, comment is 'Implementation of persistent object flags.' ]). :- public(get_flag_value/2). :- mode(get_flag_value(+atom, ?nonvar), zero_or_one). :- info(get_flag_value/2, [ comment is 'Gets or tests the value of a flag.', argnames is ['Flag', 'Value'] ]). :- public(set_flag_value/2). :- mode(set_flag_value(+atom, @nonvar), one). :- info(set_flag_value/2, [ comment is 'Sets the value of a flag.', argnames is ['Flag', 'NewValue'] ]). :- public(set_flag_value/3). :- mode(set_flag_value(+atom, ?nonvar, @nonvar), one). :- info(set_flag_value/3, [ comment is 'Sets the value of a flag, returning the old value.', argnames is ['Flag', 'OldValue', 'NewValue'] ]). :- public(reset_flags/0). :- mode(reset_flags, one). :- info(reset_flags/0, [ comment is 'Resets all flags to their default values.' ]). :- public(reset_flags/1). :- mode(reset_flags(+atom), one). :- info(reset_flags/1, [ comment is 'Resets all flags in a group to their default values.', argnames is ['Group'] ]). :- public(flag_groups/1). :- mode(flag_groups(-list(atom)), one). :- info(flag_groups/1, [ comment is 'Returns a list of all flag groups.', argnames is ['Groups'] ]). :- public(flag_group_chk/1). :- mode(flag_group_chk(+atom), zero_or_one). :- info(flag_group_chk/1, [ comment is 'Checks if a given atom is a flag group.', argnames is ['Group'] ]). :- public(print_flags/0). :- mode(print_flags, one). :- info(print_flags/0, [ comment is 'Prints a listing of all flags.' ]). :- public(print_flags/1). :- mode(print_flags(+atom), one). :- info(print_flags/1, [ comment is 'Prints a listing of all flags in a group.', argnames is ['Group'] ]). :- public(defined_flag/6). :- mode(defined_flag(?atom, ?atom, ?nonvar, ?nonvar, ?atom, ?atom), zero_or_more). :- info(defined_flag/6, [ comment is 'Gets or test the existing (visible) flag definitions.', argnames is ['Flag', 'Group', 'Type', 'DefaultValue', 'Description', 'Access'] ]). :- public(built_in_flag/2). :- mode(built_in_flag(?atom, ?nonvar), zero_or_more). :- info(built_in_flag/2, [ comment is 'True if the argument is a built-in flag type with the specified default value.', argnames is ['Type', 'DefaultValue'] ]). :- protected(unsafe_set_flag_value/2). :- mode(unsafe_set_flag_value(+atom, @nonvar), one). :- info(unsafe_set_flag_value/2, [ comment is 'Sets the value of a flag without performing any validation checks.', argnames is ['Flag', 'NewValue'] ]). :- protected(define_flag/1). :- mode(define_flag(+atom), one). :- info(define_flag/1, [ comment is 'Defines a new flag using default options.', argnames is ['Flag'] ]). :- protected(define_flag/2). :- mode(define_flag(+atom, @list), one). :- info(define_flag/2, [ comment is 'Defines a new flag using a given set of options (for example, [group(general), type(nonvar), default(true), description(Flag), access(read_write)]).', argnames is ['Flag', 'Options'] ]). :- private(defined_flag_/6). :- dynamic(defined_flag_/6). :- mode(defined_flag_(?atom, ?atom, ?nonvar, ?nonvar, ?atom, ?atom), zero_or_more). :- info(defined_flag_/6, [ comment is 'Gets or test the existing flag definitions.', argnames is ['Flag', 'Group', 'Type', 'DefaultValue', 'Description', 'Access'] ]). :- private(flag_value_/2). :- dynamic(flag_value_/2). :- mode(flag_value_(?atom, ?nonvar), zero_or_more). :- info(flag_value_/2, [ comment is 'Table of flag values.', argnames is ['Flag', 'Value'] ]). :- private([ validate/3, validate_type/1, is_validator/1 ]). get_flag_value(Flag, Value) :- ( ::flag_value_(Flag, CurrentValue) -> Value = CurrentValue ; throw(error(existence_error(flag, Flag), message('The flag is not defined.', get_flag_value(Flag, Value)))) ). set_flag_value(Flag, Value) :- catch( set_flag_value(Flag, _OldValue, Value), error(Error, message(Message, _)), throw(error(Error, message(Message, set_flag_value(Flag, Value)))) ). set_flag_value(Flag, OldValue, Value) :- atom(Flag), ::defined_flag_(Flag, _Group, Type, _Default, _Description, Access), Access \== read_only, Access \== hidden_read_only, !, validate(Type, Value, Flag), ::retract(flag_value_(Flag, OldValue)), ::assertz(flag_value_(Flag, Value)). set_flag_value(Flag, OldValue, Value) :- throw(error(permission_error(set, flag, Flag), message('Setting the flag value is not allowed.', set_flag_value(Flag, OldValue, Value)))). unsafe_set_flag_value(Flag, Value) :- ::retract(flag_value_(Flag, _)), ::assertz(flag_value_(Flag, Value)). reset_flags:- ::retractall(flag_value_(_, _)), ::defined_flag_(Flag, _Group, _Type, Default, _Description, _Access), ::assertz(flag_value_(Flag, Default)), fail. reset_flags. reset_flags(Group) :- ::defined_flag_(Flag, Group, _Type, Default, _Description, _Access), ::retractall(flag_value_(Flag, _)), ::assertz(flag_value_(Flag, Default)), fail. reset_flags(_). define_flag(Flag) :- catch( define_flag(Flag, []), error(Error, message(Message, _)), throw(error(Error, message(Message, define_flag(Flag)))) ). define_flag(Flag, Options) :- process_options(Options, Flag, Group, Type, Default, Description, Access), catch( define_flag(Flag, Group, Type, Default, Description, Access), error(Error, message(Message, _)), throw(error(Error, message(Message, define_flag(Flag)))) ). process_options([], Flag, Group, Type, Default, Description, Access) :- (var(Group) -> Group = general; true), (var(Type) -> Type = nonvar; true), (var(Default) -> built_in_flag(Type, Default); true), (var(Description) -> Description = Flag; true), (var(Access) -> Access = read_write; true). process_options([group(Group)| Options], Flag, Group, Type, Default, Description, Access) :- process_options(Options, Flag, Group, Type, Default, Description, Access). process_options([type(Type)| Options], Flag, Group, Type, Default, Description, Access) :- process_options(Options, Flag, Group, Type, Default, Description, Access). process_options([default(Default)| Options], Flag, Group, Type, Default, Description, Access) :- process_options(Options, Flag, Group, Type, Default, Description, Access). process_options([description(Description)| Options], Flag, Group, Type, Default, Description, Access) :- process_options(Options, Flag, Group, Type, Default, Description, Access). process_options([access(Access)| Options], Flag, Group, Type, Default, Description, Access) :- process_options(Options, Flag, Group, Type, Default, Description, Access). define_flag(Flag, Group, Type, Default, Description, Access) :- nonvar(Flag), nonvar(Group), nonvar(Type), nonvar(Access), !, ( \+ atom(Flag) -> throw(error(type_error(atom, Flag), message('Flag name must be an atom.', define_flag(Flag, Group, Type, Default, Description, Access)))) ; \+ atom(Group) -> throw(error(type_error(atom, Group), message('Flag group must be an atom.', define_flag(Flag, Group, Type, Default, Description, Access)))) ; \+ validate_type(Type) -> throw(error(evaluation_error(type_validation), message('Validation of flag type failed, check custom domain.', define_flag(Flag, Group, Type, Default, Description, Access)))) ; ::defined_flag_(Flag, _Group, _Type, _Default, _Description, _Access) -> throw(error(permission_error(create, flag, Flag), message('Re-defining a flag is not allowed.', define_flag(Flag, Group, Type, Default, Description, Access)))) ; \+ member(Access, [read_write, read_only, hidden, hidden_read_only]), throw(error(domain_error(access, Access), message('Wrong access attribute, available are: read_write, read_only, hidden, hidden_read_only.', define_flag(Flag, Group, Type, Default, Description, Access)))) ; validate(Type, Default, Flag), ::assertz(defined_flag_(Flag, Group, Type, Default, Description, Access)), ::assertz(flag_value_(Flag, Default)) ). define_flag(Flag, Group, Type, Default, Description, Access) :- throw(error(instantiation_error, message('Flag name, group, type and access must be instantiated.', define_flag(Flag, Group, Type, Default, Description, Access)))). is_validator(Type) :- built_in_flag(Type, _), !. is_validator(Type) :- current_object(Type), conforms_to_protocol(Type, flags_validator), !. validate_type(Type) :- built_in_flag(Type, _), !. validate_type(Type) :- is_validator(Type), Type::validate. built_in_flag(nonvar, true). built_in_flag(ground, true). built_in_flag(compound, true). built_in_flag(list, []). built_in_flag(atomic, true). built_in_flag(atom, true). built_in_flag(boolean, true). built_in_flag(switch, on). built_in_flag(number, 0). built_in_flag(integer, 0). built_in_flag(float, 0.0). built_in_flag(positive_integer, 0). built_in_flag(non_negative_integer, 0.0). built_in_flag(negative_integer, -1). built_in_flag(positive_float, 0.0). built_in_flag(non_negative_float, 0.0). built_in_flag(negative_float, -1.0). built_in_flag(positive_number, 0). built_in_flag(non_negative_number, 0). built_in_flag(negative_number, -1). % built-in types: validate(nonvar, Value, _) :- !, nonvar(Value). validate(ground, Value, _) :- !, ground(Value). validate(compound, Value, _) :- !, compound(Value). validate(list, Value, _) :- !, is_proper_list(Value). validate(atomic, Value, _) :- !, atomic(Value). validate(atom, Value, _) :- !, atom(Value). validate(boolean, Value, _) :- !, (Value == true -> true; Value == false). validate(switch, Value, _) :- !, (Value == on -> true; Value == off). validate(number, Value, _) :- !, number(Value). validate(integer, Value, _) :- !, integer(Value). validate(float, Value, _) :- !, float(Value). validate(positive_integer, Value, _) :- !, integer(Value), Value > 0. validate(non_negative_integer, Value, _) :- !, integer(Value), Value >= 0. validate(negative_integer, Value, _) :- !, integer(Value), Value < 0. validate(positive_float, Value, _) :- !, float(Value), Value > 0.0. validate(non_negative_float, Value, _) :- !, float(Value), Value >= 0.0. validate(negative_float, Value, _) :- !, float(Value), Value < 0.0. validate(positive_number, Value, _) :- !, number(Value), Value > 0. validate(non_negative_number, Value, _) :- !, number(Value), Value >= 0. validate(negative_number, Value, _) :- !, number(Value), Value < 0. % user-defined object validators: validate(Type, Value, _Flag) :- current_object(Type), Type::validate(Value), !. validate(Type, Value, Flag) :- throw(error(validation_error(Type, Value), message('Validation of value fails.', validate(Type, Value, Flag)))). flag_groups(Groups) :- setof(Group, flag_group(Group), Groups). flag_group(Group) :- ::defined_flag_(_Flag, Group, _Type, _Default, _Description, Access), Access \== hidden, Access \== hidden_read_only. flag_group_chk(Group) :- nonvar(Group), flag_group(Group), !. print_flags :- flag_groups(Groups), member(Group, Groups), print_flags(Group), fail. print_flags. :- if(( % GNU Prolog format/2-3 doesn't support setting tabs \+ current_logtalk_flag(prolog_dialect, gnu), % format/2-3 are not standard Prolog predicates predicate_property(format(_, _), built_in) )). print_flags(Group) :- format('~w:~n~w~38+ ~w~19+ ~w~10+ ~w~10+~n', [Group, 'Description', 'Domain', 'Flag', 'Value']), fail. print_flags(Group) :- ::defined_flag_(Flag, Group, Type, _Default, Description, Access), Access \== hidden, Access \== hidden_read_only, ::get_flag_value(Flag, Value), format('~w~38+ ~w~19+ ~w~10+ ~q~10+~n', [Description, Type, Flag, Value]), fail. print_flags(_). :- else. print_flags(Group) :- write(Group), nl, write(' Description Domain Flag Value'), nl, fail. print_flags(Group) :- ::defined_flag_(Flag, Group, Type, _Default, Description, Access), Access \== hidden, Access \== hidden_read_only, ::get_flag_value(Flag, Value), write(Description), write(' '), write(Type), write(' '), write(Flag), write(' '), write(Value), nl, fail. print_flags(_). :- endif. defined_flag(Flag, Group, Type, Default, Description, Access) :- ::defined_flag_(Flag, Group, Type, Default, Description, Access), Access \== hidden, Access \== hidden_read_only. defined_flag(Flag, Group, Type, Default, Description, Access) :- nonvar(Flag), nonvar(Group), ::defined_flag_(Flag, Group, Type, Default, Description, Access). is_proper_list(-) :- % catch variables and lists with unbound tails !, fail. is_proper_list([]). is_proper_list([_| T]) :- is_proper_list(T). member(H, [H| _]). member(H, [_| T]) :- member(H, T). :- end_category.