I'm coming from C/C++ on embedded systems and all the time inside a function we use a static variable so that the value is retained throughout calls.
In Ada, it seems like this is only done with the equivalent of file-level static variables. Is there an Ada equivalent.
C++:
function Get_HW_Counter() {
static int count = 0;
return ++count;
}
Ada:??
Package level variables.
Note that packages are not necessarily at file level; you can even create and use a package local to a subprogram if you wish. One use of a package is to create an object and all the methods acting on it (singleton pattern); keeping all details of the object private.
If my understanding of C++ is not too rusty, a close equivalent would be:
package HW_Counter is
function Get_Next;
private
count : natural := 0; -- one way of initialising
-- or integer, allowing -ve counts for compatibility with C++
end HW_Counter;
and that's all the package's customer needs to see.
package body HW_Counter is
function Get_Next return natural is
begin
count := count + 1;
return count;
end Get_Next;
begin -- alternative package initialisation part
count := 0;
end HW_Counter;
And usage would typically be
C := HW_Counter.get_next;
Related
The following is an attempt to produce my problem with the minimum code (it is not intended to be a useful program).
My problem is that I want to make a precondition on a public function dependent on a private variable. I have to declare my function before the "private" indicator and my variables after that indicator. This means that I get the compilation error
problem.ads:10:16: "secondPrivateVariable" is undefined
problem.ads:10:40: "firstPrivateVariable" is undefined
I have tried putting placeholder definitions above the function, but then I get compilation errors about conflicting definitions.
package Problem is
pragma Elaborate_Body (Problem);
function publicAPI(which : Positive) return Natural with
Pre => secondPrivateVariable > firstPrivateVariable;
-- should only be called when second > first
private
-- the following variables are used by many procedures and
-- should be kept private
firstPrivateVariable : Natural := 7;
secondPrivateVariable : Natural := 465;
end Problem;
Any assistance would be welcomed.
You could wrap the check in a function:
function Call_Permitted return Boolean;
function publicAPI(which : Positive) return Natural with
Pre => Call_Permitted;
private
firstPrivateVariable : Natural := 7;
secondPrivateVariable : Natural := 465;
function Call_Permitted return Boolean is
(secondPrivateVariable > FirstPrivateVariable);
If Call_Permitted is only to be used locally and only to generate object code if assertions are enabled, you could say
function Call_Permitted return Boolean with Ghost;
(this is a SPARK-related feature, probably only available in GNAT)
I have the following code, related to the dining philosopher problem. I am very new to Ada so am not sure about how to implement the Id_Dispenser package.
with Ada.Text_IO; use Ada.Text_IO;
with Id_Dispenser;
with Semaphores; use Semaphores;
procedure Philos is
No_of_Philos : constant Positive := 5; -- Number of philosophers
Meditation : constant Duration := 0.0;
type Table_Ix is mod No_of_Philos;
Forks : array (Table_Ix) of Binary_Semaphore (Initially_Available => True);
package Index_Dispenser is new Id_Dispenser (Element => Table_Ix);
use Index_Dispenser;
task type Philo;
task body Philo is
Philo_Nr : Table_Ix; -- Philisopher number
begin
Dispenser.Draw_Id (Id => Philo_Nr);
Put_Line ("Philosopher" & Table_Ix'Image (Philo_Nr) & " looks for forks.");
Forks (Philo_Nr).Wait; delay Meditation; Forks (Philo_Nr + 1).Wait;
Put_Line ("Philosopher" & Table_Ix'Image (Philo_Nr) & " eats.");
Forks (Philo_Nr).Signal; Forks (Philo_Nr + 1).Signal;
Put_Line ("Philosopher" & Table_Ix'Image (Philo_Nr) & " dropped forks.");
end Philo;
Table : array (Table_Ix) of Philo; pragma Unreferenced (Table);
begin
null;
end Philos;
I have implemented the following semaphore, which I think should be correct
package body semaphores is
protected body Binary_Semaphore is
entry Wait when Count > 0 is
begin
Count := Count - 1;
end Wait;
entry Release when Count < 1 is
begin
Count := Count + 1;
end Signal
end Binary_Semaphore;
end semaphores;
What does the Id_Dispenser need?
Looking at your code,
type Table_Ix is mod No_of_Philos;
...
package Index_Dispenser is new Id_Dispenser (Element => Table_Ix);
we can tell that Id_Dispenser is a generic package with a formal type named Element, and that the formal type is modular:
generic
type Element is mod <>;
package Id_Dispenser is
This
Philo_Nr : Table_Ix; -- Philisopher number
begin
Dispenser.Draw_Id (Id => Philo_Nr);
tells us that Id_Dispenser has some sort of component called Dispenser with a subprogram Draw_Id with an out parameter named Id which returns an Element.
Now, since this is a concurrent program, I'm going to guess that Dispenser is a protected object:
protected Dispenser is
procedure Draw_Id (Id : out Element);
private
...
end Dispenser;
The private part could simply be an array of Boolean indexed by Element,
Available : array (Element) of Boolean := (others => True);
but unfortunately you can't have an anonymous array as a component, so you need a proper type, giving
generic
type Element is mod <>;
package Id_Dispenser is
type Availability is array (Element) of Boolean;
protected Dispenser is
procedure Draw_Id (Id : out Element);
private
Available : Availability := (others => True);
end Dispenser;
end Id_Dispenser;
I'm not happy that the type Availability is visible, but the package now just needs implementing (!)
We could make Availability invisible by making Id_Dispenser.Dispenser a package, with Availability and the actual PO declared in the body. But that may be getting a little too purist for Ben’s context.
Firstly, you shouldn't really shorten identifiers, so you should have task type Philosophers... You can always use a renaming later on.
Shouldn't you model the forks and the philosophers? Each Philosopher as a task (hint array of task types).
Look at protected objects to model the forks.
Id_dispenser needs to implement a Draw_ID method.
Since the Dispenser variable is not declared here, it must presumably be declared in Id_dispenser. This hidden declaration is not very good style, as you can see it causes confusion; I would use a qualified name to make it obvious where it came from, as Index_Dispenser.Dispenser (which can then be renamed to reduce clutter in the rest of the code).
Id_dispenser may also need to provide an object factory method to initialise the Dispenser variable at its declaration.
Or, the intent may be that Dispenser will be the only one of its type, in which case you can treat Id_dispenser as a singleton package with Dispenser as the only object.
How to write median & mode calculation function based on the group in mariadb ? So that i can use it in the query itself. My mariadb version version is 5.5.
While querying when i am using partition by clause i am getting error ? Can anybody suggest me any solution.
I recently encountered the same (or rather a similar) problem. I have not solved it, yet, but I am advancing towards a solution, which I will draft here.
User defined functions (UDFs) are written in C or C++ and have to be compiled to a shared library (*.so for *nix-Systems and *.dll for Windows). They follow a certain convention, which can be found out about in the MySQL manual. I've chosen a general quantile Approach, for it can easily return the median.
my_bool quantile_init(UDF_INIT *initid, UDF_ARGS *args, char *message)
{
INIT_BUFFER();
}
//the initialization for the *current group*
void quantile_clear(UDF_INIT *initid, char *is_null, char *error)
{
CLEAR_BUFFER();
num_elements=0;
ADD_TO_BUFFER(args);
num_elements++;
if(ISNAN(quantile_value))
quantile_value = GET_QUANTILE_VALUE(args); //should only be called once, for its assumed to be constant
}
//add groups item
void void quantile_add(UDF_INIT *initid, UDF_ARGS *args,
char *is_null, char *error)
{
ADD_TO_BUFFER(args);
num_elements++;
}
//very simple percentile calculation, may be flawed - just for presentation
double quantile(UDF_INIT *initid, UDF_ARGS *args,
char *is_null, char *error)
{
SORT_BUFFER();
return GET_BUFFER_AT(ROUNDDOWN(quantile_value * num_elements));
}
void quantile_deinit(UDF_INIT *initid)
{
CLEANUP();
}
To clarify the logic: MariaDB or MySQL first calls quantile_init in which all of your fancy initialization will take place (allocate buffers and so on). For each group that shall be aggregated the quantile_clear is called, in which you can reset the internal summary variables used and add the first value to the list. Now for each remaining row the quantile_add method is called, in which you would add the respective value. In the quantile function the quantile is calculated and returned.
After compilation as a shared library you can copy the file (libmylib.so/mylib.dll) to the plugins directory of your RDBS and load the function by calling
CREATE AGGREGATE FUNCTION quantile RETURNS REAL SONAME mylib
Now you should be able to use the function like
SELECT quantile(value, .5) FROM data GROUP BY category;
I've never undergone the whole procedure, hence all this information is of theoretical value, but according to the MySQL Manual it should work alike.
I am attempting to understand how to fix this circular dependency. All the examples I can find online suggest using a limited with, but then they demonstrate the use with two basic types, whereas this is a bit more advanced. The circular dependency is between the two files below. I thought it was between package Chessboard ... and the Piece type, but now I am not so sure. Attempting to put the package Chessboard ... line within chess_types.ads after the Piece type is declared and removing the use and with of Chessboard results in an error: this primitive operation is declared too late for the Move procedure. I am stuck on how to get out of this dependency. Any help would be much appreciated!
Thank you
chessboard.ads:
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
with Chess_Types;
use Chess_Types;
package Chessboard is new Indefinite_Vectors(Board_Index, Piece'Class);
chess_types.ads:
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
with Chessboard;
use Chessboard;
package Chess_Types is
subtype Board_Index is Integer range 1 .. 64;
type Color is (Black, White);
type Piece is tagged
record
Name : String (1 .. 3) := " ";
Alive : Boolean := False;
Team : Color;
Coordinate : Integer;
end record;
procedure Move_Piece(Board: in Vector; P: in Piece; Move_To: in Integer);
end Chess_Types;
More Code for question in comments:
Chess_Types.Piece_Types.ads:
package Chess_Types.Piece_Types is
type Pawn is new Piece with
record
First_Move : Boolean := True;
end record;
overriding
procedure Move_Piece(Board: in CB_Vector'Class; Po: in Pawn; Move_To: in Board_Index);
-- Other piece types declared here
end Chess_Types.Piece_Types;
Chess_Types.Piece_Types.adb:
with Ada.Text_IO;
use Ada.Text_IO;
package body Chess_Types.Piece_Types is
procedure Move_Piece(Board: in CB_Vector'Class; Po: in Pawn; Move_To: in Board_Index) is
Index_From, Index_To : Board_Index;
Move_From : Board_Index := Po.Coordinate;
begin
-- Obtain locations of Pawn to move from (Index_From) and to (Index_To)
-- in terms of the single dimension vector
for I in Board.First_Index .. Board.Last_Index loop
if Board.Element(I).Coordinate = Move_From then
Index_From := I;
end if;
if Board.Element(I).Coordinate = Move_To then
Index_To := I;
end if;
end loop;
-- Determine if the requested move is legal, and if so, do the move.
-- More possibilties to be entered, very primitive for simple checking.
if Move_To - Move_From = 2 and then Po.First_Move = True then
Board.Swap(I => Index_From, J => Index_To); -- "actual for "Container" must be a variable"
Board.Element(Index_From).First_Move := False; -- "no selector for "First_Move" for type "Piece'Class"
elsif Move_To - Po.Coordinate = 1 then
Board.Swap(Index_From, Index_To); -- "actual for "Container" must be a variable"
end if;
-- Test to make sure we are in the right Move_Piece procedure
Put_Line("1");
end Move_Piece;
-- Other piece type move_piece procedures defined here
end Chess_types.Piece_Types;
As a note to understand further, the Coordinate component of each piece correspond to ICCF numeric notation, which is two digits, so there needs to be some type of conversion between the vector and the ICCF notation, hence the reason for the whole for loop at the start.
This is a tough one. It looks like limited with and generics don't play nice together. The only way to make it work is to go back to using your own access type:
with Ada.Containers.Vectors;
use Ada.Containers;
limited with Chess_Types;
use Chess_Types;
package Chessboard_Package is
subtype Board_Index is Integer range 1 .. 64;
type Piece_Acc is access all Piece'Class;
package Chessboard is new Vectors(Board_Index, Piece_Acc);
end Chessboard_Package;
I had to put the instantiation into a new package, and move the Board_Index there too. Also, I changed it to Vectors since Piece_Acc is a definite type and there's no point in using Indefinite_Vectors. But in any event, this defeats the purpose. I'm just not sure Ada gives you a way to do what you want with two packages like this.
Even doing it in one package is not easy:
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
package Chess_Types is
subtype Board_Index is Integer range 1 .. 64;
type Color is (Black, White);
type Piece is tagged record ... end record;
type CB_Vector is tagged;
procedure Move_Piece (Board : in CB_Vector'Class;
P : in Piece;
Move_To : in Board_Index);
package Chessboard is new Indefinite_Vectors(Board_Index, Piece'Class);
type CB_Vector is new Chessboard.Vector with null record;
end Chess_Types;
This compiles, but I had to add extra stuff to get around some of the language rules (in particular, when you instantiate a generic, that "freezes" all prior tagged types so that you can no longer declare a new primitive operation of the type); also, I had to make the Board parameter a classwide type to avoid running into the rule about primitive operations of multiple tagged types.
As I understand it, this will do what you want.
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
package Chess_Types is
subtype Board_Index is Integer range 1 .. 64;
type Color is (Black, White);
type Piece is abstract tagged
record
Name : String (1 .. 3) := " ";
Alive : Boolean := False;
Team : Color;
Coordinate : Board_Index;
end record;
type Piece_Ptr is access all Piece'Class;
package Chessboard is new Indefinite_Vectors(Board_Index, Piece_Ptr);
procedure Move_Piece (Board : in Chessboard.Vector;
P : in Piece'Class;
Move_To : in Board_Index) is abstract;
end Chess_Types;
NOTES:
Piece is now abstract, as is the Move_Piece method. This will mean you now need to derive your other piece types (package piece_type-rook.ads, with a move_piece method for rook) etc...
Chessboard now contains pointers (Class wide pointers), beware allocating, deallocating, deep copy, shallow copy issues when using it.
You should now be able to call Move_Piece on any dereference of a piece_ptr and have it dispatch to the correct method.
The Move_To parameter is now the same type as the Board_Index. (Coordinate also brought in line) -- this seems a bit clunky, perhaps rethink this. (Row & Column Indices defining a 2D array perhaps? --No need for Indefinite_Vectors)
To answer the second question in the comment:
To use First_Move, the procedure has to know that it's a Pawn. If the object is declared with type Piece'Class, you can't access components that are defined only for one of the derived types. (That's true in most OO languages.) This may indicate a flaw in your design; if you have a procedure that takes a Piece'Class as a parameter, but you want to do something that makes sense only for a Pawn, then maybe you should add another operation to your Piece that does a default action for most pieces (perhaps it does nothing) and then override it for Pawn. Other possibilities are to use a type conversion:
procedure Something (P : Piece'Class) is ...
if Pawn(P).First_Move then ...
which will raise an exception if P isn't a Pawn. If you want to test first, you can say "if P in Pawn". I sometimes write code like:
if P in Pawn then
declare
P_Pawn : Pawn renames Pawn(P);
begin
if P_Pawn.First_Move then ...
end;
end if;
But defining a new polymorphic operation is preferable. (Note: I haven't tested the above code, hope I didn't make a syntax error somewhere.)
I use TCL 8.4 and for that version I need to add a new mathematical function into TCL interpreter by using TCL library function, particularly Tcl_CreateMathFunc. But I could not find a single example of how it can be done. Please could you write for me a very simple example, assuming that in the C code you have a Tcl_Interp *interp to which you should add a math function (say, a function that multiplies two double numbers).
I once did some alternative implementations of random number generators for Tcl and you can look at some examples at the git repository. The files in generic implement both a tcl command and a tcl math function for each PRNG.
So for instance in the Mersenne Twister implementation, in the package init function we add the new function to the interpreter by declaring
Tcl_CreateMathFunc(interp, "mt_rand", 1, (Tcl_ValueType *)NULL, RandProc, (ClientData)state);
this registers the C function RandProc for us. In this case the function takes no arguments but the seeding equivalent (srand) shows how to handle a single parameter.
/*
* A Tcl math function that implements rand() using the Mersenne Twister
* Pseudo-random number generator.
*/
static int
RandProc(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
{
State * state = (State *)clientData;
if (! (state->flags & Initialized)) {
unsigned long seed;
/* This is based upon the standard Tcl rand() initializer */
seed = time(NULL) + ((long)Tcl_GetCurrentThread()<<12);
InitState(state, seed);
}
resultPtr->type = TCL_DOUBLE;
resultPtr->doubleValue = RandomDouble(state);
return TCL_OK;
}
Be aware that this is an API that is very unlikely to survive indefinitely (for reasons such as its weird types, inflexible argument handling, and the inability to easily use it from Tcl itself). However, here's how to do an add(x,y) with both arguments being doubles:
Registration
Tcl_ValueType types[2] = { TCL_DOUBLE, TCL_DOUBLE };
Tcl_CreateMathFunc(interp, "add", 2, types, AddFunc, NULL);
Implementation
static int AddFunc(ClientData ignored, Tcl_Interp *interp,
Tcl_Value *args, Tcl_Value *resultPtr) {
double x = args[0].doubleValue;
double y = args[1].doubleValue;
resultPtr->doubleValue = x + y;
resultPtr->type = TCL_DOUBLE;
return TCL_OK;
}
Note that because this API is always working with a fixed number of arguments to the function (and argument type conversions are handled for you) then the code you write can be pretty short. (Writing it to be type-flexible with TCL_EITHER — only permissible in the registration/declaration — makes things quite a lot more complex, and you really are stuck with a fixed argument count.)