Commit 1ca6cc00 authored by taste's avatar taste
Browse files

Use strings instead of enumerated for language

To avoid recompilation and adding cases each time a langage is added,
remove dependency on the "Supported_Language" enumerated type
parent a57d99a0
with Text_IO; use Text_IO;
with Ada.Strings.Unbounded,
Ada.Characters.Handling,
with Ada.Characters.Handling,
Ada.Containers.Ordered_Sets,
Ada.Exceptions,
Ada.Directories,
......@@ -32,8 +31,6 @@ package body TASTE.Backend.Code_Generators is
Prefix_Middleware : constant String :=
Prefix & "glue/middleware_interface";
use Ada.Strings.Unbounded;
-- Return a Tag list of ASN.1 Modules for the headers
function Get_Module_List return Tag is
Result : Tag;
......@@ -358,7 +355,6 @@ package body TASTE.Backend.Code_Generators is
-- Context Parameters
function CP_Template (F : Taste_Terminal_Function) return Translate_Set is
use Ada.Strings.Unbounded;
package Sort_Set is new Ordered_Sets (Unbounded_String);
use Sort_Set;
Sorts_Set : Set;
......@@ -540,7 +536,6 @@ package body TASTE.Backend.Code_Generators is
function Interface_View_Template (IV : Complete_Interface_View)
return IV_As_Template is
use Func_Maps;
use Ada.Strings.Unbounded;
Result : IV_As_Template;
begin
for Each of IV.Flat_Functions loop
......
with Ocarina.Backends.Properties,
with Ada.Strings.Unbounded,
-- Ocarina.Backends.Properties,
TASTE.Interface_View;
package TASTE.Backend is
use Ocarina.Backends.Properties,
use Ada.Strings.Unbounded,
-- Ocarina.Backends.Properties,
Interface_View;
Backend_Error : exception;
function Language_Spelling (Func : Taste_Terminal_Function) return String is
(case Func.Language is
when Language_Ada_95 => "Ada",
when Language_ASN1 => "ASN1",
when Language_C => "C",
when Language_Esterel => "Esterel", -- Not supported
when Language_Device => "Blackbox_C",
when Language_Gui => "GUI",
when Language_Lua => "Lua", -- Not supported
when Language_Lustre => "SCADE", -- Not supported
when Language_Rhapsody => "CPP",
when Language_SDL_RTDS => "RTDS", -- Pragmadev Studio
when Language_CPP => "CPP",
when Language_SDL_OpenGEODE => "SDL",
when Language_RTSJ => "RTSJ", -- Not supported
when Language_Scade => "SCADE", -- Not supported
when Language_SDL => "SDL",
when Language_Simulink => "SIMULINK",
when Language_QGenC => "QGenC",
when Language_QGenAda => "QGenAda",
when Language_System_C => "System_C", -- Not supported
when Language_VDM => "VDM", -- Partial support
when Language_VHDL => "VHDL",
when Language_VHDL_BRAVE => "VHDL_BRAVE",
when Language_MicroPython => "MicroPython",
when Language_None => "None");
(if Func.Language = "ada" then "Ada"
elsif Func.Language = "c" then "C"
elsif Func.Language = "blackbox_device" then "Blackbox_C"
elsif Func.Language = "gui" then "GUI"
elsif Func.Language = "cpp" then "CPP"
elsif Func.Language = "rtds" then "RTDS"
elsif Func.Language = "sdl" then "SDL"
elsif Func.Language = "sdl_opengeode" then "SDL"
elsif Func.Language = "simulink" then "SIMULINK"
elsif Func.Language = "qgenc" then "QGenC"
elsif Func.Language = "qgenada" then "QGenAda"
elsif Func.Language = "system_c" then "System_C"
elsif Func.Language = "vdm" then "VDM"
elsif Func.Language = "vhdl" then "VHDL"
elsif Func.Language = "vhdl_brave" then "VHDL_BRAVE"
elsif Func.Language = "micropython" then "MicroPython"
else "None");
-- (case Func.Language is
-- when Language_Ada_95 => "Ada",
-- when Language_ASN1 => "ASN1",
-- when Language_C => "C",
-- when Language_Esterel => "Esterel", -- Not supported
-- when Language_Device => "Blackbox_C",
-- when Language_Gui => "GUI",
-- when Language_Lua => "Lua", -- Not supported
-- when Language_Lustre => "SCADE", -- Not supported
-- when Language_Rhapsody => "CPP",
-- when Language_SDL_RTDS => "RTDS", -- Pragmadev Studio
-- when Language_CPP => "CPP",
-- when Language_SDL_OpenGEODE => "SDL",
-- when Language_RTSJ => "RTSJ", -- Not supported
-- when Language_Scade => "SCADE", -- Not supported
-- when Language_SDL => "SDL",
-- when Language_Simulink => "SIMULINK",
-- when Language_QGenC => "QGenC",
-- when Language_QGenAda => "QGenAda",
-- when Language_System_C => "System_C", -- Not supported
-- when Language_VDM => "VDM", -- Partial support
-- when Language_VHDL => "VHDL",
-- when Language_VHDL_BRAVE => "VHDL_BRAVE",
-- when Language_MicroPython => "MicroPython",
-- when Language_None => "None");
end TASTE.Backend;
......@@ -9,8 +9,11 @@ with Ada.Exceptions,
Ocarina.Analyzer,
Ocarina.Options,
Ocarina.Instances,
Ocarina.Backends.Properties,
Ocarina.ME_AADL.AADL_Tree.Nodes,
Ocarina.ME_AADL.AADL_Instances.Nodes,
Ocarina.Namet,
Ocarina.ME_AADL.AADL_Tree.Nutils,
Ocarina.ME_AADL.AADL_Instances.Nutils,
Ocarina.ME_AADL.AADL_Instances.Entities,
Ocarina.Backends.Utils;
......@@ -23,12 +26,42 @@ package body TASTE.Interface_View is
Ocarina.Analyzer,
Ocarina.Options,
Ocarina.Instances,
Ocarina.Backends.Properties,
Ocarina.ME_AADL.AADL_Instances.Nodes,
Ocarina.ME_AADL.AADL_Instances.Nutils,
Ocarina.ME_AADL.AADL_Instances.Entities,
Ocarina.ME_AADL,
Ocarina.Backends.Utils;
package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes;
package ATNU renames Ocarina.ME_AADL.AADL_Tree.Nutils;
------------------------------
-- Get_Language (as string) --
------------------------------
function Get_Language (E : Node_Id) return String is
Source_Property : constant Name_Id :=
Get_String_Name ("source_language");
begin
if Is_Defined_List_Property (E, Source_Property) then
declare
Source_Language_List : constant List_Id :=
Get_List_Property (E, Source_Property);
begin
if ATNU.Length (Source_Language_List) > 1 then
raise Interface_Error with "Cannot use more than one language";
end if;
return Get_Name_String
(ATN.Name
(ATN.Identifier (ATN.First_Node (Source_Language_List))));
end;
else
return "None";
end if;
end Get_Language;
----------------------------
-- Get_RCM_Operation_Kind --
----------------------------
......@@ -508,7 +541,8 @@ package body TASTE.Interface_View is
Result.Name := US (Name);
Result.Full_Prefix := (if Prefix'Length > 0 then Just (US (Prefix))
else Nothing);
Result.Language := Get_Source_Language (Inst);
-- Result.Language := Get_Source_Language (Inst);
Result.Language := US (Get_Language (Inst));
if Source_Text'Length /= 0 then
Zip_Id := Source_Text (1);
Result.Zip_File := Just (US (Get_Name_String (Zip_Id)));
......@@ -853,7 +887,8 @@ package body TASTE.Interface_View is
Put_Line (Output, "├─ Full Prefix : "
& To_String (Value_Or (Each.Full_Prefix, US ("(none)"))));
Put_Line (Output, "├─ Language : " & Each.Language'Img);
Put_Line (Output, "├─ Language : "
& To_String (Each.Language));
Put_Line (Output, "├─ Zip file : "
& To_String (Value_Or (Each.Zip_File, US ("(none)"))));
Put_Line (Output, "├─ Is type : " & Each.Is_Type'Img);
......
......@@ -12,7 +12,7 @@ with Ada.Containers.Indefinite_Ordered_Maps,
Text_IO,
Ocarina,
Ocarina.Types,
Ocarina.Backends.Properties,
-- Ocarina.Backends.Properties,
Option_Type,
TASTE.Parser_Utils;
......@@ -21,7 +21,7 @@ use Ada.Containers,
Text_IO,
Ocarina,
Ocarina.Types,
Ocarina.Backends.Properties,
-- Ocarina.Backends.Properties,
TASTE.Parser_Utils;
package TASTE.Interface_View is
......@@ -36,6 +36,8 @@ package TASTE.Interface_View is
type Synchronism is (Sync, Async);
function Get_Language (E : Node_Id) return String;
type Supported_RCM_Operation_Kind is (Unprotected_Operation,
Protected_Operation,
Cyclic_Operation,
......@@ -131,7 +133,8 @@ package TASTE.Interface_View is
Name : Unbounded_String;
Context : Unbounded_String := Null_Unbounded_String;
Full_Prefix : Optional_Unbounded_String := Nothing;
Language : Supported_Source_Language;
-- Language : Supported_Source_Language;
Language : Unbounded_String;
Zip_File : Optional_Unbounded_String := Nothing;
Context_Params : Ctxt_Params.Vector;
Directives : Ctxt_Params.Vector; -- TASTE Directives
......
with Ada.Containers,
Ocarina.Backends.Properties,
-- Ocarina.Backends.Properties,
TASTE.Parser_Utils;
use Ada.Containers,
Ocarina.Backends.Properties,
-- Ocarina.Backends.Properties,
TASTE.Parser_Utils;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
......@@ -18,7 +18,7 @@ package body TASTE.Model_Transformations is
Count_Passive_PI : Natural := 0;
begin
-- Look for GUIs and add a Poll PI (if there is at least one RI)
if F.Required.Length > 0 and F.Language = Language_GUI then
if F.Required.Length > 0 and F.Language = "gui" then
F.Provided.Insert (Key => "Poll",
New_Item => (Name => US ("Poll"),
Parent_Function => F.Name,
......@@ -49,7 +49,8 @@ package body TASTE.Model_Transformations is
declare
New_F : Taste_Terminal_Function :=
(Name => F.Name & "_" & PI.Name,
Language => Language_Device,
Language => US ("blackbox_device"),
-- Language_Device,
Context => F.Context,
others => <>);
New_F_PI : Taste_Interface := PI;
......@@ -120,7 +121,7 @@ package body TASTE.Model_Transformations is
-- Test / Debug:
for F of Result.Interface_View.Flat_Functions loop
if F.Language = Language_GUI then
if F.Language = "gui" then
for I of F.Provided loop
null;
-- Put_Line (To_String (I.Name));
......
with Ada.Strings.Unbounded,
Ada.Containers,
Ocarina.Backends.Properties,
-- Ocarina.Backends.Properties,
TASTE.Deployment_View,
TASTE.Interface_View,
TASTE.Parser_Utils;
use Ada.Strings.Unbounded,
Ada.Containers,
Ocarina.Backends.Properties,
-- Ocarina.Backends.Properties,
TASTE.Deployment_View,
TASTE.Interface_View,
TASTE.Interface_View.Interfaces_Maps,
......@@ -31,8 +31,8 @@ package body TASTE.Semantic_Check is
-- Check that functions have at least one PI
-- with the exception of GUIs and Blackbox devices
if Each.Language /= Language_Gui
and then Each.Language /= Language_Device
if Each.Language /= "gui"
and then Each.Language /= "blackbox_device"
and then Each.Provided.Length = 0
then
raise Semantic_Error with
......@@ -41,11 +41,11 @@ package body TASTE.Semantic_Check is
end if;
-- Check that Simulink functions have exactly one PI and no RI
if (case Each.Language is
when
Language_Simulink | Language_QGenAda | Language_QGenC => True,
when others => False) and then
(Each.Provided.Length /= 1 or Each.Required.Length /= 0)
if (Each.Language = "simulink"
or Each.Language = "qgenada"
or Each.Language = "qgenc")
and then (Each.Provided.Length /= 1
or Each.Required.Length /= 0)
then
raise Semantic_Error with
"Function " & To_String (Each.Name) & " must contain only "
......@@ -53,10 +53,9 @@ package body TASTE.Semantic_Check is
end if;
-- Check that Simulink/QGen functions's PI is synchronous
if (case Each.Language is
when
Language_Simulink | Language_QGenAda | Language_QGenC => True,
when others => False)
if Each.Language = "simulink"
or Each.Language = "qgenada"
or Each.Language = "qgenc"
then
for PI of Each.Provided loop
if PI.RCM /= Unprotected_Operation
......@@ -72,7 +71,7 @@ package body TASTE.Semantic_Check is
-- GUI checks:
-- 1) interfaces must all have a parameter
-- 2) interfaces must all be sporadic (TODO)
if Each.Language = Language_Gui and then
if Each.Language = "gui" and then
((for all I of Each.Provided => I.Params.Length /= 1) or else
(for all I of Each.Required => I.Params.Length /= 1))
then
......@@ -121,12 +120,14 @@ package body TASTE.Semantic_Check is
end loop;
-- Component type/instance checks
if Each.Is_Type and then not (case Each.Language is
when Language_Ada_95 | Language_SDL | Language_CPP => True,
when others => False)
if Each.Is_Type
and Each.Language /= "ada"
and Each.Language /= "sdl"
and Each.Language /= "cpp"
then
raise Semantic_Error with "Function " & To_String (Each.Name)
& " can be a type only if it is implemented in Ada, C++ or SDL";
& " can be a type only if it is implemented in Ada, C++ or SDL"
& " (not " & To_String (Each.Language) & ")";
end if;
if Each.Instance_Of.Has_Value then
......
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