Special Current promotion for kernel numeric types for symmetric arit…

…hmetic
tybor · May 2, 2010 · e5799eb · e5799eb
1 parent 61f51c3
commit e5799eb
Show file tree

Hide file tree

Showing 3 changed files with 41 additions and 7 deletions.
diff --git a/src/tools/interpreter/liberty_interpreter_feature_call.e b/src/tools/interpreter/liberty_interpreter_feature_call.e
@@ -85,7 +85,7 @@ feature {LIBERTY_INTERPRETER, LIBERTY_FEATURE_ACCELERATOR, LIBERTY_INTERPRETER_E
 		local
 			i: INTEGER; p: FAST_ARRAY[LIBERTY_INTERPRETER_OBJECT]
 			val: LIBERTY_INTERPRETER_OBJECT
-			formal_type: LIBERTY_ACTUAL_TYPE
+			formal_type, actual_type: LIBERTY_ACTUAL_TYPE
 		do
 			if parameters = Void then
 				interpreter.set_evaluating_parameters(Current)
@@ -105,12 +105,24 @@ feature {LIBERTY_INTERPRETER, LIBERTY_FEATURE_ACCELERATOR, LIBERTY_INTERPRETER_E
 					actuals.item(i).accept(interpreter.expressions)
 					val := interpreter.expressions.eval_as_right_value
 					formal_type ::= bound_feature.parameters.item(i).result_type.known_type
-					if val.type.is_conform_to(formal_type) then
+					actual_type ::= val.type.known_type
+					if actual_type.is_conform_to(formal_type) then
 						p.add_last(val)
-					elseif val.type.converts_to(formal_type) then
+					elseif actual_type.converts_to(formal_type) then
 						p.add_last(interpreter.object_converter.convert_object(val, formal_type))
+					elseif formal_type = bound_feature.current_type and then formal_type.may_promote_current and then formal_type.converts_to(actual_type) then
+						-- Special Current promotion for kernel numeric types
+						check
+							not_a_precursor: feature_name /= Void
+						end
+						make(interpreter, interpreter.object_converter.convert_object(target, actual_type),
+							  actual_type.feature_definition(feature_name), actuals, position)
+						check
+							bound_feature.parameters.count = actuals.count
+						end
+						i := actuals.lower - 1 -- try again
 					else
-						interpreter.fatal_error("Bad object type: " + val.type.full_name + " does not conform or convert to " + formal_type.full_name, actuals.item(i).position)
+						interpreter.fatal_error("Bad object type: " + actual_type.full_name + " does not conform or convert to " + formal_type.full_name, actuals.item(i).position)
 						p.add_last(val)
 					end
 					i := i + 1
@@ -177,9 +189,9 @@ feature {LIBERTY_INTERPRETER, LIBERTY_INTERPRETER_EXTERNAL_BUILTINS, LIBERTY_INT
 			Result := parameter_map.fast_reference_at(parameter_name)
 		end
 
-	writable_feature_static_type (feature_name: LIBERTY_FEATURE_NAME): LIBERTY_ACTUAL_TYPE is
+	writable_feature_static_type (a_feature_name: LIBERTY_FEATURE_NAME): LIBERTY_ACTUAL_TYPE is
 		do
-			Result ::= target.type.feature_definition(feature_name).result_type.known_type
+			Result ::= target.type.feature_definition(a_feature_name).result_type.known_type
 		end
 
 	set_writable_feature (a_name: LIBERTY_FEATURE_NAME; a_value: LIBERTY_INTERPRETER_OBJECT) is
@@ -401,7 +413,8 @@ feature {}
 			a_actuals /= Void
 			a_position /= Void
 		do
-			name := a_feature_definition.feature_name.full_name
+			feature_name := a_feature_definition.feature_name
+			name := feature_name.full_name
 			interpreter := a_interpreter
 			target := a_target
 			actuals := a_actuals
@@ -446,6 +459,8 @@ feature {}
 			actuals = a_actuals
 		end
 
+	feature_name: LIBERTY_FEATURE_NAME
+
 	name_precursor: FIXED_STRING is
 		once
 			Result := "Precursor".intern

diff --git a/src/tools/liberty_universe.e b/src/tools/liberty_universe.e
@@ -102,6 +102,7 @@ feature {ANY} -- Kernel types
 			Result := kernel_type("INTEGER_64", visit_type_integer_64)
 			Result.add_converter(type_real_128, convert_integer_64_real_128)
 			Result.add_converter(type_real_80, convert_integer_64_real_80)
+			Result.set_may_promote_current
 		end
 
 	type_integer, type_integer_32: LIBERTY_ACTUAL_TYPE is
@@ -113,6 +114,7 @@ feature {ANY} -- Kernel types
 			Result.add_converter(type_real_128, convert_integer_32_real_128)
 			Result.add_converter(type_real_80, convert_integer_32_real_80)
 			Result.add_converter(type_real_64, convert_integer_32_real_64)
+			Result.set_may_promote_current
 		end
 
 	type_integer_16: LIBERTY_ACTUAL_TYPE is
@@ -126,6 +128,7 @@ feature {ANY} -- Kernel types
 			Result.add_converter(type_real_80, convert_integer_16_real_80)
 			Result.add_converter(type_real_64, convert_integer_16_real_64)
 			Result.add_converter(type_real_32, convert_integer_16_real_32)
+			Result.set_may_promote_current
 		end
 
 	type_integer_8: LIBERTY_ACTUAL_TYPE is
@@ -140,13 +143,15 @@ feature {ANY} -- Kernel types
 			Result.add_converter(type_real_80, convert_integer_8_real_80)
 			Result.add_converter(type_real_64, convert_integer_8_real_64)
 			Result.add_converter(type_real_32, convert_integer_8_real_32)
+			Result.set_may_promote_current
 		end
 
 	type_real_128: LIBERTY_ACTUAL_TYPE is
 		require
 			not errors.has_error
 		once
 			Result := kernel_type("REAL_128", visit_type_real_128)
+			Result.set_may_promote_current
 		end
 
 	type_real_80: LIBERTY_ACTUAL_TYPE is
@@ -155,6 +160,7 @@ feature {ANY} -- Kernel types
 		once
 			Result := kernel_type("REAL_80", visit_type_real_80)
 			Result.add_converter(type_real_128, convert_real_80_128)
+			Result.set_may_promote_current
 		end
 
 	type_real, type_real_64: LIBERTY_ACTUAL_TYPE is
@@ -164,6 +170,7 @@ feature {ANY} -- Kernel types
 			Result := kernel_type("REAL_64", visit_type_real_64)
 			Result.add_converter(type_real_80, convert_real_64_80)
 			Result.add_converter(type_real_128, convert_real_64_128)
+			Result.set_may_promote_current
 		end
 
 	type_real_32: LIBERTY_ACTUAL_TYPE is
@@ -174,6 +181,7 @@ feature {ANY} -- Kernel types
 			Result.add_converter(type_real_64, convert_real_32_64)
 			Result.add_converter(type_real_80, convert_real_32_80)
 			Result.add_converter(type_real_128, convert_real_32_128)
+			Result.set_may_promote_current
 		end
 
 	type_character: LIBERTY_ACTUAL_TYPE is

diff --git a/src/tools/semantics/types/impl/liberty_actual_type.e b/src/tools/semantics/types/impl/liberty_actual_type.e
@@ -136,6 +136,10 @@ feature {ANY}
 			converter(target_type).call([a_converter])
 		end
 
+	may_promote_current: BOOLEAN
+			-- True if Current's type may be promoted in order to fix arithmetic operations (available only on a
+			-- very few select kernel types such as integers, naturals and reals)
+
 feature {LIBERTY_KNOWN_TYPE}
 	full_name_in (buffer: STRING) is
 		local
@@ -415,6 +419,13 @@ feature {LIBERTY_UNIVERSE} -- Semantics building
 			Result := builder.is_built
 		end
 
+	set_may_promote_current is
+		do
+			may_promote_current:= True
+		ensure
+			may_promote_current
+		end
+
 	add_converter (target_type: LIBERTY_ACTUAL_TYPE; a_converter: like converter) is
 		require
 			not has_converter(target_type)