Skip to content

GitLab

Commits (1)
Hide whitespace changes
Inline Side-by-side
src/taste-parser_utils.adb
View file @ 1b799952
-- *************************** taste aadl parser ************************* --
-- (c) 2008-2018 European Space Agency - maxime.perrotin@esa.int
-- (c) 2008-2021 European Space Agency - maxime.perrotin@esa.int
-- LGPL license, see LICENSE file
with Ada.Characters.Latin_1,
......@@ -434,6 +434,123 @@ package body TASTE.Parser_Utils is
-- Get all properties as a Map Key/String --
-- Input parameter is an AADL instance --
--------------------------------------------
function Numeric_Term_As_String (Node : Node_Id) return String is
function Signed_Number (Value, Unit : Node_Id) return String
is
Result : Unbounded_String;
begin
if ATN.Kind (Value) = K_Literal then
-- aadlinteger or aadlreal
Result := US (Ocarina.AADL_Values.Image (ATN.Value (Value)));
else
-- If this is ever needed, relevant code to adapt is in
-- ocarina-be_aadl-properties-values.adb
Result := US ("UNSUPPORTED CONSTANTS");
end if;
if Present (Unit) then
Result := Result & US (Get_Name_String (ATN.Display_Name (Unit)));
end if;
return To_String (Result);
end Signed_Number;
begin
return (case ATN.Kind (Node) is
when K_Minus_Numeric_Term =>
"-" & Numeric_Term_As_String (ATN.Numeric_Term (Node)),
when K_Signed_AADLNumber =>
Signed_Number (Number_Value (Node), Unit_Identifier (Node)),
when K_Entity_Reference =>
-- This comes from ocarina-be_aadl-identifiers.adb, function
-- Print_Entity_Reference
(if ATN.Namespace_Identifier (Node) /= No_Node
then Get_Name_String
(ATN.Display_Name (ATN.Namespace_Identifier (Node))) & "::"
else "")
& Get_Name_String (ATN.Display_Name (Node)),
when K_Property_Term |
K_Unique_Property_Const_Identifier =>
-- This comes from ocarina-be_aadl-identifiers.adb, function
-- Print_Entity_Reference
(if ATN.Property_Set_Identifier (Node) /= No_Node
then Get_Name_String
(ATN.Display_Name (ATN.Property_Set_Identifier (Node)))
& "::"
else "")
& Get_Name_String (ATN.Display_Name (Node)),
when others =>
"ERROR WITH NUMERIC TERM");
end Numeric_Term_As_String;
function Record_As_String (Node : Node_Id) return String;
function Property_Value_As_String (Single_Val : Node_Id;
Array_Value : Node_Id := No_Node)
return String
is
-- return the sting corresponding to a property value
begin
return (case ATN.Kind (Single_Val) is
when ATN.K_Signed_AADLNumber =>
Ocarina.AADL_Values.Image
(ATN.Value (ATN.Number_Value (single_val)))
& (if Present (ATN.Unit_Identifier (single_val))
then " "
& Get_Name_String
(ATN.Display_Name
(ATN.Unit_Identifier (single_val)))
else ""),
when ATN.K_Literal =>
Ocarina.AADL_Values.Image
(ATN.Value (single_val),
Quoted => False),
when ATN.K_Reference_Term =>
Get_Name_String
(ATN.Display_Name (ATN.First_Node -- XXX must iterate
(ATN.List_Items (ATN.Reference_Term (single_val))))),
when ATN.K_Enumeration_Term =>
Get_Name_String
(ATN.Display_Name (ATN.Identifier (Single_Val))),
when ATN.K_Number_Range_Term =>
Numeric_Term_As_String (Lower_Bound (Single_Val))
& ".."
& Numeric_Term_As_String (Upper_Bound (Single_Val)),
when ATN.K_Component_Classifier_Term =>
-- When property is "classifier (...)" the following
-- returns the name of the component (e.g. foo.other)
(if Array_Value /= No_Node then
Get_Name_String (AIN.Display_Name
(AIN.Identifier
(Get_Classifier_Of_Property_Value
(ATN.Expanded_Single_Value (Array_Value)))))
else "UNSUPPORTED CLASSIFIER HERE"),
when ATN.K_Record_Term =>
Record_As_String (single_val),
when others => "ERROR! Kazoo does not support Kind: "
& ATN.Kind (single_val)'Img);
end Property_Value_As_String;
function Record_As_String (Node : Node_Id) return String is
-- Get the string of a complex record property
-- We have to form this string as Ocarina does not have an API for that
-- (the closest is found in ocarina-be_aadl-properties-values.adb but
-- it only prints to screen)
List_Node : Node_Id := ATN.First_Node (ATN.List_Items (Node));
Result : Unbounded_String := US ("[ ");
begin
while Present (List_Node) loop
if Kind (List_Node) = K_Record_Term_Element then
Result := Result
& US (Get_Name_String
(ATN.Display_Name (ATN.Identifier (List_Node))))
& " => "
& Property_Value_As_String (Property_Expression (List_Node));
else
Result := Result & "ERROR - UNIDENTIFIED RECORD FIELD";
end if;
Result := Result & "; ";
List_Node := ATN.Next_Node (List_Node);
end loop;
return To_String (Result & " ]");
end Record_As_String;
function Get_Properties_Map (D : Node_Id) return Property_Maps.Map is
Properties : constant List_Id := AIN.Properties (D);
Result : Property_Maps.Map := Property_Maps.Empty_Map;
......@@ -442,50 +559,15 @@ package body TASTE.Parser_Utils is
Single_Val : Node_Id;
begin
while Present (property) loop
prop_value := AIN.Property_Association_Value (property);
Prop_Value := AIN.Property_Association_Value (property);
Single_Val := ATN.Single_Value (Prop_Value);
if Present (ATN.Single_Value (prop_value)) then
-- Only support single-value properties for now
Single_Val := ATN.Single_Value (Prop_Value);
Result.Insert
(Key => AIN_Case (property),
New_Item =>
(Name => US (AIN_Case (property)),
Value =>
US (case ATN.Kind (single_val) is
when ATN.K_Signed_AADLNumber =>
Ocarina.AADL_Values.Image
(ATN.Value (ATN.Number_Value (single_val))) &
(if Present (ATN.Unit_Identifier (single_val))
then " "
& Get_Name_String
(ATN.Display_Name
(ATN.Unit_Identifier (single_val)))
else ""),
when ATN.K_Literal =>
Ocarina.AADL_Values.Image
(ATN.Value (single_val),
Quoted => False),
when ATN.K_Reference_Term =>
Get_Name_String
(ATN.Display_Name (ATN.First_Node -- XXX must iterate
(ATN.List_Items (ATN.Reference_Term (single_val))))),
when ATN.K_Enumeration_Term =>
Get_Name_String
(ATN.Display_Name (ATN.Identifier (single_val))),
when ATN.K_Number_Range_Term =>
"RANGE NOT SUPPORTED!",
when ATN.K_Component_Classifier_Term =>
-- When property is "classifier (...)" the following
-- returns the name of the component (e.g. foo.other)
Get_Name_String
(AIN.Display_Name
(AIN.Identifier
(Get_Classifier_Of_Property_Value
(ATN.Expanded_Single_Value
(Prop_Value))))),
when others => "ERROR! Kazoo does not support Kind: "
& ATN.Kind (single_val)'Img)));
Value => US (Property_Value_As_String
(Single_Val, Prop_Value))));
end if;
Property := AIN.Next_Node (Property);
end loop;
......