Commit 5ccd0823 authored by jhugues's avatar jhugues

* Move Convert_To_Base to Ocarina.Processor.Properties.

	* Use Convert_To_Base to convert property values to their base
	 units

	 For ticket 61



git-svn-id: https://tecsw.estec.esa.int/svn/taste/trunk/ocarina@3537 129961e7-ef38-4bb5-a8f7-c9a525a55882
parent cede5a2a
......@@ -2442,8 +2442,8 @@ package body Ocarina.Backends.REAL is
declare
V : Value_Id;
VT : Value_Type;
Cpt : Integer := 1;
Real_Cpt : Float := 1.0;
Cpt : Long_Long := 1;
Real_Cpt : Long_Long_Float := 1.0;
N : Node_Id;
Is_Int : Boolean;
R : Value_Id;
......@@ -2478,10 +2478,11 @@ package body Ocarina.Backends.REAL is
while Present (N) loop
V := Item_Val (N);
-- XXX dubious
if Is_Int then
Cpt := Cpt * Integer (Get_Value_Type (V).IVal);
Cpt := Cpt * Long_Long (Get_Value_Type (V).IVal);
else
Real_Cpt := Real_Cpt * Float (Get_Value_Type (V).RVal);
Real_Cpt := Real_Cpt * Get_Value_Type (V).RVal;
end if;
N := Next_Node (N);
end loop;
......@@ -2492,7 +2493,7 @@ package body Ocarina.Backends.REAL is
T := RT_Integer;
else
result := New_Real_Value
(Long_Long_Float (Real_Cpt));
(Real_Cpt);
T := RT_Float;
end if;
end;
......@@ -2501,8 +2502,8 @@ package body Ocarina.Backends.REAL is
declare
V : Value_Id;
VT : Value_Type;
Cpt : Integer := 0;
Real_Cpt : Float := 0.0;
Cpt : Long_Long := 0;
Real_Cpt : Long_Long_Float := 0.0;
N : Node_Id;
Is_Int : Boolean;
R : Value_Id;
......@@ -2546,12 +2547,14 @@ package body Ocarina.Backends.REAL is
while Present (N) loop
V := Item_Val (N);
if Is_Int then
Cpt := Cpt + Integer (Get_Value_Type (V).IVal);
Cpt := Cpt + Long_Long (Get_Value_Type (V).IVal);
-- XXX Dubious
else
if Get_Value_Type (V).T = LT_Real then
Real_Cpt := Real_Cpt + Float (Get_Value_Type (V).RVal);
Real_Cpt := Real_Cpt + Get_Value_Type (V).RVal;
elsif Get_Value_Type (V).T = LT_Integer then
Real_Cpt := Real_Cpt + Float (Get_Value_Type (V).IVal);
Real_Cpt := Real_Cpt
+ Long_Long_Float (Get_Value_Type (V).IVal);
else
Display_Located_Error
(Loc (First_Node (Parameters (E))),
......@@ -2568,7 +2571,7 @@ package body Ocarina.Backends.REAL is
result := New_Integer_Value (Unsigned_Long_Long (Cpt));
T := RT_Integer;
else
result := New_Real_Value (Long_Long_Float (Real_Cpt));
result := New_Real_Value (Real_Cpt);
T := RT_Float;
end if;
end;
......
......@@ -42,12 +42,14 @@ with Ocarina.REAL_Values;
with Ocarina.AADL_Values;
with Locations;
with Ocarina.ME_AADL.AADL_Instances.Entities;
with Ocarina.Processor.Properties;
package body Ocarina.Instances.REAL_Finder is
use Ocarina.ME_REAL.REAL_Tree.Nodes;
use Ocarina.ME_REAL.REAL_Tree.Nutils;
use Ocarina.ME_AADL.AADL_Instances.Nodes;
use Ocarina.REAL_Values;
use Ocarina.Processor.Properties;
package RNU renames Ocarina.ME_REAL.REAL_Tree.Nutils;
package AIEP renames Ocarina.ME_AADL.AADL_Instances.Entities.Properties;
......@@ -150,7 +152,22 @@ package body Ocarina.Instances.REAL_Finder is
case ATN.Kind (N) is
when ATN.K_Signed_AADLNumber =>
Result := AADL_Value (ATN.Value (ATN.Number_Value (N)));
declare
Base_Value : Node_Id;
begin
if Present (ATN.Unit_Identifier (N))
and then Present
(ATN.Corresponding_Entity (ATN.Unit_Identifier (N)))
then
Base_Value :=
Convert_To_Base
(ATN.Number_Value (N),
ATN.Corresponding_Entity (ATN.Unit_Identifier (N)));
Result := AADL_Value (ATN.Value (Base_Value));
else
Result := AADL_Value (ATN.Value (ATN.Number_Value (N)));
end if;
end;
when ATN.K_Literal =>
VT := OV.Get_Value_Type (ATN.Value (N));
......
......@@ -33,7 +33,6 @@
with Errors;
with Namet;
with Utils;
with Ocarina.AADL_Values;
......@@ -53,7 +52,7 @@ package body Ocarina.Analyzer.AADL.Semantics is
use Errors;
use Namet;
use Utils;
use Ocarina.AADL_Values;
use Ocarina.Analyzer.Messages;
use Ocarina.Analyzer.AADL.Queries;
......@@ -2082,125 +2081,6 @@ package body Ocarina.Analyzer.AADL.Semantics is
Literal_1 : out Node_Id;
Literal_2 : out Node_Id)
is
function Convert_To_Base (L : Node_Id; U : Node_Id) return Node_Id;
-- Converts the literal L associated to the unit U into a
-- literal associated with the base dentifier of the units
-- type.
procedure Fetch
(U : Node_Id;
Fetched : out Node_Id;
Base : out Boolean);
-- Return the defining identifier corresponding to the
-- multiplier U in the corresponding units type. Base is set to
-- True if the fetched identifier is the base unit
-- identifier. If the identifier is not found, return No_Node
-- and False.
---------------------
-- Convert_To_Base --
---------------------
function Convert_To_Base (L : Node_Id; U : Node_Id) return Node_Id is
Fetched : Node_Id;
N : Node_Id;
Base : Boolean;
Result : Value_Type;
Count : Natural;
Max_Iterations : Natural;
Units_Type : Node_Id;
begin
Fetch (U, Fetched, Base);
if not Base then
-- To avoid infinite loops and detect bad formed units
-- types.
Units_Type := Corresponding_Entity
(Unit_Identifier
(Corresponding_Entity
(Fetched)));
Max_Iterations := Length (Unit_Definitions (Units_Type));
end if;
Result := Value (Value (L));
Count := 0;
while not Base loop
Result := Result * Value
(Value
(Numeric_Literal
(Corresponding_Entity
(Fetched))));
Fetch
(Unit_Identifier (Corresponding_Entity (Fetched)),
Fetched,
Base);
Count := Count + 1;
if Count > Max_Iterations + 1 then
DAE
(Message0 => "Units Type ",
Node1 => Units_Type,
Message1 => " is ill-defined: it contains cycles");
exit;
end if;
end loop;
N := New_Node (K_Literal, Loc (L));
Set_Value (N, New_Value (Result));
return N;
end Convert_To_Base;
-----------
-- Fetch --
-----------
procedure Fetch
(U : Node_Id;
Fetched : out Node_Id;
Base : out Boolean)
is
Units_Type : Node_Id;
Unit_Definition : Node_Id;
begin
if Kind (Corresponding_Entity (U)) = K_Units_Type then
-- We have the base identifier
Units_Type := Corresponding_Entity (U);
else
Units_Type := Corresponding_Entity
(Unit_Identifier
(Corresponding_Entity
(U)));
end if;
-- This phase is neccessary because the Unit_Identifier of a
-- Unit_definition is not linked directly to its
-- corresponding unit definition.
Fetched := Base_Identifier (Units_Type);
if To_Lower (Name (Fetched)) = To_Lower (Name (U)) then
Base := True;
else
Base := False;
Unit_Definition := First_Node (Unit_Definitions (Units_Type));
while Present (Unit_Definition) loop
Fetched := Identifier (Unit_Definition);
exit when To_Lower (Name (Fetched)) = To_Lower (Name (U));
Fetched := No_Node;
Unit_Definition := Next_Node (Unit_Definition);
end loop;
end if;
end Fetch;
Unit_1 : Node_Id;
Unit_2 : Node_Id;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2005-2010, European Space Agency (ESA). --
-- Copyright (C) 2005-2011, European Space Agency (ESA). --
-- --
-- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
......@@ -31,6 +31,7 @@
-- --
------------------------------------------------------------------------------
with Utils;
with Ocarina.AADL_Values;
with Ocarina.Analyzer.Messages;
......@@ -101,6 +102,16 @@ package body Ocarina.Processor.Properties is
(Root : Node_Id)
return Boolean;
procedure Fetch
(U : Node_Id;
Fetched : out Node_Id;
Base : out Boolean);
-- Return the defining identifier corresponding to the
-- multiplier U in the corresponding units type. Base is set to
-- True if the fetched identifier is the base unit
-- identifier. If the identifier is not found, return No_Node
-- and False.
-----------------------------
-- Compute_Property_Values --
-----------------------------
......@@ -1454,4 +1465,114 @@ package body Ocarina.Processor.Properties is
return Success;
end Resolve_All_Property_Names;
---------------------
-- Convert_To_Base --
---------------------
function Convert_To_Base (L : Node_Id; U : Node_Id) return Node_Id is
use Ocarina.AADL_Values;
use Utils;
use Ocarina.ME_AADL.AADL_Tree.Nutils;
use Ocarina.Analyzer.Messages;
Fetched : Node_Id;
N : Node_Id;
Base : Boolean;
Result : Value_Type;
Count : Natural;
Max_Iterations : Natural;
Units_Type : Node_Id;
begin
Fetch (U, Fetched, Base);
if not Base then
-- To avoid infinite loops and detect bad formed units
-- types.
Units_Type := Corresponding_Entity
(Unit_Identifier
(Corresponding_Entity
(Fetched)));
Max_Iterations := Length (Unit_Definitions (Units_Type));
end if;
Result := Value (Value (L));
Count := 0;
while not Base loop
Result := Result * Value
(Value
(Numeric_Literal
(Corresponding_Entity
(Fetched))));
Fetch
(Unit_Identifier (Corresponding_Entity (Fetched)),
Fetched,
Base);
Count := Count + 1;
if Count > Max_Iterations + 1 then
DAE
(Message0 => "Units Type ",
Node1 => Units_Type,
Message1 => " is ill-defined: it contains cycles");
exit;
end if;
end loop;
N := New_Node (K_Literal, Loc (L));
Set_Value (N, New_Value (Result));
return N;
end Convert_To_Base;
-----------
-- Fetch --
-----------
procedure Fetch
(U : Node_Id;
Fetched : out Node_Id;
Base : out Boolean)
is
use Utils;
Units_Type : Node_Id;
Unit_Definition : Node_Id;
begin
if Kind (Corresponding_Entity (U)) = K_Units_Type then
-- We have the base identifier
Units_Type := Corresponding_Entity (U);
else
Units_Type := Corresponding_Entity
(Unit_Identifier
(Corresponding_Entity
(U)));
end if;
-- This phase is neccessary because the Unit_Identifier of a
-- Unit_definition is not linked directly to its corresponding
-- unit definition.
Fetched := Base_Identifier (Units_Type);
if To_Lower (Name (Fetched)) = To_Lower (Name (U)) then
Base := True;
else
Base := False;
Unit_Definition := First_Node (Unit_Definitions (Units_Type));
while Present (Unit_Definition) loop
Fetched := Identifier (Unit_Definition);
exit when To_Lower (Name (Fetched)) = To_Lower (Name (U));
Fetched := No_Node;
Unit_Definition := Next_Node (Unit_Definition);
end loop;
end if;
end Fetch;
end Ocarina.Processor.Properties;
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2005-2009, GET-Telecom Paris. --
-- Copyright (C) 2005-2011, European Space Agency (ESA). --
-- --
-- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
......@@ -45,4 +45,8 @@ package Ocarina.Processor.Properties is
-- are explicit (no more value() statements). Return True if there
-- was no problem during the resolution process.
function Convert_To_Base (L : Node_Id; U : Node_Id) return Node_Id;
-- Converts the literal L associated to the unit U into a literal
-- associated with the base dentifier of the units type.
end Ocarina.Processor.Properties;
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment