Ada is a programming language created in 1980 by Jean Ichbiah.
| #50on PLDB | 44Years Old | 5kRepos |
Ada is a structured, statically typed, imperative, wide-spectrum, and object-oriented high-level computer programming language, extended from Pascal and other languages. It has built-in language support for design-by-contract, extremely strong typing, explicit concurrency, offering tasks, synchronous message passing, protected objects, and non-determinism. Ada improves code safety and maintainability by using the compiler to find errors in favor of runtime errors. Read more on Wikipedia...
-- This pragma will remove the warning produced by the default
-- CE filename and the procedure name differing,
-- see : https://gcc.gnu.org/onlinedocs/gcc-8.2.0/gnat_rm/Pragma-Source_005fFile_005fName.html#Pragma-Source_005fFile_005fName
pragma Source_File_Name (Square, Body_File_Name => "example.adb");
-- Type your code here, or load an example.
function Square(num : Integer) return Integer is
begin
return num**2;
end Square;
-- Ada 2012 also provides Expression Functions
-- (http://www.ada-auth.org/standards/12rm/html/RM-6-8.html)
-- as a short hand for functions whose body consists of a
-- single return statement. However they cannot be used as a
-- compilation unit.
-- function Square(num : Integer) return Integer is (num**2);
with Ada.Text_IO;
procedure Main is
begin
Ada.Text_IO.Put_Line("Hello, world!");
end Main;
with Ada.Text_IO;
procedure Hello_World is
use Ada.Text_IO;
begin
Put_line ("Hello World");
end Hello_World;
-- Hello World in Ada
with Text_IO;
procedure Hello_World is
begin
Text_IO.Put_Line("Hello World!");
end Hello_World;
with Ada.Text_IO; use Ada.Text_IO;
procedure Traffic is
type Airplane_ID is range 1..10; -- 10 airplanes
task type Airplane (ID: Airplane_ID); -- task representing airplanes, with ID as initialisation parameter
type Airplane_Access is access Airplane; -- reference type to Airplane
protected type Runway is -- the shared runway (protected to allow concurrent access)
entry Assign_Aircraft (ID: Airplane_ID); -- all entries are guaranteed mutually exclusive
entry Cleared_Runway (ID: Airplane_ID);
entry Wait_For_Clear;
private
Clear: Boolean := True; -- protected private data - generally more than just a flag...
end Runway;
type Runway_Access is access all Runway;
-- the air traffic controller task takes requests for takeoff and landing
task type Controller (My_Runway: Runway_Access) is
-- task entries for synchronous message passing
entry Request_Takeoff (ID: in Airplane_ID; Takeoff: out Runway_Access);
entry Request_Approach(ID: in Airplane_ID; Approach: out Runway_Access);
end Controller;
-- allocation of instances
Runway1 : aliased Runway; -- instantiate a runway
Controller1: Controller (Runway1'Access); -- and a controller to manage it
------ the implementations of the above types ------
protected body Runway is
entry Assign_Aircraft (ID: Airplane_ID)
when Clear is -- the entry guard - calling tasks are blocked until the condition is true
begin
Clear := False;
Put_Line (Airplane_ID'Image (ID) & " on runway ");
end;
entry Cleared_Runway (ID: Airplane_ID)
when not Clear is
begin
Clear := True;
Put_Line (Airplane_ID'Image (ID) & " cleared runway ");
end;
entry Wait_For_Clear
when Clear is
begin
null; -- no need to do anything here - a task can only enter if "Clear" is true
end;
end Runway;
task body Controller is
begin
loop
My_Runway.Wait_For_Clear; -- wait until runway is available (blocking call)
select -- wait for two types of requests (whichever is runnable first)
when Request_Approach'count = 0 => -- guard statement - only accept if there are no tasks queuing on Request_Approach
accept Request_Takeoff (ID: in Airplane_ID; Takeoff: out Runway_Access)
do -- start of synchronized part
My_Runway.Assign_Aircraft (ID); -- reserve runway (potentially blocking call if protected object busy or entry guard false)
Takeoff := My_Runway; -- assign "out" parameter value to tell airplane which runway
end Request_Takeoff; -- end of the synchronised part
or
accept Request_Approach (ID: in Airplane_ID; Approach: out Runway_Access) do
My_Runway.Assign_Aircraft (ID);
Approach := My_Runway;
end Request_Approach;
or -- terminate if no tasks left who could call
terminate;
end select;
end loop;
end;
task body Airplane is
Rwy : Runway_Access;
begin
Controller1.Request_Takeoff (ID, Rwy); -- This call blocks until Controller task accepts and completes the accept block
Put_Line (Airplane_ID'Image (ID) & " taking off...");
delay 2.0;
Rwy.Cleared_Runway (ID); -- call will not block as "Clear" in Rwy is now false and no other tasks should be inside protected object
delay 5.0; -- fly around a bit...
loop
select -- try to request a runway
Controller1.Request_Approach (ID, Rwy); -- this is a blocking call - will run on controller reaching accept block and return on completion
exit; -- if call returned we're clear for landing - leave select block and proceed...
or
delay 3.0; -- timeout - if no answer in 3 seconds, do something else (everything in following block)
Put_Line (Airplane_ID'Image (ID) & " in holding pattern"); -- simply print a message
end select;
end loop;
delay 4.0; -- do landing approach...
Put_Line (Airplane_ID'Image (ID) & " touched down!");
Rwy.Cleared_Runway (ID); -- notify runway that we're done here.
end;
New_Airplane: Airplane_Access;
begin
for I in Airplane_ID'Range loop -- create a few airplane tasks
New_Airplane := new Airplane (I); -- will start running directly after creation
delay 4.0;
end loop;
end Traffic;abort else new return abs elsif not reverse abstract end null accept entry select access exception of separate aliased exit or some all others subtype and for out synchronized array function overriding at tagged generic package task begin goto pragma terminate body private then if procedure type case in protected constant interface until is raise use declare range delay limited record when delta loop rem while digits renames with do mod requeue xor| Feature | Supported | Example | Token |
|---|---|---|---|
| Scientific Notation | ✓ | ||
| Fixed Point Numbers | ✓ | ||
| Integers | ✓ | -- [0-9_]+ | |
| Floats | ✓ | -- [0-9_]+\.[0-9_]* | |
| Hexadecimals | ✓ | -- [0-9_]+#[0-9a-f_\.]+# | |
| Conditionals | ✓ | ||
| Functions | ✓ | ||
| While Loops | ✓ | ||
| Booleans | ✓ | True False | |
| Strings | ✓ | "Hello world" | " |
| Assignment | ✓ | := | |
| Print() Debugging | ✓ | Text_IO.Put_Line | |
| Line Comments | ✓ | -- A comment | -- |
| Case Insensitive Identifiers | ✓ | with Gnat.Io; use Gnat.Io; procedure Numbers is Score: Integer; F: Float := 1.0; begin Score := 3 + 2#1011#; Put(score); New_Line; Score := Score + 1_000_000; Put(Score); New_Line; end Numbers; | |
| Operator Overloading | ✓ | ||
| Directives | ✓ | ||
| Comments | ✓ | -- A comment | |
| Generics | ✓ | generic Max_Size : Natural; -- a generic formal value type Element_Type is private; -- a generic formal type; accepts any nonlimited type package Stacks is type Size_Type is range 0 .. Max_Size; type Stack is limited private; procedure Create (S : out Stack; Initial_Size : in Size_Type := Max_Size); procedure Push (Into : in out Stack; Element : in Element_Type); procedure Pop (From : in out Stack; Element : out Element_Type); Overflow : exception; Underflow : exception; private subtype Index_Type is Size_Type range 1 .. Max_Size; type Vector is array (Index_Type range <>) of Element_Type; type Stack (Allocated_Size : Size_Type := 0) is record Top : Index_Type; Storage : Vector (1 .. Allocated_Size); end record; end Stacks; | |
| Pointers | ✓ | ||
| Case Sensitivity | X | ||
| Semantic Indentation | X | ||
| MultiLine Comments | X |