Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
TASTE
Ocarina
Commits
603581e7
Commit
603581e7
authored
Oct 30, 2013
by
yoogx
Browse files
* Work in progress in Python bindings, first functional prototypes
parent
bb6684df
Changes
6
Show whitespace changes
Inline
Side-by-side
src/main/ocarina-python.adb
0 → 100644
View file @
603581e7
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- O C A R I N A . P Y T H O N --
-- --
-- B o d y --
-- --
-- Copyright (C) 2013 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 2, or (at your option) any --
-- later version. Ocarina is distributed in the hope that it will be --
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details. You should have received a copy of the --
-- GNU General Public License distributed with Ocarina; see file COPYING. --
-- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02111-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- Ocarina is maintained by the TASTE project --
-- (taste-users@lists.tuxfamily.org) --
-- --
------------------------------------------------------------------------------
with
Ada
.
Text_IO
;
use
Ada
.
Text_IO
;
with
GNATCOLL
.
Scripts
;
use
GNATCOLL
.
Scripts
;
with
GNATCOLL
.
Scripts
.
Python
;
use
GNATCOLL
.
Scripts
.
Python
;
with
Ocarina
.
Utils
;
package
body
Ocarina
.
Python
is
function
Register_Scripts_And_Functions
return
GNATCOLL
.
Scripts
.
Scripts_Repository
;
-- Register the various scripting languages and the functions we
-- export to them
-------------
-- Console --
-------------
type
Text_Console
is
new
GNATCOLL
.
Scripts
.
Virtual_Console_Record
with
record
Instances
:
GNATCOLL
.
Scripts
.
Instance_List
;
end
record
;
overriding
procedure
Insert_Text
(
Console
:
access
Text_Console
;
Txt
:
String
);
overriding
procedure
Insert_Prompt
(
Console
:
access
Text_Console
;
Txt
:
String
);
overriding
procedure
Insert_Error
(
Console
:
access
Text_Console
;
Txt
:
String
);
overriding
procedure
Set_Data_Primitive
(
Instance
:
GNATCOLL
.
Scripts
.
Class_Instance
;
Console
:
access
Text_Console
);
overriding
function
Get_Instance
(
Script
:
access
GNATCOLL
.
Scripts
.
Scripting_Language_Record
'
Class
;
Console
:
access
Text_Console
)
return
GNATCOLL
.
Scripts
.
Class_Instance
;
------------------------
-- Set_Data_Primitive --
------------------------
procedure
Set_Data_Primitive
(
Instance
:
Class_Instance
;
Console
:
access
Text_Console
)
is
begin
Set
(
Console
.
Instances
,
Get_Script
(
Instance
),
Instance
);
end
Set_Data_Primitive
;
------------------
-- Get_Instance --
------------------
function
Get_Instance
(
Script
:
access
Scripting_Language_Record
'
Class
;
Console
:
access
Text_Console
)
return
Class_Instance
is
begin
return
Get
(
Console
.
Instances
,
Script
);
end
Get_Instance
;
-----------------
-- Insert_Text --
-----------------
procedure
Insert_Text
(
Console
:
access
Text_Console
;
Txt
:
String
)
is
pragma
Unreferenced
(
Console
);
begin
Put
(
Txt
);
end
Insert_Text
;
-------------------
-- Insert_Prompt --
-------------------
procedure
Insert_Prompt
(
Console
:
access
Text_Console
;
Txt
:
String
)
is
pragma
Unreferenced
(
Console
);
begin
Put
(
Txt
);
end
Insert_Prompt
;
------------------
-- Insert_Error --
------------------
procedure
Insert_Error
(
Console
:
access
Text_Console
;
Txt
:
String
)
is
pragma
Unreferenced
(
Console
);
begin
Put
(
Standard_Error
,
Txt
);
end
Insert_Error
;
----------------
-- On_Version --
----------------
procedure
On_Version
(
Data
:
in
out
Callback_Data
'
Class
;
Command
:
String
);
procedure
On_Version
(
Data
:
in
out
Callback_Data
'
Class
;
Command
:
String
)
is
pragma
Unreferenced
(
Data
,
Command
);
begin
Ocarina
.
Utils
.
Version
;
end
On_Version
;
---------------
-- On_Status --
---------------
procedure
On_Status
(
Data
:
in
out
Callback_Data
'
Class
;
Command
:
String
);
procedure
On_Status
(
Data
:
in
out
Callback_Data
'
Class
;
Command
:
String
)
is
pragma
Unreferenced
(
Data
,
Command
);
begin
Ocarina
.
Utils
.
Print_Status
;
end
On_Status
;
------------------------------------
-- Register_Scripts_And_Functions --
------------------------------------
function
Register_Scripts_And_Functions
return
Scripts_Repository
is
Repo
:
Scripts_Repository
;
begin
-- Register all scripting languages. In practice, you only need to
-- register those you intend to support
Repo
:=
new
Scripts_Repository_Record
;
Register_Python_Scripting
(
Repo
,
"Ocarina"
);
Register_Standard_Classes
(
Repo
,
"Console"
);
-- Register our custom functions
-- version() function
Register_Command
(
Repo
,
"version"
,
0
,
0
,
Handler
=>
On_Version
'
Unrestricted_Access
);
-- status() function
Register_Command
(
Repo
,
"status"
,
0
,
0
,
Handler
=>
On_Status
'
Unrestricted_Access
);
return
Repo
;
end
Register_Scripts_And_Functions
;
----------------
-- Run_Python --
----------------
procedure
Run_Python
is
Repo
:
Scripts_Repository
:=
Register_Scripts_And_Functions
;
Buffer
:
String
(
1
..
1000
);
Last
:
Integer
;
Errors
:
Boolean
;
Console
:
aliased
Text_Console
;
begin
Put_Line
(
"Ocarina interactive Python shell"
);
Put_Line
(
"Please type python commands:"
);
Set_Default_Console
(
Lookup_Scripting_Language
(
Repo
,
"python"
),
Console
'
Unchecked_Access
);
loop
Get_Line
(
Buffer
,
Last
);
Execute_Command
(
Script
=>
Lookup_Scripting_Language
(
Repo
,
"python"
),
Command
=>
Buffer
(
1
..
Last
),
Show_Command
=>
False
,
Hide_Output
=>
False
,
Errors
=>
Errors
);
end
loop
;
exception
when
End_Error
=>
Destroy
(
Repo
);
end
Run_Python
;
end
Ocarina
.
Python
;
src/main/ocarina-python.ads
0 → 100644
View file @
603581e7
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- O C A R I N A . P Y T H O N --
-- --
-- S p e c --
-- --
-- Copyright (C) 2013 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 2, or (at your option) any --
-- later version. Ocarina is distributed in the hope that it will be --
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details. You should have received a copy of the --
-- GNU General Public License distributed with Ocarina; see file COPYING. --
-- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02111-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- Ocarina is maintained by the TASTE project --
-- (taste-users@lists.tuxfamily.org) --
-- --
------------------------------------------------------------------------------
package
Ocarina
.
Python
is
procedure
Run_Python
;
end
Ocarina
.
Python
;
src/main/ocarina-scripts.adb
View file @
603581e7
...
...
@@ -70,7 +70,7 @@ package body Ocarina.Scripts is
function
"+"
(
S
:
String
)
return
String_Access
;
procedure
Show_Help
;
procedure
Free
is
new
Ada
.
Unchecked_Deallocation
(
String
,
String_Access
);
procedure
Print_Status
;
function
Next
return
String
;
function
Argument
(
Index
:
Natural
)
return
String_Access
;
function
Count
(
Prompt
:
String
:=
"> "
)
return
Natural
;
...
...
@@ -139,17 +139,6 @@ package body Ocarina.Scripts is
end
loop
;
end
Show_Help
;
------------------
-- Print_Status --
------------------
procedure
Print_Status
is
begin
Write_Line
(
"AADL version: "
&
Ocarina
.
AADL_Version
'
Img
);
Write_Line
(
"Library Path: "
&
Get_Name_String
(
Default_Library_Path
));
end
Print_Status
;
--------------
-- Argument --
--------------
...
...
src/main/ocarina-utils.adb
View file @
603581e7
...
...
@@ -30,16 +30,19 @@
-- (taste-users@lists.tuxfamily.org) --
-- --
------------------------------------------------------------------------------
with
Ada
.
Command_Line
;
use
Ada
.
Command_Line
;
with
GNAT
.
Directory_Operations
;
use
GNAT
.
Directory_Operations
;
with
GNAT
.
OS_Lib
;
use
GNAT
.
OS_Lib
;
with
Namet
;
use
Namet
;
with
Output
;
use
Output
;
with
Ocarina
.
Backends
;
use
Ocarina
.
Backends
;
with
Ocarina
.
Configuration
;
use
Ocarina
.
Configuration
;
with
Ocarina
.
FE_AADL
;
use
Ocarina
.
FE_AADL
;
with
Ocarina
.
FE_REAL
;
use
Ocarina
.
FE_REAL
;
with
Ocarina
.
Options
;
use
Ocarina
.
Options
;
package
body
Ocarina
.
Utils
is
...
...
@@ -62,6 +65,17 @@ package body Ocarina.Utils is
&
Ocarina_Last_Configure_Year
&
" ESA & ISAE"
);
end
Version
;
------------------
-- Print_Status --
------------------
procedure
Print_Status
is
begin
Write_Line
(
"AADL version: "
&
Ocarina
.
AADL_Version
'
Img
);
Write_Line
(
"Library Path: "
&
Get_Name_String
(
Default_Library_Path
));
end
Print_Status
;
-----------
-- Usage --
-----------
...
...
src/main/ocarina-utils.ads
View file @
603581e7
...
...
@@ -39,4 +39,6 @@ package Ocarina.Utils is
procedure
Usage
;
-- Display a message describing the usage of Ocarina
procedure
Print_Status
;
end
Ocarina
.
Utils
;
src/main/ocarina_cmd.adb
View file @
603581e7
...
...
@@ -69,7 +69,7 @@ with Ocarina.FE_AADL.Parser; use Ocarina.FE_AADL.Parser;
with
Ocarina
.
ME_REAL
.
Tokens
;
with
Ocarina
.
Scripts
;
use
Ocarina
.
Scripts
;
with
Ocarina
.
Utils
;
use
Ocarina
.
Utils
;
with
Ocarina
.
Python
;
use
Ocarina
.
Python
;
with
Ocarina
.
ME_AADL
.
AADL_Instances
.
Nodes
;
procedure
Ocarina_Cmd
is
...
...
@@ -633,7 +633,10 @@ procedure Ocarina_Cmd is
case
Getopt
(
"* aadlv1 aadlv2 help o: c d g: "
&
"r: real_lib: real_theorem: boundt_process: "
&
"disable-annexes=: "
&
"i p q v V s x t?"
)
is
&
"i p q v V s x t? z"
)
is
when
'z'
=>
Set_Current_Action
(
Python_Shell
);
when
'a'
=>
if
Full_Switch
=
"aadlv2"
then
...
...
@@ -788,6 +791,7 @@ procedure Ocarina_Cmd is
and
then
Get_Current_Action
/=
Show_Help
and
then
Get_Current_Action
/=
Shell
and
then
Get_Current_Action
/=
Parse_Scenario_Files_First
and
then
Get_Current_Action
/=
Python_Shell
then
Set_Current_Action
(
Show_Usage
);
...
...
@@ -862,10 +866,15 @@ begin
Ocarina_Shell
;
OS_Exit
(
0
);
when
Python_Shell
=>
Run_Python
;
OS_Exit
(
0
);
when
Parse_Scenario_Files_First
=>
Parse_Scenario_Files
;
Reset_Current_Action
;
Set_Current_Action
(
After_Scenario_Action
);
when
others
=>
null
;
end
case
;
...
...
@@ -909,8 +918,8 @@ begin
when
Generate_Code
=>
if
Get_Current_Backend_Name
=
Get_String_Name
(
"real_theorem"
)
or
else
Get_Current_Backend_Name
=
Get_String_Name
(
"real_pp"
)
then
or
else
Get_Current_Backend_Name
=
Get_String_Name
(
"real_pp"
)
then
AADL_Root
:=
Instantiate_Model
(
AADL_Root
);
Exit_On_Error
(
No
(
AADL_Root
),
"Cannot instantiate AADL models"
);
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment