FUNCTION member_of
(val : GENERIC:g, spc : maths_space) : LOGICAL;
FUNCTION fedex(val : AGGREGATE OF GENERIC:X; i : INTEGER) : GENERIC:X; RETURN (val[i]); END_FUNCTION; -- fedex
LOCAL v : maths_value := simplify_maths_value (convert_to_maths_value (val)); vtypes : SET OF STRING := stripped_typeof (v); s : maths_space := simplify_maths_space (spc); stypes : SET OF STRING := stripped_typeof (s); tmp_int : INTEGER; tmp_real : REAL; tmp_cmplx : complex_number_literal; lgcl, cum : LOGICAL; vspc, sspc : maths_space; smem : SET OF maths_value; factors : LIST OF maths_space; END_LOCAL; IF NOT EXISTS (s) THEN RETURN (FALSE); END_IF; IF NOT EXISTS (v) THEN RETURN (s = the_generics); END_IF; IF ('GENERIC_EXPRESSION' IN vtypes) AND NOT ('MATHS_SPACE' IN vtypes) AND NOT ('MATHS_FUNCTION' IN vtypes) AND NOT ('COMPLEX_NUMBER_LITERAL' IN vtypes) THEN IF has_values_space (v) THEN vspc := values_space_of (v); IF subspace_of (vspc, s) THEN RETURN (TRUE); END_IF; IF NOT compatible_spaces (vspc, s) THEN RETURN (FALSE); END_IF; RETURN (UNKNOWN); END_IF; RETURN (UNKNOWN); END_IF; IF 'ELEMENTARY_SPACE' IN stypes THEN CASE s\elementary_space.space_id OF es_numbers : RETURN (('NUMBER' IN vtypes) OR ('COMPLEX_NUMBER_LITERAL' IN vtypes)); es_complex_numbers : RETURN ('COMPLEX_NUMBER_LITERAL' IN vtypes); es_reals : RETURN (('REAL' IN vtypes) AND NOT ('INTEGER' IN vtypes)); es_integers : RETURN ('INTEGER' IN vtypes); es_logicals : RETURN ('LOGICAL' IN vtypes); es_booleans : RETURN ('BOOLEAN' IN vtypes); es_strings : RETURN ('STRING' IN vtypes); es_binarys : RETURN ('BINARY' IN vtypes); es_maths_spaces : RETURN ('MATHS_SPACE' IN vtypes); es_maths_functions : RETURN ('MATHS_FUNCTION' IN vtypes); es_generics : RETURN (TRUE); END_CASE; END_IF; IF 'FINITE_INTEGER_INTERVAL' IN stypes THEN IF 'INTEGER' IN vtypes THEN tmp_int := v; RETURN ({s\finite_integer_interval.min <= tmp_int <= s\finite_integer_interval.max}); END_IF; RETURN (FALSE); END_IF; IF 'INTEGER_INTERVAL_FROM_MIN' IN stypes THEN IF 'INTEGER' IN vtypes THEN tmp_int := v; RETURN (s\integer_interval_from_min.min <= tmp_int); END_IF; RETURN (FALSE); END_IF; IF 'INTEGER_INTERVAL_TO_MAX' IN stypes THEN IF 'INTEGER' IN vtypes THEN tmp_int := v; RETURN (tmp_int <= s\integer_interval_to_max.max); END_IF; RETURN (FALSE); END_IF; IF 'FINITE_REAL_INTERVAL' IN stypes THEN IF ('REAL' IN vtypes) AND NOT ('INTEGER' IN vtypes) THEN tmp_real := v; IF s\finite_real_interval.min_closure = closed THEN IF s\finite_real_interval.max_closure = closed THEN RETURN ({s\finite_real_interval.min <= tmp_real <= s\finite_real_interval.max}); ELSE RETURN ({s\finite_real_interval.min <= tmp_real < s\finite_real_interval.max}); END_IF; ELSE IF s\finite_real_interval.max_closure = closed THEN RETURN ({s\finite_real_interval.min < tmp_real <= s\finite_real_interval.max}); ELSE RETURN ({s\finite_real_interval.min < tmp_real < s\finite_real_interval.max}); END_IF; END_IF; END_IF; RETURN (FALSE); END_IF; IF 'REAL_INTERVAL_FROM_MIN' IN stypes THEN IF ('REAL' IN vtypes) AND NOT ('INTEGER' IN vtypes) THEN tmp_real := v; IF s\real_interval_from_min.min_closure = closed THEN RETURN (s\real_interval_from_min.min <= tmp_real); ELSE RETURN (s\real_interval_from_min.min < tmp_real); END_IF; END_IF; RETURN (FALSE); END_IF; IF 'REAL_INTERVAL_TO_MAX' IN stypes THEN IF ('REAL' IN vtypes) AND NOT ('INTEGER' IN vtypes) THEN tmp_real := v; IF s\real_interval_to_max.max_closure = closed THEN RETURN (tmp_real <= s\real_interval_to_max.max); ELSE RETURN (tmp_real < s\real_interval_to_max.max); END_IF; END_IF; RETURN (FALSE); END_IF; IF 'CARTESIAN_COMPLEX_NUMBER_REGION' IN stypes THEN IF 'COMPLEX_NUMBER_LITERAL' IN vtypes THEN RETURN (member_of(v\complex_number_literal.real_part, s\cartesian_complex_number_region.real_constraint) AND member_of(v\complex_number_literal.imag_part, s\cartesian_complex_number_region.imag_constraint)); END_IF; RETURN (FALSE); END_IF; IF 'POLAR_COMPLEX_NUMBER_REGION' IN stypes THEN IF 'COMPLEX_NUMBER_LITERAL' IN vtypes THEN tmp_cmplx := v; tmp_cmplx.real_part := tmp_cmplx.real_part - s\polar_complex_number_region.centre.real_part; tmp_cmplx.imag_part := tmp_cmplx.imag_part - s\polar_complex_number_region.centre.imag_part; tmp_real := SQRT (tmp_cmplx.real_part**2 + tmp_cmplx.imag_part**2); IF NOT member_of(tmp_real, s\polar_complex_number_region.distance_constraint) THEN RETURN (FALSE); END_IF; IF tmp_real = 0.0 THEN RETURN (TRUE); -- The centre has no direction. END_IF; tmp_real := atan2(tmp_cmplx.imag_part,tmp_cmplx.real_part); RETURN (member_of(tmp_real, s\polar_complex_number_region.direction_constraint) OR member_of(tmp_real + 2.0*PI, s\polar_complex_number_region.direction_constraint)); END_IF; RETURN (FALSE); END_IF; IF 'FINITE_SPACE' IN stypes THEN smem := s\finite_space.members; cum := FALSE; REPEAT i := 1 TO SIZEOF (smem); cum := cum OR equal_maths_values(v,smem[i]); IF cum = TRUE THEN RETURN (TRUE); END_IF; END_REPEAT; RETURN (cum); END_IF; IF 'UNIFORM_PRODUCT_SPACE' IN stypes THEN IF 'LIST' IN vtypes THEN IF SIZEOF (v) = s\uniform_product_space.exponent THEN sspc := s\uniform_product_space.base; cum := TRUE; REPEAT i := 1 TO SIZEOF (v); cum := cum AND member_of(v[i],sspc); -- cum := cum AND member_of (fedex (v, i), sspc); -- See note above FOR explanation OF fedex() IF cum = FALSE THEN RETURN (FALSE); END_IF; END_REPEAT; RETURN (cum); END_IF; END_IF; RETURN (FALSE); END_IF; IF 'LISTED_PRODUCT_SPACE' IN stypes THEN IF 'LIST' IN vtypes THEN factors := s\listed_product_space.factors; IF SIZEOF (v) = SIZEOF (factors) THEN cum := TRUE; REPEAT i := 1 TO SIZEOF (v); cum := cum AND member_of(v[i],factors[i]); -- cum := cum AND member_of (fedex (v, i), factors[i]); -- See note above FOR explanation OF fedex() IF cum = FALSE THEN RETURN (FALSE); END_IF; END_REPEAT; RETURN (cum); END_IF; END_IF; RETURN (FALSE); END_IF; IF 'EXTENDED_TUPLE_SPACE' IN stypes THEN IF 'LIST' IN vtypes THEN sspc := s\extended_tuple_space.base; tmp_int := space_dimension(sspc); IF SIZEOF (v) >= tmp_int THEN cum := TRUE; REPEAT i := 1 TO tmp_int; cum := cum AND member_of(v[i],factor_space(sspc,i)); -- cum := cum AND member_of (fedex (v, i), factor_space (sspc, i)); -- See note above FOR explanation OF fedex() IF cum = FALSE THEN RETURN (FALSE); END_IF; END_REPEAT; sspc := s\extended_tuple_space.extender; REPEAT i := tmp_int+1 TO SIZEOF (v); cum := cum AND member_of(v[i],sspc); IF cum = FALSE THEN RETURN (FALSE); END_IF; END_REPEAT; RETURN (cum); END_IF; END_IF; RETURN (FALSE); END_IF; IF 'FUNCTION_SPACE' IN stypes THEN IF 'MATHS_FUNCTION' IN vtypes THEN vspc := v\maths_function.domain; sspc := s\function_space.domain_argument; CASE s\function_space.domain_constraint OF sc_equal : cum := equal_maths_spaces (vspc, sspc); sc_subspace : cum := subspace_of (vspc, sspc); sc_member : cum := member_of (vspc, sspc); END_CASE; IF cum = FALSE THEN RETURN (FALSE); END_IF; vspc := v\maths_function.range; sspc := s\function_space.range_argument; CASE s\function_space.range_constraint OF sc_equal : cum := cum AND equal_maths_spaces (vspc, sspc); sc_subspace : cum := cum AND subspace_of (vspc, sspc); sc_member : cum := cum AND member_of (vspc, sspc); END_CASE; RETURN (cum); END_IF; RETURN (FALSE); END_IF; -- Should be unreachable RETURN (UNKNOWN); END_FUNCTION; -- member_of
|