(********************************************************************) (* *) (* enumeration.s7i Enumeration types support library *) (* Copyright (C) 1989 - 2023 Thomas Mertes *) (* *) (* This file is part of the Seed7 Runtime Library. *) (* *) (* The Seed7 Runtime 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. *) (* *) (* The Seed7 Runtime 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 program; if not, write to the *) (* Free Software Foundation, Inc., 51 Franklin Street, *) (* Fifth Floor, Boston, MA 02110-1301, USA. *) (* *) (********************************************************************) const func ref_list: expr_to_list (ref expr: elem_expr) is action "RFL_EXPR"; (** * Abstract data type, describing enumeration types. * To define a new enumeration type the desired enumeration literals * must be listed. Commas must seperate the enumeration literals. * const type: enumType is new enum * enum_literal1, enum_literal2 * end enum; * In order to do I/O for a new enumeration type it is necessary to * define the functions ''str'' and ''parse''. * const func string: str (in enumType: enumValue) is * return literal(enumValue); * enable_output(enumType); *) const func type: new enum (ref expr: elem_expr) end enum is func result var type: enumType is void; local var ref_list: elem_list is ref_list.EMPTY; var integer: number is 0; var reference: elem_obj is NIL; var ref_list: literal_list is ref_list.EMPTY; begin global enumType := subtype ENUMERATION; IN_PARAM_IS_VALUE(enumType); elem_list := expr_to_list(elem_expr); const proc: (ref enumType: dest) ::= (in enumType: source) is action "ENU_CREATE"; const proc: (ref enumType: dest) ::= enumlit is action "ENU_GENLIT"; const proc: destroy (ref enumType: aValue) is action "GEN_DESTR"; const proc: (inout enumType: dest) := (in enumType: source) is action "ENU_CPY"; (** * Convert an enumeration value to the corresponding literal. * @return the enumeration literal. * @exception MEMORY_ERROR Not enough memory to represent the result. *) const func string: literal (in enumType: enumValue) is action "ENU_LIT"; const func enumType: getValue(in reference: aReference, attr enumType) is action "ENU_VALUE"; const func enumType: ICONV2(in integer: number, in ref_list: literalList, attr enumType) is action "ENU_ICONV2"; const func integer: ORD2(in enumType: enum_val, in ref_list: literalList) is action "ENU_ORD2"; literal_list := ref_list.EMPTY; for number range 1 to length(elem_list) do elem_obj := elem_list[number]; # const integer: ord(symb elem_obj) is pred(number); const enumType: .(symb elem_obj) is enumlit; elem_obj := getobj(. (symb elem_obj)); if elem_obj <> NIL and getType(elem_obj) = enumType then literal_list := literal_list & make_list(elem_obj); end if; end for; const ref_list: (attr enumType) . literal_list is literal_list; if length(literal_list) >= 1 then (** * Default value of ''enumType''. *) const enumType: (attr enumType) . value is getValue(literal_list[1], enumType); (** * Minimum value of ''enumType''. *) const enumType: (attr enumType) . first is getValue(literal_list[1], enumType); (** * Maximum value of ''enumType''. *) const enumType: (attr enumType) . last is getValue(literal_list[length(literal_list)], enumType); end if; (** * Check if two enumeration values are equal. * @return TRUE if the two enumeration values are equal, * FALSE otherwise. *) const func boolean: (in enumType: enum1) = (in enumType: enum2) is action "ENU_EQ"; (** * Check if two enumeration values are not equal. * @return FALSE if the two enumeration values are equal, * TRUE otherwise. *) const func boolean: (in enumType: enum1) <> (in enumType: enum2) is action "ENU_NE"; (** * Conversion from integer ''number'' to ''enumType''. * The first enumeration literal of ''enumType'' corresponds to 0. * @return the corresponding enumeration value. * @exception RANGE_ERROR If number is neither 0 nor 1. *) const func enumType: (attr enumType) conv (in integer: number) is return ICONV2(number, enumType.literal_list, enumType); (** * Convert ''enumValue'' to [[integer]]. * The first enumeration literal of ''enumType'' corresponds to 0. * @return the [[integer]] result of the conversion. *) const func integer: ord (in enumType: enumValue) is return ORD2(enumValue, enumType.literal_list); (** * Convert ''enumValue'' to [[integer]]. * The first enumeration literal of ''enumType'' corresponds to 0. * @return the [[integer]] result of the conversion. *) const func integer: integer (in enumType: enumValue) is return ord(enumValue); (** * Compute the hash value of an enumeration value. * @return the hash value. *) const func integer: hashCode (in enumType: enumValue) is return ord(enumValue); (** * Compare two enumeration values. * @return -1, 0 or 1 if the first argument is considered to be * respectively less than, equal to, or greater than the * second. *) const func integer: compare (in enumType: enum1, in enumType: enum2) is return compare(ord(enum1), ord(enum2)); (** * Conversion from ''enumValue'' to [[integer]]. * The first enumeration literal of ''enumType'' corresponds to 0. * @return the [[integer]] result of the conversion. *) const func integer: (attr integer) conv (in enumType: enumValue) is return ord(enumValue); (** * Successor of ''enumValue''. * succ(enumType.last) raises RANGE_ERROR * @return the successor of ''enumValue''. * @exception RANGE_ERROR If ''enumValue'' is the last value of the enumeration. *) const func enumType: succ (in enumType: enumValue) is return enumType conv succ(ord(enumValue)); (** * Predecessor of ''enumValue''. * pred(enumType.first) raises RANGE_ERROR * @return the predecessor of ''enumValue''. * @exception RANGE_ERROR If ''enumValue'' is the first value of the enumeration. *) const func enumType: pred (in enumType: enumValue) is return enumType conv pred(ord(enumValue)); (** * Increment an enumeration variable. * @exception RANGE_ERROR If ''enumValue'' is the last value of the enumeration. *) const proc: incr (inout enumType: enumValue) is func begin enumValue := succ(enumValue); end func; (** * Decrement an enumeration variable. * @exception RANGE_ERROR If ''enumValue'' is the first value of the enumeration. *) const proc: decr (inout enumType: enumValue) is func begin enumValue := pred(enumValue); end func; (** * Compute pseudo-random enumeration value in the range [low, high]. * The random values are uniform distributed. * @return a random value such that low <= rand(low, high) and * rand(low, high) <= high holds. * @exception RANGE_ERROR The range is empty (low > high holds). *) const func enumType: rand (in enumType: low, in enumType: high) is return enumType conv rand(ord(low), ord(high)); const func boolean: (in enumType: enum_val1) < (in enumType: enum_val2) is return ord(enum_val1) < ord(enum_val2); const func boolean: (in enumType: enum_val1) <= (in enumType: enum_val2) is return ord(enum_val1) <= ord(enum_val2); const func boolean: (in enumType: enum_val1) > (in enumType: enum_val2) is return ord(enum_val1) > ord(enum_val2); const func boolean: (in enumType: enum_val1) >= (in enumType: enum_val2) is return ord(enum_val1) >= ord(enum_val2); FOR_DECLS(enumType); (* Necessary for this is <= < >= > *) FOR_ENUM_DECLS(enumType); DECLARE_TERNARY(enumType); CASE_DECLS(enumType); SUBRANGE_TYPES(enumType); end global; end func;