Commit 7ea77e1f authored by Maxime Perrotin's avatar Maxime Perrotin
Browse files

Slightly revisit option type

Add constant for Invalid values, in addition to Nothing
parent 29c989a0
-- ************************ taste aadl parser **************************** -- -- ************************ taste aadl parser **************************** --
-- (c) 2008-2017 European Space Agency - maxime.perrotin@esa.int -- (c) 2008-2018 European Space Agency - maxime.perrotin@esa.int
-- LGPL license, see LICENSE file -- LGPL license, see LICENSE file
-- Define a generic Option type -- Define a generic Option type
generic generic
type T is private; type T is private;
package Option_Type is package Option_Type is
type Option is tagged private; type Option is tagged private;
function Just (I : T) return Option; function Just (I : T) return Option;
function Nothing return Option; function Unsafe_Just (O : Option) return T;
function Unsafe_Just (O : Option) return T; function Value_Or (O : Option; Default : T) return T;
-- function Value (O : Option) return T renames Just; function Has_Value (O : Option) return Boolean;
function Value_Or (O : Option; Default : T) return T; Nothing : constant Option;
function Has_Value (O : Option) return Boolean; Invalid_Value : constant Option;
private private
type Option is tagged type Option is tagged
record record
Present : Boolean := False; Present : Boolean := False;
Value : T; Valid : Boolean := True;
Value : T;
end record; end record;
function Just (I : T) return Option is function Just (I : T) return Option is (Present => True,
(Present => True, Value => I); Valid => True,
Value => I);
function Nothing return Option is
(Present => False, others => <>);
function Unsafe_Just (O : Option) return T is (O.Value); function Unsafe_Just (O : Option) return T is (O.Value);
function Value_Or (O : Option; Default : T) return T is function Value_Or (O : Option; Default : T) return T is
(if O.Present then O.Value else Default); (if O.Present and O.Valid then O.Value else Default);
function Has_Value (O : Option) return Boolean is (O.Present); function Has_Value (O : Option) return Boolean is (O.Present and O.Valid);
Nothing : constant Option := (Present => False, others => <>);
Invalid_Value : constant Option := (Valid => False, others => <>);
end Option_Type; end Option_Type;
...@@ -252,8 +252,10 @@ package body TASTE.AADL_Parser is ...@@ -252,8 +252,10 @@ package body TASTE.AADL_Parser is
-- Create one protected block per application code -- Create one protected block per application code
for F of Model.Interface_View.Flat_Functions loop for F of Model.Interface_View.Flat_Functions loop
declare declare
New_Block : Protected_Block := (Name => F.Name, New_Block : Protected_Block :=
others => <>); (Name => F.Name,
Node => Model.Deployment_View.Find_Node (To_String (F.Name)),
others => <>);
begin begin
for PI of F.Provided loop for PI of F.Provided loop
declare declare
...@@ -264,7 +266,11 @@ package body TASTE.AADL_Parser is ...@@ -264,7 +266,11 @@ package body TASTE.AADL_Parser is
New_PI.PI.RCM := (if F.Provided.Length = 1 New_PI.PI.RCM := (if F.Provided.Length = 1
then Unprotected_Operation then Unprotected_Operation
else Protected_Operation); else Protected_Operation);
-- (Todo) Check in the DV if any caller is remote -- Check in the DV if any caller is remote
for Caller of PI.Remote_Interfaces loop
null;
end loop;
New_Block.Provided.Insert (Key => To_String (PI.Name), New_Block.Provided.Insert (Key => To_String (PI.Name),
New_Item => New_PI); New_Item => New_PI);
end; end;
......
...@@ -7,14 +7,14 @@ ...@@ -7,14 +7,14 @@
with Ada.Containers.Indefinite_Ordered_Maps, with Ada.Containers.Indefinite_Ordered_Maps,
Ada.Strings.Unbounded, Ada.Strings.Unbounded,
TASTE.Parser_Utils, TASTE.Parser_Utils,
-- TASTE.AADL_Parser, TASTE.Interface_View,
TASTE.Interface_View; TASTE.Deployment_View;
use Ada.Containers, use Ada.Containers,
Ada.Strings.Unbounded, Ada.Strings.Unbounded,
TASTE.Parser_Utils, TASTE.Parser_Utils,
-- TASTE.AADL_Parser, TASTE.Interface_View,
TASTE.Interface_View; TASTE.Deployment_View;
package TASTE.Concurrency_View is package TASTE.Concurrency_View is
...@@ -36,6 +36,7 @@ package TASTE.Concurrency_View is ...@@ -36,6 +36,7 @@ package TASTE.Concurrency_View is
Provided : Protected_Block_PIs.Map; Provided : Protected_Block_PIs.Map;
Required : Interfaces_Maps.Map; Required : Interfaces_Maps.Map;
Calling_Threads : String_Vectors.Vector; Calling_Threads : String_Vectors.Vector;
Node : Option_Node.Option;
end record; end record;
package Protected_Blocks is new Indefinite_Ordered_Maps package Protected_Blocks is new Indefinite_Ordered_Maps
...@@ -55,6 +56,7 @@ package TASTE.Concurrency_View is ...@@ -55,6 +56,7 @@ package TASTE.Concurrency_View is
Entry_Port_Name : Unbounded_String; Entry_Port_Name : Unbounded_String;
Protected_Block_Name : Unbounded_String; Protected_Block_Name : Unbounded_String;
Output_Ports : Ports.Map; Output_Ports : Ports.Map;
Node : Option_Node.Option;
end record; end record;
package AADL_Threads is new Indefinite_Ordered_Maps (String, AADL_Thread); package AADL_Threads is new Indefinite_Ordered_Maps (String, AADL_Thread);
......
...@@ -463,6 +463,19 @@ package body TASTE.Deployment_View is ...@@ -463,6 +463,19 @@ package body TASTE.Deployment_View is
Busses => Busses); Busses => Busses);
end Parse_Deployment_View; end Parse_Deployment_View;
function Find_Node (Deployment : Complete_Deployment_View;
Function_Name : String) return Option_Node.Option is
begin
for Node of Deployment.Nodes loop
for Partition of Node.Partitions loop
if Partition.Bound_Functions.Contains (Function_Name) then
return Option_Node.Just (Node);
end if;
end loop;
end loop;
return Option_Node.Nothing;
end Find_Node;
procedure Dump_Nodes (DV : Complete_Deployment_View; Output : File_Type) is procedure Dump_Nodes (DV : Complete_Deployment_View; Output : File_Type) is
begin begin
for Each of DV.Nodes loop for Each of DV.Nodes loop
......
...@@ -125,6 +125,11 @@ package TASTE.Deployment_View is ...@@ -125,6 +125,11 @@ package TASTE.Deployment_View is
Busses : Taste_Busses.Vector; Busses : Taste_Busses.Vector;
end record; end record;
-- Helper function: find the node of a given function
package Option_Node is new Option_Type (Taste_Node);
function Find_Node (Deployment : Complete_Deployment_View;
Function_Name : String) return Option_Node.Option;
-- Function to build up the Ada AST by transforming the one from Ocarina -- Function to build up the Ada AST by transforming the one from Ocarina
function Parse_Deployment_View (System : Node_Id) function Parse_Deployment_View (System : Node_Id)
return Complete_Deployment_View return Complete_Deployment_View
......
...@@ -271,7 +271,7 @@ package body TASTE.Interface_View is ...@@ -271,7 +271,7 @@ package body TASTE.Interface_View is
-- Get Optional Worse Case Execution Time (Upper bound in ms) -- -- Get Optional Worse Case Execution Time (Upper bound in ms) --
---------------------------------------------------------------- ----------------------------------------------------------------
function Get_Upper_WCET (Func : Node_Id) return Optional_Long_Long is function Get_Upper_WCET (Func : Node_Id) return Option_ULL.Option is
(if Is_Subprogram_Access (Func) and then Sources (Func) /= No_List (if Is_Subprogram_Access (Func) and then Sources (Func) /= No_List
and then AIN.First_Node (Sources (Func)) /= No_Node and then AIN.First_Node (Sources (Func)) /= No_Node
and then Get_Execution_Time (Corresponding_Instance (AIN.Item and then Get_Execution_Time (Corresponding_Instance (AIN.Item
...@@ -279,7 +279,7 @@ package body TASTE.Interface_View is ...@@ -279,7 +279,7 @@ package body TASTE.Interface_View is
/= Empty_Time_Array /= Empty_Time_Array
then Just (To_Milliseconds (Get_Execution_Time (Corresponding_Instance then Just (To_Milliseconds (Get_Execution_Time (Corresponding_Instance
(AIN.Item (AIN.First_Node (Sources (Func)))))(1))) (AIN.Item (AIN.First_Node (Sources (Func)))))(1)))
else Nothing); else Option_ULL.Nothing);
--------------------------- ---------------------------
-- AST Builder Functions -- -- AST Builder Functions --
...@@ -323,7 +323,7 @@ package body TASTE.Interface_View is ...@@ -323,7 +323,7 @@ package body TASTE.Interface_View is
if Get_RCM_Operation_Kind if Get_RCM_Operation_Kind
(Get_Referenced_Entity (AIN.Destination (Conn))) = Cyclic_Operation (Get_Referenced_Entity (AIN.Destination (Conn))) = Cyclic_Operation
then then
return Nothing; return Option_Connection.Nothing;
end if; end if;
PI_Name := Get_Interface_Name PI_Name := Get_Interface_Name
...@@ -377,7 +377,7 @@ package body TASTE.Interface_View is ...@@ -377,7 +377,7 @@ package body TASTE.Interface_View is
ASN1_Module => US (Get_ASN1_Module_Name (CP_ASN1)), ASN1_Module => US (Get_ASN1_Module_Name (CP_ASN1)),
ASN1_File_Name => (if NA'Length > 0 then ASN1_File_Name => (if NA'Length > 0 then
Just (US (Get_Name_String (NA (1)))) Just (US (Get_Name_String (NA (1))))
else Nothing)); else Option_UString.Nothing));
end Parse_CP; end Parse_CP;
-- Parse a single parameter of an interface -- Parse a single parameter of an interface
...@@ -428,7 +428,7 @@ package body TASTE.Interface_View is ...@@ -428,7 +428,7 @@ package body TASTE.Interface_View is
(CI, "taste::associated_queue_size") (CI, "taste::associated_queue_size")
then Just (Get_Integer_Property then Just (Get_Integer_Property
(CI, " taste::associated_queue_size")) (CI, " taste::associated_queue_size"))
else Nothing); else Option_ULL.Nothing);
Result.RCM := Get_RCM_Operation_Kind (If_I); Result.RCM := Get_RCM_Operation_Kind (If_I);
Result.Period_Or_MIAT := Get_RCM_Period (If_I); Result.Period_Or_MIAT := Get_RCM_Period (If_I);
Result.WCET_ms := Get_Upper_WCET (If_I); Result.WCET_ms := Get_Upper_WCET (If_I);
...@@ -540,7 +540,7 @@ package body TASTE.Interface_View is ...@@ -540,7 +540,7 @@ package body TASTE.Interface_View is
begin begin
Result.Name := US (Name); Result.Name := US (Name);
Result.Full_Prefix := (if Prefix'Length > 0 then Just (US (Prefix)) Result.Full_Prefix := (if Prefix'Length > 0 then Just (US (Prefix))
else Nothing); else Option_UString.Nothing);
-- Result.Language := Get_Source_Language (Inst); -- Result.Language := Get_Source_Language (Inst);
Result.Language := US (Get_Language (Inst)); Result.Language := US (Get_Language (Inst));
if Source_Text'Length /= 0 then if Source_Text'Length /= 0 then
......
...@@ -107,8 +107,8 @@ package TASTE.Interface_View is ...@@ -107,8 +107,8 @@ package TASTE.Interface_View is
Params : Parameters.Vector; Params : Parameters.Vector;
RCM : Supported_RCM_Operation_Kind; RCM : Supported_RCM_Operation_Kind;
Period_Or_MIAT : Unsigned_Long_Long; Period_Or_MIAT : Unsigned_Long_Long;
WCET_ms : Optional_Long_Long := Nothing; WCET_ms : Option_ULL.Option := Option_ULL.Nothing;
Queue_Size : Optional_Long_Long := Nothing; Queue_Size : Option_ULL.Option := Option_ULL.Nothing;
User_Properties : Property_Maps.Map; User_Properties : Property_Maps.Map;
end record; end record;
...@@ -121,7 +121,7 @@ package TASTE.Interface_View is ...@@ -121,7 +121,7 @@ package TASTE.Interface_View is
Sort : Unbounded_String; Sort : Unbounded_String;
Default_Value : Unbounded_String; Default_Value : Unbounded_String;
ASN1_Module : Unbounded_String; ASN1_Module : Unbounded_String;
ASN1_File_Name : Optional_Unbounded_String := Nothing; ASN1_File_Name : Option_UString.Option := Option_UString.Nothing;
end record; end record;
package Ctxt_Params is new Indefinite_Vectors (Natural, Context_Parameter); package Ctxt_Params is new Indefinite_Vectors (Natural, Context_Parameter);
...@@ -130,10 +130,10 @@ package TASTE.Interface_View is ...@@ -130,10 +130,10 @@ package TASTE.Interface_View is
record record
Name : Unbounded_String; Name : Unbounded_String;
Context : Unbounded_String := Null_Unbounded_String; Context : Unbounded_String := Null_Unbounded_String;
Full_Prefix : Optional_Unbounded_String := Nothing; Full_Prefix : Option_UString.Option := Option_UString.Nothing;
-- Language : Supported_Source_Language; -- Language : Supported_Source_Language;
Language : Unbounded_String; Language : Unbounded_String;
Zip_File : Optional_Unbounded_String := Nothing; Zip_File : Option_UString.Option := Option_UString.Nothing;
Context_Params : Ctxt_Params.Vector; Context_Params : Ctxt_Params.Vector;
Directives : Ctxt_Params.Vector; -- TASTE Directives Directives : Ctxt_Params.Vector; -- TASTE Directives
Simulink : Ctxt_Params.Vector; -- Simulink Tuneable Params Simulink : Ctxt_Params.Vector; -- Simulink Tuneable Params
...@@ -142,7 +142,7 @@ package TASTE.Interface_View is ...@@ -142,7 +142,7 @@ package TASTE.Interface_View is
Provided : Interfaces_Maps.Map; Provided : Interfaces_Maps.Map;
Required : Interfaces_Maps.Map; Required : Interfaces_Maps.Map;
Is_Type : Boolean := False; Is_Type : Boolean := False;
Instance_Of : Optional_Unbounded_String := Nothing; Instance_Of : Option_UString.Option := Option_UString.Nothing;
end record; end record;
-- Key for the function map is case insensitive -- Key for the function map is case insensitive
......
...@@ -112,10 +112,10 @@ package TASTE.Parser_Utils is ...@@ -112,10 +112,10 @@ package TASTE.Parser_Utils is
package Option_UString is new Option_Type (Unbounded_String); package Option_UString is new Option_Type (Unbounded_String);
-- use Option_UString; -- use Option_UString;
subtype Optional_Unbounded_String is Option_UString.Option; -- subtype Optional_Unbounded_String is Option_UString.Option;
package Option_ULL is new Option_Type (Unsigned_Long_Long); package Option_ULL is new Option_Type (Unsigned_Long_Long);
-- use Option_ULL; -- use Option_ULL;
subtype Optional_Long_Long is Option_ULL.Option; -- subtype Optional_Long_Long is Option_ULL.Option;
procedure Initialize_Ocarina; procedure Initialize_Ocarina;
......
Supports Markdown
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